FAQ DelphiConsultez toutes les FAQ

1
2
3
4
5
6
7
8
 
C:\WINNT\SYSTEM32>tdump -ee -m zipdll.dll 
Turbo Dump  Version 5.0.16.12 Copyright (c) 1988, 2000 Inprise Corporation 
    Display of File ZIPDLL.DLL 
 
EXPORT ord:0001='GetZipDllVersion' 
EXPORT ord:0002='ZipDllExec' 
EXPORT ord:0003='___CPPdebugHook'

1
2
3
4
5
6
function FunctionDetect(LibName, FuncName: string):boolean;  
Var LibHandle:THandle;  
begin  
  LibHandle := LoadLibrary(PChar(LibName));  
  Result := (LibHandle<>0)And(GetProcAddress(LibHandle, PChar(FuncName)) <> nil);  
end;

function Somme(A, B: Integer): Integer; external 'exemple.dll' name 'Somme';

function Somme(A, B: Integer): Integer; external 'exemple.dll' index 1;

ShowMessage(IntToStr(Somme(1, 2)));

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
procedure ChargerEtAppelerSomme; 
var 
  HandleDLL: THandle; 
  Somme: function (A, B: Integer): Integer; 
begin 
  Somme := nil; 
  //Chargement de la DLL 
  HandleDLL := LoadLibrary(pAnsiChar('exemple.dll')); 
  
  //Si la DLL n'est pas chargée on ne continue pas 
  If HandleDLL = 0 then Exit; 
  
  //Récupération de l'adresse de la fonction nommée 'Somme' 
  Somme := GetProcAddress(HandleDLL, pAnsiChar('Somme')); 
  
  //Appel de la fonction si on a bien récupéré son adresse 
  If Assigned(Somme) then 
    ShowMessage(IntToStr(Somme(1, 2))); 
end;

Somme := GetProcAddress(HandleDLL, pAnsiChar('1'));

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
function GetLoadedDLLList(liste: TStrings;Options: TModuleOptions): Boolean; 
type 
  TModuleArray = array[0..1] of HMODULE; 
  PHModule = ^TModuleArray; 
  EnumModType = function (hProcess: Longint; lphModule: PHModule; 
    cb: DWord; var lpcbNeeded: DWord): Boolean; stdcall; 
var 
  psapilib : HModule; 
  EnumProc : EnumModType; 
  Modules  : PHModule; 
  Nombre   : DWord; 
  i        : Longint; 
  FileName : array[0..MAX_PATH] of Char; 
  S        : string; 
