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