Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Varios (https://www.clubdelphi.com/foros/forumdisplay.php?f=11)
-   -   BIOSDATE bajo Win 2000 y XP (https://www.clubdelphi.com/foros/showthread.php?t=2469)

fcios 24-07-2003 18:25:27

BIOSDATE bajo Win 2000 y XP
 
// 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.

maco2007 19-10-2007 22:41:17

yo se se creauna aplicacion que se dirija al sig.registro

HKEY_LOCAL_MACHINE\HARDWARE\DESCRIPTION\SYSTEM
luego hay un texto que se llama SystemBiosDate

ahi taaa

fcios 20-10-2007 04:09:38

MUCHAS GRACIAS, Siii, bárbaro, por lo menos en el XP está

no está en el 98 SE

sabes si esa en el vista ?

muchísimas gracias:)

maco2007 20-10-2007 15:30:09

...
 
lo voy a probar haber si funciona y te aviso hoy mismo te tengo la respuesta....

maco2007 20-10-2007 22:43:32

..
 
1 Archivos Adjunto(s)
creo q si funciona puedes hacer algo asi para q te funcione en WinXp y 98 mira :

USES Registry;

Function LeeReg(RootKeys: HKEY; Key: String; NameValue: String): String;
Begin
With TRegistry.Create do
Try
RootKey := RootKeys;
OpenKey(Key, False);
Result:= ReadString(NameValue);
finally
FREE;
end;
end;

function QueWindows:String;
var Version:TOsVersionInfo; begin Version.dwOSVersionInfoSize:=SizeOf(Version); GetVersionex(Version); case Version.dwPlatformId of VER_PLATFORM_WIN32s: Result:='WindowsNormal';
VER_PLATFORM_WIN32_WINDOWS:
Result:='Windows98';
VER_PLATFORM_WIN32_NT:
Result:='WindowsNormal';
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var Win:String;
begin Win:= QueWindows; if (Win)= 'WindowsNormal' then Edit1.Text:= LeeReg(HKEY_LOCAL_MACHINE, 'HARDWARE\DESCRIPTION\System', 'SystemBiosDate')
else Edit1.Text:= String(Pchar(Ptr($FFFF5)));

end;

Aqui te dejo un ejemplo

maco2007 14-11-2007 22:14:14

Comentarios....


La franja horaria es GMT +2. Ahora son las 11:50:44.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi