Hola! Informacion sobre hardware instalado [Archivo]

marcoszorrilla

09-03-2004, 23:06:13

Mírate esto:

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Winsock, IniFiles, ShellApi, Menus, Registry;

type
TForm1 = class(TForm)
Memo1: TMemo;
MainMenu1: TMainMenu;
Archivo1: TMenuItem;
datos1: TMenuItem;
Abrirarchivodedatos1: TMenuItem;
Guardararchivodedatos1: TMenuItem;
Salir1: TMenuItem;
N2: TMenuItem;
HardwareInstalado1: TMenuItem;
SoftwareInstaladoydesinstaladores1: TMenuItem;
Mostrar1: TMenuItem;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure datos1Click(Sender: TObject);
procedure Salir1Click(Sender: TObject);
procedure HardwareInstalado1Click(Sender: TObject);
procedure SoftwareInstaladoydesinstaladores1Click(
Sender: TObject);
procedure Abrirarchivodedatos1Click(Sender: TObject);
procedure Guardararchivodedatos1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
wVersionRequested : WORD;
wsaData : TWSAData;
begin
{Start up WinSock}
wVersionRequested := MAKEWORD(1, 1);
WSAStartup(wVersionRequested, wsaData);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
{Shut down WinSock}
WSACleanup;
end;

procedure TForm1.datos1Click(Sender: TObject);
var
MemoryStatus: TMemoryStatus;
p : PHostEnt;
s : array[0..128] of char;
p2 : pchar;
Ini:TInifile;
ScreenSaverFile:string;
Modo :DWord;
ModoDev :TDevMode;

function GetUserName : String;
var
pcUser : PChar;
dwUSize : DWORD;
begin
dwUSize := 21;
GetMem( pcUser, dwUSize );
try
if Windows.GetUserName( pcUser, dwUSize ) then
Result := pcUser
finally
FreeMem( pcUser );
end;
end;

function GetComputerName : String;
var
pcComputer : PChar;
dwCSize : DWORD;
begin
dwCSize := MAX_COMPUTERNAME_LENGTH + 1;
GetMem( pcComputer, dwCSize );
try
if Windows.GetComputerName( pcComputer, dwCSize ) then
Result := pcComputer;
finally
FreeMem( pcComputer );
end;
end;

function GetLongFileName(Const FileName : String) : String;
var
aInfo: TSHFileInfo;
begin
if SHGetFileInfo(PChar(FileName),0,aInfo,Sizeof(aInfo),SHGFI_DISPLAYNAME)<>0 then
Result:= String(aInfo.szDisplayName)
else
Result:= FileName;
end;

function QueWindows:String;
var
Version:TOsVersionInfo;
begin
Version.dwOSVersionInfoSize:=SizeOf(Version);
GetVersionex(Version);
Case Version.dwPlatformId of
VER_PLATFORM_WIN32s:
Result:='Win311';
VER_PLATFORM_WIN32_WINDOWS:
Result:='Win9X';
VER_PLATFORM_WIN32_NT:
Result:='WinNT';
end;
end;

function IdiomaDelUsuario:string;
var
IdiomaID:LangID;
Idioma: array [0..100] of char;
begin
{Obtiene el ID del idioma del sistema}
{Get System ID}
IdiomaID:=GetUserDefaultLangID;
{Obtiene el nombre del idioma}
{Get Languaje Name}
VerLanguageName(IdiomaID,Idioma,100);
Result:=String(Idioma);
end;

