[fcios]

// Hola a todos esta rutina anda perfectamente bajo Win 9x
// pero no bajo win 2000 ni XP
// Como se puede solucionar ?
// Gracias

unit Main;
// 24/07/03
interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
BiosE: TEdit;
Button2: TButton;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
Type
TBIOS=record
case boolean of
True: (IBM:record
Copyright:array[0..80] of char;

Dummy0 :array[81..$0812] of char; // yo 80.. 2066
Marca :array[1..34] of char; // YO: Award Software International, Inc..4.51 PG.
Dummy01:array[$0812+35..$FF70] of char; // yo

//Dummy1:array[81..$FF70] of char; // 65311
Ver:array[1..22] of char; // $FF71..$FF86 = 'IBM BIOS Ver NZKT36.0 '#0
Dummy2:array[$FF87..$FF9F] of char;
check:array[1..13] of char; // '¬UVPD0RESERVE'
EPROM:array[1..9] of char; // 'NZKT36AFR'
SerialNumber:array[1..7] of char; // '5503X49'
BoardSN:array[1..11] of char; // '80K3GX7419L'
PCType:array[1..4] of char; // '6561'
Modele:array[1..3] of char; // '320'
Dummy3:array[$FFCF..$FFF4] of char;
//Dummy3:array[$FFA4..$FFC9] of char;

Date:array[1..8] of char;
Dummy4:array[$FFFD..$FFFF] of char
end);
False: (RAW:array[0..$FFFF] of byte);
end;

function WOWGetVDMPointerFix (vp,dwBytes : DWORD; fProtectedMode:BOOL) : pointer; far; stdcall; external 'WOW32.DLL';
procedure WOWGetVDMPointerUnfix(vp : pointer) ; far; stdcall; external 'WOW32.DLL';

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject) ;

var s:string;
BIOS:TBIOS;
pBIOS:^TBIOS;

begin
//--- Test for WIN XP
ShowMessage('Get bios');
// BIOS DATE
pBIOS:=WOWGetVDMPointerFix($F0000000,$FFFF,BOOL(0));
ShowMessage('make move for pBIOS^='+ intToStr(SizeOf(pBIOS^))+' BIOS='+IntToStr(SizeOf(BIOS)) );
Move(pBIOS^,BIOS,SizeOf(BIOS));
ShowMessage('wowget bios');
WOWGetVDMPointerUnfix(pBIOS);
ShowMessage('END get bios');
s:= BIOS.IBM.Date;
BiosE.Text := BIOS.IBM.Date;
// END TEST FOR WIN XP
//-------
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
close;
end;

// En esta funcion no funciona el Mov(MEM... esto no lo pude probar
{ Gets the ROM BIOS date in a ASCII string.
Part of the Heartware Toolkit v2.00 (HTelse.PAS) for Turbo Pascal.
Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.
I can also be reached at RIME network, site ->TIB or #5314.
Feel completely free to use this source code in any way you want, and, if
you do, please don't forget to mention my name, and, give me and Swag the
proper credits. }

FUNCTION ROM_Bios_Date : String;
{ DESCRIPTION:
Gets the ROM BIOS date in a ASCII string.
SAMPLE CALL:
S := ROM_Bios_Date
RETURNS:
e.g., '06/10/85'.
NOTES:
Later versions of the Compaq have this release date shifted by 1 byte,
to start at F000:FFF6h }
var
Tmp : String[8];
BEGIN { ROM_Bios_Date }
FillChar(Tmp,0,8);
Tmp[0] := Chr(8);
// error en MEM
// Move(Mem[$F000:$FFF5],Tmp[1],8);
ROM_Bios_Date := Tmp;
END; { ROM_Bios_Date }


procedure TForm1.Button3Click(Sender: TObject);
begin
ROM_Bios_Date;
end;

end.