unit UnitDllMain;

interface

uses windows,Unitwjshook,Sysutils,dialogs;

const
   MappingFileName = 'Mapping File Comm DLL';

type
  TShareMem = packed record
    ComPortFile:array[0..255] of char;
    FileHandle:THandle;
    DatToWriteFile:array[0..255] of char;
    DatToReadFile:array[0..255] of char;
    MessageHook: HHOOK;
  end;
  PShareMem = ^TShareMem;

procedure StartHook(FileBeSpy,readfile,writefile:pchar); stdcall;
procedure StopHook; stdcall;
procedure DllEntry(nReason : integer);

implementation

var
  pShMem : PShareMem;
  hMappingFile : THandle;
  hook:array[0..3]of HookStruct;
  FirstProcess:boolean;

function NewCreateFileA(lpFileName: PChar;dwDesiredAccess: Integer;dwShareMode: Integer;
   lpSecurityAttributes: PSecurityAttributes;dwCreationDisposition: DWORD;dwFlagsAndAttributes: DWORD;
   hTemplateFile: THandle): THandle;stdcall;
type
  TCreateFileA=function(lpFileName: PChar;dwDesiredAccess: Integer;dwShareMode: Integer;
   lpSecurityAttributes: PSecurityAttributes;dwCreationDisposition: DWORD;dwFlagsAndAttributes: DWORD;
   hTemplateFile: THandle): THandle;stdcall;
begin
   result:=TCreateFileA(hook[0].OldFunction)(lpFileName,dwDesiredAccess,dwShareMode,
      lpSecurityAttributes,dwCreationDisposition,dwFlagsAndAttributes,
      hTemplateFile);
   if stricomp(lpFileName,pShMem^.ComPortFile)=0 then
   begin
      pShMem^.FileHandle:=result;
   end;
end;

procedure SaveForWriteFile(const s;bytes:dword);
var
   h:integer;
begin
   if bytes=0 then exit;
   if fileexists(pShMem^.DatToWriteFile) then
   begin
      h:=fileopen(pShMem^.DatToWriteFile,fmOpenWrite);
      fileseek(h,0,2);
   end
   else h:=filecreate(pShMem^.DatToWriteFile);
   if h=-1 then exit;
   FileWrite(h,s,bytes);
   FileClose(h);
end;

function NewWriteFile(hFile: THandle;const Buffer;nNumberOfBytesToWrite: DWORD;
   var lpNumberOfBytesWritten: DWORD;lpOverlapped: POverlapped): BOOL;stdcall;
type
  TWriteFile=function(hFile: THandle;const Buffer;nNumberOfBytesToWrite: DWORD;
   var lpNumberOfBytesWritten: DWORD;lpOverlapped: POverlapped): BOOL;stdcall;
begin
   result:=TWriteFile(hook[1].OldFunction)(hFile,Buffer,nNumberOfBytesToWrite,lpNumberOfBytesWritten,lpOverlapped);
   if hFile=pShMem^.FileHandle then
      SaveForWriteFile(buffer,nNumberOfBytesToWrite);  //????  lpNumberOfBytesWritten);
end;

procedure SaveForReadFile(const s;bytes:dword);
var
   h:integer;
begin
   if bytes=0 then exit;
   if fileexists(pShMem^.DatToReadFile) then
   begin
      h:=fileopen(pShMem^.DatToReadFile,fmOpenWrite);
      fileseek(h,0,2);
   end
   else h:=filecreate(pShMem^.DatToReadFile);
   if h=-1 then exit;
   FileWrite(h,s,bytes);
   FileClose(h);
end;

function NewReadFile(hFile: THandle;var Buffer;nNumberOfBytesToRead: DWORD;
   var lpNumberOfBytesRead: DWORD;lpOverlapped: POverlapped): BOOL;stdcall;
type
  TReadFile=function(hFile: THandle;var Buffer;nNumberOfBytesToRead: DWORD;
   var lpNumberOfBytesRead: DWORD;lpOverlapped: POverlapped): BOOL;stdcall;
begin
   result:=TReadFile(hook[2].OldFunction)(hFile,Buffer,nNumberOfBytesToRead,lpNumberOfBytesRead,lpOverlapped);
   if hFile=pShMem^.FileHandle then
      SaveForReadFile(buffer,lpNumberOfBytesRead);
end;

function NewCloseHandle(hObject:THandle):BOOL;stdcall;
type
  TCloseHandle=function(hObject:THandle):BOOL;stdcall;
begin
   if (pShMem^.FileHandle=hObject)and(hObject<>INVALID_HANDLE_VALUE) then
   begin
      pShMem^.FileHandle:=INVALID_HANDLE_VALUE;
   end;
   result:=TCloseHandle(hook[3].OldFunction)(hObject);
end;

function GetMsgProc(iCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;export;
begin
  Result := CallNextHookEx(pShmem^.MessageHook, iCode, wParam, lParam);
end;

procedure StartHook(FileBeSpy,readfile,writefile:pchar); stdcall;
begin
   strlcopy(pShMem^.DatToWriteFile,writefile,255);
   strlcopy(pShMem^.DatToReadFile,readfile,255);
   strlcopy(pShMem^.ComPortFile,FileBeSpy,255);
   pShmem^.MessageHook:=SetWindowsHookEx(WH_GETMESSAGE, GetMsgProc, HInstance, 0);
end;

procedure StopHook; stdcall;
begin
   if pShmem^.MessageHook=0 then exit;
   UnhookWindowsHookEx(pShmem^.MessageHook);
   pShmem^.MessageHook:=0;
end;

procedure DllEntry(nReason : integer);
begin
  case nReason Of
    DLL_PROCESS_ATTACH:
    begin
        hMappingFile := OpenFileMapping(FILE_MAP_WRITE,False,MappingFileName);
        if hMappingFile=0 then
        begin
           hMappingFile := CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,SizeOf(TShareMem),MappingFileName);
           FirstProcess:=true;
        end
        else FirstProcess:=false;
        if hMappingFile=0 then Exception.Create('不能建立共享內存!');

        pShMem :=  MapViewOfFile(hMappingFile,FILE_MAP_WRITE or FILE_MAP_READ,0,0,0);
        if pShMem = nil then
        begin
           CloseHandle(hMappingFile);
           Exception.Create('不能映射共享內存!');
        end;
        if FirstProcess then
        begin
           pShmem^.MessageHook:=0;
           pShMem^.FileHandle:=INVALID_HANDLE_VALUE;
        end;
        //注意：getprocaddress(getmodulehandle('kernel32'),'CreateFileA')<>@CreateFileA
        //雖然它們都指向Kernel32的CreateFileA的代碼，在本例中也可以用getprocaddress...，但必須注意大小寫
        hook[0].OldFunction:=FinalFunctionAddress(@CreateFileA);
        hook[0].NewFunction:=FinalFunctionAddress(@NewCreateFileA);
        HookAPIFunction(hook[0]);

        hook[1].OldFunction:=FinalFunctionAddress(@WriteFile);
        hook[1].NewFunction:=FinalFunctionAddress(@NewWriteFile);
        HookAPIFunction(hook[1]);

        hook[2].OldFunction:=FinalFunctionAddress(@ReadFile);
        hook[2].NewFunction:=FinalFunctionAddress(@NewReadFile);
        HookAPIFunction(hook[2]);

        hook[3].OldFunction:=FinalFunctionAddress(@CloseHandle);
        hook[3].NewFunction:=FinalFunctionAddress(@NewCloseHandle);
        HookAPIFunction(hook[3]);
    end;
    DLL_PROCESS_DETACH:
    begin
        UnHookAPIFunction(hook[0]);
        UnHookAPIFunction(hook[1]);
        UnHookAPIFunction(hook[2]);
        UnHookAPIFunction(hook[3]);
        UnMapViewOfFile(pShMem);
        CloseHandle(hMappingFile);
    end;
  end;
end;

end.