Fórum Obter algumas informações dos hardwares #258671

naun estou certo, mas tenhu quase certeza que existem componentes para isso.

De uma olhada na sessao de componentes do site
e tb em www.torry.net :d achu q vai achar

unit Hardware;


interface


uses
Windows, Dialogs, Messages, SysUtils, Classes, Controls, StdCtrls, Graphics,
Printers, shellapi, MMSystem;

function TestaPlaca(Value:integer): Boolean;
function DiscoNoDrive(const drive : char): boolean;
function NumeroSerie(Unidade:PChar):String;
function DetectaDrv(const drive : char): boolean;
function NumeroDeCores : Integer;
function Percentdisk(unidade: byte): Integer;
function IsPrinter : Boolean;
function CorrentPrinter :String;

implementation

Function TestaPlaca(Value:integer): Boolean;
{Testa se existe uma placa de som no seu computador}
begin
if WaveOutGetNumDevs > 0 then
begin
result := True
end
else
begin
Result := False;
end;
end;

function DiscoNoDrive(const drive : char): boolean;
{Detecta se há disco no Drive}
var
DriveNumero : byte;
EMode : word;
begin
result := false;
DriveNumero := ord(Drive);
if DriveNumero >= ord(´a´) then
begin
dec(DriveNumero,$20);
EMode := SetErrorMode(SEM_FAILCRITICALERRORS);
end;
try
if DiskSize(DriveNumero-$40) = -1 then
begin
Result := False;
end
else
begin
Result := True;
end;
Except
SetErrorMode(EMode);
end;
end;

function NumeroSerie(Unidade:PChar):String;
{Retorna o Número serial da unidade especificada}
var
VolName,SysName : AnsiString;
SerialNo,MaxCLength,FileFlags : DWord;
begin
try
SetLength(VolName,255);
SetLength(SysName,255);
GetVolumeInformation(Unidade,PChar(VolName),255,@SerialNo,
MaxCLength,FileFlags,PChar(SysName),255);
result := IntToHex(SerialNo,8);
except
result := ´ ´;
end;
end;

function DetectaDrv(const drive : char): boolean;
{Detecta quantas unidade possui no computador}
var
Letra: string;
begin
Letra := drive + ´:\´;
if GetDriveType(PChar(Letra)) < 2 then
begin
result := False;
end
else
begin
result := True;
end;
end;


function NumeroDeCores : Integer;
{Retorna a quantidade atual de cores no Windows (16, 256, 65536 = 16 ou 24 bit}
var
DC:HDC;
BitsPorPixel: Integer;
begin
Dc := GetDc(0); // 0 = vídeo
BitsPorPixel := GetDeviceCaps(Dc,BitsPixel);
Result := 2 shl (BitsPorPixel - 1);
end;

function Percentdisk(unidade: byte): Integer;
{Retorna a porcentagem de espaço livre em uma unidade de disco}
var
A,B, Percentual : longint;
begin
if DiskFree(Unidade) -1 then
begin
A := DiskFree(Unidade) div 1024;
B := DiskSize(Unidade) div 1024;
Percentual:=(A*100) div B;
result := Percentual;
end
else
begin
result := -1;
end;
end;

function IsPrinter : Boolean;
Const
PrnStInt : Byte = $17;
StRq : Byte = $02;
PrnNum : Word = 0; { 0 para LPT1, 1 para LPT2, etc. }
Var
nResult : byte;
Begin (* IsPrinter*)
Asm
mov ah,StRq;
mov dx,PrnNum;
Int $17;
mov nResult,ah;
end;
IsPrinter := (nResult and $80) = $80;
End;

function CorrentPrinter :String;
// Retorna a impressora padrão do windows
// Requer a unit printers declarada na clausula uses da unit
var
Device : array[0..255] of char;
Driver : array[0..255] of char;
Port : array[0..255] of char;
hDMode : THandle;
begin
Printer.GetPrinter(Device, Driver, Port, hDMode);
Result := Device+´ na porta ´+Port;
end;

end.

function CPUSpeed: Double;
const
DelayTime = 500;
var
TimerHi, TimerLo: DWORD;
PriorityClass, Priority: Integer;
begin
PriorityClass := GetPriorityClass(GetCurrentProcess);
Priority := GetThreadPriority(GetCurrentThread);
SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
Sleep(10);
asm
dw 310Fh
mov TimerLo, eax
mov TimerHi, edx
end;
Sleep(DelayTime);
asm
dw 310Fh
sub eax, TimerLo
sbb edx, TimerHi
mov TimerLo, eax
mov TimerHi, edx
end;
SetThreadPriority(GetCurrentThread, Priority);
SetPriorityClass(GetCurrentProcess, PriorityClass);
Result := TimerLo / (1000.0 * DelayTime);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
const cBytesPorMb=1024*1024;
var
M: TMemoryStatus;
T : string;
begin
M.dwLength:=SizeOf(M);
GlobalMemoryStatus(M);
Memo1.Clear;
with Memo1.Lines do
begin
Add(Format(´Memória em uso: ¬d¬¬´, [M.dwMemoryLoad]));
Add(Format(´Total de física: ¬f MB´, [M.dwTotalPhys/cBytesPorMB]));
Add(Format(´Total máx. paginação: ¬f MB´, [M.dwTotalPageFile/ cBytesPorMB]));
Add(Format(´Paginação disponível: ¬f MB´, [M.dwAvailPageFile/ cBytesPorMB]));
Add(Format(´Total vitual: ¬fMB´, [M.dwTotalVirtual/cBytesPorMB]));
Add(Format(´Virtual disponível: ¬fMB´, [M.dwAvailVirtual/cBytesPorMB]));
T := formatfloat(´#,´,(diskfree(0)));
Add(´Espaço Livre do HD: ´+ copy(T,1,4)+´ MB´);
T:= formatfloat(´,´,(DiskSize(0)));
Add(´Tamanho do HD: ´+copy(T,1,4)+´ MB´) ;

end;

end;

O [url=http://www.mitec.cz/]MiTeC System Information Component (MSIC)[/url] faz isso; conforme o site:

é shareware esse componente?

Se voce ja tiver instalada a jediVCL 3.x, há alguns componentes que extraem uma boa quantidade de informações como o TJvComputerInfoEx

[]´s

Ele da possibilidade de passar pra um TStringList os valores capturados?
preciso q faça isso..