发新话题
打印

如何在DELPHI5中通过程序获取计算机一系列硬件信息

如何在DELPHI5中通过程序获取计算机一系列硬件信息

1、申明部份:
uses ….Winsock,Registry,NB30….
……
implementation
……
var s4,s5:string;
type
TNBLanaResources = (lrAlloc, lrFree);
type
PMACAddress = ^TMACAddress;
TMACAddress = array[0..5] of Byte;
type
TGate = record
Off2,op,seg,off1:WORD;
end;
LONGDWORD = INT64;
var
IDTR: LONGDWORD;
SavedGate:TGate;
OurGate: TGate;
dd: array [0..256] of word;
dsn:array [0..20] of char;
{$R *.DFM}
//以下函数用以获得硬盘出厂序列号。
procedure Ring0Proc();
asm
// Wait for controller not busy
mov dx,01f7h
@1:in al,dx
cmp al,050h
jne @1

// Get first/second drive
dec dx
mov al,0a0h
out dx,al

// Get drive info data
inc dx
mov al,0ech
out dx,al
nop
nop

// Wait for data ready
@2:in al,dx
cmp al,058h
jne @2
nop
nop
// Read sector
xor ecx,ecx
mov dx,01f0h
@3:in ax,dx
mov word ptr dd[ecx*2],ax
inc ecx
cmp ecx,256
jne @3

iretd
end;

procedure Change2Ring0();
begin
asm
mov eax, offset Ring0Proc
mov OurGate.off2, ax
shr eax, 16
mov OurGate.off1, ax
mov OurGate.op,0028h
mov OurGate.seg,0ee00h
mov ebx,offset IDTR
sidt [ebx]
mov ebx, dword ptr [IDTR 2]
add ebx, 8*3
mov edi, offset SavedGate
mov esi, ebx
movsd
movsd
mov edi, ebx
mov esi, offset OurGate
cli
movsd
movsd
sti
mov eax,6200h
mov ecx,0
int 3h
mov edi, ebx
mov esi, offset SavedGate
cli
movsd
movsd
sti
end;
asm
xor ecx,ecx
mov ebx,offset dd[10*2]
@4:mov ax,[ebx]
mov byte ptr dsn[ecx],ah
inc ecx
mov byte ptr dsn[ecx],al
inc ebx
inc ebx
inc ecx
cmp ecx,10
jne @4
end;
showmessage(dsn);
end;
//以下函数用以获得系统时间。
function GetSystemTime : AnsiString;
var
stSystemTime : TSystemTime;
begin
Windows.GetSystemTime( stSystemTime );
Result := DateTimeToStr( SystemTimeToDateTime( stSystemTime ) );
end;
//以下函数用以获得本地时间。
function GetLocalTime : AnsiString;
var
stSystemTime : TSystemTime;
begin
Windows.GetLocalTime( stSystemTime );
Result := DateTimeToStr( SystemTimeToDateTime( stSystemTime ) );
end;
//以下函数用以获得计算机名。
function GetComputerName: AnsiString;
var lpBuffer: array[0..MAX_PATH] of char;
dwSize: DWORD;
begin
dwSize:= MAX_PATH;
if not Windows.GetComputerName(lpBuffer, dwSize) then
raise
Exception.Create(SysErrorMessage(GetLastError()));
Result:= StrPas(lpBuffer);
end;
{function GetUserName: AnsiString;
var lpBuffer: array[0..MAX_PATH] of char;
dwSize: DWORD;
begin
dwSize:= MAX_PATH;

if not Windows.GetUserName(lpBuffer, dwSize) then
raise Exception.Create(SysErrorMessage(GetLastError()));

Result:= StrPas(lpBuffer);
end;}
//以下函数用以获得计算机BIOS系统信息。
function GetBios(value: integer): String;
// 1...Bios Type
// 2.. Bios Copyright
// 3.. Bios Date
// 4.. Bios Extended Info
// 5.. Bustype
// 6.. MachineType
begin
result:='(unavailable)';
case value of
1: result:=String(Pchar(Ptr($FE061)));
2: result:=String(Pchar(Ptr($FE091)));
3: result:=String(Pchar(Ptr($FFFF5)));
4: result:=String(Pchar(Ptr($FEC71)));
end;
end;
//以下函数是用以获得WINDOWS序列号函数中所调用的函数。
Function HexByte( b : Byte ) : String;
Const
Hex : Array[ $0..$F ] Of Char = '0123456789ABCDEF';
Begin
HexByte := Hex[ b Shr 4 ]   Hex[ b And $F ];
End;

Function HexWord( w : Word ) : String;
Begin
HexWord := HexByte( Hi( w ) )   HexByte( Lo( w ) );
End;
Function DecToHex( aValue : LongInt ) : String;
Var
w : Array[ 1..2 ] Of Word Absolute aValue;
Begin
Result := HexWord( w[ 2 ] )   HexWord( w[ 1 ] );
End;
//以下函数用以获得网卡地址。
function GetMACAddress(LanaNum: Byte; MACAddress: PMACAddress): Byte;
var
AdapterStatus: PAdapterStatus;
StatNCB: PNCB;
begin
New(StatNCB);
ZeroMemory(StatNCB, SizeOf(TNCB));
StatNCB.ncb_length := SizeOf(TAdapterStatus)   255 * SizeOf(TNameBuffer);
GetMem(AdapterStatus, StatNCB.ncb_length);
try
with StatNCB^ do
begin
ZeroMemory(MACAddress, SizeOf(TMACAddress));
ncb_buffer := PChar(AdapterStatus);
ncb_callname := '* '   #0;
ncb_lana_num := Char(LanaNum);
ncb_command := Char(NCBASTAT);
NetBios(StatNCB);
Result := Byte(ncb_cmd_cplt);
if Result = NRC_GOODRET then
MoveMemory(MACAddress, AdapterStatus, SizeOf(TMACAddress));
end;
finally
FreeMem(AdapterStatus);
Dispose(StatNCB);
end;
end;
function GetLanaEnum(LanaEnum: PLanaEnum): Byte;
var
LanaEnumNCB: PNCB;
begin
New(LanaEnumNCB);
ZeroMemory(LanaEnumNCB, SizeOf(TNCB));
try
with LanaEnumNCB^ do
begin
ncb_buffer := PChar(LanaEnum);
ncb_length := SizeOf(TLanaEnum);
ncb_command := Char(NCBENUM);
NetBios(LanaEnumNCB);
Result := Byte(ncb_cmd_cplt);
end;
finally
Dispose(LanaEnumNCB);
end;
end;
//以下函数用以得本机IP地址。
function LocalIP : string;
type
TaPInAddr = array [0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe : PHostEnt;
pptr : PaPInAddr;
Buffer : array [0..63] of char;
I : Integer;
GInitData : TWSADATA;

begin
WSAStartup($101, GInitData);
Result := '';
GetHostName(Buffer, SizeOf(Buffer));
phe :=GetHostByName(buffer);
if phe = nil then Exit;
pptr := PaPInAddr(Phe^.h_addr_list);
I := 0;
while pptr^[I]
相关主题

TOP

发新话题