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.

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.