Date Bios (Access Violation)

Version imprimable

Bonjour à tous ,
Et merçi d'avance pour vos réponses.

Voila j'ai developpez un soft pour lequel je dois imperativelment créer une protection sur la date du bios.

Je veux simplement aller lire cette date mais je n'y arrive pas.

Je developpe avec delphi 6 entreprise et j'ai installer la librairie rxlib ...

Mais voila lorsque je veux accéder au information du bios j'ai le message ACCESS VIOLATION AT ADRESS ...

voici le code source

Code:

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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, ShellApi,  Printers, RXCtrls, StdCtrls, Buttons;
 
type
  TForm1 = class(TForm)
    RxLabel1: TLabel;
    RxLabel2: TLabel;
    RxLabel3: TLabel;
    RxLabel4: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    SpeedButton1: TSpeedButton;
    function GetBios(value: integer): String;
    procedure FormActivate(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.DFM}
 
{ TForm1 }
 
function TForm1.GetBios(value: integer): String;
begin
  case value of
   1: result:=String(Pchar(Ptr($FE061)));
   2: result:=String(Pchar(Ptr($FE091)));
   3: result:=String(Pchar(Ptr($FFFF5)));
   4: result:=String(Pchar(Ptr($FEC71)));
  end;
///////////////////////////////////////////////////////////////////////////////////
//  {wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww  //
//  w  (********************************************************************  w  //
//  w  *  Ptr, fonction                                                    *  w  //
//  w  *  Convertit l'adresse spécifiée en pointeur.                       *  w  //
//  w  *  Unité : System                                                   *  w  //
//  w  *  Catégorie : routines d'adresses et de pointeurs                  *  w  //
//  w  *  -------------------------------------------------                *  w  //
//  w  *  function Ptr(Address: Integer): Pointer;                         *  w  //
//  w  *  La fonction Ptr convertit l'adresse donnée en pointeur.          *  w  //
//  w  *  Un appel à cette fonction ne génère pas de code, mais traite     *  w  //
//  w  *  seulement la valeur de 32 bits donnée par Address comme          *  w  //
//  w  *  un pointeur. Tout comme nil, le résultat de Ptr est compatible   *  w  //
//  w  *  en terme d'affectation avec tous les types de pointeurs.         *  w  //
//  w  ********************************************************************)  w  //
//  wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww}  //
///////////////////////////////////////////////////////////////////////////////////
end;
 
procedure TForm1.FormActivate(Sender: TObject);
begin
    RxLabel1.caption:=GetBios(1);
    RxLabel2.caption:=GetBios(2);
    RxLabel3.caption:=GetBios(3);
    RxLabel4.caption:=GetBios(4);
end;
 
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
close
end;
 
end.

C'est un code que j'ai pomper mais aucune des 4 informations ne me parvient

Cela fait plus de deux mois que je cherche une solution mais voila

J'y arrive pas :(

Bonjour,

Les pointeurs d'addresse sur une zone mémoire qui ne fait pas partie de l'application sont manipulés diférement sous WIN32.

J'ai retrouvé un bout de code sensé la date du Bios.
Code:

1 2 3 4 5 6 7 8 9 10 var Sel: Word; begin Sel := AllocSelector(DSeg); try SetSelectorBase(Sel, $F0000); SetSelectorLimit(Sel, $FFFF); ShowMessage(StrPas(PChar(Ptr(Sel, $FFF5)))); finally FreeSelector(Sel) end end;

20/02/2006, 19h09
NoisetteProd

une approche pourrait être WMI grâce à la requète "Select ReleaseDate from Win32_BIOS" dans \root\cimv2

Voir http://laurent-dardenne.developpez.com/articles/wmi-p1/
et http://laurent-dardenne.developpez.com/articles/wmi-p2/

:wink:
20/02/2006, 23h39
sebarif

Merci déjà pour vos réponses,

Pour Graffito , j'ai tenté de récupérer le code mais je reste bloqué au niveau du "AllocSelector" . Estca que il y des librairie special ou autre chose...

Pour noisetteprod je ne vois pas vraiment ce que tu me proposes

Déso mais je développe assez rarement et je n'ai peut etre pas encore les bons reflexes.
21/02/2006, 10h09
LadyWasky

Normal, la méthode utilisée pour obtenir la date du BIOS, ne fonctionne que sur Windows 9x, et avec les BIOS AWARD. Pour les BIOS PHOENIX, AMI, etc, les infos se trouvent ailleurs.

En fait, il faut aller lire les tables DMI du BIOS. Le DMI est une zone particulière du BIOS où tout plein d'informations concernant la machine (carte mère, CPU, BIOS lui même, ports, etc...) sont stockées sous forme de tables.

Sinon, si sous Windows9x l'accès au BIOS est direct, il ne l'est pas sous Windows NT,2000 et XP parce que la mémoire physique est "mappée" en mémoire.

Pour accéder vraiment à la mémoire physique sous NT, 2000 et XP, il faut passer par l'utilisation de certaines fonctions de l'API Windows qui sont présentes dans la DLL NTdll.dll, par exemple UnmapPhysicalMemory, bien sur non documenté par Microsoft :?

Si vous me laissez un petit peu de temps, le temps pour moi de retrouver mon code, de le mettre en forme, etc...

Bon, déjà voici une unité que l'on va utiliser, c'est cette dernière qui va nous permermettre d'accéder à la mémoire physique du PC et donc d'aller lire dans le BIOS sous Windows NT, 2000, XP :

Code:

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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
unit MemoireNT;
interface
uses Windows,dialogs,sysutils,classes;
 
Const BYTESPERLINE = 16;
      LINESPERSCREEN = 25;
      PAGE_NOACCESS = $01;
      PAGE_READONLY = $02;
      PAGE_READWRITE = $04;
      PAGE_WRITECOPY = $08;
      PAGE_EXECUTE = $10;
      PAGE_EXECUTE_READ = $20;
      PAGE_EXECUTE_READWRITE = $40;
      PAGE_EXECUTE_WRITECOPY = $80;
      PAGE_GUARD = $100;
      PAGE_NOCACHE = $200;
 
      OBJ_INHERIT = $00000002;
      OBJ_PERMANENT = $00000010;
      OBJ_EXCLUSIVE = $00000020;
      OBJ_CASE_INSENSITIVE = $00000040;
      OBJ_OPENIF = $00000080;
      OBJ_OPENLINK = $00000100;
      OBJ_VALID_ATTRIBUTES = $000001F2;
 
      ViewShare = 1;
      ViewUnmap = 2 ;
// Functions dans "NTDLL.dll" que l'on localise dynamiquement
type NTSTATUS = Longint;
 
     PLARGE_INTEGER=^LARGE_INTEGER;
     LARGE_INTEGER=record
        case integer of
        0:(LowPart:DWORD;
           HighPart:Longint);
        1:(QuadPart:LONGLONG);
     end;
 
     PHYSICAL_ADDRESS=LARGE_INTEGER;
     PPHYSICAL_ADDRESS=PLARGE_INTEGER;
 
     PUNICODE_STRING=^UNICODE_STRING;
     UNICODE_STRING=record
       Length:SHORT;
       MaximumLength:SHORT;
       Buffer:LPWSTR;
     end;
 
     SECTION_INHERIT = DWord;
 
     POBJECT_ATTRIBUTES=^OBJECT_ATTRIBUTES;
     OBJECT_ATTRIBUTES = packed record
                            Length: Cardinal;
                            RootDirectory: THandle;
                            ObjectName: PUNICODE_STRING;
                            Attributes: Cardinal;
                            SecurityDescriptor: Pointer;
                            SecurityQualityOfService: Pointer;
                          end;
 
     TNTUNMAPVIEWOFSECTION=function(ProcessHandle: integer;
                                    BaseAddress: Pointer): NTSTATUS; stdcall;
     TNTOPENSECTION=function(SectionHandle: PHANDLE;
                  DesiredAccess:ACCESS_MASK;
                  ObjectAttributes: POBJECT_ATTRIBUTES): NTSTATUS; stdcall;
     TNTMAPVIEWOFSECTION=function(SectionHandle:THANDLE;
                  ProcessHandle: integer;
                  var BaseAddress: Pointer;
                  ZeroBits: ULONG;
                  CommitSize: ULONG;
                  SectionOffset:PLARGE_INTEGER;
                  ViewSize: PULONG;
                  InheritDisposition: SECTION_INHERIT;
                  AllocationType:  ULONG;
                  Protect: ULONG): NTSTATUS; stdcall;
 
     TRTLINITUNICODESTRING=procedure(DestinationString:PUNICODE_STRING;
              SourceString: LPCWSTR) stdcall;
 
     TRTLNTSTATUSTODOSERROR=function(Status:NTSTATUS): ULONG stdcall;
 
function NT_SUCCESS(Status:NTSTATUS):boolean;
procedure InitializeObjectAttributes(var p:OBJECT_ATTRIBUTES; n:UNICODE_STRING; a:Cardinal; r:THandle; s:Pointer );
procedure getmemdump(paddress:DWORD;var Alength:DWORD; var MemDump:array of byte);
function IsNTDllPresent:boolean;
 
 
var  NTUNMAPVIEWOFSECTION:TNTUNMAPVIEWOFSECTION;
     NTOPENSECTION:TNTOPENSECTION;
     NTMAPVIEWOFSECTION:TNTMAPVIEWOFSECTION;
     RTLINITUNICODESTRING:TRTLINITUNICODESTRING;
     RTLNTSTATUSTODOSERROR:TRTLNTSTATUSTODOSERROR;
     NTDLL_LibHandle:THandle;
implementation
uses Forms;
function NT_SUCCESS(Status:NTSTATUS):boolean;
begin
  result:=(Status>= 0);
end;
 
procedure InitializeObjectAttributes(var p:OBJECT_ATTRIBUTES; n:UNICODE_STRING; a:Cardinal; r:THandle; s:Pointer );
begin
        p.Length := sizeof(OBJECT_ATTRIBUTES);
        p.RootDirectory := r;
        p.Attributes := a;
        p.ObjectName := @n;
        p.SecurityDescriptor := s;
        p.SecurityQualityOfService := Nil;
end;
 
 
// PrintError
// Renvoi sous forme de message intelligible, la dernière erreur qui a été rencontrée
 
procedure PrintError(AMessage: string;status: NTSTATUS);
var errMsg:PChar;
    errMsg2:string;
begin
  errMsg:='';
  FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM+FORMAT_MESSAGE_ALLOCATE_BUFFER,
                Nil,
                RTLNTSTATUSTODOSERROR(STATUS),
                ((SUBLANG_DEFAULT) shl 10) or LANG_NEUTRAL,
                errMsg,0,nil);
  errMsg2:=errMsg;
  showmessage(AMESSAGE+' : '+errMsg2);
end;
 
// UnmapPhysicalMemory
// "Démappe" une zone mémoire
 
Procedure UnmapPhysicalMemory(AnAddress: DWORD);
var status:NTSTATUS;
begin
  status:=NtUnmapViewOfSection(-1,Ptr(AnAddress));
  if (not NT_SUCCESS(Status))
  then PrintError('Unable to unmap view',status);
end;
 
// MapPhysicalMemory
// "Mappe" une zone mémoire de mémoire physique
 
 
function MapPhysicalMemory(PhysicalMemory: THandle;
                           var AnAddress,length,VAddress,AnOffset:DWord): boolean;
var ANTStatus:NTSTATUS;
    viewBase:PHYSICAL_ADDRESS;
    VirtualAddress:Pointer;
begin
vaddress:=0;
VirtualAddress:=Ptr(vaddress);
viewBase.QuadPart:=AnAddress;
ANTStatus:=NtMapViewOfSection(PhysicalMemory,
                              -1,
                              VirtualAddress,
                              0,
                              Length,
                              @viewBase,
                              @Length,
                              ViewShare,
                              0,
                              PAGE_READONLY);
vaddress:=Cardinal(VirtualAddress);
AnOffset:=AnAddress-viewBase.LowPart;
if (not NT_SUCCESS(ANTStatus)) then
   begin
     PrintError('Could not map view of '+inttostr(AnAddress)+' length '+inttostr(length),ANTStatus);
     result:=false;
   end
else
   begin
     AnAddress:=viewBase.LowPart;
     //VAddress:=virtualaddress^;
     result:=true;
   end;
end;
 
// OpensPhysicalMemory 
// Ouvre un Handle sur la mémoire physique du PC
 
function OpenPhysicalMemory: THandle;
var Status:NTSTATUS;
    physmem:THandle;
    physmemstring:UNICODE_STRING;
    attributes:OBJECT_ATTRIBUTES;
    physmemname:array[0..24] of Widechar;
    s:string;
begin
  s:='\device\physicalmemory';
  //FreeAndNil(physmemname);
  StringToWideChar(s,@physmemname,sizeof(physmemname)-1);
  RtlInitUnicodeString(@PHYSMEMSTRING,@PHYSMEMNAME);
  InitializeObjectAttributes(ATTRIBUTES,
                             PHYSMEMSTRING,
                             OBJ_CASE_INSENSITIVE,
                             0,nil);
  Status:=NtOpenSection(@physmem,SECTION_MAP_READ,@ATTRIBUTES);
 
if (not NT_SUCCESS(Status)) then
   begin
     PrintError('Could not open \\device\\physicalmemory',Status);
     result:=0;
   end
else result:=physmem;
end;
 
// LocateNtdllEntryPoints
 
function LocateNtdllEntryPoints: BOOLEAN;
var  ok:boolean;
begin
NTDLL_LibHandle:=0;
NTDLL_LibHandle:=SafeLoadLibrary('ntdll.dll');
ok:=true;
if NTDLL_LibHandle>=HINStance_error then
    begin
      @RTLINITUNICODESTRING:=GetProcAddress(NTDLL_LibHandle,'RtlInitUnicodeString');
      if @RTLINITUNICODESTRING=nil then ok:=false;
      if ok then
      begin
        @NTUNMAPVIEWOFSECTION:=GetProcAddress(NTDLL_LibHandle,'NtUnmapViewOfSection');
        if @NTUNMAPVIEWOFSECTION=nil then ok:=false;
      end;
      if ok then
      begin
        @NTOPENSECTION:=GetProcAddress(NTDLL_LibHandle,'NtOpenSection');
        if @NTOPENSECTION=nil then ok:=false;
      end;
      if ok then
      begin
        @NTMAPVIEWOFSECTION:=GetProcAddress(NTDLL_LibHandle,'NtMapViewOfSection');
        if @NTMAPVIEWOFSECTION=nil then ok:=false;
      end;
      if ok then
      begin
        @RTLNTSTATUSTODOSERROR:=GetProcAddress(NTDLL_LibHandle,'RtlNtStatusToDosError');
        if @RTLNTSTATUSTODOSERROR=nil then ok:=false;
      end;
 
    end
    else begin
            ShowMessage('OS non NT ?');
            ok:=false;
         end;
result:=ok;
end;
 
 
// Fonctions principales utilisées
Function IsWinNT : Boolean;
var
 OS :TOSVersionInfo;
begin
 ZeroMemory(@OS,SizeOf(OS));
 OS.dwOSVersionInfoSize:=SizeOf(OS);
 GetVersionEx(OS);
 Result:=OS.dwPlatformId=VER_PLATFORM_WIN32_NT;
end;
 
function IsNTDllPresent:boolean;
var
  Handle: THandle;
begin
  result:=false;
  if IsWinNT then
  begin
  Handle := LoadLibrary('NTDLL.DLL');
  if Handle <> 0 then
  begin
    result:=true;
    FreeLibrary(Handle);
  end
  end;
end;
 
//obtient un Dump de la mémoire
procedure getmemdump(paddress:DWORD;var Alength:DWORD; var MemDump:array of byte);
var
physmem:THandle;
vaddress,i,TheOffset,LengthReturned,LengthInput,MaxLength:DWORD;
begin
// Localisation et chargement des points d''entrée de NTDLL.DLL 
LengthInput:=Alength;
if (not LocateNtdllEntryPoints) then
begin
  ShowMessage('Localisation des points d''entrée de NTDLL.DLL impossible');
  FreeLibrary(NTDLL_LibHandle);
  exit;
end;
 
// Ouvre la mémoire physique
physmem:=OpenPhysicalMemory;
if (physmem=0) then
begin
  ShowMessage('Unable to open physical memory');
  FreeLibrary(NTDLL_LibHandle);
  exit;
end;
 
// Enter the command loop
if MapPhysicalMemory(physmem,paddress,LengthInPut,vaddress,TheOffset) then
begin
  // Dump
  MaxLength:=sizeof(MemDump);
  LengthReturned:=LengthInPut-TheOffSet;
  if LengthReturned<MaxLength then MaxLength:=LengthReturned;
  if Alength<MaxLength then MaxLength:=Alength;
  Alength:=MaxLength;
  if Alength>0 then
  for i:=0 to Alength-1 do MemDump[i]:=byte(Ptr(vaddress+TheOffset+i)^);
  //movememory(@MemDump,Ptr(vaddress),sizeof(MemDump));
  // Démappe
  UnmapPhysicalMemory(vaddress);
  // Ferme la zone de mémoire physique que l'on vient d'obtenir
  CloseHandle(physmem);
  FreeLibrary(NTDLL_LibHandle);
end;
end;
end.

Et puis ça, c'est un exemple d'utilisation : un composant tout fait à installer pour accéder aux infos du bios :

Code:

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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
unit BiosInfo;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes,// Graphics, Controls,
    inifiles,registry,strutils,vclutils,memoirent;
 
type
  TBiosInfo = class(TComponent)
  private
    { Private declarations }
    fBiosName:string;
    fNT:boolean;
    fBiosVersion:string;
    fBiosDate:string;
    fBiosID:string;
    fBiosDellSN:String;
    fBiosInfo:TStringList;
    tBiosID:string;
    fComputerName:string;
    fComputerType:string;
    fComputerRole:string;
    utBiosInfo:TStringList;
    fSections:TStringList;
    fKeys:TStringList;
    fValues:TStringList;
    fEndDetect:TNotifyEvent;
    BiosFound:Boolean;
    BiosInfoInf:TmemIniFile;
    MemDump:array[0..$FFFF] of byte;
  protected
    { Protected declarations }
    procedure DellSN;
    procedure DoSection(SectionName:string);
    procedure GetRegistryBios;
    procedure ScanRegistryBios(CurrentKey,SubKey:string);
  public
    { Public declarations }
 
    constructor Create(AOwner:TComponent); override;
    procedure Loaded; override;
    procedure destroy; 
    procedure Detect;
  published
    { Published declarations }
    property BiosName:string read fBiosName write fBiosName;
    property BiosVersion:string read fBiosVersion write fBiosVersion;
    property BiosID:string read fBiosID write fBiosID;
    property BiosDate:string read fbiosDate write fbiosDate;
    property BiosInfo:TStringList read fBiosInfo write fBiosInfo;
    property BiosDellSN:string read fBiosDellSN write fBiosDellSN;
    property ComputerName:string read fComputerName write fComputerName;
    property ComputerType:string read fComputerType write fComputerType;
    property ComputerRole:string read fComputerRole write fComputerRole;
    property OnEndDetect:TNotifyEvent read fEndDetect write fEndDetect;
  end;
 
procedure Register;
 
implementation
constructor TBiosInfo.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  fBiosInfo:=TStringList.Create;
  fSections:=TStringList.Create;
  fKeys:=TStringList.Create;
  fValues:=TStringList.Create;
  fEndDetect:=nil;
end;
 
procedure TBiosInfo.Loaded;
begin
  inherited Loaded;
  //Detect;
end;
 
procedure TBiosInfo.destroy;
begin
  fValues.Free;
  fKeys.Free;
  fSections.Free;
  fBiosInfo.Free;
  inherited Free;
end;
 
procedure TBiosInfo.Detect;
var i:Cardinal;
    infos_de_version : TOSVersionInfo;
    OSVersion,si1,si2,si3:string;
    memodump:array[0..1] of byte;
    Alength:Cardinal;
