在DELPHI中通过获取计算机一系列硬件信息
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(&#118alue: integer): String; // 1...Bios Type // 2.. Bios Copyright // 3.. Bios Date // 4.. Bios Extended Info // 5.. Bustype // 6.. MachineType begin result:='(unavailable)'; case &#118alue 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( a&#118alue : LongInt ) : String; Var w : Array[ 1..2 ] Of Word Absolute a&#118alue; 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', 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&#58textfile; 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下通过。 |