如何在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] <> nil do begin
result:=StrPas(inet_ntoa(pptr^[I]^));
Inc(I);
end;
WSACleanup;
end;
//以下函数用以获得WINDOWSID号。
function GetWindowsProductID: string;
var
reg:TRegistry;
begin
Result := '';
reg := TRegistry.Create;
with reg do
begin
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('Software\Microsoft\Windows\CurrentVersion', False);
Result := ReadString('ProductID');
end;
reg.Free;
end;
//以下是在窗口出现时，显示计算机的硬件信息。
procedure TForm2.FormCreate(Sender: TObject);
var s0,s1,s2,s3:string;
//s4,s5:string为全程变量
n1,n2:longint;
myfile:textfile;
users:pchar;
i:dword;
MACAddress: PMACAddress;
RetCode: Byte;
var fulldrive :string[3];
tmp_drive :array[0..2] of char;
VolName :array[0..255] of Char;
SerialN :DWORD;
MaxCLength :DWORD;
FileSysFlag :DWORD;
FileSysName :array[0..255] of Char;
begin
Label2.Caption:='你的IP地址是: '+LocalIP;
label3.caption:='你的windowsID是：'+GetWindowsProductID;
New(MACAddress);
try
RetCode := GetMACAddress(0, MACAddress);
if RetCode = NRC_GOODRET then
begin
label5.caption := '你的网卡地址是：'+Format('%2.2x-%2.2x-%2.2x-%2.2x-%2.2x-%2.2x',
[MACAddress[0], MACAddress[1], MACAddress[2],
MACAddress[3], MACAddress[4], MACAddress[5]]);
end;
finally
Dispose(MACAddress);
end;
i:=255;
getmem(users,255);
getusername(users,i); //获得Windows用户名
label6.caption:='你登录windows的用户名是 :'+users;
freemem(users);
fulldrive:='c:\';
strpcopy(tmp_drive,fulldrive);
GetVolumeInformation(tmp_drive, VolName, 255, @SerialN, MaxCLength,FileSysFlag, FileSysName, 255);
label7.caption:='你的硬盘卷标是：'+VolName;
label8.caption:='你的硬盘序列号是：'+DecToHex(SerialN);
label9.caption:='你的计算机名是：'+getcomputername;
IF getbios(1)<>'' then
label10.caption:='你的BIOS版本号是：'+getbios(1)
else
label10.caption:='未取得BIOS版本号';
if getbios(2)<>'' then
label11.caption:='你的BIOS序列号是：'+getbios(4)
else
label11.caption:='未取得BIOS序列号';
if getsystemtime<>'' then
label12.caption:='你的系统时间是：'+getsystemtime
else
label12.Caption:='未取得系统时间';
if getlocaltime<>'' then
label13.caption:='你的本地时间是：'+getlocaltime
else
label13.caption:='未取得本地时间';
if inttostr(DiskSize(3) div 1024)<>'' then
label14.caption:='你的系统硬盘空间是：'+inttostr(DiskSize(3) div 1024)
else
label14.caption:='未取得系统硬盘间';
procedure TForm2.Button2Click(Sender: TObject);
begin
Change2Ring0();
end;
以上有部份引用了网友的代码,在此申明.
由于以上操作需要在申明处加入：Winsock,Registry,NB30
以上方法在DELPHI5、WINDOWS98下通过。
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] <> nil do begin
result:=StrPas(inet_ntoa(pptr^[I]^));
Inc(I);
end;
WSACleanup;
end;
//以下函数用以获得WINDOWSID号。
function GetWindowsProductID: string;
var
reg:TRegistry;
begin
Result := '';
reg := TRegistry.Create;
with reg do
begin
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('Software\Microsoft\Windows\CurrentVersion', False);
Result := ReadString('ProductID');
end;
reg.Free;
end;
//以下是在窗口出现时，显示计算机的硬件信息。
procedure TForm2.FormCreate(Sender: TObject);
var s0,s1,s2,s3:string;
//s4,s5:string为全程变量
n1,n2:longint;
myfile:textfile;
users:pchar;
i:dword;
MACAddress: PMACAddress;
RetCode: Byte;
var fulldrive :string[3];
tmp_drive :array[0..2] of char;
VolName :array[0..255] of Char;
SerialN :DWORD;
MaxCLength :DWORD;
FileSysFlag :DWORD;
FileSysName :array[0..255] of Char;
begin
Label2.Caption:='你的IP地址是: '+LocalIP;
label3.caption:='你的windowsID是：'+GetWindowsProductID;
New(MACAddress);
try
RetCode := GetMACAddress(0, MACAddress);
if RetCode = NRC_GOODRET then
begin
label5.caption := '你的网卡地址是：'+Format('%2.2x-%2.2x-%2.2x-%2.2x-%2.2x-%2.2x',
[MACAddress[0], MACAddress[1], MACAddress[2],
MACAddress[3], MACAddress[4], MACAddress[5]]);
end;
finally
Dispose(MACAddress);
end;
i:=255;
getmem(users,255);
getusername(users,i); //获得Windows用户名
label6.caption:='你登录windows的用户名是 :'+users;
freemem(users);
fulldrive:='c:\';
strpcopy(tmp_drive,fulldrive);
GetVolumeInformation(tmp_drive, VolName, 255, @SerialN, MaxCLength,FileSysFlag, FileSysName, 255);
label7.caption:='你的硬盘卷标是：'+VolName;
label8.caption:='你的硬盘序列号是：'+DecToHex(SerialN);
label9.caption:='你的计算机名是：'+getcomputername;
IF getbios(1)<>'' then
label10.caption:='你的BIOS版本号是：'+getbios(1)
else
label10.caption:='未取得BIOS版本号';
if getbios(2)<>'' then
label11.caption:='你的BIOS序列号是：'+getbios(4)
else
label11.caption:='未取得BIOS序列号';
if getsystemtime<>'' then
label12.caption:='你的系统时间是：'+getsystemtime
else
label12.Caption:='未取得系统时间';
if getlocaltime<>'' then
label13.caption:='你的本地时间是：'+getlocaltime
else
label13.caption:='未取得本地时间';
if inttostr(DiskSize(3) div 1024)<>'' then
label14.caption:='你的系统硬盘空间是：'+inttostr(DiskSize(3) div 1024)
else
label14.caption:='未取得系统硬盘间';
procedure TForm2.Button2Click(Sender: TObject);
begin
Change2Ring0();
end;
以上有部份引用了网友的代码,在此申明.
由于以上操作需要在申明处加入：Winsock,Registry,NB30
以上方法在DELPHI5、WINDOWS98下通过。
本栏文章均来自于互联网，版权归原作者和各发布网站所有，本站收集这些文章仅供学习参考之用。任何人都不能将这些文章用于商业或者其他目的。( Pfan.cn )
【编程爱好者论坛】