Named Pipes funktionieren nicht zwischen DLL und Programm

[hitzi]

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

[SirThornberry]

bei wm_copydata kommt nichts an? hast du eventuell PostMessage anstelle von SendMessage verwendet um die Message zu versenden?

[hitzi]

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?

[hitzi]

Da ich nun doch nochmal versuchen will das WM_COPYDATA zum Laufen zu bekommen, geht's hier weiter -> http://www.delphipraxis.net/internal...t.php?t=121628