Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Win32/Win64 API (native code) (https://www.delphipraxis.net/17-win32-win64-api-native-code/)
-   -   Delphi Kontextmenü soll mehrere Dateien einem Pragramm schicken (https://www.delphipraxis.net/110195-kontextmenue-soll-mehrere-dateien-einem-pragramm-schicken.html)

binio 14. Mär 2008 13:42


Kontextmenü soll mehrere Dateien einem Pragramm schicken
 
Hallo ich suche eine Lösung das mir wie man es von ZIP oder Antivir her kennt.
Meine bisherige Lösung ist addRegKey('.hbs','text vom kontextmenü','"/c:/angriff.exe" "%1" "modus=eins"')
Somit wird wenn jemand im Explorer 2 Dateien auswählt und mein KOntextmenüeintrag auswählt 2 mal meine angriff.exe gestartet.
Was ich aber nicht möchte.
Ich will das nur einmal meine angriff.exe starten und mit den 2 ausgewählten Dateien als Parameter aufgerufen wird.
Sodas ich in meiner angriff.exe die eine oder mehrere Parameter abarbeiten kann.
Es sollen bis zu 100 Dateien(Parameter) übergeben werden sollen.
Wie sicht der dazugehörige Registryeintrag aus ??

[edit=SirThornberry]Titel korrigiert - Mfg, SirThornberry[/edit]

s-off 14. Mär 2008 14:06

Re: Kontextmenü soll mehrere Dateien einen Pragramm schicken
 
Hallo,

guckst Du hier

Lasse2002 20. Mär 2008 13:04

Re: Kontextmenü soll mehrere Dateien einen Pragramm schicken
 
Die Methode vom SwissDelphiCenter scheint aber auch das Programm 100 mal zu starten, wenn der Anwender 100 Dateien ausgewählt hat. Bei so vielen Dateien ist es besser, das ganze per IDropTarget zu machen. Weil dann wird deine Anwendung nur ein einziges mal gestartet, egal wieviele Dateien der Benutzer ausgewählt hat.

Luckie 21. Mär 2008 14:15

Re: Kontextmenü soll mehrere Dateien einen Pragramm schicken
 
Zitat:

Zitat von Lasse2002
Die Methode vom SwissDelphiCenter scheint aber auch das Programm 100 mal zu starten, wenn der Anwender 100 Dateien ausgewählt hat.

Dann muss man das Programm so bauen, dass es mu einmal gestartet werden kann und bei jedem weiteren Start seine Paramter an die erste Instanz übergibt.

binio 9. Apr 2008 15:14

Re: Kontextmenü soll mehrere Dateien einen Pragramm schicken
 
Hmmm das Programm erfüllt auch nicht richtig das was es soll.
Also ich verstehe das IDropTarget auch nicht so richtig.
Gibt es da nicht ein einfachen Registry Eintrag ?
Hab geguckt ob ich für Winamp oder Antivir das so ein Menü hat was finde. Die Registry will mir aber nicht so wirklich helfen :o(

gmc616 10. Apr 2008 13:42

Re: Kontextmenü soll mehrere Dateien einen Pragramm schicken
 
Ich kenne keinen Registry-Eintrag dafür.

Du muß dafür sorgen, so wie Luckie schreibt, dass dein Programm nur ein mal startet.
Hier im Forum suchenMutex ist hier das Stichwort.
Schlägt das Erstellen des Mutex fehl, heißt das i.a.R., dass dein Programm bereits läuft.
In diesem Fall mußt du nur dafür sorgen, das der/die Parameter, mit dem dein Programm gerufen wurde, an das bereits laufende Programm gesendet wird.

In einem meiner alten Projekte hab ich das in der *.dpr so in etwa gelöst:
Delphi-Quellcode:
const
  cProgrammname = 'Dein Programmname';
  // alternativ bevorzuge ich einen GUID (STRG+SHIFT+G in der IDE drücken)
  cProgrammName = '{ACE3F9C0-C0E3-443A-9C04-A3F98F6578F1}';

  cFormCaption = 'Dein Fenstertitel';

var
  dwMutex  : DWORD;
  dwMessage : DWORD;
  hWindow  : DWORD;
  cdWork   : TcsCopyDataStruct

begin

  dwMessage := RegisterWindowMessage(GUID_Message);

  dwMutex  := CreateMutex(nil,true,cProgrammname);

  if GetLastError <> ERROR_ALREADY_EXISTS then
  begin
    Application.Initialize;
    Application.CreateForm(TForm, Form1);
    Application.Run;
  end
  else
  begin
    hWindow := FindWindow(nil,cFormCaption);
    if hWindow <> 0 then
    begin
      if (paramcount > 0) and FileExists(paramstr(1)) then
      begin

        cdWork.dwData := dwMessage;
        cdWork.cbData := Length(paramstr(1))+1;
        cdWork.lpData := AllocMem(cdWork.cbData);

        try
          CopyMemory(cdWork.lpData,@paramstr(1)[1],cdWork.cbData-1);
          SendMessage(hWindow,WM_COPYDATA,0,lParam(@cdWork));
        finally
          FreeMem(cdWork.lpData,cdWork.cbData);
        end;
      end;
    end;
  end;

  if dwMutex <> 0 then
  begin
    CloseHandle(dwMutex);
  end;
Zum Empfangen der Daten hab ich die WinProc der MainForm (Form1) überschrieben. In etwa so:
Delphi-Quellcode:
procedure TForm1.WndProc(var msg: TMessage);
var
  dwLen    : DWORD;
  cdWork   : PcsCopyDataStruct;
begin
  if msg.Msg = WM_COPYDATA then
  begin
    cdWork := PcsCopyDataStruct(msg.lParam);
    if cdWork.dwData = dwMessage then
    begin
      // Dein Code ... z.B.
      ShowMessage (PChar(cdWork.lpData));      
    end else
      inherited WndProc(msg);

  end else
    inherited WndProc(msg);
Ich hoffe der Code funktioniert so noch...

Natürlich mut du noch im FormCreate der Form1 auf paramstr(1) prüfen, damit auch das erste Starten des Programms die Parameter berücksichtigt.

Vielleicht hilfts :stupid:

Edit: Code geändernt!
Hab grade eben erst gemerkt, das die DP meine spitzen Klammern aus dem Code heraus formatiert.

binio 10. Apr 2008 14:27

Re: Kontextmenü soll mehrere Dateien einen Pragramm schicken
 
Wau da bin ich erstmal total von Fremdwörtern und fremdfunktionen überschüttet :o(
Das ist ja hammer. Ich denke ich werde ordentlich Zeit dafür brauchen um es zu verstehen.
Sieht aber ganz Betriebssystem nah aus. Also mit @ und co habe ich noch nie programmiert.
Was sollte den dein Programm eigentlich machen ????
kannst du mir vieleicht die .pas , .dfm und .dpr als Persönliche Nachricht schicken ?
Ich schreibe für Blinde ein Programm das es ermöglicht normale Bücher ein zu scannen und in Punktschrift umzuformatieren. Der User soll also später mehrere *.jpg im Windows Explorer auswählen können und es zur verarbeitung an das Programm schicken. Würde mich über weiter Hilfe sehr freuen

Danke schonmal für den Quelltext

_frank_ 11. Apr 2008 00:16

Re: Kontextmenü soll mehrere Dateien einen Pragramm schicken
 
Liste der Anhänge anzeigen (Anzahl: 1)
ich hab den code von gmc616 bisschen modifiziert (hat eine weile gedauert, bis das mit dem Restore geklappt hat) ;)

vielleicht findet es ja noch platz in der codelib...

Gruß Frank

gmc616 11. Apr 2008 00:40

Re: Kontextmenü soll mehrere Dateien einen Pragramm schicken
 
Danke Frank :thumb:

Das wollte ich zwar grad selbst machen, hatte bis jetzt nur keine Zeit gefunden.
Aber so isses auch gut. Brauch ich mir nicht die Arbeit machen. :-D
Dein Code sieht eh besser aus als meiner. :stupid:

Nur eine Sache:
Für RegisterWindowMessage und CreateMutex verwende ich zwei unterschiedliche GUIDs.
Sollte aber keinen Unterschied machen.

Hab eben erst gemerkt, dass die DP spitze Klammern heraus filtert bzw. nicht "reinfiltert".
In meinen Team verwenden wir spitze Klammern um den anderen zu zeigen, dass an dieser Stelle noch etwas zu ergänzen ist. Ich glaube, dass das irgendeiner Syntax-Beschreibung entspricht. In nem HTML-Code macht sich das natürlich doof. :wall:


Zitat:

Zitat von binio
Was sollte den dein Programm eigentlich machen ????

Naja, was so ein MP3-Player halt machen können soll. Mehrere MP3-Dateien in den Player laden.
Da macht es sich natürlich blöd, wenn für jede MP3 ein neuer Player gestartet wird.
Das ganze über einen eigenen Menü-Punkt im Explorer-Kontextmenü, um dort auszuwählen in welcher Liste die Dateien letzen Endes landen sollen.

Zitat:

Zitat von binio
Danke schonmal für den Quelltext

Kein Problem! :zwinker:
Hab mir damals den Code mehr oder weniger hier in der DP zusammen gesucht.
Schön, wenn man der DP mal etwas wieder geben kann.

:dp:

_frank_ 11. Apr 2008 00:44

Re: Kontextmenü soll mehrere Dateien einen Pragramm schicken
 
ich denke, auf das registerMessage kann man auch verzichten.
Es wird ja nur als kenner für das WM_CopyData verwendet, aber nicht ausgewertet. Von daher eigentlich sinnlos...die Unterscheidung, ob es wirklich die selbe anwendung ist, wird in dem Code ja anders gemacht (application.exename).
für Anregungen bin ich offen :)

Gruß Frank

gmc616 11. Apr 2008 00:55

Re: Kontextmenü soll mehrere Dateien einen Pragramm schicken
 
Ja, stimmt.
Die Message verwende ich an andere Stelle, aber für einen ähnlichen Zweck.
In diesem Fall ist sie sinnlos.

Wie gesagt: Der Code ist schon etwas alt und stammt noch aus meinen Bastelzeiten mit Delphi.

binio 16. Apr 2008 08:08

Re: Kontextmenü soll mehrere Dateien einen Pragramm schicken
 
Sehe ich das richtig das ich mit dem Programmcode alles das erreichen kann was ich wollte ?
Also die Aufrufe können dann so zu sagen aus der Liste nach und nach abgearbeitet werden ??
Oder fehlt da noch ein Stück Programmcode ?

Danke schonmal für den Quelltext der sehr einfach zu verstehen ist :o)

binio 16. Apr 2008 08:15

Re: Kontextmenü soll mehrere Dateien einen Pragramm schicken
 
Ich habe die *.exe gerade mal getestet. wenn ich 2 Textdateien markiere und dann sage öffnen mit und meine *.exe auswähle kommt nur eins der beiden Textdateien in die Liste des Programms...
Ich teste das gleich sofort mal wenn ich das per Registry eintrag mache, vieleicht ist da was anders.

_frank_ 16. Apr 2008 11:32

Re: Kontextmenü soll mehrere Dateien einen Pragramm schicken
 
ich habs mit drag&drop auf die exe probiert, hätte gedacht, es ist das gleiche, jedoch bekomme ich beim öffnen per kontextmenü nen Verschieben-Dialog :gruebel:, die Dateien werden aber richtig in die anwendung aufgenommen. der reg-eintrag ist korrekt...

Gruß Frank

_frank_ 25. Apr 2008 17:50

Re: Kontextmenü soll mehrere Dateien einen Pragramm schicken
 
hat jemand eine Idee, warum es nicht so funktioniert, wie gewünscht?

*push*

Gruß Frank

_frank_ 29. Apr 2008 18:04

Re: Kontextmenü soll mehrere Dateien einem Pragramm schicken
 
ich hab den thread mal mit ins DF gestellt...
http://www.delphi-forum.de/viewtopic...=499934#499934

Gruß Frank

orion3000 30. Apr 2008 11:40

Re: Kontextmenü soll mehrere Dateien einem Pragramm schicken
 
Hallo binio, versuchsmal mit folgender lib.

Hier die Projektdatei
Code:
library ExtKontextMenu;

uses
  Windows,
  ComServ,
  untMain in 'untMain.pas';

// Bildressource einbinden
// 12 x 12 Pixel
// Name = ExtKontextMenu oder ein anderer Name
{$R ExtKontextMenu.res}

exports
  DllGetClassObject,
  DllCanUnloadNow,
  DllRegisterServer,
  DllUnregisterServer;

begin
end.

Hier die dazu gehörende Unit.

Code:
unit untMain;

interface

uses
  ComServ, SysUtils, ShellAPI, Registry, Classes, Windows, ActiveX, ComObj, ShlObj, Graphics, Dialogs;

// Die GUID wird für die eindeutige Registrierung der Shell-Erweiterung benötigt
const
  GUID_ExtKontextMenuShellExt: TGUID = '{E8308BE3-0C9A-4429-9A3C-3F06E778C2DC}';

type
  ExtKontextMenuShellExt = class(TComObject, IShellExtInit, IContextMenu)
    protected
      function IShellExtInit.Initialize = SEInitialize;
      function SEInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject; hKeyProgID: HKEY): HResult; stdcall;
      function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast, uflags: UINT): HResult; stdcall;
      function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
      function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult; stdcall;
  end;

