Delphi-PRAXiS - Delphi Named Pipes funktionieren nicht zwischen DLL und Programm

Hallo,

ich spiel grad ein biss'l mit Hooks rum ;) Das funktioniert soweit auch alles (getestet mit Messageboxen). Nun möchte ich aber die Ausgabe über die Messageboxen abschaffen und dafür die Werte an das Hauptprogramm über Named Pipes schicken (erste versuch war mit WM_COPYDATA, aber das hatte auch schon nicht funktioniert - keine Fehlermeldung es kamen nur keine Daten an). Das Problem dabei ist, dass keine Daten bei dem Hauptprogramm ankommen. Ausgelöst wird die Funktion aber (Messageboxtest).

Schwer zu erklären, weil der Sender in einer DLL steckt. Deshalb hab ich mal das komplette Projekt auch an diese Nachricht angehangen. Seht ihr da einen Fehler?

Mein Betriebssystem ist Vista Business, wenn das eine Rolle spielt.

Code Hauptprogramm:

Delphi-Quellcode:

			unit uMain;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, ExtCtrls, StdCtrls, uallHook, uallProcess, uallUtil, uallKernel;

type

  TfrmMain = class(TForm)

    lbl1: TLabel;

    tmrSearchCondor: TTimer;

    mmo1: TMemo;

    procedure FormCreate(Sender: TObject);

    procedure tmrSearchCondorTimer(Sender: TObject);

    procedure FormDestroy(Sender: TObject);

  private

    { Private-Deklarationen }

    fCondorPID : DWord;

    fInjected : Boolean;

    fDontWork : Boolean;

    fPipeHandle : Cardinal;

    procedure SearchCondor;

    procedure InjectMyFunctions;

    procedure UnloadMyFunctions;

    function GetDebugPrivileges : Boolean;

    procedure WriteText(s : string);

    procedure ReadData;

    procedure CreateMyPipe;

  public

    { Public-Deklarationen }

  end;

var

  frmMain: TfrmMain;

implementation

{$R *.dfm}

type

  Tmydata = packed record

       whichFunction : Byte;

       lpFileName : PChar;

       lpFileNameA : PAnsiChar;

       lpFileNameW: PWideChar;

       dwDesiredAccess : DWORD;

       dwShareMode : DWORD;

  end;

const cCondorApplication = 'condor.exe';

      cinjComFuntionsDLL = 'injComFunctions.dll';

      cPipeName = '\\.\pipe\CondorCOM';

var myData : TMydata;

procedure TfrmMain.WriteText(s : string);

begin

  mmo1.Lines.Add(DateTimeToStr(now) + ':> ' + s);

end;

procedure TfrmMain.ReadData;

var 

   buffer: ShortString;

   dw    : dword; 

begin 

   ReadFile(fPipeHandle, buffer, sizeof(buffer), dw, nil);

   if dw > 0 then WriteText(buffer);

end;

procedure TfrmMain.CreateMyPipe;

var 

   FSA : SECURITY_ATTRIBUTES;

   FSD : SECURITY_DESCRIPTOR; 

begin 

   InitializeSecurityDescriptor(@FSD, SECURITY_DESCRIPTOR_REVISION); 

   SetSecurityDescriptorDacl(@FSD, True, nil, False); 

   FSA.lpSecurityDescriptor := @FSD; 

   FSA.nLength := sizeof(SECURITY_ATTRIBUTES); 

   FSA.bInheritHandle := True; 

   fpipeHandle:= CreateFile(PChar(cPipeName),

                     GENERIC_READ or GENERIC_WRITE, 

                     0, 

                     @FSA, 

                     OPEN_EXISTING, 

                     0, 

                     0); 

end;

procedure TfrmMain.InjectMyFunctions;

begin

  if not fInjected then begin

    CreateMyPipe;

    if InjectLibrary(fCondorPID, PChar(GetExeDirectory + cinjComFuntionsDLL)) then fInjected := True;

  end;

end;

procedure TfrmMain.UnloadMyFunctions;

begin

  if fInjected then begin

    UnloadLibrary(fCondorPID, PChar(GetExeDirectory + cinjComFuntionsDLL));

    fInjected := False;

  end;

end;

procedure TfrmMain.SearchCondor;

begin

  fCondorPID := FindProcess(cCondorApplication);

  if fCondorPID <> 0 then begin

    lbl1.Caption := 'Condor is running!';

    InjectMyFunctions;

  end else begin

    lbl1.Caption := 'Condor isn''t running!';

  end;

  if fInjected and (fPipeHandle <> 0) then begin

    ReadData;

  end;

