pbhook.dpr

三层的通用架构

library pbhook;

{ Important note about DLL memory management: ShareMem must be the
  first unit in your library's USES clause AND your project's (select
  Project-View Source) USES clause if your DLL exports any procedures or
  functions that pass strings as parameters or function results. This
  applies to all strings passed to and from your DLL--even those that
  are nested in records and classes. ShareMem is the interface unit to
  the BORLNDMM.DLL shared memory manager, which must be deployed along
  with your DLL. To avoid using BORLNDMM.DLL, pass string information
  using PChar or ShortString parameters. }

uses
  Windows,
  SysUtils,
  Messages,
  Classes;

type
  PMapData = ^TMapData;
  TMapData = packed record
    AppHandle, ActiveHandle: HWND;
    AppFlag, PBFlag: Byte;
    Data: array [0..1024] of Char;
  end;

const
  StrForMessage = 'BckjByWfs.Message';

var
  FMessageID: Cardinal;
  hFileMap: THandle;
  hMapView: PMapData;
  MainHandle: HWND;
  FWProc: Pointer;
  SQLCAParas: TStringList;
  LibName, WindowName: string;

{$R *.res}

function WndProcHook(Handle: HWND; Msg: Cardinal; wParam, lParam: Longint): Longint; stdcall;
begin
  if IsWindow(hMapView^.AppHandle) then
    PostMessage(hMapView^.AppHandle, FMessageID, 0, 0)
  else
    PostMessage(MainHandle, WM_CLOSE, 0, 0);
  if Msg = FMessageID then
  begin
    if (wParam = 1) and (lParam >= 0) and (lParam <= 8) then
    begin
      while SQLCAParas.Count < lParam + 1 do
        SQLCAParas.Add('');
      SQLCAParas[lParam] := PChar(@hMapView^.Data[0]);
    end;
    if wParam = 2 then
    begin
      if lParam = 1 then
        LibName := PChar(@hMapView^.Data[0]);
      if lParam = 2 then
        WindowName := PChar(@hMapView^.Data[0]);
    end;
  end;
  Result := CallWindowProc(FWProc, Handle, Msg, wParam, lParam);
end;

function Initialize(FHandle: HWND; Buf: PChar): Boolean; stdcall;
var
  MapStr, PBIniName: string;
  i: Integer;
begin
  Result := False;
  MainHandle := FHandle;
  SetLength(MapStr, MAX_PATH + 1);
  GetModuleFilename(hInstance, @MapStr[1], MAX_PATH);
  MapStr := PChar(MapStr);
  MapStr := ExtractFilePath(MapStr);
  i := Pos('\', MapStr);
  while i > 0 do
  begin
    MapStr := Copy(MapStr, 1, i - 1) + '/' + Copy(MapStr, i + 1, Length(MapStr) - i);
    i := Pos('\', MapStr);
  end;
  hFileMap := OpenFileMapping(FILE_MAP_WRITE, False, PChar(MapStr + 'BckjByWfs'));
  if hFileMap > 0 then
  begin
    hMapView := MapViewOfFile(hFileMap, FILE_MAP_WRITE, 0, 0, 0);
    if (hMapView <> nil) and IsWindow(hMapView^.AppHandle) and (hMapView^.AppFlag = 1) then
    begin
      FMessageID := RegisterWindowMessage(StrForMessage);
      if (hMapView^.PBFlag = 0) and (MainHandle > 0) and IsWindow(MainHandle) then
      begin
        hMapView^.PBFlag := 1;
        FWProc := Pointer(SetWindowLong(FHandle, GWL_WNDPROC, Integer(@WndProcHook)));
        SQLCAParas := TStringList.Create;
        PostMessage(hMapView^.AppHandle, FMessageID, 0, FHandle);
        if (hMapView^.ActiveHandle > 0) and IsWindow(hMapView^.ActiveHandle) then
          SetForeGroundWindow(hMapView^.ActiveHandle)
        else
          SetForeGroundWindow(hMapView^.AppHandle);
        SetLength(PBIniName, 1025);
        GetModuleFileName(MainInstance, @PBIniName[1], 1024);
        PBIniName := PChar(PBIniName);
        PBIniName := Copy(PBIniName, 1, Length(PBIniName) - 4) + '.INI';
        try
          StrPCopy(Buf, PBIniName);
        except
        end;
      end;
      Result := True;
    end;
  end;
end;

procedure Finalize; stdcall;
begin
  if hMapView <> nil then
    UnmapViewOfFile(hMapView);
  if hFileMap > 0 then
    CloseHandle(hFileMap);
  if (MainHandle > 0) and IsWindow(MainHandle) then
  begin
    SetWindowLong(MainHandle, GWL_WNDPROC, Longint(FWProc));
    SQLCAParas.Free;
    PostMessage(MainHandle, WM_CLOSE, 0, 0);
  end;
end;

function GetMessageID: Cardinal; stdcall;
begin
  Result := FMessageID;
end;

procedure GetSQLCAPara(Index: Cardinal; Buf: PChar); stdcall;
begin
  if (SQLCAParas.Count > 0) and (Index < Cardinal(SQLCAParas.Count)) then
    StrPCopy(Buf, SQLCAParas[Index]);
end;

procedure GetLibName(Buf: PChar); stdcall;
begin
  StrPCopy(Buf, LibName);
end;

procedure GetWindowName(Buf: PChar); stdcall;
begin
  StrPCopy(Buf, WindowName);
end;

procedure MessageTo(wParam, lParam: Longint; Buf: PChar); stdcall;
begin
  if (wParam = 2) or (wParam = 3) or (wParam = 9) then
  begin
    if (hMapView^.ActiveHandle > 0) and IsWindow(hMapView^.ActiveHandle) then
      SetForeGroundWindow(hMapView^.ActiveHandle)
    else
      SetForeGroundWindow(hMapView^.AppHandle);
  end;
  if wParam = 9 then
    Exit;
  if wParam = 1 then
  begin
    if Cardinal(GetWindowLong(HWND(lParam), GWL_STYLE)) and WS_POPUP = WS_POPUP then
    begin
      SetWindowLong(HWND(lParam), GWL_EXSTYLE, Integer(Cardinal(GetWindowLong(HWND(lParam), GWL_EXSTYLE)) or WS_EX_APPWINDOW));
      SetWindowLong(HWND(lParam), GWL_STYLE, Integer(Cardinal(GetWindowLong(HWND(lParam), GWL_STYLE)) xor WS_POPUP));
    end;
    if Cardinal(GetWindowLong(HWND(lParam), GWL_STYLE)) and WS_CHILD = WS_CHILD then
      SetWindowLong(HWND(lParam), GWL_STYLE, Integer(Cardinal(GetWindowLong(HWND(lParam), GWL_STYLE)) xor WS_CHILD));
    SetWindowLong(HWND(lParam), GWL_STYLE, Integer(Cardinal(GetWindowLong(HWND(lParam), GWL_STYLE)) or WS_OVERLAPPED or WS_CAPTION or WS_SYSMENU or WS_MINIMIZEBOX));
    Windows.SetParent(HWND(lParam), 0);
  end;
  if (Buf <> nil) and (Buf <> '') then
    StrCopy(@hMapView^.Data[0], Buf);
  SendMessage(hMapView^.AppHandle, FMessageID, wParam, lParam);
end;

exports
  Initialize,
  Finalize,
  GetMessageID,
  GetSQLCAPara,
  GetLibName,
  GetWindowName,
  MessageTo;
end.