侦测硬件信息(300分)

谁做过用delphi侦测硬件信息的啊。给点资料。谢谢大家啊。我的QQ23442436

USB设备的插入和拔出

unit U_Usb;

interface

uses
Windows, Messages, SysUtils, Classes, Forms;

type

PDevBroadcastHdr = ^DEV_BROADCAST_HDR;
DEV_BROADCAST_HDR = packed record
dbch_size: DWORD;
dbch_devicetype: DWORD;
dbch_reserved: DWORD;
end;

PDevBroadcastDeviceInterface = ^DEV_BROADCAST_DEVICEINTERFACE;
DEV_BROADCAST_DEVICEINTERFACE = record
dbcc_size: DWORD;
dbcc_devicetype: DWORD;
dbcc_reserved: DWORD;
dbcc_classguid: TGUID;
dbcc_name: short;
end;

const
GUID_DEVINTERFACE_USB_DEVICE: TGUID = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}';
DBT_DEVICEARRIVAL = $8000; // system detected a new device
DBT_DEVICEREMOVECOMPLETE = $8004; // device is gone
DBT_DEVTYP_DEVICEINTERFACE = $00000005; // device interface class

type

TComponentUSB = class(TComponent)
private
FWindowHandle: HWND;
FOnUSBArrival: TNotifyEvent;
FOnUSBRemove: TNotifyEvent;
procedure WndProc(var Msg: TMessage);
function USBRegister: Boolean;
protected
procedure WMDeviceChange(var Msg: TMessage); dynamic;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property OnUSBArrival: TNotifyEvent read FOnUSBArrival write FOnUSBArrival;
property OnUSBRemove: TNotifyEvent read FOnUSBRemove write FOnUSBRemove;
end;

implementation

constructor TComponentUSB.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FWindowHandle := AllocateHWnd(WndProc);
USBRegister;
end;

destructor TComponentUSB.Destroy;
begin
DeallocateHWnd(FWindowHandle);
inherited Destroy;
end;

procedure TComponentUSB.WndProc(var Msg: TMessage);
begin
if (Msg.Msg = WM_DEVICECHANGE) then
begin
try
WMDeviceChange(Msg);
except
Application.HandleException(Self);
end;
end
else
Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);
end;

procedure TComponentUSB.WMDeviceChange(var Msg: TMessage);
var
devType: Integer;
Datos: PDevBroadcastHdr;
begin
if (Msg.wParam = DBT_DEVICEARRIVAL) or (Msg.wParam = DBT_DEVICEREMOVECOMPLETE) then
begin
Datos := PDevBroadcastHdr(Msg.lParam);
devType := Datos^.dbch_devicetype;
if devType = DBT_DEVTYP_DEVICEINTERFACE then
begin // USB Device
if Msg.wParam = DBT_DEVICEARRIVAL then
begin
if Assigned(FOnUSBArrival) then
FOnUSBArrival(Self);
end
else
begin
if Assigned(FOnUSBRemove) then
FOnUSBRemove(Self);
end;
end;
end;
end;

function TComponentUSB.USBRegister: Boolean;
var
dbi: DEV_BROADCAST_DEVICEINTERFACE;
Size: Integer;
r: Pointer;
begin
Result := False;
Size := SizeOf(DEV_BROADCAST_DEVICEINTERFACE);
ZeroMemory(@dbi, Size);
dbi.dbcc_size := Size;
dbi.dbcc_devicetype := DBT_DEVTYP_DEVICEINTERFACE;
dbi.dbcc_reserved := 0;
dbi.dbcc_classguid := GUID_DEVINTERFACE_USB_DEVICE;
dbi.dbcc_name := 0;

r := RegisterDeviceNotification(FWindowHandle, @dbi,
DEVICE_NOTIFY_WINDOW_HANDLE
);
if Assigned(r) then Result := True;
end;

end.

有所有的代码的信息侦测的代码马？

你要侦测哪种硬件呢？

CPU,主板芯片，声卡芯片等。就和那些硬件侦测的程序一样的啊。

检测声卡：
uses mmsystem;

function SoundCardExist:boolean;
begin
result:=WaveOutGetNumDevs >0;
end;

再给你一个CPU的：
unit Cpu;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, Buttons;

type
{ All the types currently known. As new types are created,
add suitable names, and extend the case statement in

the GetCpuType function.
}
TCPUType = (i8086CPU, i286CPU, i386CPU, i486CPU, iPentiumCPU);