end;

procedure TfrmMain.FormDestroy(Sender: TObject);

begin

  CloseHandle(fPipeHandle);

  UnloadMyFunctions;

end;

function TfrmMain.GetDebugPrivileges : Boolean;

begin

  Result := False;

  if not SetDebugPrivilege(SE_PRIVILEGE_ENABLED) then begin

    Application.MessageBox('No Debug rights!', 'Error', MB_OK);

  end else begin

    Result := True;

  end;

end;

procedure TfrmMain.FormCreate(Sender: TObject);

begin

  fInjected := False;

  fpipeHandle := 0;

  fDontWork := not GetDebugPrivileges;

  tmrSearchCondor.Enabled := not fDontWork;

end;

procedure TfrmMain.tmrSearchCondorTimer(Sender: TObject);

begin

  tmrSearchCondor.Enabled := False;

  SearchCondor;

  tmrSearchCondor.Enabled := True;

end;

end.

Code der DLL:

Delphi-Quellcode:

			library injComFunctions;

uses

  windows, uallHook, SysUtils;

const cPipeName = '\\.\pipe\CondorCOM';

type Tmydata = packed record

       whichFunction : Byte;

       lpFileName : PChar;

       lpFileNameA : PAnsiChar;

       lpFileNameW: PWideChar;

       dwDesiredAccess : DWORD;

       dwShareMode : DWORD;

     end;

var

  nextCreateFile, oldCreateFile : function(lpFileName: PChar; dwDesiredAccess, dwShareMode: DWORD;

                 lpSecurityAttributes: PSecurityAttributes; dwCreationDisposition, dwFlagsAndAttributes: DWORD;

                 hTemplateFile: THandle): THandle; stdcall;

  nextCreateFileA, oldCreateFileA : function(lpFileName: PAnsiChar; dwDesiredAccess, dwShareMode: DWORD;

                          lpSecurityAttributes: PSecurityAttributes; dwCreationDisposition, dwFlagsAndAttributes: DWORD;

                          hTemplateFile: THandle): THandle; stdcall;

  nextCreateFileW, oldCreateFileW : function(lpFileName: PWideChar; dwDesiredAccess, dwShareMode: DWORD;

                          lpSecurityAttributes: PSecurityAttributes; dwCreationDisposition, dwFlagsAndAttributes: DWORD;

                          hTemplateFile: THandle): THandle; stdcall;

  pipeHandle : Cardinal;

  myData : Tmydata;

  FSA: SECURITY_ATTRIBUTES; 

  FSD: SECURITY_DESCRIPTOR;

procedure SendToApp(whichFunction : Byte; lpFileName : PChar; lpFileNameA : PAnsiChar; lpFileNameW : PWideChar; dwDesiredAccess, dwShareMode : DWORD);

var 

   buffer: ShortString; 

   dw    : dword; 

begin 

   buffer:= 'Test';

   WriteFile(pipeHandle, buffer, length(buffer), dw, nil);

   MessageBoxA(0,lpFileNameA,'Msg',0);

  {myData.whichFunction := whichFunction;

  myData.lpFileName := lpFileName;

  myData.lpFileNameA := lpFileNameA;

  myData.lpFileNameW := lpFileNameW;

  myData.dwDesiredAccess := dwDesiredAccess;

  myData.dwShareMode := dwShareMode;

  //WriteFile(pipeHandle, myData, SizeOf(TmyData), dwLen, nil);

  s := 'bingo';

  Mode := PIPE_READMODE_MESSAGE or PIPE_WAIT;

  SetNamedPipeHandleState(pipeHandle, Mode, nil, nil);

  TransactNamedPipe(pipeHandle, @s[1], inCount, @s[1], Length(s), outCount, nil);}

end;

function myCreateFile(lpFileName: PChar; dwDesiredAccess, dwShareMode: DWORD;

                 lpSecurityAttributes: PSecurityAttributes; dwCreationDisposition, dwFlagsAndAttributes: DWORD;

                 hTemplateFile: THandle): THandle; stdcall;

begin

  SendToApp(0, lpFileName, nil, nil, dwDesiredAccess, dwShareMode);

  Result := nextCreateFile(lpFileName, dwDesiredAccess, dwShareMode,

                 lpSecurityAttributes, dwCreationDisposition, dwFlagsAndAttributes,

                 hTemplateFile);

end;