begin 
  Result := False; 
  Liste.Clear; 
  
  { Cette fonction n'est possible que sous Windows NT ou supérieur} 
  if Win32Platform <> VER_PLATFORM_WIN32_NT then 
    Exit; 
  
  { Ouverture de la DLL pour obtenir la fonction voulue} 
  psapilib := LoadLibrary('psapi.dll'); 
  if psapilib = 0 then 
    Exit; 
  try 
    { Recherche de l'adresse de la fonction d'énumération} 
    EnumProc := GetProcAddress(psapilib, 'EnumProcessModules'); 
    if not Assigned(EnumProc) then 
      Exit; 
  
    { Le premier appel permet de connaître le nombre d'éléments} 
    if Not EnumProc(GetCurrentProcess, Nil , 0 , Nombre) then 
      Exit; 
    { Réservation de la mémoire ne fonction du nombre} 
    GetMem(Modules,Nombre*SizeOf(HMOdule)); 
    Try 
      { Obtention de la liste des modules} 
      if EnumProc(GetCurrentProcess, Modules, Nombre*SizeOf(HMOdule), Nombre) then 
      begin 
for I := 0 to Nombre-1 do 
begin 
  { Pour chaque module, obtention du nom complet} 
  GetModuleFileName(Modules^[i], FileName, MAX_PATH); 
  { Et ajout dans la liste ( seulement les Dll )} 
  if CompareText(ExtractFileExt(FileName), '.dll') = 0 then 
  begin 
    S := FileName; 
    if moRemovePath in Options then 
      S := ExtractFileName(S); 
    { Stockage de la chaîne} 
    if liste.IndexOf(S) = -1 Then 
      liste.Add(S); 
  end; 
end; 
      end; 
    Finally 
      FreeMem(Modules) 
    End; 
    Result := True; 
  finally 
    FreeLibrary(psapilib); 
  end; 
end;

1
2
3
4
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  GetLoadedDLLList(Memo1.Lines,[]); 
end;

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
procedure GetFileInfo2(const FileName: string;liste: TStrings); 
const 
  VersionInfo: array [1..8] of string 
      = ('FileDescription', 'CompanyName'   , 'FileVersion', 
'InternalName'   , 'LegalCopyRight', 'OriginalFileName', 
'ProductName'    , 'ProductVersion'); 
var 
  Handle   : DWord; 
  Info     : Pointer; 
  InfoData : Pointer; 
  InfoSize : LongInt; 
  DataLen  : UInt; 
  LangPtr  : Pointer; 
  InfoType : string; 
  i        : integer; 
begin 
  { Demande de la taille nécessaire pour stocker les infos de Version} 
  InfoSize:=GetFileVersionInfoSize(PChar(FileName), Handle); 
  if (InfoSize > 0) then 
  begin 
    { Réservation de la mémoire nécessaire} 
    GetMem(Info, InfoSize); 
  
    try 
      if GetFileVersionInfo(PChar(FileName), Handle, InfoSize, Info) then 
      begin 
for i:= 1 to 8 do 
begin 
  InfoType := VersionInfo[i]; 
  if VerQueryValue(Info,'\VarFileInfo\Translation',LangPtr, DataLen) then 
    InfoType:=Format('\StringFileInfo\%0.4x%0.4x\%s'#0,[LoWord(LongInt(LangPtr^)), 
HiWord(LongInt(LangPtr^)), InfoType]); 
  if VerQueryValue(Info,@InfoType[1],InfoData,Datalen) then 
    liste.add(VersionInfo[i]+' : '+strPas(InfoData)); 
end; 
      end; 
    finally 
      FreeMem(Info, InfoSize); 
    end; 
  end; 
end;

1
2
3
4
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  GetFileInfo('c:\windows\system\user32.dll',Memo1.lines); 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
unit uClasseMere; 
  
interface 
  
Type 
  TClasseMere = class  
  Private 
     FOperande1 : integer; 
     FOperande2 : integer; 
  public 
     function Addition : integer; virtual; abstract; 
     Property Operande1 : Integer read FOperande1 write FOperande1; 
     Property Operande2 : Integer read Foperande2 write Foperande2; 
  end; 
  
implementation 
  
end.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
unit uObjetTest; 
  
interface 
  
uses 
  uClasseMere; 
  
Type 
  TObjetTest = class( TClasseMere) 
  public 
     function Addition :integer; 
  end; 
  
implementation 
  
function TobjetTest.Addition:Integer; 
begin 
   result := Operande1 + Operande2; 
end; 
  
end.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
library pluginDLL1; 
uses 
  ShareMem, 
  SysUtils, 
  Classes, 
  uObjetTest in 'uObjetTest.pas'; 
  
{$R *.res} 
  
function Execute( aObjet : TObjetTest):integer; stdcall; 
begin 
   result := aObjet.Addition; 
end; 
  
Exports Execute; 
  
begin 
end.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
uses 
   uClasseMere, uObjetTest; 
  
......... 
  
// Déclaration statique de la DLL 
function Execute( aObjet : TclasseMere):integer; stdcall; external 'PluginDLL1.dll'; 
  
  
procedure TForm1.Button1Click(Sender: TObject); 
var 
 wObjetTest : TObjetTest; 
begin 
  wObjetTest := TObjetTest.Create; 
  try 
    wObjetTest.Operande1 := 3; 
    wObjetTest.Operande2 := 2; 
   showMessage( inttostr( Execute( wObjetTest))); 
  finally 
    Free; 
  end; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
unit uInterface; 
  
interface 
  
type 
  IAddition = Interface 
    function Calcul:integer; 
  end; 
  
implementation 
  
end.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
library PluginDLL1; 
  
uses 
  ShareMem, 
  SysUtils, 
  Classes, 
  uInterface in 'uInterface.pas'; 
  
{$R *.res} 
  
function Execute( aObjet : IAddition):integer; stdcall; 
begin 
   result := aObjet.Calcul; 
end; 
  
exports Execute; 
  
begin 
end.

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
unit uObjetTest; 
  
interface 
  
Uses 
  uInterface; 
  
Type 
  TObjetTest = class( TinterfacedObject, IAddition) 
  Private 
     FOperande1 : integer; 
     FOperande2 : integer; 
  public 
     function Calcul :integer; 
     Property Operande1 : Integer read FOperande1 write FOperande1; 
     Property Operande2 : Integer read Foperande2 write Foperande2; 
  end; 
  
implementation 
  
function TobjetTest.Calcul:Integer; 
begin 
   result := FOperande1 + FOperande2; 
end; 
  
end.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
uses 
   uInterface; 
  
......... 
  
// Déclaration statique de la DLL 
function Execute( aObjet : IAddition):integer; stdcall; external 'PluginDLL1.dll'; 
  
procedure TForm1.Button1Click(Sender: TObject); 
var 
 wObjetTest : TObjetTest; 
begin  
   wObjetTest := TObjetTest.Create; 
   try 
      wObjetTest.Operande1 := 3; 
      wObjetTest.Operande2 := 2; 
      showMessage( inttostr( Execute( wObjetTest))); 
   finally 
      wObjetTest :=nil 
  end; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Dans la DLL :  
//La fonction renvoie à proprement parler la taille de la chaîne, le message est passé en paramètre  
function MessageTexte(Buffer: pChar): Cardinal; stdcall;  
var  
  msg: String;  
begin  
  //On récupère le résultat. Notez que le type string n'est pas proscrit en interne  
  msg := FonctionQuiRenvoieLeMessage();  
  
  Result := Length(msg);  
  
  //Si le buffer a été alloué, on y effectue une copie de la chaîne  
  if Buffer <> nil then  
    StrCopy(Buffer, pAnsiChar(msg));  
end;  
  
exports  
  MessageTexte;

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
function MessageTexte(Buffer: pChar): Cardinal; stdcall; external 'MaDLL.dll';  
  
implementation  
  
{$R *.dfm}  
  
procedure TForm1.Button1Click(Sender: TObject);  
var  
  Taille: Cardinal;  
  Buf: pChar;  
begin  
  
  //On récupère la taille du message  
  Taille := MessageTexte(nil);  
  
  //Puis on alloue la mémoire nécessaire  
  GetMem(Buf, Taille);  
  
  //On récupère/traite le résultat  
  MessageTexte(Buf);  
  ShowMessage(String(Buf));  
  
  //Et enfin on peut libérer la mémoire  
  FreeMem(Buf);  
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
uses ..., Windows;  
  
...  
  
function MessageTexte(var Atome: Word): Cardinal; stdcall;  
var  
  msg: pAnsiChar;  
begin  
  msg := 'message';  
  
  Atome := GlobalAddAtom(msg);  
  
  Result := Length(msg);  
end;  
  
exports 
 MessageTexte;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
function MessageTexte(var Atome: Word): Cardinal; stdcall; external 'dll.dll';  
  
implementation  
  
{$R *.dfm}  
  
procedure TForm1.Button1Click(Sender: TObject);  
var  
  Atome: Word;  
  Taille: Cardinal;  
  Buf: pChar;  
begin  
  Taille := MessageTexte(Atome);  
  
  GetMem(Buf, Taille);  
  
  GlobalGetAtomName(Atome, Buf, Taille);  
  
  ShowMessage(Buf);  
  
  FreeMem(Buf);  
  GlobalDeleteAtom(Atome);  
end;

int WINAPI RemplirTableau(int* TabInt);

FDLLRemplirTableau: function(var iTab : integer): Integer;stdcall;

1
2
3
4
5
6
7
8
9
10
var 
  ... 
  MonTab : array of integer; 
  MaValeurRetour : integer; 
begin 
  ... 
  SetLength(MonTab, 20); 
  
  MaValeurRetour := FDLLRemplirTableau(MonTab[0]); 
  ...