begin
  infos_de_version.dwOSVersionInfoSize:=sizeof(infos_de_version);
  GetVersionEx(infos_de_version);    //lecture des infos
  case infos_de_version.dwPlatformId of
        VER_PLATFORM_WIN32s          : OSVersion:='Windows 3.1 avec Win32s ';
        VER_PLATFORM_WIN32_WINDOWS   : OSVersion:='Windows 95';
        VER_PLATFORM_WIN32_NT        : OSVersion:='Windows NT';
  end;
  fNT:=(OSVersion='Windows NT');
  try
  //fmemport.Address:=$FFFF5;
  if fNT then
  begin
    for i:=0 to $ffff do
    begin
      ALength:=1;
      getmemdump($f0000+i,ALength,MemoDump);
      memdump[i]:=MemoDump[0];
    end;
  end else
     for i:=0 to $ffff do memdump[i]:=byte(Ptr($f0000+i)^);
 
  fBiosDate:='';
  fBiosDate:=Pchar(@MemDump[$fff5]);
 
  fBiosID:='';
  fBiosVersion:='';
  utBiosInfo:=TStringList.Create;
  fBiosInfo.Clear;
  fSections.Clear;
  BiosFound:=False;
  BiosInfoInf:=Tmeminifile.Create('BiosInfo.inf');
  BiosInfoInf.ReadSections(fSections);
  i:=0;
  while (i<fSections.Count) do
  begin
    DoSection(fSections.Strings[i]);
    inc(i);
  end;
  if pos('Dell',fBiosID)>0 then DellSN;
  finally
  utBiosInfo.Free;
  BiosInfoInf.Free;
  end;
  GetRegistryBios;
  si1:=ExtractDelimited(1,fBiosDate,['/']);  //MM
  si2:=ExtractDelimited(2,fBiosDate,['/']);  //JJ
  si3:=ExtractDelimited(3,fBiosDate,['/']);  //YY
  //fBiosDate:=si2+'/'+si1+'/'+si3;
  DellSN;
  if assigned(fEndDetect) then fEndDetect(self);
end;
 
procedure TBiosInfo.DellSN;
var s2,s3:string;
    success,bsearch:boolean;
    StartSearch,EndSearch,i1,i2:cardinal;
    sc:array[0..200] of char;
begin
    StartSearch:=H2D('0000');
    EndSearch:=H2D('FFFF')-1;
    s2:='Dell Computer Corporation';
    i1:=length(s2);
    for i2:=0 to i1 do sc[i2]:=s2[i2+1];
    bsearch:=false;
    i2:=StartSearch;
    while ((i2<=(EndSearch-i1)) and (not bsearch)) do
        begin
          //move(ptr(i2)^,BiosCopy[0],200);
          //for j:=0 to 199 do
          //    sc2[j]:=Pchar(i2+j)^;
          //copymemory(@BiosCopy[0],ptr(i2),200);
 
          //if fNT then
          //begin
            //ALength:=100;
            //getmemdump(i2,ALength,MemDump);
            s3:=Pchar(@MemDump[i2]);
          //end
          //else s3:=PChar(i2);
 
          if length(s3)>0 then
          bsearch:=comparemem(@sc[0],@s3[1],i1) and (s3=s2)
          else bsearch:=false;
          if (bsearch and ((i2+length(s2)+1)<=(EndSearch-5))) then
          begin
            //move(ptr(i2+length(s2)+1)^,sc2[0],i1);
            //for j:=0 to 199 do sc2[j]:=Pchar(i2+length(s2)+1j)^;
            //if fNT then
            //begin
              //ALength:=100;
              //getmemdump(i2+length(s2)+1,ALength,MemDump);
              s3:=PChar(@MemDump[i2+length(s2)+1]);
            //end
            //else s3:=Pchar(i2+length(s2)+1);
          end
          else s3:='';
          bsearch:=bsearch and ((length(s3)=5) or (length(s3)=7));
          inc(i2,1);
        end;
    Success:=bsearch;
    if Success then fBiosDellSN:=s3 else fBiosDellSN:='Non trouvé...';
end;
 
procedure TBiosInfo.DoSection(SectionName:string);
var BiosIdentified:boolean;
    i:Cardinal;
    date1,date2:TDatetime;
    s1,s2,s22,s3,s4:string;
    i1,i2,i3,i4:Cardinal;
    c1,c2:char;
    i5:integer;
    si1,si2,si3:word;
    sc:array[0..200] of char;
    bsearch,Success:boolean;
    StartSearch,EndSearch,MLocation:Cardinal;
    sLine:string;
    Alength:Cardinal;
begin
   tBiosID:=SectionName;
   Success:=true;
   fKeys.Clear;
   fValues.Clear;
   BiosInfoInf.ReadSection(SectionName,fKeys);
   BiosInfoInf.ReadSectionValues(SectionName,fValues);
   If ((fkeys.IndexOf('search')<0) and
      (fkeys.IndexOf('memory')<0) and
      (fkeys.IndexOf('pointer')<0))
   then Success:=False;
   utBiosInfo.Clear;
   i:=0;
   BiosIdentified:=Success;
   While ((Success) and (i<fKeys.Count)) do
   begin
     sLine:=fValues.strings[i];
     s1:=Copy2SymbDel(sLine,'=');
     if fKeys.strings[i]='date' then
        begin
          //s1:=ExtractDelimited(1,sLine,[',']);  //comp
          si1:=strtoint(ExtractDelimited(1,fBiosDate,['/']));  //MM
          si2:=strtoint(ExtractDelimited(2,fBiosDate,['/']));  //JJ
          si3:=strtoint(ExtractDelimited(3,fBiosDate,['/']));  //YY
          if si3<60 then si3:=si3+2000 else si3:=si3+1900;
          //shortdateformat:='mm/dd/yy';
          if (si2>12) then Date2:=EncodeDate(si3,si1,si2)
          else
          if (si1>12) then Date2:=EncodeDate(si3,si2,si1)
          else Date2:=EncodeDate(si3,si1,si2);
          s1:=ExtractDelimited(1,sLine,[',']);  //comp
          si1:=strtoint(ExtractDelimited(2,sLine,[',']));  //MM
          si2:=strtoint(ExtractDelimited(3,sLine,[',']));  //JJ
          si3:=strtoint(ExtractDelimited(4,sLine,[',']));  //YY
          if si3<60 then si3:=si3+2000 else si3:=si3+1900;
          if (si2>12) then Date1:=EncodeDate(si3,si1,si2)
          else
          if (si1>12) then Date1:=EncodeDate(si3,si2,si1)
          else Date1:=EncodeDate(si3,si1,si2);
          if s1='"<"' then Success:=(Date2 < Date1);
          if ((s1='"<="') or (s1='"=<"')) then Success:=(Date2 <= Date1);
          if ((s1='"="') or (s1='"=="')) then Success:=(Date2 = Date1);
          if ((s1='">="') or (s1='"=>"')) then Success:=(Date2 >= Date1);
          if s1='">"' then Success:=(Date2 > Date1);
        end
     else if fKeys.strings[i]='search' then
        begin
          StartSearch:=H2D(ExtractDelimited(1,sLine,[',']));
          StartSearch:=StartSearch*16+H2D(ExtractDelimited(2,sLine,[',']))-$F0000;
          EndSearch:=H2D(ExtractDelimited(1,sLine,[',']));
          EndSearch:=EndSearch*16+(H2D(ExtractDelimited(3,sLine,[',']))-2)-$F0000;
          if ExtractDelimited(4,sLine,[','])='B' then
            begin
              i1:=WordCount(sline,[','])-4;
              for i2:=0 to i1-1 do sc[i2]:=char(H2D(ExtractDelimited(i2+5,sLine,[','])));
            end;
          if ExtractDelimited(4,sLine,[','])='S' then
            begin
              s2:=ExtractDelimited(5,sLine,[',']);
              s22:='';
              i1:=length(s2)-2;
              for i2:=0 to i1-1 do
              begin
                sc[i2]:=s2[i2+2];
                s22:=s22+s2[i2+2];
              end;
            end;
 
          bsearch:=false;
          i2:=StartSearch;
          while ((i2<=(EndSearch-i1)) and (not bsearch)) do
              begin
                //if fNT then
                //  begin
                    ALength:=100;
                    //Getmemdump(i2,ALength,MemDump);
                    s4:=PChar(@MemDump[i2]);
                    bsearch:=(length(s4)>=i1);
                    i3:=0;
                    while ((i3<i1) and bsearch) do
                    begin
                      c1:=sc[i3];
                      c2:=s4[i3+1];
                      bsearch:=bsearch and (c1=c2);
                      inc(i3);
                    end;
                //  end
                //else
                //  begin
                //    s4:=PChar(i2);
                //    bsearch:=(length(s4)>=i1);
                //    i3:=0;
                //    while ((i3<i1) and bsearch) do
                //    begin
                //      c1:=sc[i3];
                //      c2:=s4[i3+1];
                //      bsearch:=bsearch and (c1=c2);
                //      inc(i3);
                //    end;
                //  end;
                if (length(s4)>(2*i1)) then
                begin
                 if (pos(s22,s4)<0) then inc(i2,i1)
                 else inc(i2,1);
                end else inc(i2,1);
              end;
          Success:=bsearch;
          s3:=s4;
          if (Success  and (ExtractDelimited(4,sLine,[','])='S'))
          then utBiosInfo.Add(s3);
        end
     else if fKeys.strings[i]='memory' then
        begin
          MLocation:=H2D(ExtractDelimited(1,sLine,[',']));
          MLocation:=MLocation*16+H2D(ExtractDelimited(2,sLine,[',']))-$F0000;
          if ExtractDelimited(3,sLine,[','])='B' then
            begin
              i1:=WordCount(sline,[','])-3;
              for i2:=0 to i1-1 do sc[i2]:=char(H2D(ExtractDelimited(i4+5,sLine,[','])));
            end;
          if ExtractDelimited(3,sLine,[','])='S' then
            begin
              s2:=ExtractDelimited(4,sLine,[',']);
              i1:=length(s2)-2;
              for i2:=0 to i1-1 do sc[i2]:=s2[i2+2];
            end;
          //if fNT then
          //begin
            //ALength:=100;
            //Getmemdump(MLocation,ALength,MemDump);
            s3:=Pchar(@MemDump[MLocation]);
            //for i3:=0 to i1 do sc2[i3]:=char(MemDump[MLocation+i3]);
            Success:=comparemem(@sc[0],@MemDump[MLocation],i1);
            //Success:=comparemem(@sc[0],@sc2[0],i1);
          //end
          //else
          //  begin
          //    s3:=Pchar(MLocation);
          //    Success:=comparemem(@sc[0],Ptr(MLocation),i1);
          //  end;
          if (Success  and (ExtractDelimited(3,sLine,[','])='S'))
          then utBiosInfo.Add(s3);
        end
     else if fKeys.strings[i]='pointer' then
        begin
          MLocation:=H2D(ExtractDelimited(1,sLine,[',']));
          MLocation:=MLocation*16+H2D(ExtractDelimited(3,sLine,[',']));
          MLocation:=MLocation+H2D(ExtractDelimited(4,sLine,[',']));
          MLocation:=MLocation+H2D(ExtractDelimited(5,sLine,[',']))-$FFFF;
          s1:=ExtractDelimited(6,sLine,[',']);
          if ExtractDelimited(7,sLine,[','])='B' then
            begin
              i1:=WordCount(sline,[','])-7;
              s4:='';
              for i2:=0 to i1-1 do s4:=s4+char(H2D(ExtractDelimited(i2+8,sLine,[','])));
              s3:='';
              for i2:=0 to i1-1 do
              begin
                //if fNT
                //then
                //  begin
                     //ALength:=100;
                     //getmemdump(MLocation,ALength,MemDump);
                     s3:=Pchar(@MemDump[i2])
                //  end
                //else s3:=s3+char(MLocation+i2);
              end;
            end;
          if ExtractDelimited(7,sLine,[','])='S' then
            begin
              s2:=ExtractDelimited(8,sLine,[',']);
              i1:=length(s1)-2;
              s4:='';
              for i2:=0 to i1-1 do s4:=s4+s2[i2+2];
              //if fNT
              //  then begin
              //         ALength:=100;
                       //getmemdump(MLocation,ALength,MemDump);
                       s3:=Pchar(@MemDump[MLocation]);
              //       end
              //  else s3:=strpas(Pchar(MLocation));
            end;
          i5:=comparestr(s3,s4);
          if s1='"<"' then Success:=(i5 < 0)
          else  if ((s1='"<="') or (s1='"=<"')) then Success:=(i5 <= 0)
          else  if ((s1='"="') or (s1='"=="')) then Success:=(i5 = 0)
          else  if ((s1='">="') or (s1='"=>"')) then Success:=(i5 >= 0)
          else  if s1='">"' then Success:=(i5 > 0);
 
          if (Success  and (ExtractDelimited(8,sLine,[','])='S'))
          then utBiosInfo.Add(s3);
        end;
        BiosIdentified:=BiosIdentified and success;
     inc(i);
   end;
   BiosFound:=BiosFound or BiosIdentified;
   if Biosidentified then
   begin
      if fBiosID='' then
      fBiosId:=tBiosId else
      fBiosId:=fBiosId+' - '+tBiosId;
      fBiosInfo.AddStrings(utBiosInfo);
   end;
end;
 
procedure TBiosInfo.ScanRegistryBios(CurrentKey,SubKey:string);
var HardList:TStringList;
    i:Cardinal;
    ini:TRegistry;
    s1,KeyToDo:string;
begin
  If CurrentKey='' then
  begin
    KeyToDo:='Enum';
  end
  else KeyToDo:=CurrentKey+'\'+SubKey;
  ini := TRegistry.Create;
  ini.LazyWrite := false;
  if pos('*PNP0C01',CurrentKey)>0 then
  begin
    ini.RootKey:=HKEY_LOCAL_MACHINE;
    ini.OpenKeyReadOnly(KeyToDo);
    If ini.valueexists('BIOSName') and (fBiosName='') then
       fBiosName:=ini.Readstring('BIOSName');
    If ini.valueexists('BIOSVersion') and (fBiosVersion='') then
       fBiosVersion:=ini.Readstring('BIOSVersion');
    If ini.valueexists('ComputerName') and (fComputerName='') then
       fComputerName:=ini.Readstring('ComputerName');
    If ini.valueexists('MachineType') and (fComputerType='') then
       fComputerType:=ini.Readstring('MachineType');
    If ini.valueexists('SetupMachineType') and (fComputerRole='') then
       fComputerRole:=ini.Readstring('SetupMachineType');
    ini.closekey;
  end;
  HardList := TStringList.Create;
  HardList.Clear;
  ini.RootKey:=HKEY_LOCAL_MACHINE;
  ini.OpenKeyReadOnly(KeyToDo);
    if ini.HasSubKeys then
    begin
      ini.GetKeyNames(HardList);
      i:=0;
      while (i<HardList.Count)  do
      begin
        s1:=HardList.Strings[i];
        ScanRegistryBios(KeyToDo,s1);
        i:=i+1;
      end;
    end;
  ini.CloseKey;
  ini.Free;
  HardList.Free;
end;
 
procedure TBiosInfo.GetRegistryBios;
var infos_de_version : TOSVersionInfo;
    OSVersion:string;
    iniBios:TRegistry;
    BData : array[0..255] of char;
begin
  infos_de_version.dwOSVersionInfoSize:=sizeof(infos_de_version);
  GetVersionEx(infos_de_version);    //lecture des infos
  case infos_de_version.dwPlatformId of
        VER_PLATFORM_WIN32s          : OSVersion:='Windows 3.1 avec Win32s ';
        VER_PLATFORM_WIN32_WINDOWS   : OSVersion:='Windows 95';
        VER_PLATFORM_WIN32_NT        : OSVersion:='Windows NT';
  end;
  if OSVersion='Windows NT'
  then
  begin
    iniBios:=TRegistry.Create;
    iniBios.RootKey:=HKEY_LOCAL_MACHINE;
    If iniBios.OpenKeyReadOnly('HARDWARE\DESCRIPTION\System') Then
     Begin
      //IF iniBios.ValueExists('SystemBiosDate') then fBiosDate:=iniBios.Readstring('BiosDate');
      If iniBios.ValueExists('Identifier') then fBiosName:=iniBios.Readstring('Identifier');
      If iniBios.ValueExists('SystemBiosVersion') then
          Begin
           try
            iniBios.ReadBinaryData('SystemBiosVersion',BData,255);
            fBiosVersion:=Bdata;
           except
           End;
          end;
     End;
     iniBios.CloseKey;
     iniBios.Free;
     ScanRegistryBios('SYSTEM','CurrentControlSet')
  end
  else ScanRegistryBios('','');
end;
 
procedure Register;
begin
  RegisterComponents('WA', [TBiosInfo]);
end;
 
end.

Enfin, sachez, que les deux unités que je vous ai livré sont de ma création, qu'elles sont libres de droit et d'utilisation. :wink:
Bref, no copyright inside.

Voilà, voilà.

21/02/2006, 10h32
LadyWasky

Une précision de taille, pour faire tourner le code sous NT, 2000 ou XP, il faut avoir les droits administrateur !
21/02/2006, 12h16
edam

une question, peut on utlisé ZLPortIO pour accédé au bios???
:oops:
21/02/2006, 12h53
LadyWasky

Citation:

Envoyé par edam

une question, peut on utlisé ZLPortIO pour accédé au bios???
:oops:

C'est pas un composant pour acceder aux ports d'entrée sortie( port COM/Parallele, etc..) ?

Précision : Le code que j'ai donné en exemple, c'est pour récupérer le numéro de série d'un DELL, ça ne marche pas avec les autres PC :cry:

Ceci est un peu plus générique, attention, ça fait mal :P :

Code:

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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
 
unit WAMemory;
 
interface
uses windows,classes,SysUtils,forms;
type
  TPlatform=(OS_Win9x,OS_WinNT);
const Platforms:array[OS_Win9x..OS_WinNT] of string=('Win 3.1/95/98/98SE/ME','Win NT/2000/XP');
 
type
  TMemoryZone=array[$f0000..$fffff] of byte;
  TWAMemory=class(TObject)
  private
    md:TMemoryZone; //Dump Memoire
    fCurrentAddress:Cardinal;
    fplatform:TPlatform;
  protected
    procedure getplatform;
    procedure DumpBios;
  public
    constructor Create;
    destructor destroy; override;
    procedure LoadFromBios;
    procedure LoadFromFile(const FileName: string);
    procedure SavetoFile(const FileName: string);
    function gsfb(debut,longueur:cardinal):string;
    function getbyte(adresse:cardinal):byte;
    function getchar(adresse:cardinal):char;
    function getword(adresse:cardinal):word;
    function getdword(adresse:cardinal):dword;
    //accès par ofset, initialiser "CurrentAddress" avant
    function obyte(offset:cardinal):byte;
    function ochar(offset:cardinal):char;
    function oword(offset:cardinal):word;
    function odword(offset:cardinal):dword;
    property BiosDump:TMemoryZone read md;
    property CurrentAddress:Cardinal read fCurrentAddress write fCurrentAddress;
    property OSPlatform:TPlatform read fplatform;
  end;
 
  TWAMemoryInfo=class(TComponent)
  private
    mi:TWAmemory;
    fOSVersion:string;
  protected
    procedure setdummy(AValue:string);
  public
    constructor Create(AOwner:TComponent); override;
    destructor destroy; override;
    property MemoryInfo:TWAmemory read mi write mi;
  published
    property OSVersion:string read fOSVersion write setdummy;
  end;
 
procedure Register;
implementation
uses memoirent;
 
constructor TWAMemory.Create;
begin
  inherited create;
  getplatform;
  Application.processmessages;
end;
 
destructor TWAMemory.destroy;
begin
  inherited destroy;
end;
 
procedure TWAMemory.Getplatform;
var infos_de_version :TOSVersionInfo;
begin
  infos_de_version.dwOSVersionInfoSize:=sizeof(infos_de_version);
  GetVersionEx(infos_de_version);    //lecture des infos
  if infos_de_version.dwPlatformId=VER_PLATFORM_WIN32_NT
  then fplatform:=OS_WinNT
  else fplatform:=OS_Win9x;
end;
 
procedure TWAMemory.LoadFromBios;
begin
  DumpBios;
  fCurrentAddress:=$f0000;
end;
 
procedure TWAMemory.LoadFromFile(const FileName: string);
var AStream:TFileStream;
begin
  AStream:=TFileStream.Create(FileName,fmOpenRead);
  AStream.Read(md[$f0000],sizeof(md));
  AStream.Free;
  fCurrentAddress:=$f0000;
end;
 
procedure TWAMemory.SavetoFile(const FileName: string);
var AStream:TFileStream;
begin
  AStream:=TFileStream.Create(FileName,fmCreate or fmOpenWrite);
  AStream.Write(md[$f0000],sizeof(md));
  AStream.Free;
  fCurrentAddress:=$f0000;
end;
 
procedure TWAMemory.DumpBios;
var i:Cardinal;
    memodump:array[0..1] of byte;
    Alength:Cardinal;