function myCreateFileA(lpFileName: PAnsiChar; dwDesiredAccess, dwShareMode: DWORD;

                          lpSecurityAttributes: PSecurityAttributes; dwCreationDisposition, dwFlagsAndAttributes: DWORD;

                          hTemplateFile: THandle): THandle; stdcall;

begin

  SendToApp(1, nil, lpFileName, nil, dwDesiredAccess, dwShareMode);

  Result := nextCreateFileA(lpFileName, dwDesiredAccess, dwShareMode,

                          lpSecurityAttributes, dwCreationDisposition, dwFlagsAndAttributes,

                          hTemplateFile);

end;

function myCreateFileW(lpFileName: PWideChar; dwDesiredAccess, dwShareMode: DWORD;

                          lpSecurityAttributes: PSecurityAttributes; dwCreationDisposition, dwFlagsAndAttributes: DWORD;

                          hTemplateFile: THandle): THandle; stdcall;

begin

  SendToApp(2, nil, nil, lpFileName, dwDesiredAccess, dwShareMode);

  Result := nextCreateFileW(lpFileName, dwDesiredAccess, dwShareMode,

                          lpSecurityAttributes, dwCreationDisposition, dwFlagsAndAttributes,

                          hTemplateFile);

end;

procedure InjectMain;

var kernelHandle : Integer;

begin

  InitializeSecurityDescriptor(@FSD, SECURITY_DESCRIPTOR_REVISION); 

  SetSecurityDescriptorDacl(@FSD, True, nil, False); 

  FSA.lpSecurityDescriptor := @FSD; 

  FSA.nLength := sizeof(SECURITY_ATTRIBUTES); 

  FSA.bInheritHandle := True; 

  pipeHandle := CreateNamedPipe(PChar(cPipeName),

                          PIPE_ACCESS_DUPLEX or FILE_FLAG_WRITE_THROUGH, 

                          PIPE_TYPE_MESSAGE or PIPE_READMODE_MESSAGE or PIPE_NOWAIT, 

                          PIPE_UNLIMITED_INSTANCES, 

                          1024, 

                          1024, 

                          50, 

                          @FSA); 

  @oldCreateFile := nil;

  @oldCreateFileA := nil;

  @oldCreateFileW := nil;

  kernelHandle := GetModuleHandle('kernel32.dll');

  if kernelHandle > 0 then begin

    @oldCreateFile := GetProcAddress(kernelHandle,'CreateFile');

    if @oldCreateFile <> nil then HookCode(@oldCreateFile, @myCreateFile, @nextCreateFile);

    @oldCreateFileA := GetProcAddress(kernelHandle,'CreateFileA');

    if @oldCreateFileA <> nil then HookCode(@oldCreateFileA, @myCreateFileA, @nextCreateFileA);

    @oldCreateFileW := GetProcAddress(kernelHandle,'CreateFileW');

    if @oldCreateFileW <> nil then HookCode(@oldCreateFileW, @myCreateFileW, @nextCreateFileW);

  end;

end;

procedure UnInjectMain;

begin

  if @oldCreateFile <> nil then UnhookCode(@nextCreateFile);

  if @oldCreateFileA <> nil then UnhookCode(@nextCreateFileA);

  if @oldCreateFileW <> nil then UnhookCode(@nextCreateFileW);

  CloseHandle(pipeHandle);

end;

procedure DllMain(dwReason: DWord);

begin

  case dwReason of

    DLL_PROCESS_ATTACH: begin

                          InjectMain;

                          MessageBoxA(0,PChar('Loaded :'+Paramstr(0)),'Msg',0);

                        end;

    DLL_PROCESS_DETACH: begin

                          UnInjectMain;

                          //MessageBoxA(0,PChar('Unloaded :'+Paramstr(0)),'Msg',0);

                        end;

  end;

end;

begin

  DllProc := @DllMain;

  DllMain(DLL_PROCESS_ATTACH);

end.

Viele Grüße

Bei WM_COPYDATA hab ich mich an dem TrafficCounter Beispiel von der uallCollection gehalten. Aber selbst mit dem Beispiel funktioniert es nicht - also es wird nichts angezeigt, da keine Daten beim Hauptprogramm ankommen. Mir wäre es ja auch am liebsten, wenn ich WM_COPYDATA verwenden könnte.

Source Beispiel Hauptprogramm:

Delphi-Quellcode:

			unit main;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, Grids, uallProcess, uallHook, uallUtil, StdCtrls;

type

  TForm1 = class(TForm)

    trafficgrid: TStringGrid;

    Label1: TLabel;

    procedure FormCreate(Sender: TObject);

    procedure WMNOTIFYCD(var Msg: TWMCopyData); message WM_COPYDATA;

    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

  private

    { Private-Deklarationen }

  public

    { Public-Deklarationen }

  end;