implementation

var
  // Aufnahme der selektierten Dateinamen
  FFileName: array[0..MAX_PATH] of Char;
  // für das Bild im Kontextmenü
  hBmp: TBitmap;

type
  ExtKontextMenuShellExtFactory = class(TComObjectFactory)
    public
      procedure UpdateRegistry(Register: boolean); override;
  end;

// wird aufgerufen, um einen Hilfetext zum Menü abzufragen, z. B. beim Überfahren
// des Menüs im Explorer wird in dessen Statuszeile dieser Text angezeigt
function ExtFKontextMenuShellExt.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
  pszName: LPSTR; cchMax: UINT): HResult;
begin
  Result := S_OK;
  try

  if(idCmd = 0) then
  begin
    if(uType = GCS_HELPTEXT) then
      StrCopy(pszName, 'Extern KontextMenu');

    Result := NOERROR;
  end
  else
    Result := E_INVALIDARG;

  except
    Result := E_UNEXPECTED;
  end;
end;

// wird aufgerufen, wenn ein Menüpunkt des Kontextmenüs gewählt wurde
function ExtKontextMenuShellExt.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
begin
  Result := E_FAIL;
  if (HiWord(Integer(lpici.lpVerb)) <> 0) then // kein Anwendungsaufruf
    Exit;

  // überprüfe den Index (0..Anzahl Menüpunkte - 1)
  if LoWord(lpici.lpVerb) > 4 then
  begin
    Result := E_INVALIDARG;
    Exit;
  end;

  // Hier könntest mit Hilfe einer Tstrinliste alle ausgewählten Datei(en) / Ordner in
     einen gesonderten Pfad, wie X:\windows\Filelst.dat speichern, diese dann mit Shellexecute
     als Parameter übergeben!      

  // Zeige je nach gewählten Menüpunkt eine Info an
  case LoWord(lpici.lpVerb) of
    0: ShowMessage('Menüpunkt 1');
    1: ShowMessage('Menüpunkt 2');
    3: ShowMessage('Menüpunkt 3');
  end;

  Result := NOERROR;
