Création d'une DLL
Test Simple avec chargement dynamique
Code de la DLL
- dllDLL1.dpr
library dllDLL1; {$mode objfpc}{$H+} var FI: integer; function test:integer; begin result:=FI; inc(FI); end; exports test; initialization FI:=1234; end.
Code du projet de test
unit uFormMain; {$mode objfpc}{$H+} interface uses SysUtils, Forms, Dialogs, StdCtrls; type TFuncInDll = function(): integer; stdcall; { TForm1 } TForm1 = class(TForm) Button1: TButton; Label1: TLabel; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private FDLLHandle: TLibHandle; FDLLFunc: TFuncInDll; procedure LoadDLL; procedure UnloadDLL; public end; var Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.Button1Click(Sender: TObject); begin label1.Caption := IntToStr(FDLLFunc()); end; procedure TForm1.FormCreate(Sender: TObject); begin FDLLFunc := nil; LoadDLL; end; procedure TForm1.FormDestroy(Sender: TObject); begin UnloadDLL; end; { Chargement de la DLL et assignation des functions } procedure TForm1.LoadDLL; var vNomDLL, vNomFunction: string; begin vNomDLL:='dllDLL1.dll'; vNomFunction:='test'; { Chargement de la DLL } FDLLHandle := SafeLoadLibrary(vNomDLL); if FDLLHandle <> 0 then begin { Assignation de la function "test" } FDLLFunc := TFuncInDll(GetProcedureAddress(FDLLHandle, vNomFunction)); if not assigned(FDLLFunc) then raise Exception.CreateFmt('function [%s] non trouvée !',[vNomFunction]); end else raise Exception.CreateFmt('DLL [%s] non chargée !',[vNomDLL]); end; procedure TForm1.UnloadDLL; begin FreeLibrary(FDLLHandle); end; end.
Vous pourriez laisser un commentaire si vous étiez connecté.