147 lines
3.7 KiB
ObjectPascal
147 lines
3.7 KiB
ObjectPascal
unit U_testdll;
|
||
|
||
interface
|
||
|
||
uses
|
||
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
||
Dialogs, ExtCtrls, StdCtrls, Menus, ToolWin, ComCtrls, ImgList, DB, ADODB,
|
||
System.ImageList, cxGraphics, cxControls, cxLookAndFeels, cxLookAndFeelPainters,
|
||
|
||
|
||
|
||
|
||
|
||
cxStyles, cxCustomData, cxFilter, cxData, cxDataStorage, cxEdit, cxNavigator, dxDateRanges,
|
||
dxScrollbarAnnotations, cxDBData, cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxGridCustomView, cxGrid;
|
||
|
||
type
|
||
TForm1 = class(TForm)
|
||
MainMenu1: TMainMenu;
|
||
test1: TMenuItem;
|
||
ToolBar1: TToolBar;
|
||
Edit1: TEdit;
|
||
ToolButton1: TToolButton;
|
||
ImageList1: TImageList;
|
||
ADOConnection1: TADOConnection;
|
||
DllName: TEdit;
|
||
Label1: TLabel;
|
||
tv1: TcxGridDBTableView;
|
||
cxGrid1Level1: TcxGridLevel;
|
||
cxGrid1: TcxGrid;
|
||
tv1Column1: TcxGridDBColumn;
|
||
tv1Column2: TcxGridDBColumn;
|
||
tv1Column3: TcxGridDBColumn;
|
||
tv1Column4: TcxGridDBColumn;
|
||
tv1Column5: TcxGridDBColumn;
|
||
test11: TMenuItem;
|
||
ADOQuery1: TADOQuery;
|
||
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
||
procedure test1Click(Sender: TObject);
|
||
procedure ToolButton1Click(Sender: TObject);
|
||
procedure FormResize(Sender: TObject);
|
||
procedure test11Click(Sender: TObject);
|
||
private
|
||
{ Private declarations }
|
||
public
|
||
{ Public declarations }
|
||
end;
|
||
|
||
var
|
||
Form1: TForm1;
|
||
newh: hwnd;
|
||
ss:string;
|
||
|
||
implementation
|
||
|
||
{$R *.dfm}
|
||
|
||
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
|
||
begin
|
||
sendmessage(newh, 1034, 4, 0);
|
||
Action := cafree;
|
||
end;
|
||
|
||
procedure TForm1.test11Click(Sender: TObject);
|
||
type
|
||
TMyFunc = function(mCxGridView: TcxGridDBTableView; ADOCmd: TADOQuery;xx:PWideChar): String; stdcall;
|
||
var
|
||
Tf: TMyFunc;
|
||
Tp: TFarProc;
|
||
Th: Thandle;
|
||
begin
|
||
Th := LoadLibrary('djdPackPlan.dll');
|
||
if Th > 0 then
|
||
begin
|
||
try
|
||
Tp := GetProcAddress(Th, 'test1');
|
||
if Tp <> nil then
|
||
begin
|
||
Tf := TMyFunc(Tp);
|
||
ss := Tf(Tv1,ADOQuery1,PWideChar('<27>й<EFBFBD>'));
|
||
ShowMessage(ss);
|
||
end
|
||
else
|
||
begin
|
||
ShowMessage('<27><>ӡִ<D3A1>д<EFBFBD><D0B4><EFBFBD>');
|
||
end;
|
||
finally
|
||
// FreeLibrary();
|
||
end;
|
||
end
|
||
else
|
||
begin
|
||
ShowMessage('<27>Ҳ<EFBFBD><D2B2><EFBFBD>' + Trim(DllName.Text));
|
||
end;
|
||
end;
|
||
|
||
procedure TForm1.test1Click(Sender: TObject);
|
||
type
|
||
TMyFunc = function(App: Tapplication; FormH: hwnd; FormID: integer; Language: integer; WinStyle: integer; GCode: Pchar; GName: Pchar; DataBase: Pchar; Title: PChar; Parameters1: PChar; Parameters2: PChar; Parameters3: PChar; Parameters4: PChar; Parameters5: PChar; Parameters6: PChar; Parameters7: PChar; Parameters8: PChar; Parameters9: PChar; Parameters10: PChar; DataBaseStr: PChar): hwnd; stdcall;
|
||
var
|
||
Tf: TMyFunc;
|
||
Tp: TFarProc;
|
||
Th: Thandle;
|
||
begin
|
||
//<2F><>̬<EFBFBD><CCAC><EFBFBD><EFBFBD>
|
||
//newh:=getForm(Application,1,ADOConnection1,PChar('sa'),PChar('dsa'));
|
||
|
||
//<2F><>̬<EFBFBD><CCAC><EFBFBD><EFBFBD>
|
||
// showMessage(intTostr(application.Handle));
|
||
Th := LoadLibrary('djdPackPlan.dll');
|
||
if Th > 0 then
|
||
begin
|
||
try
|
||
Tp := GetProcAddress(Th, 'GetDllForm');
|
||
if Tp <> nil then
|
||
begin
|
||
Tf := TMyFunc(Tp);
|
||
newh := Tf(Application, 0, strToint(edit1.text), 0, 0, PChar('admin'), PChar('admin'), PChar('datebase'), PChar('title'), PChar(''), PChar(''), '', '', '', '', '', '', '', '', '');
|
||
end
|
||
else
|
||
begin
|
||
ShowMessage('<27><>ӡִ<D3A1>д<EFBFBD><D0B4><EFBFBD>');
|
||
end;
|
||
finally
|
||
// FreeLibrary();
|
||
end;
|
||
end
|
||
else
|
||
begin
|
||
ShowMessage('<27>Ҳ<EFBFBD><D2B2><EFBFBD>' + Trim(DllName.Text));
|
||
end;
|
||
|
||
end;
|
||
|
||
procedure TForm1.ToolButton1Click(Sender: TObject);
|
||
begin
|
||
close;
|
||
end;
|
||
|
||
procedure TForm1.FormResize(Sender: TObject);
|
||
begin
|
||
sendmessage(newh, 1034, 1, 0);
|
||
end;
|
||
|
||
end.
|
||
|