end;

// wird aufgerufen, wenn das Kontextmenü erstellt werden soll
// es wird dann in das Kontextmenü des Explorers integriert
function ExtKontextMenuShellExt.QueryContextMenu(Menu: HMENU; indexMenu,
  idCmdFirst, idCmdLast, uflags: UINT): HResult;
var
  hMnu: HMENU;
  hMnu2: HMENU;
  vReg: TRegistry;
  Idx: Integer;
  mii: TMenuItemInfo;
begin
  if ((uFlags and $0000000F) = CMF_NORMAL) or ((uFlags and CMF_EXPLORE) <> 0) or
     ((uFlags and CMF_VERBSONLY) <> 0) then // VERBS -- auch für Desktop-Icons
  begin
    // ffg. Menüstruktur soll erzeugt werden =>
    // ExtKontextMenü   - Hauptmenüeintrag (kein Index) - kann keine Aktion auslösen
    //   Menüpunkt 1   - Index 0
    //   Menüpunkt 2   - Index 1
    //   Menüpunkt 4   - hier kommt ein weiteres Untermenü (Index 2 - kann aber keine Aktion auslösen)
    //     Untermenü   - Index 3

    hMnu := CreatePopupMenu();
    AppendMenu(hMnu, MF_STRING, idCmdFirst, 'Menüpunkt 1');
    AppendMenu(hMnu, MF_STRING, idCmdFirst + 1, 'Menüpunkt 2');

    // Untermenü erzeugen - dies hat dann den "virtuellen" Index von 2
    hMnu2 := CreatePopupMenu();
    // das ist der dritte Menüpunkt
    AppendMenu(hMnu2, MF_STRING, idCmdFirst + 3, 'Untermenü');

    // Das Untermenü erhält den Text Menüpunkt 4
    mii.cbSize    := sizeof(TMenuItemInfo);
    mii.fMask     := MIIM_SUBMENU or MIIM_STRING or MIIM_ID;
    mii.wID       := idCmdFirst + 2;
    mii.hSubMenu  := hMnu2;
    mii.dwTypeData := PAnsiChar('Untermenü');
    InsertMenu(hMnu, idCmdFirst + 2, MF_STRING or MF_BYPOSITION or MF_POPUP, hMnu2, 'Menüpunkt 4'); // 2

    mii.cbSize    := sizeof(TMenuItemInfo);
    mii.fMask     := MIIM_SUBMENU or MIIM_STRING or MIIM_ID;
    mii.wID       := idCmdFirst + 4;
    mii.hSubMenu  := hMnu;
    mii.dwTypeData := PAnsiChar('DF KontextMenü');

    // die folgenden Anweisungen sind wichtig, damit das Bild korrekt erscheint.
    InsertMenuItem(Menu, indexMenu, True, mii);

    if hBmp.Handle <> 0 then
      SetMenuItemBitmaps(Menu, indexMenu, MF_BYPOSITION, hBmp.Handle, hBmp.Handle);

    Result := 4 // Anzahl der zusätzlichen Menüpunkte
  end
  else
    Result := 0;
