在程序中弹出一个窗口(FORM注入)问题请教(大富翁上放了两天没人回)

Question

我按tt.t的代码写了一个HOOK,用来在其它窗口(我在MYIE2下,和一个全屏游戏下进行测试的)
按热键后可以在当前窗口下弹出我建的窗口,但是当前窗口会假死,因为用的模式窗口,父窗口(也就是前面说的当前窗口)等待模式窗口退出,但模式窗口同时死掉,按任何键无效,鼠标点击无效....我听说把要弹出的窗口改为非模式窗口即可,可是我把
form1.ShowModal;
换为
form1.Show;
form1.update;
之后,还是不行,弹出窗口一闪即没....也试了SetParent,SetWindowPos,等等方法,都是不行
找遍了delphibbs,csdn,没找到办法,请大家帮忙了,,最好能给出源代码,谢谢!!!我要做的就是在一个程序中呼出一个窗口,并且可以操作这个窗口
而且要在全屏程序(比如游戏)中也可以呼出,同时不会切换出来(还是在全屏模式中,如金山游侠)5555
贴了90%的贴子，被一个非法操作就给over了。
那就再写一遍吧。
问题基本搞定，不一定要用dialgobox,关键是要现实的窗体的parnet必须要设成
游戏的窗体。这样就可以弹出自己的窗体，而游戏的窗体也不会最小化了。
我写了一个，w2k+delphi6+q3a测试通过。
代码比较乱，注意看注释。
热键是左边的win建加小键盘上得*建
ps,别忘了给分。
//--------------App part start----------------
//form上放两个button.
//Copyright by tt.t(ttui) @2k 3.1.19@bitunit test;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.DFM}
function sethook:bool;external 'ptdll.dll';
function endhook:bool;external 'ptdll.dll';procedure TForm1.Button1Click(Sender: TObject);
begin
//if
 sethook;
 // then showmessage('Hook Successful');
end;procedure TForm1.Button2Click(Sender: TObject);
begin
//if
endhook;
// then showmessage('Unhook Successful!!');
end;procedure TForm1.FormDestroy(Sender: TObject);
begin
//endhook;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
//sethook;
end;end.
//--------------App part end------------------//--------------DLL part start------------------
//--------------library project------------------
library ptdll;uses
  SysUtils,
  Classes,
  Windows,
  Messages,
  dll_vol in 'dll_vol.pas',
  dia in 'dia.pas' {Form1};{$R *.RES}exports sethook,endhook;
begin
hNextHookProc := 0;
procSaveExit := ExitProc;
ExitProc := @HotKeyHookExit;
end.
//-------------------dll_vol unit-----------------------
unit dll_vol;interfaceuses Windows,Messages,Dialogs,Sysutils,dia;var
  hNextHookProc: HHook;
  procSaveExit: Pointer;  function sethook:bool;export;
  function hookproc(iCode:Integer;wParam: WPARAM;lParam: LPARAM): LRESULT; stdcall;
  function endhook:bool;export;
  procedure HotKeyHookExit;far;implementationfunction HookProc(iCode: integer; wParam: wParam; lParam: lParam): LResult; stdcall;
var
  hwnd:dword;
  AppRect:TRect;
  title:pchar;
//  dc:hdc;
begin
  result:=0;
    if iCode<0 then
    begin
      CallNextHookEx(hnexthookproc,iCode,wParam,lParam);
      result:=0;
      Exit;
    end;
{
    dc:=getdc(0);
    textout(dc,20,20,pchar(inttohex(wparam,3)),3);
    releasedc(0,dc);
}
  if ((lParam and $80000000)=0) and
     (GetKeyState(VK_LWIN)<0) and (wParam=$6a) then
  begin
    Messagebeep(0);
    hwnd:=getforegroundwindow;
    try
      GetMem(title,255);
      getwindowtext(hwnd,title,255);
      if title<>'_Msg_Dx_' then
      begin
        try
          form1:=TForm1.CreateParented(hwnd);
          GetWindowRect(hwnd,AppRect);
          form1.Left:=(AppRect.Right-AppRect.Left) div 2;
          form1.Top:=(AppRect.Bottom-AppRect.Top) div 2;
          form1.Caption:='_Msg_Dx_';
          form1.ShowModal;
        finally
          form1.Free;
        end;
      end;
    finally
      FreeMem(title);
    end;
    result:=1;
  end;
end;function sethook:bool;export;
begin
  result:=false;
  if hnexthookproc<>0 then exit;
  hNextHookProc := SetWindowsHookEx(WH_KEYBOARD,hookproc,HInstance,0);
  Result := hNextHookProc <> 0;
end;procedure hotkeyhookexit;
begin
  if hNextHookProc <> 0 then endHook;
  ExitProc := procSaveExit;
end;function endhook:bool;export;
begin
  if hNextHookProc <> 0 then
  begin
    UnhookWindowshookEx(hNextHookProc); // 解除 Keyboard Hook
    hNextHookProc := 0;
  end;
  Result := hNextHookProc = 0;
end;end.
//----------------dia unit-------------------
//注意！！form的borderstyle必须设成bsdialog！！
unit dia;interfaceuses
  Windows, Messages, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;type
  TForm1 = class(TForm)
    Button1: TButton;
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}end.//--------------DLL part end------------------

Answer 1

任何全屏幕的都可以吗？
发个EXE我试下OK？
[email protected]

Answer 2

我运行起来怎么出现:Cannot debug project unless a host application is defined.
Use the Run|Parameters...dialog box.我也把dig的form的borderstyle设成bsdialog能否帮我解决一下????

Answer 3

Form 注入代码如下，请给分：这个很简单啊，写入如下代码： type 
  TForm1 = class(TForm) 
    procedure FormDestroy(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
  private 
    aatom:atom; 
    procedure hotkey(var msg:tmessage);message wm_hotkey; 
  public 
    { Public declarations } 
  end; var 
  Form1: TForm1; 
  h:HWND; 
implementation uses Unit2; {$R *.dfm} 
procedure TForm1.hotkey(var msg:tmessage); 
begin 
  if (msg.LParamHi=VK_MULTIPLY) then 
  begin 
    h:=GetForegroundWindow; 
    if h=0 then Exit; 
    freeAndNil(Form2); 
   Form2:= TForm2.CreateParented(h); 
    Form2.show; 
  end; 
end; procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  globalDeleteatom(aatom); 
end; procedure TForm1.FormCreate(Sender: TObject); 
begin 
  aatom:=globaladdatom('hot key'); 
  RegisterHotKey(handle,aatom,0,vk_MULTIPLY); 
end; 
代码下载地址是：ftp://new:[email protected]/datanew/2003120914451810182.rar 用小键盘星号呼出试试？不过窗体重绘没有写成DirectX 窗体，只是一个标准窗体，我试过在魔兽3中呼出，窗体经常被屏幕刷新覆盖，但确实不影响游戏

Answer 4

SetForegroundWindow(MainForm.Handle);
MainForm.BringToFront;