1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97
| procedure TFrmTestDivers.WriteStringList(const FileName: string; const Strings: TStrings);
var
HandleDLL: HMODULE;
_WriteStringList: procedure(const FileName: string; const Strings: TStrings); stdcall;
begin
HandleDLL := LoadLibrary('DLLTest.dll');
if HandleDLL > 0 then
begin
try
@_WriteStringList := GetProcAddress(HandleDLL, 'WriteStringList');
if Assigned(@_WriteStringList) then
_WriteStringList(FileName, Strings);
finally
FreeLibrary(HandleDLL);
end;
end;
end;
procedure TFrmTestDivers.BtnWriteStringListInFileClick(Sender: TObject);
begin
WriteStringList(EdDLLOutFileName.Text, MemoDLL.Lines);
end;
procedure TFrmTestDivers.GetDLLForm(out Form: TForm);
var
HandleDLL: HMODULE;
_GetDLLForm: procedure(out Form: TForm); stdcall;
begin
HandleDLL := LoadLibrary('DLLTest.dll');
if HandleDLL > 0 then
begin
@_GetDLLForm := GetProcAddress(HandleDLL, 'GetDLLForm');
if Assigned(@_GetDLLForm) then
_GetDLLForm(Form)
else
Form := nil;
if Assigned(Form) then
begin
Form.OnClose := DLLFormClose;
Form.Tag := HandleDLL;
Form.Caption := Form.Caption + ' - ' + Application.ExeName;
end;
end;
end;
procedure TFrmTestDivers.FreeDLLForm(const Form: TForm);
var
_FreeDLLForm: procedure(const Form: TForm); stdcall;
begin
if Form.Tag > 0 then
begin
@_FreeDLLForm := GetProcAddress(Form.Tag, 'FreeDLLForm');
if Assigned(@_FreeDLLForm) then
begin
_FreeDLLForm(Form);
FreeLibrary(Form.Tag);
end;
end;
end;
procedure TFrmTestDivers.SetDLLFormMemo(const Form: TForm; const Lines: string);
var
_SetDLLFormMemo: procedure(const Form: TForm; const Lines: string); stdcall;
begin
if Form.Tag > 0 then
begin
@_SetDLLFormMemo := GetProcAddress(Form.Tag, 'SetDLLFormMemo');
if Assigned(@_SetDLLFormMemo) then
_SetDLLFormMemo(Form, Lines);
end;
end;
procedure TFrmTestDivers.DLLFormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caHide;
end;
var
Form: TForm;
procedure TFrmTestDivers.BtnGetDLLFormClick(Sender: TObject);
begin
GetDLLForm(Form);
Form.Show();
end;
procedure TFrmTestDivers.BtnFreeDLLFormClick(Sender: TObject);
begin
FreeDLLForm(Form);
end;
procedure TFrmTestDivers.BtnSetMemoDLLFormClick(Sender: TObject);
begin
SetDLLFormMemo(Form, MemoDLL.Lines.Text);
end; |
Partager