вторник, 8 июля 2014 г.

Передача данных в DLL (Статическая загрузка DLL)

Код:

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;

Передача данных в DLL (Динамическая загрузка DLL)

Рыдаю. Просто рыдаю.

Волшебное слово - 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}

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.