begin
  getplatform;
  if (fplatform=OS_WinNT) then
  begin
    for i:=$f0000 to $fffff do
    begin
      ALength:=1;
      getmemdump(i,ALength,MemoDump);
      md[i]:=MemoDump[0];
    end;
  end else
     for i:=$f0000 to $fffff do md[i]:=byte(Ptr(i)^);
end;
 
function TWAMemory.gsfb(debut,longueur:cardinal):string;
var i:cardinal;
    s:string;
begin
  s:='';
  if longueur>0 then
  for i:=debut to debut+longueur-1 do
  s:=s+char(md[i]);
  result:=s;
end;
 
function TWAMemory.getbyte(adresse:cardinal):byte;
begin
  result:=md[adresse];
end;
 
function TWAMemory.getchar(adresse:cardinal):char;
begin
  result:=chr(md[adresse]);
end;
 
function TWAMemory.getword(adresse:cardinal):word;
begin
  result:=md[adresse+1]*256+md[adresse];
end;
 
function TWAMemory.getdword(adresse:cardinal):dword;
begin
  result:=getword(adresse+2)*65536+getword(adresse);
end;
 
function TWAMemory.obyte(offset:cardinal):byte;
begin
  result:=getbyte(fCurrentAddress+offset);
end;
 
function TWAMemory.ochar(offset:cardinal):char;
begin
  result:=getchar(fCurrentAddress+offset);
end;
 
function TWAMemory.oword(offset:cardinal):word;
begin
  result:=getword(fCurrentAddress+offset);
end;
 
function TWAMemory.odword(offset:cardinal):dword;
begin
  result:=getdword(fCurrentAddress+offset);
end;
 
constructor TWAMemoryInfo.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  mi:=TWAMemory.Create;
  fOSVersion:=Platforms[mi.OSPlatform];
end; 
 
destructor TWAMemoryInfo.destroy;
begin
  mi.destroy;
  mi:=nil;
end;
 
procedure TWAMemoryInfo.setdummy(AValue:string);
begin
  //
end;
 
procedure Register;
begin
  RegisterComponents('WA',[TWAMemoryInfo]);
end;
 
end.

Seconde unité...

Code:

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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
unit SMBIOSStructures;
 
interface
uses
  Windows, Messages, SysUtils, Classes,WADMIUtils;
 
const
  sWakeupType:array[0..8] of string=('Réservé','Autre','Inconnu','APM Timer','Modem Ring','LAN Remote','Power Switch','PCI PME#','AC Power Restored');
  sBoardType:array[1..$D] of string=('Autre',
                                     'Inconnu',
                                     'Server Blade',
                                     'Connectivity Switch',
                                     'System management Module',
                                     'Module Processeur',
                                     'Module E/S',
                                     'Module mémoire',
                                     'Carte fille',
                                     'Carte mère (inclue processeur, mémoire, E/S)',
                                     'Module Processeur+Mémoire',
                                     'Module Processeur+E/S',
                                     'Carte d''interconnection'); 
  sChassisType:array[1..$19] of string=('Autre',
                                       'Inconnu',
                                       'Desktop',
                                       'Low Profile Desktop',
                                       'Pizza Box',
                                       'Mini Tour',
                                       'Tour',
                                       'Portable',
                                       'LapTop',
                                       'Notebook',
                                       'Hand Held',
                                       'Docking Station',
                                       'Tout-en-un',
                                       'Sub Notebook',
                                       'Space-saving',
                                       'Lunch Box',
                                       'Chassis Serveur Principal',
                                       'Chassis d''extension',
                                       'Sous-Chassis',
                                       'Chassis d''extension bus',
                                       'Chassis périphérique',
                                       'Chassis RAID',
                                       'Chassis Rack amovible',
                                       'Boitier scellé',
                                       'Chassis Multi-système');
  sChassisState:array[1..6] of string=('Autre','Inconnu','Sécurisé','Warning','Critique','Non récupérable');
  sChassisSecurityStatus:array[1..5] of string=('Autre','Inconnu','Aucun','Interface externe désolidarisée','Interface externe activée');
  sProcessorType:array[1..6] of string=('Autre','Inconnu',
			                'Processeur Central',
			                'Processeur Math',
			                'Processeur DSP',
			                'Processeur Video');
  sProcessorFamily1:array[1..202] of string=(
                            'Autre',
                            'Inconnu',
                            '8086',
                            '80286',
                            '80386',
                            '80486',
                            '8087',
                            '80287',
                            '80387',
                            '80487',
                            'Pentium(R) Brand"',
                            'Pentium(R) Pro',
                            'Pentium(R) II',
                            'Pentium(R) Processor with MMX(TM) Technology',
                            'Celeron(TM)',
                            'Pentium(R) II Xeon(TM)',
                            'Pentium(R) III',
                            'M1 Family',
                            'M2 Family', //19
                            '','','','',
                            'AMD Duron(TM) Processor Family', //24
                            'K5 Family',
                            'K6 Family',
                            'K6-2',
                            'K6-III',
                            'AMD Athlon(TM) Processor Family',
                            'AMD29000 Family',
                            'K6-2+',
                            'Power PC Family',
                            'Power PC 601',
                            'Power PC 603',
                            'Power PC 603+',
                            'Power PC 604',
                            'Power PC 620',
                            'Power PC X704',
                            'Power PC 750', //39
                            '','','','','','','','',
                            'Alpha Family (or Pentium Pro)', //48
                            'Alpha 21064',
                            'Alpha 21066',
                            'Alpha 21164',
                            'Alpha 21164PC',
                            'Alpha 21164a',
                            'Alpha 21264',
                            'Alpha 21364', //55
                            '','','','','','','','',
                            'MIPS Family', //64
                            'MIPS R4000',
                            'MIPS R4200',
                            'MIPS R4400',
                            'MIPS R4600',
                            'MIPS R10000', //69
                            '','','','','','','','','','',
                            'SPARC Family', //80
                            'SuperSPARC',
                            'microSPARC II',
                            'microSPARC IIep',
                            'UltraSPARC',
                            'UltraSPARC II',
                            'UltraSPARC IIi',
                            'UltraSPARC III',
                            'UltraSPARC IIIi', //88
                            '','','','','','','',
                            '68040',         //96
                            '68xxx Family',
                            '68000',
                            '68010',
                            '68020',
                            '68030', //101
                            '','','','','','','','','','',
                            'Hobbit Family', //112
                            '','','','','','','',
                            'Crusoe(TM) TM5000 Family', //120
                            'Crusoe(TM) TM3000 Family', //121
                            '','','','','','',
                            'Weitek', //128
                            '',
                            'Itanium(TM) Processor', //130
                            '','','','','','','','','','','','','',
                            'PA-RISC Family', //144
                            'PA-RISC 8500',
                            'PA-RISC 8000',
                            'PA-RISC 7300LC',
                            'PA-RISC 7200',
                            'PA-RISC 7100LC',
                            'PA-RISC 7100',//150
                            '','','','','','','','','',
                            'V30 Family',//160
 
                            '','','','','','','','','','','','','','','',
                            'Pentium(R) III Xeon(TM)', //176
                            'Pentium(R) III Processor with Intel(R) SpeedStep(TM) Technology',
                            'Pentium(R) 4 Processor',
                            'Intel(R) Xeon(TM)',
                            'AS400 Family',//180
                            '','','','','','','','','','','','','','','','','','','',
                            'IBM390 Family', //200
                            'G4',
                            'G5');
  sProcessorFamily2:array[250..320] of string=(
			'i860','i960','','','','','','','','',
                        'SH-3',
                        'SH-4','','','','','','','','','','','','','','','','','','',
			'ARM',
			'StrongARM','','','','','','','','','','','','','','','','','','',
			'6x86',
			'MediaGX',
			'MII','','','','','','','','','','','','','','','','','',
			'WinChip');
  sProcessorFamily3:array[350..351] of string=('DSP','');
  sProcessorFamily4:array[500..501] of string=('Video Processor','');
 
  sProcessorUpgrade:array[1..15] of string=('Autre',
                                            'Inconnu',
                                            'Carte fille',
                                            'Socket ZIF',
                                            'Piggy Back remplaçable',
                                            'Aucun',
                                            'Socket LIF',
                                            'Slot 1',
                                            'Slot 2',
                                            '370 Pin Socket',
                                            'Slot A',
                                            'Slot M',
                                            'Socket 423',
                                            'Socket A (Socket 462)',
                                            'Socket 478');
  sMemoryControllerEDM:array[1..8] of string=('Autre','Inconnu','Aucun','Parité 8 bits','ECC 32 bits','ECC 64 bits','ECC 128 bits','CRC');
  sMemoryControllerInterleave:array[1..7] of string=('Autre','Inconnu','One Way Interleave','Two  Way Interleave','Four Way Interleave','Eight Way Interleave','Sixteen Way Interleave');
  sCacheInformationErrorCorrectionType:array[1..6] of string=('Autre','Inconnu','Aucune','Parité','ECC bit unique','ECC bits multiples');
  sCacheInformationSystemCacheType:array[1..5] of string=('Autre','Inconnu','Instruction','Data','Unifié');
  sCacheInformationAssociativity:array[1..8] of string=
                                        ('Autre',
                                         'Inconnu',
                                         'Direct Mapped',
                                         '2-way Set-Associative',
                                         '4-way Set-Assotiative',
                                         'Fully Associative',
                                         '8-way Set-Assotiative',
                                         '16-way Set-Assotiative');
  sPortInformationConnectorTypes1:array[0..$21] of string=
                                        ('Aucun',
                                         'Centronics',
                                         'Mini Centronics',
                                         'Propriétaire',
                                         'DB-25 broches mâle',
                                         'DB-25 broches femelle',
                                         'DB-15 broches mâle',
                                         'DB-15 broches femelle',
                                         'DB-9 broches mâle',
                                         'DB-9 broches femelle',
                                         'RJ-11',
                                         'RJ-45',
                                         'MiniSCSI 50 broches',
                                         'Mini DIN',
                                         'Micro-DIN',
                                         'PS/2',
                                         'Infra-Rouge',
                                         'HP-HIL',
                                         'Access Bus (USB)',
                                         'SSA SCSI',
                                         'DIN-8 mâle circulaire',
                                         'DIN-8 femelle circulaire',
                                         'IDE sur carte',
                                         'Floppy sur carte',
                                         '9 broches Dual Inline (broche 10 coupée)',
                                         '25 broches Dual Inline (broche 26 coupée)',
                                         '50 broches Dual Inline',
                                         '68 broches Dual Inline',
                                         'Entrée son sur carte depuis le CD-ROM',
                                         'Mini-Centronics Type-14',
                                         'Mini-Centronics Type-26',
                                         'Mini-Jack (Casque audio)',
                                         'BNC',
                                         '1394');
  sPortInformationConnectorTypes2:array[$A0..$A4] of string=('PC-98',
                                         'PC-98Hireso',
                                         'PC-H98',
                                         'PC-98Note',
                                         'PC-98Full');
  sPortTypes1:array[0..$1F] of string=('Aucun',
                                         'Port parallèle compatible XT/AT',
                                         'Port parallèle PS/2',
                                         'Port parallèle ECP',
                                         'Port parallèle EPP',
                                         'Port parallèle ECP/EPP',
                                         'Port série Compatible XT/AT',
                                         'Port série Compatible 16450',
                                         'Port série Compatible 16550',
                                         'Port série Compatible 16550A',
                                         'Port SCSI',
                                         'Port MIDI',
                                         'Port Joystick',
                                         'Port Clavier',
                                         'Port Souris',
                                         'SSA SCSI',
                                         'USB',
                                         'FireWire (IEE P1394)',
                                         'PCMCIA Type II',
                                         'PCMCIA Type II',
                                         'PCMCIA Type III',
                                         'Cardbus',
                                         'Port Access Bus',
                                         'SCSI II',
                                         'SCSI Wide',
                                         'PC-98',
 
                                         'PC-98-Hireso',
                                         'PC-H98',
                                         'Port Vidéo',
                                         'Port Audio',
                                         'Port Modem',
                                         'Port Réseau');
  sPortTypes2:array[$A0..$A1] of string=('Compatible 8251',
                                         'Compatible 8251 FIFO');
  sSystemSlotsSlotTypes1:array[1..$11] of string=('Autre','Inconnu',
                                         'ISA',
                                         'MCA',
                                         'EISA',
                                         'PCI',
                                         'PC Card (PCMCIA)',
                                         'VL-VESA',
                                         'Propriétaire',
                                         'Slot pour carte processeur',
                                         'Slot pour carte mémoire propriétaire',
                                         'slot pour carte "I/O Riser"',
                                         'NuBus',
                                         'PCI - 66MHz',
                                         'AGP',
                                         'AGP 2x',
                                         'AGP 4x');
  sSystemSlotsSlotTypes2:array[$A0..$A4] of string=(
                                         'PC-98/C20',
                                         'PC-98/C24',
                                         'PC-98/E',
                                         'PC-98/Bus Local',
                                         'PC-98/Carte');
  sSystemSlotsSlotDataBusWidth:array[1..7] of string=('Autre','Inconnu',
                                         '8 bits',
                                         '16 bits',
                                         '32 bits',
                                         '64 bits',
                                         '128 bits');
  sSystemSlotsCurrentUsage:array[1..4] of string=('Autre','Inconnu','Disponible','Utilisée');
  sSystemSlotsSlotLength:array[1..4] of string=('Autre','Inconnue','Courte','Longue');
  sOnBoardDeviceInformationOnBoarDeviceType:array[1..7] of string=('Autre','Inconnu','Vidéo','Controller SCSI','Ethernet','Token Ring','Son');
 
  sPhysicalMeMoryArrayLocation1:array[1..9] of String=('Autre','Inconnu','Carte systême ou Carte mère',
                                                       'Add-on carte ISA','Add-on carte EISA','Add-on carte PCI',
                                                       'Add-on carte MCA','Add-on carte PCMCIA','Add-on carte propriétaire');
  sPhysicalMeMoryArrayLocation2:array[$A0..$A3] of String=('Add-on carte PC-98/20','Add-on carte PC-98/C24','Add-on carte PC-98/E',
                                                       'Add-on carte PC-98/Bus Local');
  sPhysicalMeMoryArrayUse:array[1..7] of String=('Autre','Inconnu','Mémoire système','Mémoire vidéo',
                                                 'Mémoire Falsh','RAM non-volatile','Mémoire cache');
  sPhysicalMeMoryArrayECT:array[1..7] of String=('Autre','Inconnu','Aucune','Parité','ECC bit unique','ECC bits multiples','CRC');
 
  sMemoryDeviceFormFactor:array[1..$E] of string=('Autre','Inconnu','SIMM','SIP','Puce','DIP','ZIP','Carte propriétaire',
                                                  'DIMM','TSOP','Ligne de puces','RIMM','SODIMM','SRIMM');
  sMemoryDeviceType:array[1..$11] of string=('Autre','Inconnu','DRAM','EDRAM','VRAM','SRAM','RAM',
                                            'ROM','Flash','EEPROM','FEPROM','EPROM','CDRAM','3DRAM','SDRAM','SGRAM','RDRAM');
 
 
 
 
type
  THandles=array[0..255] of word;
  TSMBIOS_STEP=record //SMBIOS Structure Table Entry Point
    Address:Cardinal;
    DMIAddress:Cardinal;
    AnchorString:string[4];
    EntryPointStructureChecksum:byte;
    EntryPointLength:byte;
    MajorVersion:byte;
    MinorVersion:byte;
    MaximumStructureSize:word;
    EntryPointRevision:byte;//00h : Entry Point is based on SMBIOS 2.1 definition
                            //      formatted area is reserved and set to all 00h
                            //01h-ffh : Reserved for assignment via this specification
    FormattedArea:array[0..4] of byte;
    IntermediateAnchorString:string[5];
    IntermediateChecksum:byte;
    StructureTableLength:word;
    StructureTableAddress:dword;
    NumberOfStructures:word;
    BCDRevision:byte;
  end;
 
  TBIOSCharacteristics=record //type 0
    bytes:array[0..7] of byte;
    BIOS_Characteristics_Not_Supported:boolean; //3
    ISA_Support:boolean;   // 4
    MCA_Support:boolean;   // 5
    EISA_Support:boolean;  // 6
    PCI_Support:boolean;   // 7
    PCMCIA_Support:boolean;// 8
    PnP_Support:boolean;   // 9
    APM_Support:boolean;   //10
    BIOS_Upgradable:boolean; //11
    BIOSShadowingAllowed:boolean; //12
    VL_VESA_Supported:boolean; //13
    ESCD_Support_Available:boolean; //14
    BootFromCD_Available:boolean;
    Selectable_Boot_Support:boolean;
    BIOS_ROM_Socketed:boolean;
    BootFromPCMCIA_Support:boolean;
    EDD_Specification_Support:boolean;
    JapaneseFloppyNEC9800_Support:boolean;
    JapaneseFloppyToshiba_Support:boolean;
    Floppy_525_360KB_Support:boolean;
    Floppy_525_122MB_Support:boolean;
    Floppy_35_720KB_Support:boolean;
    Floppy_35_288MB_Support:boolean;
    PrintScreen_Support:boolean;
    Keyboard_8042_Support:boolean;
    Serial_Support:boolean;
    Printer_Support:boolean;
    CGAMono_Video_Support:boolean;
    NEC_PC98:boolean;
    BIOSVendorReserved:array[0..1] of byte;
    SystemVendorReserved:array[0..1] of byte;
  end;
 
  TBIOSCaracteristicsExtensionBytes=record //type 0 (extension)
    bytes:array[0..1] of byte;
    ACPI_Support:boolean;
    USB_Legacy_Support:boolean;
    AGP_Support:boolean;
    I2O_Boot_Support:boolean;
    LS120_Boot_Support:boolean;
    ATAPI_ZIPDrive_Boot_Support:boolean;
    IEE1394_Boot_Support:boolean;
    Smart_Battery_Support:boolean;
    //byte2
    BiosBootSpecification_Support:boolean;
  end;
 
  TBIOSInformation=record  //type 0
    Vendor:string;
    BIOSVersion:string;
    BIOSStartingAddressSegment:word;
    BIOSReleaseDate:string;
    BIOSROMSize_KB:word;
    BIOSCaracteristics:TBIOSCharacteristics;
    NumberOfBIOSCaracteristicsExtensionBytes:byte;
    BIOSCaracteristicsExtensionBytes:TBIOSCaracteristicsExtensionBytes;
  end;
 
  TBaseBoard=record
    Manufacturer:string;
    ProductName:string;
    Version:String;
    SerialNumber:String;
    AssetTag:string;
    LocationInChassis:string;
    Features:string;
    AssociatedChassisHandle:word;
    BoardType:string;
    NumberOfContainedObjects:byte;
    ContainedObjectsHandle:array[0..255] of word;
  end;
 
  TSystemInformation=record //type 2
    Manufacturer:string;
    ProductName:string;
    Version:String;
    SerialNumber:String;
    UUID:string[32];
    WakeUpType:string;
  end;
 
  TChassis=record //Type 3
    Manufacturer:string;
    TypeChassis:string;
    Version:string;
    SerialNumber:string;
    AssetTagNumber:string;
    BootupState:String;
    PowerSupplyState:String;
    ThermalState:String;
    SecurityStatus:String;
    OEM_Defined:dword;
    Height:string;
    NumberOfPowerChords:byte;
    ContainedElementsCount:byte;
  end;
 
  TProcessorInformation=record //type 4
    SocketDesignation:string;
    ProcessorType:string;
    ProcessorFamily:string;
    ProcessorManufacturer:string;
    ProcessorID:string;
    ProcessorVersion:string;
    Voltage:string;
    ExternalClock:word;
    MaxSpeed:word;
    CurrentSpeed:word;
    Status:string;
    ProcessorUpgrade:string;
    L1CacheHandle:word;
    L2CacheHandle:word;
    L3CacheHandle:word;
    SerialNumber:string;
    AssetTag:string;
    PartNumber:string;
  end;
 
  TCacheInformation=record //type 7
    Comment:string;
    SocketDesignation:string;
    CacheConfiguration:string;
    MaximumCacheSize:string;
    InstalledSize:string;
    SupportedSRAMType:string;
    CurrentSRAMType:string;
    CacheSpeed:string;
    ErrorCorrectionType:string;
    SystemCacheType:string;
    Associativity:string;
  end;
 
  TMemoryControllerInfo=record //type 5
    ErrorDetectingMethod:string;
    ErrorCorrectingCapability:string;
    SupportedInterleave:string;
    CurrentInterleave:string;
    MaximumMemorySupported:String;
    MaximumMemoryModuleSize:String;
    SupportedSpeeds:string;
    SupportedMemoryTypes:string;
    MemoryModuleVoltage:string;
    NumberOfAssociaTedMemorySlots:byte;
    MemoryConfigurationHandles:THandles;
    EnableECC:string;
   end;
 
   TMemoryModuleInfo=record //type 6
    SocketDesignation:string;
    BankConnections:string;
    CurrentSpeed:string;
    CurrentMemoryType:string;
    InstalledSize:string;
    EnabledSize:String;
    ErrorStatus:string;
   end;
 
   TPortConnectorInformation=record
     InternalReferenceDesignator:string;
     InternalConnectorType:string;
     ExternalReferenceDesignator:string;
     ExternalConnectorType:string;
     PortType:string;
   end;
 
   TSystemSlots=record
     SlotDesignation:string;
     SlotType:string;
     SlotDataBusWidth:string;
     CurrentUsage:string;
     SlotLength:string;
     SlotID:string;
     SlotCharacteristics1:string;
     SlotCharacteristics2:string;
   end;
 
   TOnBoardDevices=record
     DeviceCount:byte;
     DevicesType:array[0..255] of string;
     DevicesString:array[0..255] of string;
   end;
 
   TGroupAssociations=record
     GroupName:string;
     Count:integer;
     ItemType:array[0..255] of byte;
     ItemHandle:array[0..255] of word;
   end;
 
   TLanguage=record
     Present:boolean;
     InstallableLanguages:byte;
     ListOfLanguages:array[0..255] of string;
     AbreviatedFormat:boolean;
     CurrentLanguage:string;
   end;
implementation
 
end.

La suite dans le prochain post

troisième et dernière...

Code:

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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
unit WADMIBiosInfo;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  SMBIOSStructures,WADMIUtils,WAMemory,inifiles;
 
type
  TWADMIHeader=record
    AnAddress:Cardinal;
    TypeIndex:byte;
    AType:byte;
    ALength:byte;
    AHandle:word;
  end;
 
  TCurrentStructure=record
     Available:boolean;
     TypeIndex:byte;
     StructIndex:byte;
     AnAddress:Cardinal;
     AType:byte;
     ALength:byte;
     AHandle:word;
  end;
 
  TWADMIBiosInfo= class(TComponent)
  private
    { Déclarations privées }
    fLoaded:boolean;
    fSMBiosFound:boolean;
    fDMIFound:boolean;
    fStructureTableEntryPoint:TSMBIOS_STEP;
    fBIOSInformation:TBIOSInformation;
    fSystemInformation:TSystemInformation;
    fBaseBoardCount:byte;
    fBaseBoard:TBaseBoard;
    fChassisCount:byte;
    fChassis:TChassis;
    fProcessorCount:byte;
    fProcessorInformation:TProcessorInformation;
    fCacheCount:byte;
    fCacheInformation:TCacheInformation;
    fMemoryControllerCount:byte;
    fMemoryControllerInfo:TMemoryControllerInfo;
    fMemoryModuleCount:Byte;
    fMemoryModuleInfo:TMemoryModuleInfo;
 
    fPortCount:Byte;
    fPortInfo:TPortConnectorInformation;
    fSystemSlotCount:byte;
    fSystemSlot:TSystemSlots;
    fOnBoardDevicesCount:byte;
    fOnBoardDevices:TOnBoardDevices;
    fLanguage:TLanguage;
    fOEMStringsCount:byte;
    fOEMStrings:TStringList;
    fSystemConfigOptionsCount:byte;
    fSystemConfigOptions:TStringList;
    fGroupAssociationsCount:byte;
    fGroupAssociations:TGroupAssociations;
 
    fCurrentStruct:array[0..255] of TCurrentStructure;
    fStructureHeaders:array[0..255] of TWADMIHeader;
    fTypeCount:array[0..255] of byte;
 
    fDumpBIOS:TWAMemory;
    StringInfo:array[-1..255] of string;
  protected
    { Déclarations protégées }
    procedure GetAllHeaders;
    function FindStructure(GetWich:TGetOrder;GetHow:TGetMethod;atype:byte;aHandle:word):TCurrentStructure;
    function FindFirstStructure(atype:byte):TCurrentStructure;
    function FindNextStructure(atype:byte):TCurrentStructure;
    procedure Getstringinfo(StructAdress:Cardinal);
    procedure GetSTEP;
    procedure GetBiosInformation;
    procedure GetSystemInformation;
 
    //------
    function GetChassis(GetWhich:TGetOrder):boolean;
    function GetBaseBoard(GetWhich:TGetOrder):boolean;
    function GetProcessor(GetWhich:TGetOrder):boolean;
 
    procedure PopulateLevelCache(AnAddress:Cardinal);
    function GetLevelCache(Handle:word):boolean; overload;
    function GetLevelCache(GetWhich:TGetOrder):boolean; overload;
    //------
    function GetMemoryController(GetWhich:TGetOrder):boolean;
 
    procedure PopulateMemoryModule(AnAddress:Cardinal);
 
    function GetMemoryModule(GetWhich:TGetOrder):boolean; overload;
    //------
    function GetPort(GetWhich:TGetOrder):boolean;
    function GetSystemSlot(GetWhich:TGetOrder):boolean;
    function GetOnBoardDevices(GetWhich:TGetOrder):boolean;
    function GetGroupAssotiations(GetWhich:TGetOrder):boolean;
    procedure GetLanguage;
    procedure GetOEMStrings;
    procedure GetSystemConfigOptions;
    function FindSMBIOS:boolean;
    function FindDMI:boolean;
  public
    { Déclarations publiques }
    constructor Create(AOwner: TComponent); override;
    destructor destroy; override;
    procedure LoadFromBios;
    procedure LoadFromFile(const FileName: string);
    procedure SavetoFile(const FileName: string);
    function Detect:boolean;
    function GetFirstChassis:boolean;
    function GetNextChassis:boolean;
    function GetFirstBaseBoard:boolean;
    function GetNextBaseBoard:boolean;
    function GetFirstProcessor:boolean;
    function GetNextProcessor:boolean;
    function GetL1Cache:boolean;
    function GetL2Cache:boolean;
    function GetL3Cache:boolean;
    function GetFirstCache:boolean;
    function GetNextCache:boolean;
    function GetFirstMemoryController:boolean;
    function GetMemoryModule(Handle:word):boolean; overload;
    function GetFirstMemoryModule:boolean;
    function GetNextMemoryController:boolean;
    function GetNextMemoryModule:boolean;
    function GetFirstPort:boolean;
    function GetNextPort:boolean;
    function GetFirstSystemSlot:boolean;
    function GetNextSystemSlot:boolean;
    function GetFirstOnBoardDevices:boolean;
    function GetNextOnBoardDevices:boolean;
    function GetFirstGroupAssotiations:boolean;
    function GetNextGroupAssotiations:boolean;
    function HandleToTypeIndex(AType:byte;AHandle:word):byte;
    property StructureTableEntryPoint:TSMBIOS_STEP read fStructureTableEntryPoint;
    property BIOSInformation:TBIOSInformation read fBIOSInformation;
    property SystemInformation:TSystemInformation read fSystemInformation;
    property BaseBoardCount:byte read fBaseBoardCount;
    property CurrentBaseBoard:TBaseBoard read fBaseBoard;
    property ChassisCount:byte read fChassisCount;
    property CurrentChassis:TChassis read fChassis;
    property ProcessorCount:byte read fProcessorCount;
    property CacheCount:byte read fCacheCount;
    property MemoryControllerCount:byte read fMemoryControllerCount;
    property MemoryModuleCount:Byte read fMemoryModuleCount;
    property PortCount:byte read fPortCount;
 
    property OnBoardDevicesCount:byte read fOnBoardDevicesCount;
    property SystemSlotCount:byte read fSystemSlotCount;
    property Language:TLanguage read fLanguage;
    property GroupAssotiationsCount:byte read fGroupAssociationsCount;
    property SystemConfigOptionsCount:byte read fSystemConfigOptionsCount;
    property CurrentProcessorInformation:TProcessorInformation read fProcessorInformation;
    property CurrentCacheInformation:TCacheInformation read fCacheInformation;
    property CurrentMemoryControllerInfo:TMemoryControllerInfo read fMemoryControllerInfo;
    property CurrentMemoryModuleInfo:TMemoryModuleInfo read fMemoryModuleInfo;
    property CurrentPortInfo:TPortConnectorInformation read fPortInfo;
    property CurrentSystemSlot:TSystemSlots read fSystemSlot;
    property CurrentOnBoardDevices:TOnBoardDevices read fOnBoardDevices;
    property CurrentGroupAssotiations:TGroupAssociations read fGroupAssociations;
    property OEMStrings:TStringList read fOEMStrings;
    property SystemConfigOptions:TStringList read fSystemConfigOptions;
  published
    { Déclarations publiées }
  end;
 
procedure Register;
 
implementation
 
 
constructor TWADMIBiosInfo.Create(AOwner: TComponent);
begin
  inherited create(AOwner);
  fLoaded:=false;
  fOEMStrings:=TStringList.create;
  fSystemConfigOptions:=TStringList.Create;
  fDumpBIOS:=TWAMemory.Create;
end;
 
destructor TWADMIBiosInfo.destroy;
begin
  fOEMStrings.free;
  fSystemConfigOptions.free;
  fDumpBIOS.Free;
  inherited destroy;
 
end;
 
procedure TWADMIBiosInfo.GetAllHeaders;
var i:byte;
    CurrentStructure:TWADMIHeader;
    AnAddress:Cardinal;
begin
  for i:=0 to 255 do fTypeCount[i]:=0;
  i:=0;
  AnAddress:=fStructureTableEntryPoint.StructureTableAddress;
  while i<fStructureTableEntryPoint.NumberOfStructures do
  begin
    CurrentStructure.AnAddress:=AnAddress;
    fDumpBIOS.CurrentAddress:=AnAddress;
    CurrentStructure.AType:=fDumpBIOS.obyte(0);
    CurrentStructure.ALength:=fDumpBIOS.obyte(1);
    CurrentStructure.AHandle:=fDumpBIOS.oword(2);
    CurrentStructure.TypeIndex:=fTypeCount[CurrentStructure.AType];
    fStructureHeaders[i]:=CurrentStructure;
    inc(fTypeCount[CurrentStructure.AType]);
    inc(AnAddress,CurrentStructure.ALength);
    while fDumpBIOS.getword(AnAddress)<>0 do inc(AnAddress);
    //while fDumpBIOS.getbyte(AnAddress)=0 do inc(AnAddress);
    inc(AnAddress,2);
    inc(i);
  end;
end;
 
function TWADMIBiosInfo.FindFirstStructure(atype:byte):TCurrentStructure;
begin
  result:=FindStructure(GetFirst,ByType,atype,0);
end;
 
function TWADMIBiosInfo.FindNextStructure(atype:byte):TCurrentStructure;
begin
  result:=FindStructure(GetNext,ByType,atype,0);
end;
 
function TWADMIBiosInfo.FindStructure(GetWich:TGetOrder;GetHow:TGetMethod;atype:byte;aHandle:word):TCurrentStructure;
var i:byte;
begin
  if GetHow=ByType then
  begin
    if (GetWich=Getfirst) then fCurrentStruct[atype].TypeIndex:=0
    else inc(fCurrentStruct[atype].TypeIndex);
    if fCurrentStruct[atype].TypeIndex>=fTypeCount[atype] then
    begin
      fCurrentStruct[atype].Available:=false;
      fCurrentStruct[atype].TypeIndex:=fTypeCount[atype];
      fCurrentStruct[atype].StructIndex:=fStructureTableEntryPoint.NumberOfStructures;
      fCurrentStruct[atype].AnAddress:=0;
      fCurrentStruct[atype].AType:=atype;
      fCurrentStruct[atype].ALength:=0;
      fCurrentStruct[atype].AHandle:=$ffff;
      result:=fCurrentStruct[atype];
      exit;
    end;
    i:=0;
    while ((fStructureHeaders[i].AType<>atype) or (fStructureHeaders[i].TypeIndex<>fCurrentStruct[atype].TypeIndex))
    do inc(i);
  end else
  begin
    i:=0;
    while ((fStructureHeaders[i].AHandle<>aHandle) and (i<fStructureTableEntryPoint.NumberOfStructures))
    do inc(i);
    if i>=fStructureTableEntryPoint.NumberOfStructures then
    begin
      result.Available:=false;
      result.TypeIndex:=fTypeCount[atype];
      result.StructIndex:=fStructureTableEntryPoint.NumberOfStructures;
      result.AnAddress:=0;
      result.AType:=atype;
      result.ALength:=0;
      result.AHandle:=$ffff;
      exit;
    end;
  end;
  fCurrentStruct[fStructureHeaders[i].AType].Available:=true;
  fCurrentStruct[fStructureHeaders[i].AType].TypeIndex:=fStructureHeaders[i].TypeIndex;
  fCurrentStruct[fStructureHeaders[i].AType].StructIndex:=i;
  fCurrentStruct[fStructureHeaders[i].AType].AnAddress:=fStructureHeaders[i].AnAddress;
  fCurrentStruct[fStructureHeaders[i].AType].AType:=fStructureHeaders[i].AType;
  fCurrentStruct[fStructureHeaders[i].AType].ALength:=fStructureHeaders[i].ALength;
  fCurrentStruct[fStructureHeaders[i].AType].AHandle:=fStructureHeaders[i].AHandle;
  result:=fCurrentStruct[atype];
end;
 
function TWADMIBiosInfo.HandleToTypeIndex(AType:byte;AHandle:word):byte;
var i:byte;
begin
 i:=0;
 while ((fStructureHeaders[i].AHandle<>AHandle) and
        (fStructureHeaders[i].AType<>AType) and
        (i<fStructureTableEntryPoint.NumberOfStructures)) do inc(i);
 if i>=fStructureTableEntryPoint.NumberOfStructures
 then result:=255
 else result:=fStructureHeaders[i].TypeIndex;
end;
 
procedure TWADMIBiosInfo.Getstringinfo(StructAdress:Cardinal);
var i:integer;
    caddress:Cardinal;
    //ctype:byte;
    //chandle:word;
    clength:byte;
begin
  with fDumpBIOS do
  begin
    caddress:=StructAdress;
    CurrentAddress:=caddress;
    //ctype:=obyte(0);
    clength:=obyte(1);
    //chandle:=oword(2);
    caddress:=caddress+clength;
    for i:=-1 to 19 do stringinfo[i]:='';
    i:=0;
    while getbyte(caddress)<>0 do
    begin
      while getbyte(caddress)<>0 do
      begin
        stringinfo[i]:=stringinfo[i]+getchar(caddress);
        inc(caddress);
      end;
      inc(caddress);
      inc(i);
    end;
  end;
end;
 
function TWADMIBiosInfo.FindSMBios;
var b:boolean;
    i:cardinal;
    s:string;
begin
  b:=false;
  i:=$f0000;
  while ((not b) and (i<$fffff-20)) do
  begin
    s:=fDumpBIOS.gsfb(i,4);
    b:=(s='_SM_');
    if not b then inc(i,16);
  end;
  fSMBiosFound:=b;
  fDMIFound:=b;
  fStructureTableEntryPoint.Address:=i;
  result:=b;
end;
 
function TWADMIBiosInfo.FindDMI;
var b:boolean;
    i:cardinal;
    s:string;
begin
  b:=false;
  i:=$f0000;
  while ((not b) and (i<$fffff-20)) do
  begin
    s:=fDumpBIOS.gsfb(i,5);
    b:=(s='_DMI_');
    if not b then inc(i,16);
  end;
  fDMIFound:=b;
  fStructureTableEntryPoint.DMIAddress:=i;
  fStructureTableEntryPoint.Address:=i-$10;
  result:=b;
end;
 
procedure TWADMIBiosInfo.GetStep;
var i:integer;
begin
 
  with fStructureTableEntryPoint,fDumpBIOS do
  begin
  CurrentAddress:=Address;
  if fSMBiosFound then
  begin
   AnchorString:=gsfb(Address,4);
   EntryPointStructureChecksum:=obyte($4);
   EntryPointLength:=           obyte($5);
   MajorVersion:=               obyte($6);
   MinorVersion:=               obyte($7);
   MaximumStructureSize:=       oword($8);
   EntryPointRevision:=         obyte($A);
   for i:=0 to 5 do FormattedArea[i]:=obyte($B+i);
   end;
   if fDMIFound then
   begin
   IntermediateAnchorString:=   gsfb(Address+$10,5);
   IntermediateChecksum:=       obyte($15);
   StructureTableLength:=       oword($16);
   StructureTableAddress:=      odword($18);
   NumberOfStructures:=         oword($1C);
   BCDRevision:=                obyte($1E);
   if not fSMBiosFound then
   begin
     AnchorString:='Absente';
     EntryPointStructureChecksum:=0;
     EntryPointLength:=0;
     MajorVersion:=0;
     MinorVersion:=0;
     MaximumStructureSize:=0;
     EntryPointRevision:=0;
   end;
  end;
  end;
end;
 
procedure TWADMIBiosInfo.GetBiosInformation;
var i,j:integer;
    ALength:byte;
    cs:TCurrentStructure;
begin
  with fStructureTableEntryPoint do
  cs:=FindFirstStructure(0);
  if cs.Available then
  with fBIOSInformation,fDumpBIOS do
  begin
   Getstringinfo(cs.AnAddress);
   CurrentAddress:=cs.AnAddress;
   ALength:=cs.ALength;
   Vendor:=          BooleanToString((obyte(4)<>0),StringInfo[obyte(4)-1],'');
   BIOSVersion:=     BooleanToString((obyte(5)<>0),StringInfo[obyte(5)-1],'');
   BIOSStartingAddressSegment:=oword(6);
   BIOSReleaseDate:= BooleanToString((obyte(8)<>0),StringInfo[obyte(8)-1],'--/--/----');
   BIOSROMSize_KB:=64*(obyte(9)+1);
 
   with BIOSCaracteristics do
   begin
     for i:=0 to 7 do bytes[i]:=obyte($A+i);
     BIOS_Characteristics_Not_Supported:=BitSet(bytes[0],3);
     ISA_Support:=BitSet(bytes[0],4);   // 4
     MCA_Support:=BitSet(bytes[0],5);   // 5
     EISA_Support:=BitSet(bytes[0],6);  // 6
     PCI_Support:=BitSet(bytes[0],7);   // 7
     PCMCIA_Support:=BitSet(bytes[1],0);// 8
     PnP_Support:=BitSet(bytes[1],1);   // 9
     APM_Support:=BitSet(bytes[1],2);   //10
     BIOS_Upgradable:=BitSet(bytes[1],3); //11
     BIOSShadowingAllowed:=BitSet(bytes[1],4); //12
     VL_VESA_Supported:=BitSet(bytes[1],5); //13
     ESCD_Support_Available:=BitSet(bytes[1],6); //14
     BootFromCD_Available:=BitSet(bytes[1],7);
     Selectable_Boot_Support:=BitSet(bytes[2],0);
     BIOS_ROM_Socketed:=BitSet(bytes[2],1);
     BootFromPCMCIA_Support:=BitSet(bytes[2],2);
     EDD_Specification_Support:=BitSet(bytes[2],3);
     JapaneseFloppyNEC9800_Support:=BitSet(bytes[2],4);
     JapaneseFloppyToshiba_Support:=BitSet(bytes[2],5);
     Floppy_525_360KB_Support:=BitSet(bytes[2],6);
     Floppy_525_122MB_Support:=BitSet(bytes[2],7);
     Floppy_35_720KB_Support:=BitSet(bytes[3],0);
     Floppy_35_288MB_Support:=BitSet(bytes[3],1);
     PrintScreen_Support:=BitSet(bytes[3],2);
     Keyboard_8042_Support:=BitSet(bytes[3],3);
     Serial_Support:=BitSet(bytes[3],4);
     Printer_Support:=BitSet(bytes[3],5);
     CGAMono_Video_Support:=BitSet(bytes[3],6);
     NEC_PC98:=BitSet(bytes[3],7);
     BIOSVendorReserved[0]:=bytes[4];
     BIOSVendorReserved[1]:=bytes[5];
     SystemVendorReserved[0]:=bytes[6];
     SystemVendorReserved[1]:=bytes[7];
   end;
 
   NumberOfBIOSCaracteristicsExtensionBytes:=ALength-$12;
   if NumberOfBIOSCaracteristicsExtensionBytes>0 then
   with BIOSCaracteristicsExtensionBytes do
   begin
     j:=NumberOfBIOSCaracteristicsExtensionBytes;
     if j>2 then j:=2;
     for i:=0 to (j-1) do bytes[i]:=obyte($12+i);
     ACPI_Support:=BitSet(bytes[0],0);
     USB_Legacy_Support:=BitSet(bytes[0],1);
     AGP_Support:=BitSet(bytes[0],2);
     I2O_Boot_Support:=BitSet(bytes[0],3);
     LS120_Boot_Support:=BitSet(bytes[0],4);
     ATAPI_ZIPDrive_Boot_Support:=BitSet(bytes[0],5);
     IEE1394_Boot_Support:=BitSet(bytes[0],6);
     Smart_Battery_Support:=BitSet(bytes[0],7);
     if j>1 then
     begin
       BiosBootSpecification_Support:=BitSet(bytes[1],0);
     end else
     begin
       BiosBootSpecification_Support:=false;
     end;
   end;
  end;
end;
 
procedure TWADMIBiosInfo.GetSystemInformation;
var i:integer;
    ALength:byte;
    cs:TCurrentStructure;
begin
  with fStructureTableEntryPoint,fDumpBIOS do
  cs:=FindFirstStructure(1);
  if cs.Available then
  with fSystemInformation,fDumpBIOS do
  begin
   Getstringinfo(cs.AnAddress);
   CurrentAddress:=cs.AnAddress;
   ALength:=cs.ALength;
   Manufacturer:=BooleanToString((obyte(4)<>0),stringinfo[obyte(4)-1],'');
   ProductName:=BooleanToString((obyte(5)<>0),stringinfo[obyte(5)-1],'');
   fSystemInformation.Version:=BooleanToString((obyte(6)<>0),stringinfo[obyte(6)-1],'');
   SerialNumber:=BooleanToString((obyte(7)<>0),stringinfo[obyte(7)-1],'');
   UUID:='-';
   WakeUpType:='-';
   if ALength=$8 then exit;
   UUID:='';
   for i:=0 to 15 do UUID:=UUID+IntToHex(obyte(8+i),2)+' ';
   WakeUpType:=BooleanToString(Between(obyte($18),low(sWakeupType),high(sWakeupType)),sWakeupType[obyte($18)],'');
  end;
end;
 
function TWADMIBiosInfo.GetBaseBoard(GetWhich:TGetOrder):boolean;
var i:integer;
    ALength:byte;
    AByte:byte;
    cs:TCurrentStructure;
begin
  with fStructureTableEntryPoint do
  cs:=FindStructure(GetWhich,ByType,2,0);
  if cs.Available then
  with fBaseBoard,fDumpBIOS do
  begin
   result:=true;
   Getstringinfo(cs.AnAddress);
   CurrentAddress:=cs.AnAddress;
   ALength:=cs.ALength;
   Manufacturer:=BooleanToString((obyte(4)<>0),stringinfo[obyte(4)-1],'');
   ProductName:=BooleanToString((obyte(5)<>0),stringinfo[obyte(5)-1],'');
   Version:=BooleanToString((obyte(6)<>0),stringinfo[obyte(6)-1],'');
   SerialNumber:=BooleanToString((obyte(7)<>0),stringinfo[obyte(7)-1],'');
   AssetTag:='-';
   Features:='-';
   LocationInChassis:='-';
   AssociatedChassisHandle:=0;
   BoardType:='-';
   NumberOfContainedObjects:=0;
   for i:=0 to 255 do ContainedObjectsHandle[i]:=0;
   if ALength=$8 then exit;
   AssetTag:=BooleanToString((obyte(8)<>0),stringinfo[obyte(8)-1],'');
   AByte:=obyte($9);
   Features:=BitList(AByte,['Carte hôte (e.g. carte mère)',
                            'Requière au moins une carte fille',
                            'Carte amovible',
                            'Remplaçable',
                            '"Hot-swappable"']);
 
   LocationInChassis:=BooleanToString((obyte($A)<>0),stringinfo[obyte($A)-1],'');
   AssociatedChassisHandle:=oword($B);
   BoardType:=BooleanToString(Between(obyte($0D),low(sBoardType),high(sBoardType)),sBoardType[obyte($0D)],'');
 
   if Alength=$E then exit;
   NumberOfContainedObjects:=obyte($E);
   for i:=0 to NumberOfContainedObjects do
   begin
     if Alength=($E+2*i) then exit;
     ContainedObjectsHandle[i]:=oword($E+2*i);
   end;
  end else result:=false;
end;
 
function TWADMIBiosInfo.GetFirstBaseBoard:boolean;
begin
  result:=GetBaseBoard(GetFirst);
end;
 
function TWADMIBiosInfo.GetNextBaseBoard:boolean;
begin
  result:=GetBaseBoard(GetNext);
end;
 
function TWADMIBiosInfo.GetChassis(GetWhich:TGetOrder):boolean;
var ALength,Abyte:byte;
    cs:TCurrentStructure;
begin
  with fStructureTableEntryPoint do
  cs:=FindStructure(GetWhich,ByType,3,0);
  if cs.Available then
  with fChassis,fDumpBIOS do
  begin
   result:=true;
   Getstringinfo(cs.AnAddress);
   CurrentAddress:=cs.AnAddress;
   ALength:=cs.ALength;
   Manufacturer:=BooleanToString((obyte(4)<>0),stringinfo[obyte(4)-1],'');
   TypeChassis:='Fermeture de chassis ';
   TypeChassis:=TypeChassis+BooleanToString(BitSet(obyte(5),7),'présente','non présente ou inconnue')+', ';
   TypeChassis:=TypeChassis+'Type :'+BooleanToString(Between((obyte(5) and 127),low(sChassisType),high(sChassisType)),sChassisType[(obyte(5) and 127)],'');
   fChassis.Version:=BooleanToString((obyte(6)<>0),stringinfo[obyte(6)-1],'');
   SerialNumber:=BooleanToString((obyte(7)<>0),stringinfo[obyte(7)-1],'');
   AssetTagNumber:=BooleanToString((obyte(8)<>0),stringinfo[obyte(8)-1],'');
   if Alength=$09 then exit;
   //v2.1+
   BootupState:=BooleanToString(Between(obyte(9),low(sChassisState),high(sChassisState)),sChassisState[obyte(9)],'');
   PowerSupplyState:=BooleanToString(Between(obyte($0A),low(sChassisState),high(sChassisState)),sChassisState[obyte($0A)],'');
   ThermalState:=BooleanToString(Between(obyte($0B),low(sChassisState),high(sChassisState)),sChassisState[obyte($0B)],'');
   SecurityStatus:=BooleanToString(Between(obyte($0C),low(sChassisSecurityStatus),high(sChassisSecurityStatus)),sChassisSecurityStatus[obyte($0C)],'');
   Height:='-';
   NumberOfPowerChords:=0;
   ContainedElementsCount:=0;
   OEM_Defined:=0;
   if Alength=$0D then exit;
   //2.3+
   OEM_Defined:=odword($0D);
 
   if Alength=$11 then exit;
   AByte:=obyte($11);
   Height:=IntToStr(Abyte)+' Unités (='+FloatToStr(Abyte*4.445)+' cm = '+FloatToStr(Abyte*1.75)+' pouces)';
   if Alength=$12 then exit;
   NumberOfPowerChords:=obyte($12);
   ContainedElementsCount:=obyte($13);
  end else result:=false;
end;
 
function TWADMIBiosInfo.GetFirstChassis:boolean;
begin
  result:=GetChassis(GetFirst);
end;
 
function TWADMIBiosInfo.GetNextChassis:boolean;
begin
  result:=GetChassis(GetNext);
end;
 
procedure TWADMIBiosInfo.PopulateLevelCache(AnAddress:Cardinal);
var i:byte;
    ALength:byte;
    Aword:word;
    AwordTest:word;
begin
  with fCacheInformation,fDumpBIOS do
  begin
    Getstringinfo(AnAddress);
    CurrentAddress:=AnAddress;
    ALength:=obyte(1);
    SocketDesignation:=BooleanToString((obyte(4)<>0),stringinfo[obyte(4)-1],'');
    AWord:=oword(5);
    CacheConfiguration:='Mode opératoire : ';
    AwordTest:=(Aword and 768) shr 8;
    CacheConfiguration:=CacheConfiguration+CaseToString(AWordTest,['Write Through',
                                                                   'Write Back',
                                                                   'Write Back ou Through (dépend de l''adresse mémoire)',
                                                                   'Inconnu'],'-');
    CacheConfiguration:=CacheConfiguration+', Statut au démarrage : ';
    CacheConfiguration:=CacheConfiguration+BooleanToString((Aword and 128)=128,'Activé','Désactivé');
    CacheConfiguration:=CacheConfiguration+', Emplacement par rapport au module CPU : ';
    AwordTest:=(Aword and 96) shr 6;
    CacheConfiguration:=CacheConfiguration+CaseToString(AWordTest,['Interne','Externe','(Réservé)','Inconnu'],'-');
 
    CacheConfiguration:=CacheConfiguration+', Cache sur socket : '+OuiNon((Aword and 4)=4);
    AwordTest:=(Aword and 7);
    CacheConfiguration:=CacheConfiguration+', Niveau de cache : '+inttostr(AwordTest+1);
 
    AWord:=oword(7);
    if (Aword and 32768)=0 then i:=1 else i:=64;
    MaximumCacheSize:=inttostr((Aword and 32767)*i)+'Ko ('+inttostr(Aword and 32767)+'x'+inttostr(i)+'K)';
 
    AWord:=oword(9);
    if (Aword and 32768)=0 then i:=1 else i:=64;
    if Aword=0
    then InstalledSize:='Pas de cache installé'
    else InstalledSize:=inttostr((Aword and 32767)*i)+'Ko ('+inttostr(Aword and 32767)+'x'+inttostr(i)+'K)';
 
    AWord:=oword($0B);
    SupportedSRAMType:=BitList(AWord,['Autres','Inconnue','Non-Burst','Burst',
                                      'Pipeline Burst','Synchrone','Asynchrone']);
 
 
    AWord:=oword($0D);
    CurrentSRAMType:=BitList(AWord,['Autres','Inconnue','Non-Burst','Burst',
                                    'Pipeline Burst','Synchrone','Asynchrone']);
    CacheSpeed:='';
    ErrorCorrectionType:='';
    SystemCacheType:='';
    Associativity:='';
 
    if Alength=$0f then exit;
    if obyte($0F)=0 then CacheSpeed:='Inconnue' else
    CacheSpeed:=IntToStr(obyte($0F))+' ns';
    ErrorCorrectionType:=BooleanToString(Between(obyte($10),low(sCacheInformationErrorCorrectionType),high(sCacheInformationErrorCorrectionType)),sCacheInformationErrorCorrectionType[obyte($10)],'');
    SystemCacheType:=BooleanToString(Between(obyte($11),low(sCacheInformationSystemCacheType),high(sCacheInformationSystemCacheType)),sCacheInformationSystemCacheType[obyte($11)],'');
    Associativity:=BooleanToString(Between(obyte($12),low(sCacheInformationAssociativity),high(sCacheInformationAssociativity)),sCacheInformationAssociativity[obyte($12)],'');
  end;
end;
 
function TWADMIBiosInfo.GetLevelCache(Handle:word):boolean;
var cs:TCurrentStructure;
begin
  if Handle<>$ffff then
  with fStructureTableEntryPoint do
    cs:=FindStructure(GetFirst,ByHandle,7,Handle);
  if not cs.Available then
  begin
    if ((fStructureTableEntryPoint.MajorVersion>=2) and (fStructureTableEntryPoint.MinorVersion>=3))
    then //version DMI 2.3+
    fCacheInformation.Comment:='Informations Indisponibles'
    else fCacheInformation.Comment:='N''existe pas';
  end
  else PopulateLevelCache(cs.AnAddress);
  result:=cs.Available;
end;
 
function TWADMIBiosInfo.GetL1Cache:boolean;
begin
  result:=GetLevelCache(CurrentProcessorInformation.L1CacheHandle);
end;
 
function TWADMIBiosInfo.GetL2Cache:boolean;
begin
  result:=GetLevelCache(CurrentProcessorInformation.L2CacheHandle);
end;
 
function TWADMIBiosInfo.GetL3Cache:boolean;
begin
 result:=GetLevelCache(CurrentProcessorInformation.L3CacheHandle);
end;
 
function TWADMIBiosInfo.GetLevelCache(GetWhich:TGetOrder):boolean;
var cs:TCurrentStructure;
begin
  with fStructureTableEntryPoint do
  cs:=FindStructure(GetWhich,ByType,7,0);
  if cs.Available
  then PopulateLevelCache(cs.AnAddress);
  result:=cs.Available;
end;
 
function TWADMIBiosInfo.GetFirstCache:boolean;
begin
  result:=GetLevelCache(GetFirst);
end;
 
function TWADMIBiosInfo.GetNextCache:boolean;
begin
  result:=GetLevelCache(GetNext);
end;
 
 
function TWADMIBiosInfo.GetProcessor(GetWhich:TGetOrder):boolean;
var ALength:byte;
    Abyte:byte;
    cs:TCurrentStructure;
begin
  with fStructureTableEntryPoint do
  cs:=FindStructure(GetWhich,ByType,4,0);
  if cs.Available then
  with fProcessorInformation,fDumpBIOS do
  begin
   result:=true;
   Getstringinfo(cs.AnAddress);
   CurrentAddress:=cs.AnAddress;
   ALength:=cs.ALength;
   SocketDesignation:=BooleanToString((obyte(4)<>0),stringinfo[obyte(4)-1],'');
   ProcessorType:=BooleanToString(Between(obyte(5),low(sProcessorType),high(sProcessorType)),sProcessorType[obyte(5)],'');
   ProcessorFamily:=BooleanToString(Between(obyte($6),low(sProcessorFamily1),high(sProcessorFamily1)),sProcessorFamily1[obyte($6)],'');
   if ProcessorFamily='' then
   ProcessorFamily:=BooleanToString(Between(obyte($6),low(sProcessorFamily2),high(sProcessorFamily2)),sProcessorFamily2[obyte($6)],'');
   if ProcessorFamily='' then
   ProcessorFamily:=BooleanToString(Between(obyte($6),low(sProcessorFamily3),high(sProcessorFamily3)),sProcessorFamily3[obyte($6)],'');
   if ProcessorFamily='' then
   ProcessorFamily:=BooleanToString(Between(obyte($6),low(sProcessorFamily4),high(sProcessorFamily4)),sProcessorFamily4[obyte($6)],'');
 
   ProcessorManufacturer:=BooleanToString((obyte(7)<>0),stringinfo[obyte(7)-1],'');
   ProcessorID:='EAX='+IntToHex(odword(8),8)+'; EDX='+IntToHex(odword($0C),8);
   ProcessorVersion:=BooleanToString((obyte($10)<>0),stringinfo[obyte($10)-1],'');
   AByte:=obyte($11);
   Voltage:='';
   case BitSet(AByte,7) of
     false:begin
             if BitSet(AByte,7) then Voltage:=Voltage+'Mode "Legacy", ';
             Voltage:=Voltage+'Voltages supportés : ';
             if BitSet(AByte,0) then Voltage:=Voltage+'5V ';
             if BitSet(AByte,1) then Voltage:=Voltage+'3.3V ';
             if BitSet(AByte,2) then Voltage:=Voltage+'2.9V';
           end;
     true:Voltage:=FloatToStr((Abyte-128)/10)+' volts (voltage utilisé)';
   end;
   ExternalClock:=oword($12);
   MaxSpeed:=oword($14);
   CurrentSpeed:=oword($16);
   Abyte:=obyte($18);
   Status:=BooleanToString(BitSet(Abyte,6),'Processeur présent','Socket vide')+', Statut : ';
   case (Abyte and 7) of
     0:Status:=Status+'Inconnu';
     1:Status:=Status+'CPU activé';
     2:Status:=Status+'CPU désactivé par l''utilisateur via la configuration du BIOS';
     3:Status:=Status+'CPU désactivé par le BIOS au démarrage (Erreur de POST)';
     4:Status:=Status+'CPU en sommeil et en attente d''être activé';
     5,6:Status:=Status+'Indisponible (réservé)';
     7:Status:=Status+'Autre (!!)';
   end;
   ProcessorUpgrade:='-';
   L1CacheHandle:=0;
   L2CacheHandle:=0;
   L3CacheHandle:=0;
   SerialNumber:='-';
   AssetTag:='-';
   PartNumber:='-';
   if ALength=$19 then exit;
   ProcessorUpgrade:=BooleanToString(Between(obyte($19),low(sProcessorUpgrade),high(sProcessorUpgrade)),sProcessorUpgrade[obyte($19)],'');
   if Alength=$1A then exit;
   L1CacheHandle:=oword($1A);
   if Alength=$1C then exit;
   L2CacheHandle:=oword($1C);
   if Alength=$1E then exit;
   L3CacheHandle:=oword($1E);
   if Alength=$20 then exit;
   SerialNumber:=BooleanToString((obyte($20)<>0),stringinfo[obyte($20)-1],'');
   if Alength=$21 then exit;
   AssetTag:=BooleanToString((obyte($21)<>0),stringinfo[obyte($21)-1],'');
   if Alength=$22 then exit;
   PartNumber:=BooleanToString((obyte($22)<>0),stringinfo[obyte($22)-1],'');
  end
  else result:=false;
end;
 
function TWADMIBiosInfo.GetFirstProcessor:boolean;
begin
  result:=GetProcessor(GetFirst);
end;
 
 
function TWADMIBiosInfo.GetNextProcessor:boolean;
begin
  result:=GetProcessor(GetNext);
end;
 
function TWADMIBiosInfo.GetMemoryController(GetWhich:TGetOrder):boolean;
var i:integer;
    ALength:byte;
    Abyte:byte;
    AWord:word;
    AValue:Cardinal;
    cs:TCurrentStructure;
begin
  with fStructureTableEntryPoint do
  cs:=FindStructure(GetWhich,ByType,5,0);
  if cs.Available then
  with fMemoryControllerInfo,fDumpBIOS do
  begin
   result:=true;
   Getstringinfo(cs.AnAddress);
   CurrentAddress:=cs.AnAddress;
   ALength:=cs.ALength;
   ErrorDetectingMethod:=BooleanToString(Between(obyte($4),low(sMemoryControllerEDM),high(sMemoryControllerEDM)),sMemoryControllerEDM[obyte($4)],'');
   AByte:=obyte($5);
   ErrorCorrectingCapability:=BitList(AByte,['Autre(s)',
                                             'Inconnue(s)',
                                             'Aucune',
                                             'Single Bit Error Correcting',
                                             'Double Bit Error Correcting',
                                             'Error Scrubbing']);
   SupportedInterleave:=BooleanToString(Between(obyte($6),low(sMemoryControllerInterleave),high(sMemoryControllerInterleave)),sMemoryControllerInterleave[obyte($6)],'');
   CurrentInterleave:=BooleanToString(Between(obyte($7),low(sMemoryControllerInterleave),high(sMemoryControllerInterleave)),sMemoryControllerInterleave[obyte($7)],'');
 
   AByte:=obyte($8);
   AValue:=1 shl AByte;  //2 à la puissance Abyte
   if AValue>=1024
        then MaximumMemoryModuleSize:=FloatToStr(AValue/1024)+' Go'
        else MaximumMemoryModuleSize:=inttostr(AValue)+' Mo';
   AByte:=obyte($E);
   NumberOfAssociaTedMemorySlots:=AByte;
   AValue:=AValue*AByte;
   if AValue>=1024
        then MaximumMemorySupported:=FloatToStr(AValue/1024)+' Go'
        else MaximumMemorySupported:=inttostr(AValue)+' Mo';
 
   for i:=0 to 255 do
   begin
     MemoryConfigurationHandles[i]:=0;
   end;
 
   AWord:=oword($9);
   SupportedSpeeds:=BitList(Aword,['Autre(s)','Inconnue(s)','70ns','60ns','50ns']);
   AWord:=oword($B);
   SupportedMemoryTypes:=BitList(Aword,['Autre(s)','Inconnue','Standard','Fast Page Mode','EDO','Parity',
                                      'ECC','SIMM','DIMM','Burst EDO','SDRAM']);
   AByte:=obyte($D);
   MemoryModuleVoltage:=BitList(AByte,['5V','3.3V','2.9V']);
   EnableECC:='-';
   if NumberOfAssociaTedMemorySlots>0 then
   for i:=0 to NumberOfAssociaTedMemorySlots-1 do
   begin
     MeMoryConfigurationHandles[i]:=oword($f+(2*i));
   end;
   if (ALength=($f+2*NumberOfAssociaTedMemorySlots)) then exit;
   AByte:=obyte($f+2*NumberOfAssociaTedMemorySlots);
   EnableECC:=BitList(AByte,['Autre(s)','Inconnue(s)','Aucune',
              'Single Bit Error Correcting','Double Bit Error Correcting','Error Scrubbing']);
  end
  else result:=false;
end;
 
function TWADMIBiosInfo.GetFirstMemoryController;
begin
  result:=GetMemoryController(GetFirst);
end;
 
function TWADMIBiosInfo.GetNextMemoryController;
begin
  result:=GetMemoryController(GetNext);
end;
 
procedure TWADMIBiosInfo.PopulateMemoryModule(AnAddress:Cardinal);
var AByte:byte;
    Aword:word;
    AValue:cardinal;
    s:string;
begin
  with fMemoryModuleInfo,fDumpBIOS do
  begin
    Getstringinfo(AnAddress);
    CurrentAddress:=AnAddress;
    SocketDesignation:=BooleanToString((obyte($4)<>0),stringinfo[obyte($4)-1],'');
    AByte:=obyte(5);
    s:=inttohex(AByte,2);
    if ((s[1]='F') and (s[2]='F')) then BankConnections:='Aucune !'
    else begin
           if ((s[1]<>'F') and (s[2]<>'F')) then BankConnections:='RAS '+s[1]+'&'+s[2]
           else begin
                   if (s[1]<>'F') then BankConnections:='RAS '+s[1];
                   if (s[2]<>'F') then BankConnections:='RAS '+s[2];
                end;
         end;
    Abyte:=obyte(6);
    if Abyte=0 then CurrentSpeed:='Inconnue' else CurrentSpeed:=inttostr(Abyte)+'ns';
    Aword:=oword(7);
    CurrentMemoryType:=BitList(Aword,['Autre','Inconnue','Standard','Fast Page Mode','EDO','Parity',
                                      'ECC','SIMM','DIMM','Burst EDO','SDRAM']);
    AByte:=obyte($9);
    InstalledSize:='Connection sur Banque '+BooleanToString(BitSet(AByte,7),'Double','Simple')+'--> ';
    AByte:=(AByte and 127);
    Case AByte of
      $7F:InstalledSize:=InstalledSize+'Non installée';
      $7E:InstalledSize:=InstalledSize+'Module installé mais désactivé';
      $7D:InstalledSize:=InstalledSize+'Ne peut être déterminée';
    else begin
           AValue:=(1 shl AByte);
           if AValue>=1024
           then InstalledSize:=InstalledSize+FloatToStr(AValue/1024)+' Go'
           else InstalledSize:=InstalledSize+inttostr(AValue)+' Mo';
         end;
    end;
    //EnabledSize:String;
    AByte:=obyte($9);
    EnabledSize:='Connection sur Banque '+BooleanToString(BitSet(AByte,7),'Double','Simple')+'--> ';
    AByte:=(AByte and 127);
    Case AByte of
      $7F:EnabledSize:=EnabledSize+'Non installée';
      $7E:EnabledSize:=EnabledSize+'Module installé mais désactivé';
      $7D:EnabledSize:=EnabledSize+'Ne peut être déterminée';
    else begin
           AValue:=(1 shl AByte);
           if AValue>=1024
           then EnabledSize:=EnabledSize+FloatToStr(AValue/1024)+' Go'
           else EnabledSize:=EnabledSize+inttostr(AValue)+' Mo';
         end;
    end;
    //AByte:=obyte($B);
    ErrorStatus:=''; // A faire...
  end;
end;
 
function TWADMIBiosInfo.GetMemoryModule(Handle:word):boolean;
var cs:TCurrentStructure;
begin
  if Handle<>$ffff then
  with fStructureTableEntryPoint do
    cs:=FindStructure(GetFirst,ByHandle,6,Handle);
  if cs.Available
  then PopulateMemoryModule(cs.AnAddress);
  result:=cs.Available
end;
 
function TWADMIBiosInfo.GetMemoryModule(GetWhich:TGetOrder):boolean;
var cs:TCurrentStructure;
begin
  with fStructureTableEntryPoint do
  cs:=FindStructure(GetWhich,ByType,6,0);
  if cs.Available then PopulateMemoryModule(cs.AnAddress);
  result:=cs.Available;
end;
 
function TWADMIBiosInfo.GetFirstMemoryModule:boolean;
begin
  result:=GetMemoryModule(GetFirst);
end;
 
function TWADMIBiosInfo.GetNextMemoryModule:boolean;
begin
  result:=GetMemoryModule(GetNext);
end;
 
function TWADMIBiosInfo.GetPort(GetWhich:TGetOrder):boolean;
var cs:TCurrentStructure;
begin
  with fStructureTableEntryPoint do
  cs:=FindStructure(GetWhich,ByType,8,0);
  if cs.Available then
  with fPortInfo,fDumpBIOS do
  begin
   result:=true;
   Getstringinfo(cs.AnAddress);
   CurrentAddress:=cs.AnAddress;
   InternalReferenceDesignator:=BooleanToString((obyte($4)<>0),stringinfo[obyte($4)-1],'');
   InternalConnectorType:=BooleanToString(Between(obyte($5),low(sPortInformationConnectorTypes1),high(sPortInformationConnectorTypes1)),sPortInformationConnectorTypes1[obyte($5)],'');
   if InternalConnectorType='' then
   InternalConnectorType:=BooleanToString(Between(obyte($5),low(sPortInformationConnectorTypes2),high(sPortInformationConnectorTypes2)),sPortInformationConnectorTypes2[obyte($5)],'');
   ExternalReferenceDesignator:=BooleanToString((obyte($6)<>0),stringinfo[obyte($6)-1],'');
   ExternalConnectorType:=BooleanToString(Between(obyte($7),low(sPortInformationConnectorTypes1),high(sPortInformationConnectorTypes1)),sPortInformationConnectorTypes1[obyte($7)],'');
   if ExternalConnectorType='' then
   ExternalConnectorType:=BooleanToString(Between(obyte($7),low(sPortInformationConnectorTypes2),high(sPortInformationConnectorTypes2)),sPortInformationConnectorTypes2[obyte($7)],'');
 
   PortType:=BooleanToString(Between(obyte($8),low(sPortTypes1),high(sPortTypes1)),sPortTypes1[obyte($8)],'');
   if PortType='' then
   PortType:=BooleanToString(Between(obyte($8),low(sPortTypes2),high(sPortTypes2)),sPortTypes2[obyte($8)],'');
 
  end
  else result:=false;
end;
 
function TWADMIBiosInfo.GetFirstPort:boolean;
begin
  result:=GetPort(GetFirst);
end;
 
function TWADMIBiosInfo.GetNextPort:boolean;
begin
  result:=GetPort(GetNext);
end;
 
function TWADMIBiosInfo.GetSystemSlot(GetWhich:TGetOrder):boolean;
var ALength:byte;
    Abyte:byte;
    cs:TCurrentStructure;
begin
  with fStructureTableEntryPoint do
  cs:=FindStructure(GetWhich,ByType,9,0);
  if cs.Available then
  with fSystemSlot,fDumpBIOS do
  begin
   result:=true;
   Getstringinfo(cs.AnAddress);
   CurrentAddress:=cs.AnAddress;
   ALength:=cs.ALength;
   SlotDesignation:=BooleanToString((obyte($4)<>0),stringinfo[obyte($4)-1],'');
   AByte:=obyte($5);
   SlotType:=BooleanToString(Between(obyte($5),low(sSystemSlotsSlotTypes1),high(sSystemSlotsSlotTypes1)),sSystemSlotsSlotTypes1[obyte($5)],'');
   if SlotType='' then
   SlotType:=BooleanToString(Between(obyte($5),low(sSystemSlotsSlotTypes2),high(sSystemSlotsSlotTypes2)),sSystemSlotsSlotTypes2[obyte($5)],'');
 
   SlotDataBusWidth:=BooleanToString(Between(obyte($6),low(sSystemSlotsSlotDataBusWidth),high(sSystemSlotsSlotDataBusWidth)),sSystemSlotsSlotDataBusWidth[obyte($6)],'');
   CurrentUsage:=BooleanToString(Between(obyte($7),low(sSystemSlotsCurrentUsage),high(sSystemSlotsCurrentUsage)),sSystemSlotsCurrentUsage[obyte($7)],'');
 
   SlotLength:=BooleanToString(Between(obyte($8),low(sSystemSlotsSlotLength),high(sSystemSlotsSlotLength)),sSystemSlotsSlotLength[obyte($8)],'');
   //Aword:=oword($9);
   case AByte of
    //MCA
    $4:SlotID:='Numéro de slot logique du Micro Channel --> '+inttostr(obyte($9));
    //EISA
    $5:SlotID:='Numéro de slot EISA --> '+inttostr(obyte($9));
    //PCI&AGP
    $6,$e..$12:SlotID:='Numéro de slot PCI --> '+inttostr(obyte($9));
    //PCMCIA
    $7:SlotID:='Numéro d''adaptateur --> '+inttostr(obyte($9))+', Numéro de Socket -->'+inttostr(obyte($A));
   else SlotID:='-';
   end;
 
   AByte:=obyte($B);
   SlotCharacteristics1:=BitList(AByte,['Caractéristiques inconnues',
                                        'Fourni du 5.0 Volts',
                                        'Fourni du 3.3 Volts',
                                        'L''ouverture du slot est partagée avec un autre slot (e.g. slot partagé PCI/ISA)',
                                        'Le slot de la PC-Card supporte le standard "PC Card-16"',
                                        'Le slot de la PC-Card supporte le standard "CardBus"',
                                        'Le slot de la PC-Card supporte le standard "Zoom Video"',
                                        'Le slot de la PC-Card supporte le standard "Modem Ring Resume"']);
 
   SlotCharacteristics2:='';
   if Alength=$C then exit;
   AByte:=obyte($C);
   SlotCharacteristics2:=BitList(AByte,['Le slot PCI supporte le signal "Power Management Enable" (PME#)',
                                        'Le slot supporte les périphériques Hot-Plug',
                                        'Le slot PCI supporte le signal SMBus']);
 
  end
  else result:=false;
end;
 
function TWADMIBiosInfo.GetFirstSystemSlot:boolean;
begin
  result:=GetSystemSlot(GetFirst);
end;
 
function TWADMIBiosInfo.GetNextSystemSlot:boolean;
begin
  result:=GetSystemSlot(GetNext);
end;
 
function TWADMIBiosInfo.GetOnBoardDevices(GetWhich:TGetOrder):boolean;
var i:integer;
    ALength:byte;
    Abyte:byte;
    cs:TCurrentStructure;
begin
  with fStructureTableEntryPoint do
  cs:=FindStructure(GetWhich,ByType,10,0);
  if cs.Available then
  with fOnBoardDevices,fDumpBIOS do
  begin
   result:=true;
   Getstringinfo(cs.AnAddress);
   CurrentAddress:=cs.AnAddress;
   ALength:=cs.ALength;
   DeviceCount:=(Alength-4) div 2;
   for i:=0 to 255 do
   begin
     DevicesType[i]:='';
     DevicesString[i]:='';
   end;
   if DeviceCount>0 then
   for i:=0 to DeviceCount-1 do
   begin
     AByte:=obyte(4+2*i);
     DevicesType[i]:='Statut --> '+BooleanToString(BitSet(AByte,7),'activé','désactivé')+', Type --> ';
     AByte:=(AByte and 127);
     DevicesType[i]:=DevicesType[i]+BooleanToString(Between(Abyte,low(sOnBoardDeviceInformationOnBoarDeviceType),high(sOnBoardDeviceInformationOnBoarDeviceType)),sOnBoardDeviceInformationOnBoarDeviceType[Abyte],'');
     AByte:=obyte(5+2*i);
     DevicesString[i]:=BooleanToString((Abyte<>0),stringinfo[Abyte-1],'');
   end;
  end
  else result:=false;
end;
 
function TWADMIBiosInfo.GetFirstOnBoardDevices:boolean;
begin
  result:=GetOnBoardDevices(GetFirst);
end;
 
function TWADMIBiosInfo.GetNextOnBoardDevices:boolean;
begin
  result:=GetOnBoardDevices(GetNext);
end;
 
function TWADMIBiosInfo.GetGroupAssotiations(GetWhich:TGetOrder):boolean;
var i:integer;
    ALength:byte;
    Abyte:byte;
    cs:TCurrentStructure;
begin
  with fStructureTableEntryPoint do
  cs:=FindStructure(GetWhich,ByType,14,0);
  if cs.Available then
  with fGroupAssociations,fDumpBIOS do
  begin
   result:=true;
   Getstringinfo(cs.AnAddress);
   CurrentAddress:=cs.AnAddress;
   ALength:=cs.ALength;
   Count:=(ALength-5) div 3;
 
   AByte:=obyte(4);
   GroupName:=BooleanToString((Abyte<>0),stringinfo[Abyte-1],'');
   for i:=0 to 255 do
   begin
     ItemType[i]:=0;
     ItemHandle[i]:=0;
   end;
   if count>0 then
   for i:=0 to Count-1 do
   begin
     ItemType[i]:=obyte(5+i*3);
     ItemHandle[i]:=oword(6+i*3);
   end;
  end
  else result:=false;
end;
 
function TWADMIBiosInfo.GetFirstGroupAssotiations:boolean;
begin
  result:=GetGroupAssotiations(GetFirst);
end;
 
function TWADMIBiosInfo.GetNextGroupAssotiations:boolean;
begin
  result:=GetGroupAssotiations(GetNext);
end;
 
procedure TWADMIBiosInfo.GetLanguage;
var i:integer;
    AByte:byte;
    CodeIso639:string[2];
    CodeIso3166:string[2];
    StringIso639:string;
    StringIso3166:string;
    myinifile:tinifile;
    s:string;
    AF:boolean;
    cs:TCurrentStructure;
begin
 with fStructureTableEntryPoint,fLanguage,fDumpBIOS do
 begin
  for i:=0 to 255 do ListOfLanguages[i]:='';
  cs:=FindFirstStructure(13);
  Present:=cs.Available;
  if Present then
  begin
    GetStringInfo(cs.AnAddress);
    CurrentAddress:=cs.AnAddress;
    InstallableLanguages:=obyte(4);
    Abyte:=obyte(5);
    AbreviatedFormat:=BitSet(Abyte,0);
    fOEMStrings.Clear;
    if InstallableLanguages>0 then
    for i:=0 to InstallableLanguages-1 do
    begin
      s:=stringinfo[i];
      AF:=(Length(s)=4);
      CodeIso639:=s[1]+s[2];
      Case AF of
        true:if length(s)=4 then CodeIso3166:=s[3]+s[4];
        false:if length(s)>=5 then CodeIso3166:=s[4]+s[5];
      end;
      StringIso639:='';
      StringIso3166:='';
      if FileExists(ExtractFilePath(Application.ExeName)+'iso.ini') then
      begin
        myinifile:=TIniFile.Create(ExtractFilePath(Application.ExeName)+'iso.ini');
        try
          StringIso639:='Langage:'+myinifile.ReadString('iso639',CodeIso639,'inconnu');
          StringIso3166:='Pays:'+myinifile.ReadString('iso3166',CodeIso3166,'inconnu');
        finally
          myinifile.Free;
        end;
        ListOfLanguages[i]:=s+' ('+StringIso639+';'+StringIso3166+')';
 
      end else ListOfLanguages[i]:=s;
    end;
  end;
  CurrentLanguage:=BooleanToString((obyte($15)<>0),ListOfLanguages[obyte($15)-1],'');
 end;
end;
 
procedure TWADMIBiosInfo.GetOEMStrings;
var i:integer;
    Count:byte;
    cs:TCurrentStructure;
begin
 with fStructureTableEntryPoint do
 cs:=FindFirstStructure(11);
  if cs.Available then
  with fDumpBIOS do
  begin
  GetStringInfo(cs.AnAddress);
  CurrentAddress:=cs.AnAddress;
  Count:=obyte(4);
  fOEMStrings.Clear;
  if count>0 then
  for i:=0 to Count-1 do
    fOEMStrings.Add(stringinfo[i]);
  end;
end;
 
 
procedure TWADMIBiosInfo.GetSystemConfigOptions;
var i:integer;
    Count:byte;
    cs:TCurrentStructure;
begin
  with fStructureTableEntryPoint do
  cs:=FindFirstStructure(12);
  if cs.Available then
  with fDumpBIOS do
  begin
  Getstringinfo(cs.AnAddress);
  CurrentAddress:=cs.AnAddress;
  Count:=obyte(4);
  fSystemConfigOptions.Clear;
  if count>0 then
  for i:=0 to Count-1 do
    fSystemConfigOptions.Add(stringinfo[i]);
  end;
end;
 
function TWADMIBiosInfo.Detect:boolean;
begin
  if not fLoaded then
  begin
    result:=False;
    exit;
  end;   
 
  if not FindSMBIOS then FindDMI;
  if fDMIFound then
  begin
    GetSTEP;
    GetAllHeaders;
    GetBiosInformation;   //type 0
    GetSystemInformation; //type 1
    fBaseBoardCount:=ftypecount[2];
    fChassisCount:=ftypecount[3];
    fProcessorCount:=ftypecount[4];
    fMemoryControllerCount:=ftypecount[5];
    fMemoryModuleCount:=ftypecount[6];
    fCacheCount:=ftypecount[7];
    fPortCount:=ftypecount[8];
    fSystemSlotCount:=ftypecount[9];
    fOnBoardDevicesCount:=ftypecount[10];
    fOEMStringsCount:=ftypecount[11];
    fSystemConfigOptionsCount:=ftypecount[12];
    fGroupAssociationsCount:=ftypecount[14];
    GetFirstBaseBoard;         //Type 2
    GetFirstChassis;           //type 3
    GetFirstProcessor;
    GetLanguage;
    GetOEMStrings;        //type 11
    GetSystemConfigOptions; //type 12
  end;
  result:=fDMIFound;
end;
 
procedure TWADMIBiosInfo.LoadFromBios;
begin
  fDumpBIOS.LoadFromBios;
  fLoaded:=true;
end;
 
procedure TWADMIBiosInfo.LoadFromFile(const FileName: string);
begin
  fDumpBIOS.LoadFromFile(FileName);
  fLoaded:=true;
end;
 
procedure TWADMIBiosInfo.SavetoFile(const FileName: string);
begin
  if fLoaded then fDumpBIOS.SavetoFile(FileName);
end;
 
procedure Register;
begin
  RegisterComponents('WA', [TWADMIBiosInfo]);
end;
 
end.

Et un fichier iso.ini à mettre dans le répertoire de votre appli :

Code:

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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
 
[iso639]
aa=afar
ab=abkhaze
af=afrikaans
am=amharique
ar=arabe
as=assamais
ay=aymara
az=azéri
ba=bachkir
be=biélorusse
bg=bulgare
bh=bihari
bi=bêche-de-mer
bn=bengali
bo=tibétain
br=breton
ca=catalan
co=corse
cs=tchèque
cy=gallois
da=danois
de=allemand
dz=boutani
el=grec
en=anglais
eo=espéranto
es=espagnol
et=estonien
eu=basque
fa=persan
fi=finnois
fj=fidjien
fo=féroïen
fr=français
fy=frison
ga=irlandais
gd=gaélique,écossais
gl=galicien
gn=guarani
gu=goudjarati
ha=haoussa
hi=hindi
hr=croate
hu=hongrois
hy=arménien
ia=interlingua
ie=interlingue
ik=inupiak
in=indonésien
is=islandais
it=italien
iw=hébreu
ja=japonais
ji=yidich
jw=javanais
ka=géorgien
kk=kazakh
kl=groenlandais
km=cambodgien
kn=kannada
ko=coréen
ks=cachemiri
ku=kurde
ky=kirghiz
la=latin
ln=lingala
lo=lao
lt=lithuanien
lv=letton
mg=malgache
mi=maori
mk=macédonien
ml=malayalam
mn=mongol
mo=moldave
mr=marathe
ms=malais
mt=maltais
my=birman
na=nauri
ne=népalais
nl=néerlandais
no=norvégien
oc=occitan
om=oromo
or=oriya
pa=pendjabi
pl=polonais
ps=pachto
pt=portuguais
qu=quechua
rm=rhéto-roman
rn=roundi
ro=roumain
ru=russe
rw=rouanda
sa=sanscrit
sd=sindhi
sg=sango
sh=serbo-croate
si=cingalais
sk=slovaque
sl=slovène
sm=samoan
sn=chona
so=somali
sq=albanais
sr=serbe
ss=siswati
st=sothoduSud
su=soundanais
sv=suédois
sw=souahéli
ta=tamoul
te=télougou
tg=tadjik
th=thaï
ti=tigrigna
tk=turkmène
tl=tagal
tn=setchwana
to=kitonga
tr=turc
ts=tsonga
tt=tatar
tw=tchi
uk=ukrainien
ur=ourdou
uz=ouzbek
vi=vietnamien
vo=volapük
wo=ouolof
xh=xhosa
yo=yorouba
zh=chinois
zu=zoulou
[iso3166]
AL=Albanie
DE=Allemagne
AD=Andorre 
AT=Autriche
BE=Belgique
BY=Biélorussie
BA=Bosnie Herzégovine
BG=Bulgarie
CY=Chypre
HR=Croatie
DK=Danemark
ES=Espagne
EE=Estonie
FI=Finlande
FR=France
GI=Gibraltar 
GB=Grande Bretagne
GR=Grèce
HU=Hongrie
IE=Irlande 
IS=Islande
IT=Italie
LV=Lettonie
LI=Liechtenstein
LT=Lituanie
LU=Luxembourg
MK=Macédoine
MT=Malte
MD=Moldavie
MC=Monaco
NO=Norvège
NL=Pays-Bas
PL=Pologne
PT=Portugal
RO=Roumanie
RU=Russie 
SM=Saint Marin
SK=Slovaquie
SI=Slovénie
SE=Suède
CH=Suisse
CZ=Tchèque (République)
TR=Turquie
UA=Ukraine 
VA=Vatican   
YU=Yougoslavie
AF=Afghanistan
ZA=Afrique du Sud
DZ=Algérie
AO=Angola
AI=Anguilla 
AG=Antigua and Barbuda 
AN=Antilles néerlandaises
SA=Arabie Saoudite
AR=Argentine
AM=Arménie
AW=Aruba 
AU=Australie 
AZ=Azerbaïdjan
BS=Bahamas
BH=Bahreïn
BD=Bangladesh
BB=Barbade 
BZ=Belize 
BJ=Bénin
BM=Bermudes 
BT=Bhutan
BO=Bolivie
BW=Botswana
BV=Bouvet (Iles) 
BR=Brésil
BN=Brunei 
BF=Burkina Faso 
BI=Burundi
KH=Cambodge 
CM=Cameroun
CA=Canada 
CV=Cap Vert
KY=Caïman (Iles) 
CL=Chili
CN=Chine
CX=Christmas Island 
CC=Cocos (Keeling) Iles
CO=Colombie
KM=Comores
CG=Congo
CD=Congo (République démocratique)
CK=Cook (Iles)
KP=Corée du Nord
KR=Corée du Sud
CR=Costa Rica
CI=Côte d'Ivoire
CU=Cuba
DJ=Djibouti
DO=Dominicaine (République)
DM=Dominique
EG=Égypte
AE=Émirats Arabes Unis 
EC=Équateur
ER=Érythrée 
US=États Unis
ET=Éthiopie 
FK=Falkland   (Iles Malouines) 
FO=Féroé (Iles)
FJ=Fidji
GA=Gabon
GM=Gambie
GE=Géorgie
GH=Ghana
GD=Grenade 
GL=Groenland 
GU=Guam 
GT=Guatemala
GN=Guinée
GQ=Guinée Équatoriale
GW=Guinée-Bissau
GY=Guyane
HT=Haïti
HN=Honduras
HK=Hong Kong 
IN=Inde
ID=Indonésie
IQ=Irak
IR=Iran
IL=Israël
JM=Jamaïque
JP=Japon 
JO=Jordanie
KZ=Kazakhstan
KE=Kenya
KI=Kiribati 
KW=Koweït
KG=Kyrgyzstan
LA=Laos
LS=Lesotho
LB=Liban
LR=Liberia
LY=Libye
MO=Macao 
MG=Madagascar
MW=Malawi
MY=Malaisie 
MV=Maldives
ML=Mali
MP=Mariannes (Iles du Nord)
MA=Maroc
MH=Marshall  (Iles)
MU=Maurice (Ile)
MR=Mauritanie
YT=Mayotte 
MX=Mexico
FM=Micronésie
MN=Mongolie 
MS=Montserrat 
MZ=Mozambique
MM=Myanmar
NA=Namibie
NR=Nauru
NP=Népal
NI=Nicaragua
NE=Niger
NG=Nigeria
NU=Niue 
NF=Norfolk Island 
NZ=Nouvelle Zélande
OM=Oman
UG=Ouganda
UZ=Ouzbekistan
PK=Pakistan
PW=Palau
PA=Panama
PG=Papouasie  
PY=Paraguay
PE=Pérou
PH=Philippines
PN=Pitcairn 
PR=Porto Rico 
QA=Qatar
CF=République Centre Afrique 
RW=Rwanda
SH=Sainte Hélène 
KN=Saint Kitts et Nevis 
VC=Saint Vincent et Grenadines 
LC=Sainte Lucie 
SB=Salomon (Iles)
WS=Samoa
AS=Samoa (Iles)
SV=San Salvador
ST=São Tomé and Príncipe
SN=Sénégal
SC=Seychelles
SL=Sierra Leone
SG=Singapour
SO=Somalie
SD=Soudan
LK=Sri Lanka
SR=Suriname
SZ=Swaziland
SY=Syrie
TJ=Tadjikistan
TW=Taiwan
TZ=Tanzanie
TD=Tchad
TH=Thaïlande
TG=Togo
TK=Tokelau 
TO=Tonga
TT=Trinidad et Tobago
TN=Tunisie
TM=Turkmenistan 
TC=Turks and Caicos (Iles) 
TV=Tuvalu 
UY=Uruguay
VU=Vanuatu
VE=Venezuela
VN=Viet Nam
VG=Virgin (Iles), Britanniques 
VI=Virgin (Iles), U.S.
YE=Yémen
ZM=Zambie
ZW=Zimbabwe

C'est tout !
Vous n'avez plus qu'a installer le composant.

L'exemple est dans le prochain post :wink:

21/02/2006, 14h01
touhami

Merci baucoup,
et encore , et nous attendant Votre exemple.
Bon developpement a tous.

L'exemple :
dans une fiche, j'ai mis :

Un TRichEdit
Un TButton (Button1, intitulé 'Lire Infos du bios'
2 Tbitbtn : un intitulé "Charger" et l'autre "Sauver"
il y a aussi un TOpenDialog et un TSaveDialog

Code:

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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, WADMIBiosInfo,smbiosstructures, ComCtrls, Buttons;
const TypesStruct:array[0..31] of string=('Information Bios','Information Système','Carte mère','Chassis','Microprocesseur',
                                          'Contrôleur mémoire','Module mémoire','Mémoire Cache','Port','Slot','Périphérique Intégré',
                                          'OEM','Option de configuration',
                                          'Langage','Groupe','Evènement systême',
                                          'Grille de mémoire physique',
                                          'Périphérique mémoire',
                                          'Information Erreur mémoire 32-bits',
                                          'Adresse mappée de la Grille mémoire',
                                          'Adresse mappée du Périphérique mémoire',
                                          'Périphérique de pointage intégré',
                                          'Pile/Batterie Portable',
                                          'Reset Systême',
                                          '','','','','','','','');
type
  TForm1 = class(TForm)
    Button1: TButton;
    WADMIBiosInfo1: TWADMIBiosInfo;
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    RichEdit1: TRichEdit;
    procedure Button1Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
  private
    { Déclarations privées }
    procedure getdmi;
    function OuiNon(b:boolean):string;
    procedure MontreCache(CacheInfo:TCacheInformation;retrait:boolean);
    procedure MontreModuleMemoire(MemoryModuleInfo:TMemoryModuleInfo;retrait:boolean);
    procedure Titre(Astring:string);
    procedure DoLine(retrait:integer);
    procedure EnumDisplay(AText,AString:string;retrait:integer);
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.DFM}
function TForm1.OuiNon(b:boolean):string;
begin
  if b then result:='Oui' else result:='Non';
end;
 
procedure TForm1.Titre(Astring:string);
begin
  RichEdit1.SelAttributes.Style:=[fsbold];
  RichEdit1.Lines.Add(Astring);
  RichEdit1.SelAttributes.Style:=[];
end;
 
procedure TForm1.EnumDisplay(AText,AString:string;retrait:integer);
var s0,s:string;
    i:integer;
    liste:TStringList;
begin
  liste:=TStringList.Create;
  try
    if retrait=0
    then s0:=StringOfChar(' ',length(AText))+'·'
    else s0:=StringOfChar(' ',retrait)+'·';
    s:='"'+StringReplace(AString,', ','","',[rfReplaceAll]);
    if s[length(s)]='.' then s[length(s)]:='"' else s:=s+'"';
    liste.CommaText:=s;
    if liste.Count>0 then
    begin
    if liste.Count=1 then RichEdit1.Lines.Add(AText+AString)
    else begin
            for i:=0 to liste.Count-1 do
              if ((retrait=0) and (i=0)) then RichEdit1.Lines.Add(AText+'·'+liste.Strings[0])
              else begin
                     if i=0 then RichEdit1.Lines.Add(AText);
                     RichEdit1.Lines.Add(s0+liste.Strings[i]);
                   end;
         end;
    end;
  finally
    liste.Free;
  end;
end;
 
procedure TForm1.DoLine(retrait:integer);
var s:string;
begin
  s:=StringOfChar(' ',retrait)+StringOfChar('_',15);
  if retrait=0 then
  begin
     s:=s+StringOfChar('_',15);
     RichEdit1.SelAttributes.Style:=[fsbold];
     RichEdit1.Lines.Add(s);
     RichEdit1.SelAttributes.Style:=[];
  end else RichEdit1.Lines.Add(s);
end;
 
procedure TForm1.MontreCache(CacheInfo:TCacheInformation;retrait:boolean);
var s:string;
begin
   if retrait then s:='           - ' else s:='    ';
   with RichEdit1.lines,CacheInfo do
   begin
    Add(s+'Désignation de socket...... : '+SocketDesignation);
    EnumDisplay(s+'Configuration.............. : ',CacheConfiguration,0);
    Add(s+'Taille Maxi du cache....... : '+MaximumCacheSize);
    Add(s+'Taille Instalée............ : '+InstalledSize);
    Add(s+'Type de SRAM supportées.... : '+SupportedSRAMType);
    Add(s+'Type de SRAM installée..... : '+CurrentSRAMType);
    Add(s+'Vitesse du cache........... : '+CacheSpeed);
    Add(s+'Type de correction d''erreur : '+ErrorCorrectionType);
    Add(s+'Type de systême cache...... : '+SystemCacheType);
    Add(s+'Associativité.............. : '+Associativity);
  end;
end;
 
procedure TForm1.MontreModuleMemoire(MemoryModuleInfo:TMemoryModuleInfo;retrait:boolean);
var s:string;
begin
   if retrait then s:='           - ' else s:='    ';
   with RichEdit1.lines,MemoryModuleInfo do
   begin
    Add(s+'Désignation de socket...... : '+SocketDesignation);
    Add(s+'Connection des banques..... : '+BankConnections);
    Add(s+'Vitesse.................... : '+CurrentSpeed);
    Add(s+'Type de mémoire............ : '+CurrentMemoryType);
    Add(s+'Taille installé............ : '+InstalledSize);
    Add(s+'Taille activée............. : '+EnabledSize);
    Add(s+'Statut d''erreur............ : '+ErrorStatus);
  end;
end;
 
procedure TForm1.getdmi;
var i,j:cardinal;
    b:boolean;
