DLL中封装窗体

刚学D 对这块还不是很了解
我想问下我能不能先写个窗体然后把他放到DLL中去？请问怎么放有什么规则或要求？

13 个解决方案

#1

《Delphi 5 开发人员指南》
第9章   动态链接库 234
9.4.2   显示DLL中的模式窗体 239
9.5   显示DLL中的无模式窗体 241

#2

在dll中显示窗体会有一些很难解决的问题:无法控制焦点,最大化/最小化出现问题,低级内存访问错误,原因是主控程序和dll中均有一个application和Screen对象,虽然将主控程序的application和screen传入dll中,但仍然无法从根本上解决问题。
建议用bpl代替dll，bpl是面向对象的，用它构建的系统只能一个screen和application对象。

#3

幫頂，我也想學習下：)

#4

是这样的情况
我想用DLL HOOK目标程序的进程然后在目标程序启动后按热键将DLL中的窗体呼出（应为DLL窗体里的功能是调用目标程序的自身函数，所以只有在目标程序进程里的窗体才能实现）

#5

sdzeng(大头鸟) 的回答,好具体

#6

hehe ,刚刚做了一个，给你看看

#7

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, StrUtils, ExtCtrls, Unit3, Unit5;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Timer2: TTimer;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    readpasswd:Tic;
    states :boolean;
  public
     h:integer;
     passwd:String;
  end;

var
  Form1: TForm1;
  hTag,hand: HWND;
  hk_Next: HHOOK;
  SubThreadID:DWORD;
function HookProc(nCode:integer;wParam: WPARAM; lParam: LPARAM): LResult;stdcall;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  i:integer;
  s:PChar;
begin
  hand := FindWindow(nil,'挂号业务');
  if hand<>0 then
  begin
    repeat
    hTag := FindWindowEx(hand,0,'Button',nil);
    s:=strnew('');
    i:=GetWindowTextLength(hTag);
    GetWindowText(hTag,s,i+1);
    if AnsiStartsText('读卡',strpas(s)) then break;
    until hTag=0;
  if (hTag<>0) and (h=0) then
     begin
     hk_Next := SetWindowsHookEx(WH_JOURNALRECORD,@HookProc,HInstance,0);
     Inc(h);
     end;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
   if (hTag <> 0) and(hk_Next <> 0) then
      UnhookWindowsHookEx(hk_Next);
end;

function HookProc(nCode:integer;wParam: WPARAM; lParam: LPARAM): LResult;
begin
   Result := HC_ACTION;
    if nCode < 0 then Result := CallNextHookEx(hk_Next, nCode, wParam, lParam)
    else  if nCode = HC_ACTION then begin
      if PEventMsg(lParam)^.message = WM_LBUTTONDOWN then
        if PEventMsg(lParam)^.hwnd = hTag then
        begin
           CreateThread(nil, 0, @ThreadPro, nil, 0, SubThreadID);
        end
        else
        Result := CallNextHookEx(hk_Next, nCode, wParam, lParam);
    end;
end;

procedure TForm1.Timer2Timer(Sender: TObject);

var
  hnd:THandle;
  portste:Boolean;
begin
  hnd := Findwindow('FNWND370',nil);
  if hnd > 0 then
     begin
        readpasswd:=Tic.Create ;
        readpasswd.closeacr ;
        states := true;
        if passwd = '' then
        begin
        portste:=readpasswd.openacr(1);
        if portste then
          begin
            readpasswd.ReadBH ;
            passwd := readpasswd.Read_employee.qt1 ;
          end;
        end;
        readpasswd.Destroy ;
        states := false;
     end ;
  hand := FindWindow(nil,'挂号业务');
  if (hand<>0) then
      begin
       Timer1.Enabled := true;
      end
  else
      begin
       Timer1.Enabled := false;
      end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   hand := FindWindow(nil,'挂号业务');
  if (hand<>0) then
      begin
        Timer2.Enabled := false;
        Button1Click(Sender);
        try
        begin
        if states then begin
           readpasswd.closeacr ;
           readpasswd.Destroy ;
           end;
        end;
        except
        exit;
        end;
      end
  else
     begin
        Timer2.Enabled := true;
     end;
end;

end.

unit  unit3;

interface

const
  DllMutex = 'zwh_passwd';

  // 待插线程回调函数
procedure ThreadPro(X: Integer); stdcall;

implementation

uses Windows, Messages, Unit2;

  // 待插线程回调函数
procedure ThreadPro(X: Integer); stdcall;
var
  MsgStruct: TMsg;
  hMutexObj: DWORD;
  passw:THandle;
begin
  passw := FindWindow(nil,'请输入密码');
  if passw <> 0 then exit
  else begin
  hMutexObj := CreateMutex(nil, FALSE, DllMutex);
  Register_MainForm;
  Create_MainForm;
  while GetMessage(MsgStruct, 0, 0, 0) do
  begin
    TranslateMessage(MsgStruct);
    DispatchMessage(MsgStruct);
  end;
  Unregister_MainForm;
  CloseHandle(hMutexObj);
end;
end;

(* 注,这个线程有窗体,也可以用FindWindow来防止重复运行 *)
end.

#8

unit Unit2;

interface

procedure Register_MainForm;   // 注册窗体类
procedure Unregister_MainForm; // 撤销窗体类
procedure Create_MainForm;     // 建立主窗体

implementation

uses
  Windows, Messages,SysUtils,StrUtils,Unit1;

const
  ClassName = 'PassWd_ZWH';
var
  j:integer=0;

  // 窗体过程回调函数
function FormProc(hForm, MsgID, WParam, LParam: LongWord): LongWord; stdcall;
const
{$J+}
  TempFont: DWORD = 0;
{$J-}
  ControlID1 = 1;
  ControlID2 = 2;
  ControlID3 = 3;
var
  EditText: array[0..30] of Char;
  i:integer;
  sth:PChar;
  hands,hTagone:longword;
  newpas:string;
begin
  Result := DefWindowProc(hForm, MsgID, WParam, LParam); // 标准处理
  case MsgID of
    WM_CREATE:
      begin
        TempFont := CreateFont(12, 6, 0, 0, FW_EXTRALIGHT, Byte(FALSE), Byte(FALSE),Byte(FALSE), GB2312_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH, '宋体');

        CreateWindowEx(0, 'BUTTON', '验证密码', WS_CHILD or WS_VISIBLE,30, 60, 70, 25, hForm, ControlID1, HInstance, nil);
        SendMessage(GetDlgItem(hForm, ControlID1), WM_SETFONT, TempFont, 1);

        CreateWindowEx(0, 'BUTTON', '退出程序', WS_CHILD or WS_VISIBLE, 165, 60, 70, 25, hForm, ControlID2, HInstance, nil);
        SendMessage(GetDlgItem(hForm, ControlID2), WM_SETFONT, TempFont, 1);

        CreateWindowEx(ES_PASSWORD, 'Edit', '', WS_CHILD or WS_VISIBLE or ES_PASSWORD or WS_BORDER, 15, 20, 230, 20, hForm, ControlID3, HInstance, nil);
        SendMessage(GetDlgItem(hForm, ControlID3), WM_SETFONT, TempFont, 1);
        SETFOCUS(GetDlgItem(hForm, ControlID3));
      end;

    WM_COMMAND:
      begin
        if (HIWORD(wParam) = BN_CLICKED) then // 单击按钮
        begin
          case LOWORD(wParam) of // 控件ID
            ControlID1:
              begin
                GetWindowText(GetDlgItem(hForm, ControlID3), @EditText[0], 30);
                newpas:=EditText;
                if newpas = Form1.passwd then
                   begin
                      hands := FindWindow(nil,'挂号业务');
                      if hands<>0 then
                          begin
                            repeat
                            hTagone := FindWindowEx(hands,0,'Button',nil);
                            sth:=strnew('');
                            i:=GetWindowTextLength(hTagone);
                            GetWindowText(hTagone,sth,i+1);
                            if AnsiStartsText('读卡',strpas(sth)) then break;
                            until hTag=0;
                            strdispose(sth);
                          end;
                          UnhookWindowsHookEx(hk_Next);
                          SendMessage(hForm,WM_CLOSE,0,0);
                          SendMessage(hTagone,WM_LBUTTONDOWN,0,0);
                          SendMessage(hTagone,WM_LBUTTONup,0,0);
                          Form1.h := 0;j:=0; Form1.passwd := '';
                   end
                else
                   begin
                      if j<2 then
                          begin
                            MessageBox(hForm,'密码错误','提示',MB_OK);
                            SetWindowText(GetDlgItem(hForm, ControlID3),'');
                            SETFOCUS(GetDlgItem(hForm, ControlID3));
                            inc(j);
                          end
                      else
                          begin
                            UnhookWindowsHookEx(hk_Next);
                            hands := FindWindow(nil,'挂号业务');
                            SendMessage(hForm,WM_CLOSE,0,0);
                            SendMessage(hands,WM_CLOSE,0,0);
                            Form1.h := 0;j:=0;
                            Form1.passwd := '';
                          end;
                   end;
              end;
            ControlID2:
               begin
                  SendMessage(hForm, WM_CLOSE, 0, 0);
                  j:=0;
               end;
          end;
        end;
      end;

    WM_DESTROY:
      begin
        PostQuitMessage(0);
        DeleteObject(TempFont);
      end;
  end;
end;

  // 注册窗体类
procedure Register_MainForm;
var
  FormClass: TWndClass;
begin
  FormClass.Style := CS_HREDRAW or CS_VREDRAW;
  FormClass.lpfnWndProc := @FormProc;
  FormClass.cbClsExtra := 0;
  FormClass.cbWndExtra := 0;
  FormClass.hInstance := SysInit.HInstance;
  FormClass.hIcon := LoadIcon(HInstance,'cool');
  FormClass.hCursor :=  LoadCursor(0, IDC_ARROW);
  FormClass.hbrBackground := COLOR_WINDOW;
  FormClass.lpszMenuName := nil;
  FormClass.lpszClassName := ClassName;
  RegisterClass(FormClass);
end;

  // 注销窗体类
procedure Unregister_MainForm;
begin
  UnregisterClass(ClassName, HInstance);
end;

  // 建立主窗体
procedure Create_MainForm;
begin
  CreateWindowEx(WS_EX_TOPMOST, ClassName, '请输入密码', WS_VISIBLE or WS_TILED , 400, 350, 270, 130, 0, 0, HInstance, nil);
end;

end.

#9

谢谢楼上的麻烦你发给我下行吗发完我给你接分
我邮箱:KrisCn@qq.com

#10

dll封装的窗体使用MIDI 模式可已嵌入主窗体，但是如果lz想用DOCK的形式恐怕就不行了。

我原来也这样做过，使用DOCK的话是不行的。

#11

library Hook;

uses
  SysUtils,
  System,
  Classes,
  Unit in 'Unit{这就是你的窗体，随便什么都可以},

{$R *.res}

end.

#12

这HOOK 是个DLL

#1