Delphi Biblioteca para operações com Hardware

[.IndependentResearch.]

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.