begin
  RichEdit1.clear;
  with WADMIBiosInfo1,RichEdit1.Lines do
  if Detect then
  begin
    with StructureTableEntryPoint do
    begin
      Titre('Version SMBIos : '+inttostr(MajorVersion)+'.'+inttostr(MinorVersion));
      Titre('Version DMI... : '+inttostr(BCDRevision shr 4)+'.'+inttostr(BCDRevision and $F));
    end;
    //Bios Info
    with BIOSInformation do
    begin
      DoLine(0);
      Titre('Information Bios');
      Add('  Vendeur.................. : '+Vendor);
      Add('  Version du BIOS.......... : '+BIOSVersion);
      Add('  Date du BIOS (mm/jj/aaaa) : '+BIOSReleaseDate);
      Add('  Taille de la ROM du BIOS. : '+inttostr(BIOSROMSize_KB)+'Ko');
      with BIOSCaracteristics do
      if BIOS_Characteristics_Not_Supported
      then Add('  Caractéristiques : NON DISPONIBLES')
      else
      begin
        Add('  Caractéristiques :');
        Add('   - Support ISA ............................. : '+OuiNon(ISA_Support));
        Add('   - Support MCA ............................. : '+OuiNon(MCA_Support));
        Add('   - Support EISA ............................ : '+OuiNon(EISA_Support));
        Add('   - Support PCI ............................. : '+OuiNon(PCI_Support));
        Add('   - Support Cartes PC (PCMCIA) .............. : '+OuiNon(PCMCIA_Support));
        Add('   - Support "Plug and Play" ................. : '+OuiNon(PnP_Support));
        Add('   - Support APM ............................. : '+OuiNon(APM_Support));
        Add('   - BIOS Flashable .......................... : '+OuiNon(BIOS_Upgradable));
        Add('   - Shadowing du BIOS possible .............. : '+OuiNon(BIOSShadowingAllowed));
        Add('   - Support VL/VESA ......................... : '+OuiNon(VL_VESA_Supported));
        Add('   - Support ESCD ............................ : '+OuiNon(ESCD_Support_Available));
        Add('   - Support Boot depuis le CD ............... : '+OuiNon(BootFromCD_Available));
        Add('   - Support Selection Boot .................. : '+OuiNon(Selectable_Boot_Support));
        Add('   - "Domino" BIOS ROM amovible............... : '+OuiNon(BIOS_ROM_Socketed));
        Add('   - Support Boot Carte PC (PCMCIA)........... : '+OuiNon(BootFromPCMCIA_Support));
        Add('   - Support Spécif. EDD (Enhanced Disk Drive) : '+OuiNon(EDD_Specification_Support));
        Add('   - Support Disquettes Japonaises NEC 9800 1,2Mo (3'+#189+'", 1Ko/secteur, 360 Tr/min) : '+OuiNon(JapaneseFloppyNEC9800_Support));
        Add('   - Support Disquettes Japonaises Toshiba  1,2Mo (3'+#189+'", 360 Tr/min) ............ : '+OuiNon(JapaneseFloppyToshiba_Support));
        Add('   - Support Services Disquettes 5'+#188+'" - 360Ko.. : '+OuiNon(Floppy_525_360KB_Support));
        Add('   - Support Services Disquettes 5'+#188+'" - 1,2Mo.. : '+OuiNon(Floppy_525_122MB_Support));
        Add('   - Support Services Disquettes 3'+#189+'" - 720Ko.. : '+OuiNon(Floppy_35_720KB_Support));
        Add('   - Support Services Disquettes 3'+#189+'" - 2,88Mo. : '+OuiNon(Floppy_35_288MB_Support));
        Add('   - Support Service Impression d''écran ("PrintScreen") : '+OuiNon(PrintScreen_Support));
        Add('   - Support Service Clavier 8042............. : '+OuiNon(Keyboard_8042_Support));
        Add('   - Support Services Séries.................. : '+OuiNon(Serial_Support));
        Add('   - Support Services Imprimante.............. : '+OuiNon(Printer_Support));
        Add('   - Support Services Video CGA/Mono.......... : '+OuiNon(CGAMono_Video_Support));
        Add('   - Compatibilité NEC PC98 .................. : '+OuiNon(NEC_PC98));
      end;
      with BIOSCaracteristicsExtensionBytes do
      if NumberOfBIOSCaracteristicsExtensionBytes=0
      then Add('  Caractéristiques Etendues : NON')
      else
      begin
        Add('  Caractéristiques Etendues :');
        Add('   - Support ACPI............................. : '+OuiNon(ACPI_Support));
        Add('   - Support USB "Legacy"..................... : '+OuiNon(USB_Legacy_Support));
        Add('   - Support AGP.............................. : '+OuiNon(AGP_Support));
        Add('   - Support Boot I2O......................... : '+OuiNon(I2O_Boot_Support));
        Add('   - Support Boot LS120....................... : '+OuiNon(LS120_Boot_Support));
        Add('   - Support Boot ATAPI ZIP................... : '+OuiNon(ATAPI_ZIPDrive_Boot_Support));
        Add('   - Support Boot IEE1394..................... : '+OuiNon(IEE1394_Boot_Support));
        Add('   - Support Pile/Batterie "intelligente"..... : '+OuiNon(Smart_Battery_Support));
        Add('   - Support Spécif. "Boot BIOS" ............. : '+OuiNon(BiosBootSpecification_Support));
     end;
    end;
 
    //Base Board
    i:=0;
    DoLine(0);
    Titre('Carte(s) de base :');
    Add('  Nombre :'+IntToStr(BaseBoardCount));
    b:=GetFirstBaseBoard;
    while b do
    begin
      inc(i);
      with CurrentBaseBoard do
      begin
        DoLine(2);
        Titre('  Carte N°'+inttostr(i)+'/'+IntToStr(BaseBoardCount));
        Add('    Constructeur..................... : '+Manufacturer);
        Add('    Nom de produit................... : '+ProductName);
        Add('    Version.......................... : '+Version);
        Add('    Numéro de Série.................. : '+SerialNumber);
        Add('    Numéro de Tag Asset.............. : '+AssetTag);
        EnumDisplay('    Fonctionnalités.................. : ',Features,0);
        Add('    Emplacement dans le chassis...... : '+LocationInChassis);
        if AssociatedChassisHandle<>0 then
        Add('    Chassis Associé.................. : N°'+inttostr(HandleToTypeIndex(3,AssociatedChassisHandle)))
        else Add('    Chassis Associé.................. : -');
        Add('    Type de Carte.................... : '+BoardType);
        Add('    Nombre de composants............. : '+inttostr(NumberOfContainedObjects));
        //for i:=0 to NumberOfContainedObjects do
        //begin
            //if Alength=($E+2*i) then exit;
            //ContainedObjectsHandle[i]
        //end;
      end;
      b:=GetNextBaseBoard;
    end;
    //System Info
    with SystemInformation do
    begin
      DoLine(0);
      Titre('Information Système');
      Add('  Constructeur....................... : '+Manufacturer);
      Add('  Nom de produit..................... : '+ProductName);
      Add('  Version............................ : '+Version);
      Add('  Numéro de Série.................... : '+SerialNumber);
      Add('  Identifiant Unique Universel (UUID) : '+UUID);
      Add('  Ordinateur allumé par.............. : '+WakeUpType);
    end;
 
    //Chassis
    i:=0;
    DoLine(0);
    Titre('Système Boitier (ou Chassis)');
    Add('  Nombre :'+IntToStr(ChassisCount));
    b:=GetFirstChassis;
    while b do
    begin
      inc(i);
      with CurrentChassis do
      begin
        DoLine(2);
        Titre('  Chassis N°'+inttostr(i)+'/'+IntToStr(ChassisCount));
        Add('    Constructeur..................... : '+Manufacturer);
        EnumDisplay('    Type de Chassis.................. : ',TypeChassis,0);
        Add('    Version.......................... : '+Version);
        Add('    Numéro de Série.................. : '+SerialNumber);
        Add('    Numéro de Tag Asset.............. : '+AssetTagNumber);
        Add('    Etat de démarrage................ : '+BootupState);
        Add('    Etat de l''alimentation........... : '+PowerSupplyState);
        Add('    Etat de température.............. : '+ThermalState);
        Add('    Etat de sécurité................. : '+SecurityStatus);
        Add('    Information spécifique OEM ou du vendeur du BIOS : '+inttohex(OEM_Defined,8));
        Add('    Hauteur.......................... : '+Height);
        if Height<>'-' then
        begin
          Add('    Nombre de cables d''alimentation.. : '+inttostr(NumberOfPowerChords));
          Add('    Nombre d''éléments contenus....... : '+inttostr(ContainedElementsCount));
        end
        else begin
          Add('    Nombre de cables d''alimentation.. : -');
          Add('    Nombre d''éléments contenus....... : -');
        end
      end;
      b:=GetNextChassis;
    end;
 
    //microprocesseurs;
    i:=0;
    DoLine(0);
    Titre('Microprocesseur(s) :');
    Add('  Nombre :'+IntToStr(ProcessorCount));
    b:=GetFirstProcessor;
    while b do
    begin
      inc(i);
      with CurrentProcessorInformation do
      begin
        DoLine(2);
        Titre('  Processeur N°'+IntToStr(i)+'/'+IntToStr(ProcessorCount));
        Add('    Désignation de Socket.......... : '+SocketDesignation);
        Add('    Type........................... : '+ProcessorType);
        Add('    Famille........................ : '+ProcessorFamily);
        Add('    Constructeur................... : '+ProcessorManufacturer);
        Add('    ID............................. : '+ProcessorID);
        Add('    Version........................ : '+ProcessorVersion);
        Add('    Voltage........................ : '+Voltage);
        if ExternalClock<>0
        then Add('    Horloge Externe................ : '+inttostr(ExternalClock)+' MHz')
        else Add('    Horloge Externe................ : Fréquence inconnue');
        if MaxSpeed>=1000
        then Add('    Fréquence Maxi................. : '+FloatToStr(MaxSpeed/1000)+' GHz')
        else Add('    Fréquence Maxi................. : '+inttostr(MaxSpeed)+' MHz');
        if CurrentSpeed>=1000
        then Add('    Fréquence Actuelle............. : '+FloatToStr(CurrentSpeed/1000)+' GHz')
        else Add('    Fréquence Actuelle............. : '+inttostr(CurrentSpeed)+' MHz');
        EnumDisplay('    Statut......................... : ',Status,0);
        Add('    Upgrade Processeur............. : '+ProcessorUpgrade);
        if GetL1Cache then
        begin
             Titre('    Cache L1....................... : ');
             MontreCache(CurrentCacheInformation,true);
        end else Add('    Cache L1....................... : '+CurrentCacheInformation.Comment);
        if GetL2Cache then
        begin
             Titre('    Cache L2....................... : ');
             MontreCache(CurrentCacheInformation,true);
        end else Add('    Cache L2....................... : '+CurrentCacheInformation.Comment);
        if GetL3Cache then
        begin
             Titre('    Cache L3....................... : ');
             MontreCache(CurrentCacheInformation,true);
        end else Add('    Cache L3....................... : '+CurrentCacheInformation.Comment);
        Add('    Tag Asset...................... : '+AssetTag);
        Add('    Numéro d''assemblage............ : '+PartNumber);
      end;
      b:=GetNextProcessor;
    end;
 
    //Controleur Memoire
    i:=0;
    DoLine(0);
    Titre('Controleur(s) Mémoire :');
    Add('  Nombre :'+IntToStr(MemoryControllerCount));
    b:=GetFirstMemoryController;
    while b do
    begin
      inc(i);
      with CurrentMemoryControllerInfo do
      begin
        DoLine(2);
        Titre('  Controleur N°'+IntToStr(i)+'/'+IntToStr(MemoryControllerCount));
        Add('    Méthode de détection d''erreur...... : '+ErrorDetectingMethod);
        Add('    Possibilités de correction d''erreur : '+ErrorCorrectingCapability);
        Add('    Possibilités de correction activées : '+EnableECC);
        Add('    Interleaves possibles.............. : '+SupportedInterleave);
        Add('    Interleave utilisé................. : '+CurrentInterleave);
        Add('    Mémoire Maxi. Supportée............ : '+MaximumMemorySupported);
        Add('    Mémoire Maxi. de chaque module..... : '+MaximumMemoryModuleSize);
        Add('    Vitesses supportées................ : '+SupportedSpeeds);
        Add('    Voltage des modules................ : '+MemoryModuleVoltage);
        Add('    Types de mémoires supportées....... : '+SupportedMemoryTypes);
        Add('    Nombre de slots Mémoire............ : '+inttostr(NumberOfAssociaTedMemorySlots));
        //MeMoryConfigurationHandles
        if NumberOfAssociaTedMemorySlots>0 then
        for j:=0 to NumberOfAssociaTedMemorySlots-1 do
        begin
          if GetMemoryModule(MeMoryConfigurationHandles[j]) then
          begin
             Titre('    Module N°'+IntToStr(j+1)+'/'+IntToStr(NumberOfAssociaTedMemorySlots));
             MontreModuleMemoire(CurrentMemoryModuleInfo,true);
          end;
        end;
      end;
      b:=GetNextMemoryController;
    end;
 
 
    //Ports Connections
    i:=0;
    DoLine(0);
    Titre('Connecteurs des ports :');
    Add('  Nombre :'+IntToStr(PortCount));
    b:=GetFirstPort;
    while b do
    begin
      inc(i);
      with CurrentPortInfo do
      begin
        DoLine(2);
        Add('  Port N°'+IntToStr(i)+'/'+IntToStr(PortCount));
        Add('    Désignateur de référence Interne... : '+InternalReferenceDesignator);
        Add('    Type de Connecteur Interne......... : '+InternalConnectorType);
        Add('    Désignateur de référence Externe... : '+ExternalReferenceDesignator);
        Add('    Type de Connecteur Externe......... : '+ExternalConnectorType);
        Add('    Type de Port....................... : '+PortType);
      end;
      b:=GetNextPort;
    end;
 
    //Slots Systèmes
    i:=0;
    DoLine(0);
    Titre('Slot(s) système :');
    Add('  Nombre :'+IntToStr(SystemSlotCount));
    b:=GetFirstSystemSlot;
    while b do
    begin
      inc(i);
      with CurrentSystemSlot do
      begin
        DoLine(2);
        Add('  Slot N°'+IntToStr(i)+'/'+IntToStr(SystemSlotCount));
        Add('    Désignation........................ : '+SlotDesignation);
        Add('    Type............................... : '+SlotType);
        Add('    Largeur du bus de données.......... : '+SlotDataBusWidth);
        Add('    Utilisation........................ : '+CurrentUsage);
        Add('    Longueur du slot................... : '+SlotLength);
        Add('    ID du slot......................... : '+SlotID);
        Add('    Caractéristiques................... : '+SlotCharacteristics1);
        Add('    Caractéristiques (suite)........... : '+SlotCharacteristics2);
      end;
      b:=GetNextSystemSlot;
    end;
 
    //Périphériques Intégrés
    i:=0;
    DoLine(0);
    Titre('Périphériques Intégrés :');
    Add('  Nombre de Lots:'+IntToStr(OnBoardDevicesCount));
    b:=GetFirstOnBoardDevices;
    while b do
    begin
      inc(i);
      with CurrentOnBoardDevices do
      begin
        DoLine(2);
        Add('  Lot N°'+IntToStr(i)+'/'+IntToStr(OnBoardDevicesCount));
        if DeviceCount>0 then
        for j:=0 to DeviceCount-1 do
        begin
          Add('');
          EnumDisplay('    Type........: ',DevicesType[j],0);
          Add('    Description : '+DevicesString[j]);
        end;
      end;
      b:=GetNextOnBoardDevices;
    end;
 
    //Association de groupe
    i:=0;
    DoLine(0);
    Titre('Assotiations de composants :');
    Add('  Nombre de Groupes:'+IntToStr(GroupAssotiationsCount));
    b:=GetFirstGroupAssotiations;
    while b do
    begin
      inc(i);
      with CurrentGroupAssotiations do
      begin
        DoLine(2);
        Add('  Groupe N°'+IntToStr(i)+'/'+IntToStr(GroupAssotiationsCount));
        Add('  Nom du Groupe : '+GroupName);
        if count>0 then
        for j:=0 to Count-1 do
          Add('    - '+TypesStruct[ItemType[j]]+' N°'+inttostr(HandleToTypeIndex(ItemType[j],ItemHandle[j])+1));
      end;
      b:=GetNextGroupAssotiations;
    end;
 
    DoLine(0);
    Titre('Informations OEM');
    Add('Nombre d''informations : '+inttostr(OEMStrings.Count));
    if OEMStrings.Count>0 then
    for i:=0 to OEMStrings.Count-1 do
    begin
      Add('  -> '+OEMStrings.Strings[i]);
    end;
 
    DoLine(0);
    Titre('Options de Configuration');
    Add('Nombre d''options : '+inttostr(SystemConfigOptions.Count));
    if SystemConfigOptions.Count>0
    then
    begin
      for i:=0 to SystemConfigOptions.Count-1 do
      Add('  ->'+SystemConfigOptions.Strings[i]);
    end;
 
    DoLine(0);
    Titre('Information Langages');
    if Language.Present then
    begin
    Add('Language installé : '+Language.CurrentLanguage);
    Add('Nombre de langages installables : '+inttostr(Language.InstallableLanguages));
    if Language.InstallableLanguages>0
    then
    begin
      for i:=0 to Language.InstallableLanguages-1 do
      Add('  ->'+Language.ListOfLanguages[i]);
    end;
    end else Add('  -> information non présente');
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  WADMIBiosInfo1.LoadFromBios;
  WADMIBiosInfo1.SavetoFile(ExtractFilePath(Application.ExeName)+'def.wab');
  getdmi;
  BitBtn2.Enabled:=true;
end;
 
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
  WADMIBiosInfo1.LoadFromFile(OpenDialog1.FileName);
  getdmi;
  BitBtn2.Enabled:=true;
end;
end;
 
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
if SaveDialog1.Execute then
WADMIBiosInfo1.SavetoFile(SaveDialog1.FileName);
end;
 
end.

21/02/2006, 22h17
edam

http://www.developpez.net/forums/vie...481798#1481798

Merci edam :wink:

Sinon, j'avais oublié ceci... :oops:

Code:

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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
unit WADMIUtils;
 
interface
type
  TGetOrder=(GetFirst,GetNext);
  TGetMethod=(ByType,ByHandle);
 
  function BitSet(AByte:byte;BitNumber:byte):boolean;  overload;
  function BitSet(AWord:word;BitNumber:byte):boolean;  overload;
  function BitList(Abyte:byte;AStringArray:array of string):string; overload;
  function BitList(AWord:word;AStringArray:array of string):string; overload;
  function CaseToString(Abyte:byte;AStringArray:array of string;ElseString:String):string; overload;
  function CaseToString(AWord:word;AStringArray:array of string;ElseString:String):string; overload;
  function BooleanToString(Test:boolean;IfTrue,IFFalse:string):string;
  function OuiNon(b:boolean):string;
  function Between(Value,LowBound,HighBound:Cardinal):boolean;
  procedure LastCommaToPoint(var AString:string);
implementation
uses sysutils;
 
function Between(Value,LowBound,HighBound:Cardinal):boolean;
begin
  result:=((Value>=LowBound) and (Value<=HighBound));
end;
 
procedure LastCommaToPoint(var AString:string);
var l:integer;
begin
  l:=length(AString);
  if l<>0 then
  repeat
    dec(l);
    if AString[l]=',' then AString[l]:='.';
  until ((l<=0) or (AString[l]='.'));
  AString:=TrimRight(AString);
end;
 
function BooleanToString(Test:boolean;IfTrue,IFFalse:string):string;
begin
  if Test then Result:=IfTrue else Result:=IFFalse;
end;
 
function OuiNon(b:boolean):string;
begin
  result:=BooleanToString(b,'Oui','Non');
end;
 
function BitSet(AByte:byte;BitNumber:byte):boolean; overload;
var i:byte;
begin
  i:=1 shl BitNumber;
  result:=((AByte and i)=i);
end;
 
function BitSet(AWord:word;BitNumber:byte):boolean; overload;
var i:word;
begin
  i:=1 shl BitNumber;
  result:=((AWord and i)=i);
end;
 
function BitList(Abyte:byte;AStringArray:array of string):string; overload;
var i:byte;
    s:string;
begin
  s:='';
  for i:=0 to 7 do
  begin
    if (i<=high(AStringArray)) then
    if BitSet(Abyte,i) then s:=s+AStringArray[i]+', ';
  end;
  LastCommaToPoint(s);
  result:=s;
end;
 
function BitList(AWord:word;AStringArray:array of string):string; overload;
var i:byte;
    s:string;
begin
  s:='';
  for i:=0 to 15 do
  begin
    if (i<=high(AStringArray)) then
    if BitSet(AWord,i) then s:=s+AStringArray[i]+', ';
  end;
  LastCommaToPoint(s);
  result:=s;
end;
 
function CaseToString(Abyte:byte;AStringArray:array of string;ElseString:String):string; overload;
var i:byte;
    s:string;
begin
  s:=ElseString;
  i:=0;
  repeat
    if (i<=high(AStringArray)) then
    if AByte=i then s:=AStringArray[i];
  inc(i);
  until i=8;
  result:=s;
end;
 
function CaseToString(AWord:word;AStringArray:array of string;ElseString:String):string; overload;
var i:byte;
    s:string;
begin
  s:=ElseString;
  i:=0;
  repeat
    if (i<=high(AStringArray)) then
    if AWord=i then s:=AStringArray[i];
  inc(i);
  until i=16;
  result:=s;
end;
 
end.

22/02/2006, 12h38
LadyWasky
Pour information, c'est un code que j'ai été déterré dans mes archives.

A l'époque (en 1999), il n'y avait ni Windows 2000, ni Windows XP, et ce code semble fonctionner encore.

MAIS :
- Je l'ai testé sur mon PC du boulot, où je n'ai pas les droits administrateur et.... : ça marche quand même (miracle ! :ave: ).
- Je l'ai testé chez moi, où j'ai les droits administrateurs et... ça marche pô (sniff).

La différence doit surement provenir du fait que mon PC du boulot est sous SP1 et qu'à la maison je suis sous SP2...

A priori, sous SP2, il faudrat utiliser l'API Windows :
Code:

1 2 3 ZwOpenSection((out SectionHandle: THandle; DesiredAccess: ACCESS_MASK; ObjectAttributes: PObjectAttributes): NTSTATUS;
au lieu de
Code:

1 2 3 NtOpenSection(SectionHandle: PHANDLE; DesiredAccess:ACCESS_MASK; ObjectAttributes: POBJECT_ATTRIBUTES): NTSTATUS; stdcall;
vous remarquerez la différence subtile de paramêtres...

Je n'ai pas encore testé...
Je vous tiens informé des que j'ai du nouveau.
24/02/2006, 18h30
edam

Citation:

Envoyé par edam

une question, peut on utlisé ZLPortIO pour accédé au bios???
:oops:

zlportsio peut lire le Cmos pas le bios,, désoler, je me suis tramper, j'ai pas pigé le titre au début :oops: :oops: :oops: :sm:
24/02/2006, 23h39
smyley

j'ai pas pu me retenir de dire celà :
respect waskol :bravo: ;)
25/02/2006, 11h59
edam

Citation:

Envoyé par waskol

Je n'ai pas encore testé...
Je vous tiens informé des que j'ai du nouveau.

on attend passiament :ccool: :scarymov: :bebe:
25/02/2006, 13h22
LadyWasky

J'ai trouvé... :mrgreen:

Il s'agissait surement d'un paramètres de compilation du projet.
(une histoire d'évaluation de variable)

En effet, il s'agissait juste, dans l'unité MemoireNT.pas
de remplacer :

Code:

Status:=NtOpenSection(physmem,SECTION_MAP_READ,@ATTRIBUTES);

en

Code:

Status:=NtOpenSection(THandle(physmem),SECTION_MAP_READ,@ATTRIBUTES);

Donc pour ceux qui on des problèmes, il y a une modification de code à faire...

Pourtant physmem est du type cardinal et un THandleest le aussi un cardinal !
Allez comprendre... :koi:
25/02/2006, 13h34
smyley

mais il y a aussi une histoire de Lo et Hi part du Cardinal, c'est peut être ce que corrige le transtypage en THandle :roll:
25/02/2006, 13h58
LadyWasky

Pour la petite histoire... :
:wink:

A l'époque (en 1999), dans le service DGAC où j'étais affecté, les techniciens essayait de faire l'inventaire de toutes les machines du parc informatique.

Les collègues techniciens en bavaient puisqu'ils passaient sur toutes les machines pour noter à la main sur un bout de papier la configuration des machines avec leur numéro de série.

Après plusieurs constatations expliquées ci-après, j'ai développé ces composants...

On avait principalement des DELL (bios différent du bios AWARD), sous Windows 9x et certaines sous NT (2000 et XP n'éxistaient pas encore).

Le WMI en était à ses balbutiements... donc pas vraiment exploitable...

Lorsqu'on allait dans la configuration du BIOS des machines, le numéro de série était bien là, affiché à la rubrique "Asset Tag"... ceux qui ont un DELL confirmeront...

Donc cet info était récupérable d'une manière ou d'une autre, mais où ?
Après quelque recherches, je suis tombé sur le site du "Distributed Management Task Force" (DMTF), qui se trouve ici : http://www.dmtf.org/home

Sur ce site on parlait (et on parle toujours) des standards BIOS32, SMBIOS et DMI).
A partir de la doc du SMBIOS : http://www.dmtf.org/standards/smbios
...j'ai pu récupérer ce numéro de série et tout le reste sous Windows 9x

Il restait à faire de même sous NT, là c'était une autre paire de manche...
en cherchant BIOS et Windows NT, je suis tombé sur un site génial qui m'a permis d'arriver à ce résultat : http://www.sysinternals.com
Où se trouve encore le code source C++ d'un petit utilitaire qui permettait d'allait lire dans la mémoire physique du PC sous NT...

Sachez enfin qu'à l'époque, tout les composants Delphi que l'on trouve maintenant et qui permettent d'accéder aux information des tables DMI du SMBIOS n'existaient pas encore...

J'avais fini par poster un bout de code sur Expet exchange, et de là je pense que tous les codes sources Delphi permettant de lire les infos du BIOS et que l'on trouve maintenant se sont inspirés de mon code ou de celui de Mark Russinovich écrit en C++ (sysinternals.com), ou du mien.

Il y a même des gens de chez IBM (USA) qui m'avaient envoyé un mail pour me remercier de ma "découverte" comme une alternative à l'utilisation du DMI classique avec les fichiers CIM...

Bref, si un seul auteur doit être remercié pour mon inspiration, c'est certainement Mark Russinovich :king:

Le code est à utiliser sans modération...
25/02/2006, 14h01
LadyWasky

Citation:

Envoyé par smyley

mais il y a aussi une histoire de Lo et Hi part du Cardinal, c'est peut être ce que corrige le transtypage en THandle :roll:

Sans doute !

Au boulot, où ça marche, je suis sous Pentium 4
A la maison sur un ATHLON 64

Bon, en tous cas, comme le standard DMI à été mis à jour (v2.4), nouveaux processeurs , je met mon code à jour...

Et puis comme ça, il apparaîtra à la rubrique source du site.
25/02/2006, 18h25
NoisetteProd

Citation:

Envoyé par waskol

Et puis comme ça, il apparaîtra à la rubrique source du site.

:wink:
01/12/2006, 11h56
Bourak

salut les developpeurs

salut waskol
J'ai suivi votre message à propos du Bios et j'ai tester votre code source mais j'ai rencontré une problèmes, le compilateur delphi n'a pas trouvé vclutils.dcu. j'ai fait une recheche du ce fichier mais je ne l'ai pas trouver.

Est ce que tu peut m'expliquer ce problème.

Et Merci d'avance!
01/12/2006, 12h41
edam

http://waskol.developpez.com/
01/12/2006, 14h54
Bourak

Salut

Oui c'est bien fait ,merci edam et merci à waskol pour ces efforts, vraiment je suis satisfait.

Bon travail les mecs
02/03/2007, 16h09
LadyWasky

Citation:

Envoyé par smyley

mais il y a aussi une histoire de Lo et Hi part du Cardinal, c'est peut être ce que corrige le transtypage en THandle :roll:

Oui, c'était ça :P
03/03/2007, 18h25
Laurent Dardenne

Châpeau !
Par la suite ce qui serait intéressant de savoir c'est si ce type d'approche restera valide sous Vista...
04/03/2007, 19h44
LadyWasky

Citation:

Envoyé par Laurent Dardenne

Châpeau !
Par la suite ce qui serait intéressant de savoir c'est si ce type d'approche restera valide sous Vista...

Il y a juste à tester la démo sous vista que j'ai fourni avec mon compo sur waskol.developpez.com ;)

Il semblerais que ça passe, selon les dires d'un copain :P
13/01/2009, 15h05
LadyWasky

Citation:

Envoyé par Laurent Dardenne

Châpeau !
Par la suite ce qui serait intéressant de savoir c'est si ce type d'approche restera valide sous Vista...

Ouaip, ça marche sous VISTA, j'ai essayé hier. Et si ça marche sous VISTA, ça devrait aussi marcher sous Windows 7 ;)