TForm1 = class(TForm)
Edit1: TEdit;
Label1: TLabel;
BitBtn1: TBitBtn;
procedure FormCreate(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
private
{ Return the type of the current CPU }
function CpuType: TCPUType;
{ Return the type as a string }
function GetCPUType: String;
public
end;

var
Form1: TForm1;

{ Define the winFlags variable for 286 check }
winFlags: Longint;

implementation

{$R *.DFM}


{ Get CPU type }
function TForm1.GetCPUType: String;
var
kind: TCPUType;
begin
if winFlags and WF_CPU286 > 0 then
Result := '80286'
else
begin
kind := CpuType;
case kind of
i8086CPU:
Result := '8086';
i386CPU:
Result := '80386';
i486CPU:
Result := '80486';
iPentiumCPU:
Result := 'Pentium';

else
{ Try to be flexible for future cpu types, e.g., P6. }
Result := Format('P%d', [Ord(kind)]);
end;
end;
end;

{ Assembly function to get CPU type including Pentium and later }
function TForm1.CpuType: TCPUType; assembler;
asm
push DS
{ First check for an 8086 CPU }
{ Bits 12-15 of the FLAGS register are always set on the }
{ 8086 processor. }
pushf { save EFLAGS }
pop bx { store EFLAGS in BX }

mov ax,0fffh { clear bits 12-15 }
and ax,bx { in EFLAGS }
push ax { store new EFLAGS value on stack }
popf { replace current EFLAGS value }
pushf { set new EFLAGS }
pop ax { store new EFLAGS in AX }
and ax,0f000h { if bits 12-15 are set, then CPU }
cmp ax,0f000h { is an 8086/8088 }
mov ax, i8086CPU { turn on 8086/8088 flag }

je @@End_CpuType

{ 80286 CPU check }
{ Bits 12-15 of the FLAGS register are always clear on the }
{ 80286 processor. }
{ Commented out because 'pop ax' crashes it to the DOS prompt when running }
{ with a Delphi form on some Machines.}
{ or bx,0f000h } { try to set bits 12-15 }
{ push bx }
{ popf }
{ pushf }
{ pop ax } { This crashes Delphi programs on some machines }

{ and ax,0f000h } { if bits 12-15 are cleared, CPU=80286 }
{ mov ax, i286CPU } { turn on 80286 flag }
{ jz @@End_CpuType }

{ To test for 386 or better, we need to use 32 bit instructions,
but the 16-bit Delphi assembler does not recognize the 32 bit opcodes
or operands. Instead, use the 66H operand size prefix to change
each instruction to its 32-bit equivalent. For 32-bit immediate
operands, we also need to store the high word of the operand immediately

following the instruction. The 32-bit instruction is shown in a comment
after the 66H instruction.
}

{ i386 CPU check }
{ The AC bit, bit #18, is a new bit introduced in the EFLAGS }
{ register on the i486 DX CPU to generate alignment faults. }
{ This bit can not be set on the i386 CPU. }

db 66h { pushfd }
pushf
db 66h { pop eax }
pop ax { get original EFLAGS }
db 66h { mov ecx, eax }

mov cx,ax { save original EFLAGS }
db 66h { xor eax,40000h }
xor ax,0h { flip AC bit in EFLAGS }
dw 0004h
db 66h { push eax }
push ax { save for EFLAGS }
db 66h { popfd }
popf { copy to EFLAGS }
db 66h { pushfd }
pushf { push EFLAGS }
db 66h { pop eax }
pop ax { get new EFLAGS value }
db 66h { xor eax,ecx }

xor ax,cx { can't toggle AC bit, CPU=Intel386 }
mov ax, i386CPU { turn on 386 flag }
je @@End_CpuType

{ i486 DX CPU / i487 SX MCP and i486 SX CPU checking }
{ Checking for ability to set/clear ID flag (Bit 21) in EFLAGS }
{ which indicates the presence of a processor }
{ with the ability to use the CPUID instruction. }
db 66h { pushfd }
pushf { push original EFLAGS }
db 66h { pop eax }

pop ax { get original EFLAGS in eax }
db 66h { mov ecx, eax }
mov cx,ax { save original EFLAGS in ecx }
db 66h { xor eax,200000h }
xor ax,0h { flip ID bit in EFLAGS }
dw 0020h
db 66h { push eax }
push ax { save for EFLAGS }
db 66h { popfd }
popf { copy to EFLAGS }
db 66h { pushfd }
pushf { push EFLAGS }

db 66h { pop eax }
pop ax { get new EFLAGS value }
db 66h { xor eax, ecx }
xor ax, cx
mov ax, i486CPU { turn on i486 flag }
je @@End_CpuType { if ID bit cannot be changed, CPU=486 }
{ without CPUID instruction functionality }

{ Execute CPUID instruction to determine vendor, family, }
{ model and stepping. The use of the CPUID instruction used }
{ in this program can be used for B0 and later steppings }

{ of the P5 processor. }
db 66h { mov eax, 1 }
mov ax, 1 { set up for CPUID instruction }
dw 0
db 66h { cpuid }
db 0Fh { Hardcoded opcode for CPUID instruction }
db 0a2h
db 66h { and eax, 0F00H }
and ax, 0F00H { mask everything but family }
dw 0
db 66h { shr eax, 8 }
shr ax, 8 { shift the cpu type down to the low byte }

sub ax, 1 { subtract 1 to map to TCpuType }

@@End_CpuType:
pop ds
end;


{ Get the Windows Flags to check for 286. The 286 assembly code
crashes due to a problem when using with Delphi Forms on some machines. This
method is safer.
}
procedure TForm1.FormCreate(Sender: TObject);
begin
winFlags := GetWinFlags;
end;

{ Call the CPU function and assign it to the Edit box }
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
Edit1.Text := GetCPUType;

end;

end.

完成了。。