unitinstalldll.pas

在delphi中实现windows核心编程.原书光盘代码核心编程.原书光盘代码

unit UnitInstallDll;

interface

uses
  windows, forms, messages, sysutils, 
  dialogs, UnitConst;

type
  TInstallGetKey = procedure; stdcall; {声明过程}
  TRemoveGetKey = procedure; stdcall; {声明过程}  
  {声明共享内存记录结构}

    procedure InstallDll(path:string;MainFormHandle,ExplorerProcessID:THandle);stdcall;
    procedure RemoveDll;stdcall;
var
//  hMain: integer;
//  Msg: TMsg;
  MemFile: THandle;
  pShMem: PInstallMem;
  HHGetMsgProc: HHook;
  InstallGetKey: TInstallGetKey;
  RemoveGetKey: TRemoveGetKey;  

implementation

procedure wait(ticks:dword);
var
   t:dword;
begin
   t:=gettickcount;
   while gettickcount-t<ticks do application.ProcessMessages;
end;

procedure tfun; stdcall;
var
   h,LibHandle:THandle;
   p:PGetkeyMem;
   RetCode:dword;
begin
  h:=OpenFileMapping(FILE_MAP_WRITE or FILE_MAP_READ,False, MemNameGetKey);
  if h<>0 then
  begin
     p:=MapViewOfFile(h,FILE_MAP_WRITE or FILE_MAP_READ,0,0,0);
     if p<>nil then
     begin
        LibHandle:=p^.LibHandle;
        if LibHandle <> 0 then
        begin
           RemoveGetKey := GetProcAddress(LibHandle, 'RemoveGetkey'); {获得Run过程地址}
           if @RemoveGetKey <> nil then
           begin
              RemoveGetKey;
           end;
           p^.ExitIt:=true;
//           while p^.ExitIt do application.ProcessMessages;
           repeat begin
              GetExitCodeThread(pShmem^.GetkeyThreadID,RetCode);
              application.ProcessMessages;
           end until RetCode<>STILL_ACTIVE;
           SendMessage(HWND_BROADCAST,WM_SETTINGCHANGE,0,0);
           wait(500);
           FreeLibrary(LibHandle);
        end;
        UnmapViewofFile(p);
     end;
     closeHandle(h);
     postmessage(pShMem^.MainFormHandle, wm_user, 1, 2);//卸载主程序
  end
  else begin
      {装入GetKey.dll}
      LibHandle := LoadLibrary(pchar(pShMem^.MainPath + 'GetKey.dll'));
      {装入成功}
      if LibHandle <> 0 then
      begin
          InstallGetKey := GetProcAddress(LibHandle, 'InstallGetkey'); {获得Run过程地址}
          if @InstallGetKey <> nil then
          begin
             InstallGetKey;
          end
          else FreeLibrary(LibHandle);
      end;
   end;
end;

{消息钩子回调过程}
function GetMsgProc(nCode: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  if (nCode >= 0)and(pShMem^.ExplorerProcessID<>0)and(getcurrentprocessid = pShMem^.ExplorerProcessID) then
  begin
     pShMem^.ExplorerProcessID:=0;
     CreateThread(nil, 0, @tfun, nil, 0, pShMem^.GetkeyThreadID);
  end;
  Result := CallNextHookEx(HHGetMsgProc, nCode, wParam, lParam);
end;

procedure InstallDll(path:string;MainFormHandle,ExplorerProcessID:THandle); stdcall;
begin
  pShMem^.MainFormHandle:= MainFormHandle;
  pShMem^.ExplorerProcessID:=ExplorerProcessID;
  strcopy(pShMem^.MainPath,pchar(path));
  if HHGetMsgProc = 0 then
     HHGetMsgProc := SetWindowsHookEx(WH_GETMESSAGE, GetMsgProc, hinstance, 0);
end;

procedure RemoveDll;stdcall;
begin
   if HHGetMsgProc <> 0 then UnhookWindowsHookEx(HHGetMsgProc);
   HHGetMsgProc := 0;
   SendMessage(HWND_BROADCAST,WM_SETTINGCHANGE,0,0);
end;

procedure Extro;
begin
  UnmapViewOfFile(pShMem);
  CloseHandle(MemFile);
end;

procedure Intro;
begin
  MemFile := OpenFileMapping(FILE_MAP_WRITE or FILE_MAP_READ,False, MemNameInstall);
  if MemFile=0 then
  begin
     MemFile := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0,
        SizeOf(TInstallMem), MemNameInstall);
  end;
  pShMem := MapViewOfFile(MemFile,FILE_MAP_WRITE or FILE_MAP_READ, 0, 0, 0);
end;

initialization
      Intro;
finalization
      Extro;
end.