end;

// es können 1-n Dateien/Ordner markiert werden, wenn ein Menüpunkt aufgerufen
// wird - hier werden diese Dateien ermittelt
function ExtKontextMenuShellExt.SEInitialize(pidlFolder: PItemIDList;
  lpdobj: IDataObject; hKeyProgID: HKEY): HResult;
var
  StgMedium: TStgMedium;
  FormatEtc: TFormatEtc;
  Idx: Integer;
begin
  if (lpdobj = nil) then
  begin
    Result := E_INVALIDARG;
    Exit;
  end;

  with FormatEtc do
  begin
    cfFormat := CF_HDROP;
    ptd     := nil;
    dwAspect := DVASPECT_CONTENT;
    lindex  := -1;
    tymed   := TYMED_HGLOBAL;
  end;

  Result := lpdobj.GetData(FormatEtc, StgMedium);
  if Failed(Result) then
    Exit;

  // alle ausgewählten Dateien ermitteln
  for Idx := 0 to DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, nil, 0) - 1 do
  begin
    DragQueryFile(StgMedium.hGlobal, Idx, FFileName, SizeOf(FFileName));
    // hier können die Dateinamen eingesammelt werden, z. B.
    // StringListe.Add(FFileName);
  end;

  ReleaseStgMedium(StgMedium);
  Result := NOERROR;
