Einzelnen Beitrag anzeigen

Benutzerbild von binio
binio

Registriert seit: 25. Nov 2005
Ort: Werl, Iserlohn, Dortmund, Hagen
85 Beiträge
 
Delphi 2006 Professional
 
#18

Re: Kontextmenü soll mehrere Dateien einem Pragramm schicken

  Alt 30. Apr 2008, 13:13
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
if(copy_paste==false)
Programmierer=Hilflos;
  Mit Zitat antworten Zitat