Показаны сообщения с ярлыком DLL. Показать все сообщения
Показаны сообщения с ярлыком DLL. Показать все сообщения

среда, 10 сентября 2014 г.

Автозагрузка приложения при старте Windows

Пишем библиотеку:

library autorun;

uses
  Windows,
  Registry;

{$R *.res}


procedure RunOnWinStart(Flag:boolean; NameParam, Path:String);
var Reg:TRegistry;
begin
  if Flag then
  begin
     Reg := TRegistry.Create;
     Reg.RootKey := HKEY_CURRENT_USER;
     Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Run', false);
     Reg.WriteString(NameParam, Path);
     Reg.Free;
  end
  else
  begin
     Reg := TRegistry.Create;
     Reg.RootKey := HKEY_CURRENT_USER;
     Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Run',false);
     Reg.DeleteValue(NameParam);
     Reg.Free;
  end;
end;

exports
  RunOnWinStart;

begin
end.

Далее в программе делаем ее динамическое выполнение:

procedure 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;

вторник, 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.