end;

// Hier legen Sie die Einträge in der Registrierung fest
procedure ExtKontextMenuShellExtFactory.UpdateRegistry(Register: boolean);
var
  ClassID: string;
begin
  if Register then
  begin
    inherited UpdateRegistry(Register);

    ClassID := GUIDToString(GUID_ExtKontextMenuShellExt);

    // Die Shell-Erweiterung wird hier für Ordner (Folder) registriert
    // Der Text DFKontextMenu ist frei wählbar und charakterisier die eigene Erweiterung
    CreateRegKey('Folder\shellex', '', '');
    CreateRegKey('Folder\shellex\ContextMenuHandlers', '', '');
    CreateRegKey('Folder\shellex\ContextMenuHandlers\DFKontextMenu', '', ClassID);

    // Die Shell-Erweiterung wird hier für alle Dateien registriert
    // ansonsten muss statt des Sterns (alle Dateien) die konkrete Dateiendung
    // stehen, z. B. '.zip'
    // Der Text DFKontextMenu ist frei wählbar und charakterisier die eigene Erweiterung
    CreateRegKey('*\shellex', '', '');
    CreateRegKey('*\shellex\ContextMenuHandlers', '', '');
    CreateRegKey('*\shellex\ContextMenuHandlers\DFKontextMenu', '', ClassID);

    // Shell-Erweiterung als "genehmigt" eintragen
    if (Win32Platform = VER_PLATFORM_WIN32_NT) then
      with TRegistry.Create do
        try
          RootKey := HKEY_LOCAL_MACHINE;
          OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions', True);
          OpenKey('Approved', True);
          WriteString(ClassID, 'DFKontextMenu');
        finally
          Free;
        end;
  end
  else
  begin
    // wird die Shell-Erweiterung wieder entfernt, werden die Einträge der
    // Registrierung gelöscht
    DeleteRegKey('Folder\shellex\ContextMenuHandlers\ExternKontextMenu');
    DeleteRegKey('Folder\shellex\ContextMenuHandlers');
    DeleteRegKey('Folder\shellex');

    DeleteRegKey('*\shellex\ContextMenuHandlers\ExternKontextMenu');
    DeleteRegKey('*\shellex\ContextMenuHandlers');
    DeleteRegKey('*\shellex');

    inherited UpdateRegistry(Register);
  end;
end;

initialization
  // hier wird die Erweiterung registriert
  ExtKontextMenuShellExtFactory.Create(ComServer, ExtKontextMenuShellExt, GUID_ExtKontextMenuShellExt,
    '', 'DFKontextMenu', ciMultiInstance, tmApartment);
  // Bitmap erzeugen
  hBmp := TBitmap.Create;
  // Bild aus Ressourcendatei laden (der Name der Bildressource muss als 2. Parameter angegeben
  // werden - auf keinen Fall den DefaultNamen belassen, den der Bildeditor vergibt!
  hBmp.LoadFromResourceName(hInstance, 'DFKONTEXTMENU');
finalization
  // Bitmap wieder freigeben
  hBmp.Free;
end.
Du musst nur noch die passende Resource ersetellen, siehe Projektdatei ($R ExtKontextMenu.res).

Habe den Quellcode jetzt nicht überarbeitet, das müsstest du in folge tun!

nachdem Kompilieren muß nur noch die DLL mit Regsvr32 registriert werden.



Gruß
Orion3000

binio 30. Apr 2008 12:13

Re: Kontextmenü soll mehrere Dateien einem Pragramm schicken
 
Ok hab nun fast das was ich mir wünsche:
Delphi-Quellcode:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,ShellAPI;

type stack1 = class
  public
    zeiger: Integer;
    wert: array[0..200] of String[255];
    procedure ini();
    procedure push(value:String);
    function pop():String;
    function gettop():String;
end;

const
  WM_FormActivate=WM_USER+10;

type
  TSingleInstanceFrm = class(TForm)
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
    procedure WMCopyData(var Msg: TWMCopyData); message WM_COPYDATA;
    procedure ProcessFilename(fName:string);
  public
    { Public-Deklarationen }
  end;

var
  SingleInstanceFrm: TSingleInstanceFrm;
  Stack: stack1;
  status: boolean =false;

implementation

{$R *.DFM}

procedure stack1.ini();
begin
  zeiger:=0;
end;

