Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   API de Windows (https://www.clubdelphi.com/foros/forumdisplay.php?f=7)
-   -   Hola! Informacion sobre hardware instalado (https://www.clubdelphi.com/foros/showthread.php?t=8140)

kolokol 09-03-2004 22:58:01

Hola! Informacion sobre hardware instalado
 
Hola a todos, Alguien conoce de que manera se puede obtener la informacion de hardware+software disponible en Windows desde delphi.
De antemano gracias

marcoszorrilla 09-03-2004 23:06:13

Mírate esto:

Código:

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.


La franja horaria es GMT +2. Ahora son las 17:03:17.

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