begin
Memo1.Lines.Clear;
Memo1.Lines.Add('Usuario: '+GetUserName);
Memo1.Lines.Add('Idioma del usuario: '+IdiomaDelUsuario);
Memo1.Lines.Add('Nombre del PC: '+GetComputerName);
Memo1.Lines.Add('Tipo de Windows: '+QueWindows);
Ini:=TInifile.Create('system.ini');
ScreenSaverFile:=GetLongFileName(
Ini.ReadString('boot','SCRNSAVE.EXE','No Available') );
Ini.Free;
Memo1.Lines.Add('Nombre del salvapantallas en uso: '+ScreenSaverFile);
{Get the computer name}
GetHostName(@s, 128);
p := GetHostByName(@s);
Memo1.Lines.Add('Nombre local de la máquina: '+p^.h_Name);
{Get the IpAddress}
p2 := iNet_ntoa(PInAddr(p^.h_addr_list^)^);
Memo1.Lines.Add('IP: '+p2);
Memo1.Lines.Add('');
with Memo1.Lines do
begin
Add('Tipo de Bios:'+^I+String(Pchar(Ptr($FE061))));
Add('Bios CopyRight:'+^I+String(Pchar(Ptr($FE091))));
Add('Fecha de la Bios:'+^I+String(Pchar(Ptr($FFFF5))));
Add('Informacion Adicional:'+^I+String(Pchar(Ptr($FEC71))));
end;
Memo1.Lines.Add('');
MemoryStatus.dwLength := SizeOf(MemoryStatus);
GlobalMemoryStatus(MemoryStatus);
with MemoryStatus do
begin
{ Per-Cent of Memory in use by your system }
Memo1.Lines.Add(IntToStr(dwMemoryLoad) +
'% de memoria en uso');
{The amount of Total Physical memory allocated to your system.}
Memo1.Lines.Add('Nº total de bytes de memoria física: '+IntToStr(dwTotalPhys));
{ The amount available of physical memory in your system. }
Memo1.Lines.Add('Nº total de bytes libres en la memoria física: '+IntToStr(dwAvailPhys));
{ The amount of Total Bytes allocated to your page file }
Memo1.Lines.Add('Nº de bytes en el fichero de intercambio: '+IntToStr(dwTotalPageFile));
{ The amount of available bytes in your page file }
Memo1.Lines.Add('Nº de bytes libres en el fichero de intercambio: '+IntToStr(dwAvailPageFile));
{ The amount of Total bytes allocated to this program
(generally 2 gigabytes of virtual space) }
Memo1.Lines.Add('Nº de bytes en la dirección de espacio del usuario: '+IntToStr(dwTotalVirtual));
{ The amount of avalable bytes that is left to your program to use }
Memo1.Lines.Add('Nº de bytes libres del espacio del usuario: '+IntToStr(dwAvailVirtual));
end;
end;

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

procedure TForm1.HardwareInstalado1Click(Sender: TObject);
procedure GetHardwareList(DisplayStrings : TStrings);
var
RegHKDD, RegHKLM: TRegistry;
SLKeys, SLHWL: TStringList;
i: Integer;
RegDataInfo : TRegDataInfo;
begin
try
RegHKDD := TRegistry.Create;
RegHKDD.RootKey := HKEY_DYN_DATA;
RegHKLM := TRegistry.Create;
RegHKLM.RootKey := HKEY_LOCAL_MACHINE;
SLKeys := TStringList.Create;
SLHWL := TStringList.Create;
SLHWL.Sorted := true;
if RegHKDD.OpenKey('\Config Manager\Enum', false) then begin
RegHKDD.GetKeyNames(SLKeys);
for i := 0 to SLKeys.Count - 1 do
if RegHKDD.OpenKey('\Config Manager\Enum\' + SLKeys[i], false)then
if RegHKLM.OpenKey('\Enum\' + RegHKDD.ReadString('HardWareKey'), false) then
if RegHKLM.GetDataInfo('Class', RegDataInfo) then
SLHWL.Add(RegHKLM.ReadString('Class')
+ ': '
+ RegHKLM.ReadString('DeviceDesc'));
end; {if RegHKDD.OpenKey('\Config Manager\Enum', false)}
finally
SLKeys.Free;
RegHKLM.Free;
RegHKDD.Free;
end;
DisplayStrings.Assign(SLHWL);
SLHWL.Free;
end;

begin
GetHardwareList(Memo1.Lines);
end;

procedure TForm1.SoftwareInstaladoydesinstaladores1Click(
Sender: TObject);

const CLAVE =
'\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall';

var
reg : TRegistry;
Lista : TStringList;
Lista2 : TStringList;
i,n : integer;

begin
Memo1.Lines.Clear;
{Creamos cosas temporales}
{Create temporal things}
reg := TRegistry.Create;
Lista := TStringList.Create;
Lista2 := TStringList.Create;

{Cargamos todas las subkeys}
{Load all the subkeys}
with Reg do
begin
RootKey := HKEY_LOCAL_MACHINE;
OpenKey(CLAVE,false);
GetKeyNames(Lista);
end;

{Cargamos todos los Nombres de valores}
{Load all the Value Names}
for i := 0 to Lista.Count -1 do
begin
reg.OpenKey(CLAVE + '\' +Lista.Strings[i],false);
reg.GetValueNames(Lista2);

{Mostraremos sólo los que tengan 'DisplayName'}
{We will show only if there is 'DisplayName'}
n:=Lista2.IndexOf('DisplayName');
if (n <> -1) and (Lista2.IndexOf('UninstallString')<>-1) then
begin
{DisplayName+UnInstallString}
Memo1.Lines.Append ( reg.ReadString(Lista2.Strings[n])+'-'+
reg.ReadString(Lista2.Strings[Lista2.IndexOf('UninstallString')]) );
end;
end;
{Liberamos temporales}
{Free temporals}
Lista.Free;
Lista2.Free;
reg.CloseKey;
reg.Destroy;
end;

Un Saludo.