procedure stack1.push(value:String);
var both: boolean;
i: integer;
begin
  both:=false;
  if (zeiger<200) then
  begin
    for i:=0 to zeiger do
    begin
      if (value = wert[i]) then both:=true;
    end;
    if (both <> true) then
    begin
      wert[zeiger]:=value;
      zeiger:=zeiger+1;
    end;
  end;
end;

function stack1.pop():String;
begin
  if (zeiger>0) then
  begin
    zeiger:=zeiger-1;
    Result:=wert[zeiger];
  end
  else
    Result:='';
end;


function stack1.gettop(): String;
begin
  if (zeiger>0) AND (zeiger<200) then Result:=wert[zeiger-1];
end;

procedure TSingleInstanceFrm.WMCopyData(var Msg: TWMCopyData);
var s:array[0..max_path-1] of Char;
begin
  StrLCopy(s,Msg.CopyDataStruct.lpData, Msg.CopyDataStruct.cbData);
  ProcessFilename(s);
end;

procedure TSingleInstanceFrm.ProcessFilename(fName:string);
var
   SEInfo: TShellExecuteInfo;
   ExitCode: DWORD;
   ExecuteFile, ParamString, StartInString: string;
begin
   ExecuteFile:='c:\sleep.exe';

   repeat
    if status=false then
    begin
      status:=true;
      FillChar(SEInfo, SizeOf(SEInfo), 0);
      SEInfo.cbSize := SizeOf(TShellExecuteInfo);
      with SEInfo do begin
        fMask := SEE_MASK_NOCLOSEPROCESS;
        Wnd := Application.Handle;
        lpFile := PChar(ExecuteFile);
        {
        ParamString can contain the
        application parameters.
        }
        //lpParameters := PChar(Stack.pop()) ;
{
StartInString specifies the
name of the working directory.
If ommited, the current directory is used.
}
// lpDirectory := PChar(StartInString) ;
        nShow := SW_SHOWNORMAL;
      end;
      if ShellExecuteEx(@SEInfo) then
      begin
        repeat
          Application.ProcessMessages;
          GetExitCodeProcess(SEInfo.hProcess, ExitCode);
        until (ExitCode <> STILL_ACTIVE) or Application.Terminated;
        ShowMessage('Calculator terminated');
        Stack.pop();
        status:=false;
      end
      else
        ShowMessage('Error starting Calc!');
    end
    else
      Stack.push(fName);
   until Stack.zeiger = 0;
   showmessage('FERTIG. Programm wird Beendet');
   SingleInstanceFrm.Close;
end;


  {
  Stack.push(fName);

  for i:=0 to Stack.zeiger-1 do
  begin
    showmessage('Stackzähler:'+inttostr(i));
    showmessage('Stackinhalt:'+Stack.wert[i]);
  end;
  ListBox1.Items.Add(fName);
  ShellExecute(SingleInstanceFrm.Handle, nil, 'c:\sleep.exe', nil, nil, SW_SHOWNORMAL);
  //ShellExecute(SingleInstanceFrm.Handle, nil, pchar(fName), nil, nil, SW_SHOWNORMAL);
  //ExecuteFile(fName);
end;                  }

procedure TSingleInstanceFrm.FormCreate(Sender: TObject);
begin
  Stack:=stack1.create;
  if ParamStr(1)<>'' then
    ProcessFilename(ParamStr(1));
end;

end.
Dejoch gibt es da noch 2 Probleme.
Er Beendet das Projekt nicht
Delphi-Quellcode:
   showmessage('FERTIG. Programm wird Beendet');
   SingleInstanceFrm.Close;
Und bleibt hängen wenn die Exe 2 mal aufgerufen wird.
Also die sleep.exe ist ein Programm das einfach 10 Sekunden was macht und sich dann Beendet.
Somit teste ich ob erst nachdem ich die Sleep.exe beendet habe die nächte abarbeitung stattfinden kann.
Ich denke ich bin kurz vorm Ziel nur fehlt hier noch der letzte Schliff.

Würde mich sehr über Hilfe freuen


Alle Zeitangaben in WEZ +1. Es ist jetzt 03:46 Uhr.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz