Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Varios
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Grupo de Teaming del ClubDelphi

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 24-07-2003
fcios fcios is offline
Miembro
 
Registrado: jul 2003
Posts: 108
Poder: 21
fcios Va por buen camino
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.

Última edición por fcios fecha: 24-07-2003 a las 18:35:30.
Responder Con Cita
  #2  
Antiguo 19-10-2007
maco2007 maco2007 is offline
No confirmado
 
Registrado: may 2007
Posts: 70
Poder: 0
maco2007 Va por buen camino
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
Responder Con Cita
  #3  
Antiguo 20-10-2007
fcios fcios is offline
Miembro
 
Registrado: jul 2003
Posts: 108
Poder: 21
fcios Va por buen camino
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
Responder Con Cita
  #4  
Antiguo 20-10-2007
maco2007 maco2007 is offline
No confirmado
 
Registrado: may 2007
Posts: 70
Poder: 0
maco2007 Va por buen camino
...

lo voy a probar haber si funciona y te aviso hoy mismo te tengo la respuesta....
Responder Con Cita
  #5  
Antiguo 20-10-2007
maco2007 maco2007 is offline
No confirmado
 
Registrado: may 2007
Posts: 70
Poder: 0
maco2007 Va por buen camino
..

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
Archivos Adjuntos
Tipo de Archivo: zip BIOSDATEW98XP.zip (3,5 KB, 21 visitas)

Última edición por maco2007 fecha: 21-10-2007 a las 02:02:18.
Responder Con Cita
  #6  
Antiguo 14-11-2007
maco2007 maco2007 is offline
No confirmado
 
Registrado: may 2007
Posts: 70
Poder: 0
maco2007 Va por buen camino
Comentarios....
Responder Con Cita
Respuesta



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro


La franja horaria es GMT +2. Ahora son las 06:09:31.


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
Copyright 1996-2007 Club Delphi