Код:
library Project2;
uses
Windows,
SysUtils;
type
TCallbackProc = function: Integer; stdcall;
var
GetValue: TCallbackProc;
procedure Init(const ACallback: TCallbackProc); stdcall;
begin
GetValue := ACallback;
end;
function DoSomething: Integer; stdcall;
begin
Result := GetValue * 2;
end;
exports
DoSomething,
Init;
end.
Код:
unit Unit1;
...
type
TCallbackProc = function: Integer; stdcall;
procedure Init(const ACallback: TCallbackProc); stdcall; external 'Project2.dll';
function DoSomething: Integer; stdcall; external 'Project2.dll';
...
function Callback: Integer; stdcall;
begin
Result := Form1.Tag;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Init(Callback);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Tag := 5;
Caption := IntToStr(DoSomething); // выведет '10'
end;
вторник, 8 июля 2014 г.
Передача данных в DLL (Статическая загрузка DLL)
Передача данных в DLL (Динамическая загрузка DLL)
Рыдаю. Просто рыдаю.
Волшебное слово - Callback (a.k.a. функция обратного вызова).
Волшебное слово - Callback (a.k.a. функция обратного вызова).
Код:
library Project2;
uses
Windows,
SysUtils;
type
TCallbackProc = function: Integer; stdcall;
var
GetValue: TCallbackProc;
procedure Init(const ACallback: TCallbackProc); stdcall;
begin
GetValue := ACallback;
end;
function DoSomething: Integer; stdcall;
begin
Result := GetValue * 2;
end;
exports
DoSomething,
Init;
end.
Код:
unit Unit1;
...
function Callback: Integer; stdcall;
begin
Result := Form1.Tag;
end;
procedure TForm1.Button1Click(Sender: TObject);
type
TCallbackProc = function: Integer; stdcall;
TInitProc = procedure(const ACallback: TCallbackProc); stdcall;
TDoSomethingProc = function: Integer; stdcall;
var
Lib: HMODULE;
Init: TInitProc;
DoSomething: TDoSomethingProc;
begin
Lib := LoadLibrary('Project2.dll');
Win32Check(Lib <> 0);
try
Init := GetProcAddress(Lib, 'Init');
Win32Check(Assigned(Init));
Init(Callback);
DoSomething := GetProcAddress(Lib, 'DoSomething');
Win32Check(Assigned(DoSomething));
Tag := 5;
Caption := IntToStr(DoSomething); // выведет '10'
finally
FreeLibrary(Lib);
end;
end;
четверг, 3 июля 2014 г.
Динамическая загрузка функции из DLL
{... Здесь идет заголовок файла и определение формы TForm1 и ее экземпляра Form1}
ПРИМЕЧАНИЕ: Следует воздерживаться от использования типа string в библиотечных функциях, т.к. при его использовании существуют проблемы с "разделением памяти". Подробней об этом можно прочитать (правда, на английском) в тексте пустого проекта DLL, который создает Delphi (File -> New -> DLL). Так что лучше используйте PChar, а затем при необходимости конвертируйте его в string функцией StrPas.
Еще вариант
procedure TOptions.SetRunOnStart(const Value: boolean);
var
LibHandle:Integer;
Fc_AutoRun: procedure(Flag:boolean; NameParam, Path:String);
begin
FRunOnStart := Value;
LibHandle := LoadLibrary('autorun.dll');
if LibHandle >=32 then
begin
@Fc_AutoRun := GetProcAddress(LibHandle, 'RunOnWinStart');
Fc_autoRun(Value, Application.title, paramstr(0));
end;
FreeLibrary(LibHandle);
end;
var Form1: TForm1; GetSimpleText: function(LangRus: Boolean): PChar; LibHandle: THandle;procedure Button1Click(Sender: TObject);begin {"Чистим" адрес функции от "грязи"} @GetSimpleText := nil; {Пытаемся загрузить библиотеку} LibHandle := LoadLibrary('MYDLL.DLL'); {Если все OK} if LibHandle >= 32 then begin {...то пытаемся получить адрес функции в библиотеке} @GetSimpleText := GetProcAddress(LibHandle,'GetSimpleText'); {Если и здесь все OK} if @GetSimpleText <> nil then {...то вызываем эту функцию и показываем результат} ShowMessage(StrPas(GetSimpleText(True))); end; {И не забываем освободить память и выгрузить DLL} FreeLibrary(LibHandle);end;
ПРИМЕЧАНИЕ: Следует воздерживаться от использования типа string в библиотечных функциях, т.к. при его использовании существуют проблемы с "разделением памяти". Подробней об этом можно прочитать (правда, на английском) в тексте пустого проекта DLL, который создает Delphi (File -> New -> DLL). Так что лучше используйте PChar, а затем при необходимости конвертируйте его в string функцией StrPas.
Еще вариант
procedure TOptions.SetRunOnStart(const Value: boolean);
var
LibHandle:Integer;
Fc_AutoRun: procedure(Flag:boolean; NameParam, Path:String);
begin
FRunOnStart := Value;
LibHandle := LoadLibrary('autorun.dll');
if LibHandle >=32 then
begin
@Fc_AutoRun := GetProcAddress(LibHandle, 'RunOnWinStart');
Fc_autoRun(Value, Application.title, paramstr(0));
end;
FreeLibrary(LibHandle);
end;
вторник, 1 июля 2014 г.
Версия файла. DLL
Библиотека для определения версии файла
library fileversion;
uses
System.SysUtils,
System.Classes,
Winapi.Windows;
{$R *.res}
function GetFileVersionToStr(FileName: string): string; stdcall;
var
Size, Handle: DWORD;
Buffer: TBytes;
FixedPtr: PVSFixedFileInfo;
begin
Size := GetFileVersionInfoSize(PChar(FileName), Handle);
if Size = 0 then
RaiseLastOSError;
SetLength(Buffer, Size);
if not GetFileVersionInfo(PChar(FileName), Handle, Size, Buffer) then
RaiseLastOSError;
if not VerQueryValue(Buffer, '\', Pointer(FixedPtr), Size) then
RaiseLastOSError;
Result := Format('%d.%d.%d.%d',
[LongRec(FixedPtr.dwFileVersionMS).Hi, //major
LongRec(FixedPtr.dwFileVersionMS).Lo, //minor
LongRec(FixedPtr.dwFileVersionLS).Hi, //release
LongRec(FixedPtr.dwFileVersionLS).Lo]) //build
end;
exports
GetFileVersionToStr;
begin
end.
library fileversion;
uses
System.SysUtils,
System.Classes,
Winapi.Windows;
{$R *.res}
function GetFileVersionToStr(FileName: string): string; stdcall;
var
Size, Handle: DWORD;
Buffer: TBytes;
FixedPtr: PVSFixedFileInfo;
begin
Size := GetFileVersionInfoSize(PChar(FileName), Handle);
if Size = 0 then
RaiseLastOSError;
SetLength(Buffer, Size);
if not GetFileVersionInfo(PChar(FileName), Handle, Size, Buffer) then
RaiseLastOSError;
if not VerQueryValue(Buffer, '\', Pointer(FixedPtr), Size) then
RaiseLastOSError;
Result := Format('%d.%d.%d.%d',
[LongRec(FixedPtr.dwFileVersionMS).Hi, //major
LongRec(FixedPtr.dwFileVersionMS).Lo, //minor
LongRec(FixedPtr.dwFileVersionLS).Hi, //release
LongRec(FixedPtr.dwFileVersionLS).Lo]) //build
end;
exports
GetFileVersionToStr;
begin
end.
Подписаться на:
Сообщения (Atom)