var

  Form1: TForm1;

implementation

{$R *.dfm}

type Tmydata = packed record

      exe: array[0..60] of char;

      prid: integer;

      datacount: integer;

      ind: boolean;

     end;

var notclosed: Boolean = true;

    gesamt: longint = 0;

    mydata: TMydata;

procedure TForm1.WMNOTIFYCD(var Msg: TWMCopyData);

var exeanz: string;

begin

  if Msg.CopyDataStruct^.cbData = sizeof(TMydata) then

  begin

    CopyMemory(@myData,Msg.CopyDataStruct^.lpData,sizeof(TMyData));

    gesamt := gesamt+mydata.datacount;

    label1.Caption := 'transfered: '+inttostr(Gesamt);

    exeanz := mydata.exe+' '+inttostr(mydata.prid);

    if trafficgrid.Cols[0].IndexOf(exeanz) = -1 then

    begin

      trafficgrid.Cells[0,trafficgrid.RowCount-1] := exeanz;

      if mydata.ind then

        trafficgrid.Cells[1,trafficgrid.RowCount-1] :=

          inttostr(strtointdef(trafficgrid.Cells[1,trafficgrid.RowCount-1],0)+mydata.datacount) else

        trafficgrid.Cells[2,trafficgrid.RowCount-1] :=

          inttostr(strtointdef(trafficgrid.Cells[2,trafficgrid.RowCount-1],0)+mydata.datacount);

      trafficgrid.RowCount := trafficgrid.RowCount+1;

    end else

    begin

      trafficgrid.Cells[0,trafficgrid.Cols[0].IndexOf(exeanz)] := exeanz;

      if mydata.ind then

        trafficgrid.Cells[1,trafficgrid.Cols[0].IndexOf(exeanz)] :=

          inttostr(strtointdef(trafficgrid.Cells[1,trafficgrid.Cols[0].IndexOf(exeanz)],0)+mydata.datacount) else

        trafficgrid.Cells[2,trafficgrid.Cols[0].IndexOf(exeanz)] :=

          inttostr(strtointdef(trafficgrid.Cells[2,trafficgrid.Cols[0].IndexOf(exeanz)],0)+mydata.datacount);

    end;

  end;

end;

function ProcessSearch(p: pointer): integer;

var listpr, listmd: TStringList;

    i, j: integer;

    addtopr: boolean;

begin

  listpr := TStringlist.Create;

  listmd := TStringlist.Create;

  while notclosed do

  begin

    listpr.text := uallProcess.FindAllProcesses;

    for i := 0 to listpr.Count-1 do

    begin

      listmd.Text := uallProcess.FindModulesInProcess(PChar(listpr[i]));

      addtopr := true;

      for j := 0 to listmd.count-1 do

      begin

        if pos('TRAFFICREAD',uppercase(listmd[j])) > 0 then

          addtopr := false;

      end;

      if addtopr then

        uallHook.InjectLibrary(uallProcess.FindProcess(PChar(listpr[i])),

                               pchar(uallUtil.GetExeDirectory+'trafficread.dll'));

    end;

    sleep(1000);

  end;

  listmd.free;

  listpr.free;

  result := 0;

end;

procedure TForm1.FormCreate(Sender: TObject);

var tidpr: cardinal;

begin

  BeginThread(nil,0,@ProcessSearch,nil,0,tidpr);

//  InjectLibrary(FindProcess('firefox.exe'),

//    pchar(uallUtil.GetExeDirectory+'trafficread.dll'));

  trafficgrid.Cells[0,0] := 'program executable';

  trafficgrid.Cells[1,0] := 'in';

  trafficgrid.Cells[2,0] := 'out';

  trafficgrid.ColWidths[0] := 400;

  trafficgrid.ColWidths[1] := 80;

  trafficgrid.ColWidths[2] := 80;

end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

  notclosed := false;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  uallHook.GlobalUnloadLibrary('trafficread.dll');

end;

end.

Source DLL:

Delphi-Quellcode:

			library trafficread;

uses

  windows, 

  uallHook in '..\..\uallHook.pas',

  uallUtil in '..\..\uallUtil.pas',

  uallDisasm in '..\..\uallDisasm.pas',

  uallDisasmEx in '..\..\uallDisasmEx.pas',

  uallProcess in '..\..\uallProcess.pas',

  uallKernel in '..\..\uallKernel.pas';

const

  WM_COPYDATA         = $004A;

type Tmydata = packed record

      exe: array[0..60] of char;

      prid: integer;

      datacount: integer;

      ind: boolean;

     end;

var

  oldsendto, nextsendto: function(s: dword; var Buf; len, flags: Integer; var addrto: dword;

                                  tolen: Integer): Integer; stdcall;

  oldsend, nextsend: function(s: dword; var Buf; len, flags: Integer): Integer; stdcall;

  oldrecv, nextrecv: function(s: dword; var Buf; len, flags: Integer): Integer; stdcall;

  oldrecvfrom, nextrecvfrom: function(s: dword; var Buf; len, flags: Integer;

                      var from: dword; var fromlen: Integer): Integer; stdcall;

  CDS: TCopyDataStruct;

  winh: integer;

  mydata: TMyData;

  lenstr: cardinal;

procedure sendapp(len: integer; indata: boolean);

begin

  ZeroMemory(@mydata.exe[0],61);

  lenstr := GetModuleFilenameA(GetModuleHandleA(nil),@mydata.exe[0],50);

  mydata.prid := GetCurrentProcessID;

  mydata.datacount := len;

  mydata.ind := indata;

  SendMessageA(winh,WM_COPYDATA,0,cardinal(@CDS));

end;

function myrecvfrom(s: dword; var Buf; len, flags: Integer;

                      var from: dword; var fromlen: Integer): Integer; stdcall;

begin

  sendapp(len,true);

  result := nextrecvfrom(s,buf,len,flags,from,fromlen);

end;

function myrecv(s: dword; var Buf; len, flags: Integer): Integer; stdcall;

begin

  sendapp(len,true);

  result := nextrecv(s,buf,len,flags);

end;

function mysend(s: dword; var Buf; len, flags: Integer): Integer; stdcall;

begin

  sendapp(len,false);

  result := nextSend(s,buf,len,flags);

end;

function mysendto(s: dword; var Buf; len, flags: Integer; var addrto: dword;

  tolen: Integer): Integer; stdcall;

begin

  sendapp(len,false);

  result := nextSendTo(s,buf,len,flags,addrto,tolen);

end;

procedure injectmain;

var h: integer;

    usr: integer;

begin

  @oldsendto := nil;

  @oldsend := nil;

  @oldrecvfrom := nil;

  @oldrecv := nil;

  usr := GetModuleHandle('user32.dll');

  h :=  GetModuleHandle('wsock32.dll');

  CDS.dwData := 0;

  CDS.cbData := sizeof(TMyData);

  CDS.lpData := @mydata;

  if (h > 0) and (usr > 0) then

  begin

    winh := FindWindowA(nil,'ShowTraffic');

    @oldsendto := GetProcAddress(h,'sendto');

    if @oldsendto <> nil then

      uallHook.HookCode(@oldsendto, @mysendto, @nextsendto);

    @oldsend := GetProcAddress(h,'send');

    if @oldsend <> nil then

      uallHook.HookCode(@oldsend, @mysend, @nextsend);

    @oldrecv := GetProcAddress(h,'recv');

    if @oldrecv <> nil then

      uallHook.HookCode(@oldrecv, @myrecv, @nextrecv);

    @oldrecvfrom := GetProcAddress(h,'recvfrom');

    if @oldrecvfrom <> nil then

      uallHook.HookCode(@oldrecvfrom, @myrecvfrom, @nextrecvfrom);

  end;

end;

procedure uninjectmain;

begin

  if @oldsendto <> nil then

    uallHook.UnhookCode(@nextsendto);

  if @oldsend <> nil then

    uallHook.UnhookCode(@nextsend);

  if @oldrecv <> nil then

    uallHook.UnhookCode(@nextrecv);

  if @oldrecvfrom <> nil then

    uallHook.UnhookCode(@nextrecvfrom);

end;

procedure dllmain(dwReason: integer);

begin

  case dwreason of

    DLL_PROCESS_ATTACH:

      injectmain;

    DLL_PROCESS_DETACH:

      uninjectmain;

  end;

end;

begin

  DLLProc := @DLLMain;

  DLLMain(1);

end.

[EDIT]

Zwischen zwei normalen Anwendungen funktioniert die Kommunikation über WM_COPYDATA. Bei Bedarf kann ich den dazu gehörigen Quelltext auch noch dranhängen.
Also scheint das Problem das Injektieren der DLL in einen anderen Prozess zu sein. Kommt das jemanden bekannt vor und kennt dazu die Lösung?