Code
- {*******************************************************}
- { }
- { System Information Library }
- { 2006, Gullb3rg }
- { Codius }
- { }
- {*******************************************************}
- Unit unSystemInformation;
- Interface
- uses
- Windows, Winsock,
- SysUtils, NB30;
- Type
- POSVersionInfoEx = ^TOSVersionInfoEx;
- TOSVersionInfoEx = packed record
- dwOSVersionInfoSize : DWORD;
- dwMajorVersion : DWORD;
- dwMinorVersion : DWORD;
- dwBuildNumber : DWORD;
- dwPlatformId : DWORD;
- szCSDVersion : Array [0..127] of AnsiChar;
- wSerconnectionePackMajor : Word;
- wSerconnectionePackMinor : Word;
- wSuiteMask : Word;
- wProductType : Byte;
- wReserved : Byte;
- end;
- TRSystemInformation = Record
- UserName : String;
- OS : String;
- Edition : String;
- ComputerName : String;
- Location : String;
- LocalIP : String;
- WinVersion : String;
- Build : Cardinal;
- WindowsID : String;
- SerconnectionePack : String;
- VolumeSerial : String;
- DefultBrowser : String;
- MACAdress : String;
- WinEdition : String;
- UpTime : String;
- end;
- TCSystemInformation = Class
- Private
- CSystemInformation : TCSystemInformation;
- RSystemInformation : TRSystemInformation;
- Function GetUser : String;
- Function GetComputerNetName : String;
- Function GetLanguage(cType: Cardinal) : String;
- Function GetOS : String;
- Function GetUpTime : String;
- Function GetLocalIP : String;
- Function GetWinVersion : String;
- Function GetBuild : Cardinal;
- Function GetWindowsID : String;
- Function GetSerconnectionePack : String;
- Function FindVolumeSerial(const Drive : PChar) : String;
- Function GetDefultBrowser : String;
- Function GetMACAdress : String;
- Function GetWinEdition : String;
- Function GetOSVerInfo(var Info: TOSVersionInfoEx): Boolean;
- Function ViewUser : String;
- Function ViewComputerNetName : String;
- Function ViewLanguage : String;
- Function ViewOS : String;
- Function ViewUpTime : String;
- Function ViewLocalIP : String;
- Function ViewWinVersion : String;
- Function ViewBuild : Cardinal;
- Function ViewWindowsID : String;
- Function ViewSerconnectionePack : String;
- Function ViewVolumeSerial : String;
- Function ViewDefultBrowser : String;
- Function ViewMACAdress : String;
- Function ViewWinEdition : String;
- Public
- Constructor Create;
- Procedure Refresh;
- Property UserName : String Read ViewUser;
- Property ComputerName : String Read ViewComputerNetName;
- Property Language : String Read ViewLanguage;
- Property OS : String Read ViewOS;
- Property UpTime : String Read ViewUpTime;
- Property LocalIP : String Read ViewLocalIP;
- Property WinVersion : String Read ViewWinVersion;
- Property Build : Cardinal Read ViewBuild;
- Property WindowsID : String Read ViewWindowsID;
- Property SerconnectionePack : String Read ViewSerconnectionePack;
- Property VolumeSerial : String Read ViewVolumeSerial;
- Property DefultBrowser : String Read ViewDefultBrowser;
- Property MACAdress : String Read ViewMACAdress;
- Property WinEdition : String Read ViewWinEdition;
- end;
- Const
- VER_NT_WORKSTATION = $0000001;
- {$EXTERNALSYM VER_NT_WORKSTATION}
- VER_SUITE_PERSONAL = $00000200;
- {$EXTERNALSYM VER_SUITE_PERSONAL}
- implementation
- { IntToStr
- This function is used to convert integers to strings. }
- Function IntToStr(Const Value: Integer): String;
- Var
- s : String[11];
- Begin
- Str(Value, s);
- Result := s;
- End;
- { StrToInt
- This function is used to convert strings to integers. }
- Function StrToInt(Const s: String): Integer;
- Var
- e : integer;
- Begin
- val(s, Result, e);
- End;
- { TCSystemInformation.Create
- This constructor will initialize the system information record. }
- Constructor TCSystemInformation.Create;
- Begin
- Inherited;
- Refresh;
- End;
- { TCSystemInformation.Refresh
- This routine will refresh the processor record. }
- Procedure TCSystemInformation.Refresh;
- Begin
- RSystemInformation.UserName := GetUser;
- RSystemInformation.ComputerName := GetComputerNetName;
- RSystemInformation.WinEdition := GetWinEdition;
- RSystemInformation.Location := GetLanguage(LOCALE_SENGCOUNTRY);
- RSystemInformation.LocalIP := GetLocalIP;
- RSystemInformation.WinVersion := GetWinVersion;
- RSystemInformation.Build := GetBuild;
- RSystemInformation.WindowsID := GetWindowsID;
- RSystemInformation.SerconnectionePack := GetSerconnectionePack;
- RSystemInformation.VolumeSerial := FindVolumeSerial('C:\');
- RSystemInformation.DefultBrowser := GetDefultBrowser;
- RSystemInformation.MACAdress := GetMACAdress;
- RSystemInformation.WinEdition := GetWinEdition;
- RSystemInformation.UpTime := GetUpTime;
- RSystemInformation.OS := GetOS;
- end;
- { TCSystemInformation.ViewUser
- This routine will return the username. }
- Function TCSystemInformation.ViewUser : String;
- Begin
- Result := RSystemInformation.UserName;
- End;
- { TCSystemInformation.ViewBuild
- This routine will return the Build number of your OS version. }
- Function TCSystemInformation.ViewBuild : Cardinal;
- Begin
- Result := RSystemInformation.Build;
- End;
- { TCSystemInformation.ViewOS
- This routine will return the OS version installed. }
- Function TCSystemInformation.ViewOS : String;
- Begin
- Result := RSystemInformation.OS;
- End;
- { TCSysemInformation.ViewComputerNetName
- This routine will return the computer name. }
- Function TCSystemInformation.ViewComputerNetName : String;
- Begin
- Result := RSystemInformation.ComputerName;
- End;
- { TCSystemInformation.ViewLocation
- This routine will return the location. }
- Function TCSystemInformation.ViewLanguage : String;
- Begin
- Result := RSystemInformation.Location;
- End;
- { TCSystemInformation.ViewLocalIP
- This routine will return your local IP. }
- Function TCSystemInformation.ViewLocalIP : String;
- Begin
- Result := RSystemInformation.LocalIP;
- End;
- { TCSystemInformation.ViewWinVersion
- This routine will return the Windows version. }
- Function TCSystemInformation.ViewWinVersion : String;
- Begin
- Result := RSystemInformation.WinVersion;
- End;
- { TCSystemInformation.ViewBuild
- This routine will return Windows build number. }
- Function TCSystemInformation.ViewWindowsID : String;
- Begin
- Result := RSystemInformation.WindowsID;
- End;
- { TCSystemInformation.ViewSerconnectionePack
- This routine will return yout Serconnectione Pack. }
- Function TCSystemInformation.ViewSerconnectionePack : String;
- Begin
- Result := RSystemInformation.SerconnectionePack;
- End;
- { TCSystemInformation.ViewVolumeSerial
- This routine will return root serial number. }
- Function TCSystemInformation.ViewVolumeSerial : String;
- Begin
- Result := RSystemInformation.VolumeSerial;
- End;
- { TCSystemInformation.ViewDefultBrowser
- This routine will return the defult browser. }
- Function TCSystemInformation.ViewDefultBrowser;
- Begin
- Result := RSystemInformation.DefultBrowser;
- End;
- { TCSystemInformation.ViewMACAdress
- This routine will return the MAC adress. }
- Function TCSystemInformation.ViewMACAdress : String;
- Begin
- Result := RSystemInformation.MACAdress;
- End;
- { TCSystemInformation.ViewWinEdition
- This routine will return the Windows Edition. }
- Function TCSystemInformation.ViewWinEdition : String;
- Begin
- Result := RSystemInformation.WinEdition;
- End;
- { TCSystemInformation.ViewUpTime
- This routine will return the UpTime. }
- Function TCSystemInformation.ViewUpTime : String;
- Begin
- Result := RSystemInformation.UpTime;
- End;
- { TCSystemInformation.GetUser
- This routine is used to retrive Username. }
- Function TCSystemInformation.GetUser: string;
- Var
- UserName : string;
- UserNameLen : Dword;
- Begin
- UserNameLen := 255;
- SetLength(userName, UserNameLen) ;
- If GetUserName(pChar(UserName), UserNameLen) Then
- Result := Copy(UserName,1,UserNameLen - 1)
- Else
- Result := 'Unknown';
- End;
- { TCSystemInformation.GetComputerNetName
- This routine is used to retrive computer name. }
- Function TCSystemInformation.GetComputerNetName: string;
- var
- Temp : Array[0..255] of char;
- size : dword;
- begin
- size := 256;
- if GetComputerName(Temp, size) then
- Result := Temp
- else
- Result := ''
- end;
- { TCSystemInformation.GetLanguage
- This routine is used to retrive language. }
- Function TCSystemInformation.GetLanguage(cType: Cardinal): String;
- Var
- Temp : Array [0..255] of Char;
- begin
- FillChar(Temp, sizeOf(Temp), #0);
- GetLocaleInfo(LOCALE_SYSTEM_DEFAULT, cType, Temp, sizeOf(Temp));
- Result := String(Temp);
- end;
- { TCSystemInformation.GetOSVerInfo(var Info: TOSVersionInfoEx
- This routine is used to help return Windows Edition. }
- Function TCSystemInformation.GetOSVerInfo(var Info: TOSVersionInfoEx): Boolean;
- begin
- FillChar(Info, SizeOf(TOSVersionInfoEx), 0);
- Info.dwOSVersionInfoSize := SizeOf(TOSVersionInfoEx);
- Result := GetVersionEx(TOSVersionInfo(Addr(Info)^));
- if (not Result) then
- begin
- FillChar(Info, SizeOf(TOSVersionInfoEx), 0);
- Info.dwOSVersionInfoSize := SizeOf(TOSVersionInfoEx);
- Result := GetVersionEx(TOSVersionInfo(Addr(Info)^));
- if (not Result) then
- Info.dwOSVersionInfoSize := 0;
- end;
- end;
- { TCSystemInformation.GetWinEdition
- This routine will return the windows edition. }
- Function TCSystemInformation.GetWinEdition : String;
- Var
- Info : TOSVersionInfoEx;
- Begin
- If (Not GetOsVerInfo(Info)) Then
- Exit;
- If Info.dwPlatformId = VER_PLATFORM_WIN32_NT Then
- begin
- if (Info.dwOSVersionInfoSize >= SizeOf(TOSVersionInfoEx)) then
- begin
- If (Info.wProductType = VER_NT_WORKSTATION) Then
- begin
- if (Info.dwMajorVersion = 4) Then
- Result := 'Workstation 4.0'
- else if (Info.wSuiteMask and VER_SUITE_PERSONAL <> 0) Then
- Result := 'Home Edition'
- else
- Result := 'Professional';
- end;
- end;
- end;
- End;
- { TCSystemInformation.GetOS
- This routine is used to retrive the Operating System, }
- Function TCSystemInformation.GetOS: String;
- Var
- OSVersionInfo :TOSVersionInfo;
- Begin
- OSVersionInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
- GetVersionEx(OSVersionInfo);
- If (OSVersionInfo.dwMajorVersion = 4) And
- (OSVersionInfo.dwMinorVersion = 0) Then
- Begin
- If (OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT) Then Result := 'Windows 95';
- If (OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS) Then Result := 'Windows NT';
- End
- Else If (OSVersionInfo.dwMajorVersion = 4) And (OSVersionInfo.dwMinorVersion = 10) Then Result := 'Windows 98'
- Else If (OSVersionInfo.dwMajorVersion = 4) And (OSVersionInfo.dwMinorVersion = 90) Then Result := 'Windows ME'
- Else If (OSVersionInfo.dwMajorVersion = 5) And (OSVersionInfo.dwMinorVersion = 0) Then Result := 'Windows 2000'
- Else If (OSVersionInfo.dwMajorVersion = 5) And (OSVersionInfo.dwMinorVersion = 1) Then Result := 'Windows XP'
- Else If (OSVersionInfo.dwMajorVersion = 6) And (OsVersionInfo.dwMinorVersion = 1) Then Result := 'Windows Vista'
- Else Result := 'Unknown OS';
- End;
- { TCSystemInformation.GetUptime
- This routine is used to retrive the uptime. }
- Function TCSystemInformation.GetUpTime: string;
- const
- ticksperday : Integer = 1000 * 60 * 60 * 24;
- ticksperhour : Integer = 1000 * 60 * 60;
- ticksperminute : Integer = 1000 * 60;
- tickspersecond : Integer = 1000;
- var
- t: Longword;
- d, h, m, s: Integer;
- begin
- t := GetTickCount;
- d := t div ticksperday;
- Dec(t, d * ticksperday);
- h := t div ticksperhour;
- Dec(t, h * ticksperhour);
- m := t div ticksperminute;
- Dec(t, m * ticksperminute);
- s := t div tickspersecond;
- Result := IntToStr(d) + ' Day(s) ' + IntToStr(h) + ' Hour(s) ' + IntToStr(m) +
- ' Minute(s) ' + IntToStr(s) + ' Seconds';
- end;
- { TCSystemInformation.GetLocalIP
- This routine is used to retrive local IP. }
- Function TCSystemInformation.GetLocalIP: 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 := inet_ntoa(pptr^[i]^);
- Inc(I);
- end;
- WSACleanup;
- end;
- { TCSystemInformation.GetWinVersion
- This routine is used to retrive Windows version. }
- Function TCSystemInformation.GetWinVersion: String;
- Var
- Version : DWORD;
- MajorVersion : BYTE;
- MinorVersion : BYTE;
- Begin
- Version := GetVersion();
- MajorVersion := LOBYTE(LOWORD(Version));
- MinorVersion := HIBYTE(LOWORD(Version));
- Result := IntToStr(MajorVersion) + '.' + IntToStr(MinorVersion);
- End;
- { TCSystemInformation.GetBuild
- This routine is used to retrive Build number. }
- Function TCSystemInformation.GetBuild: Cardinal;
- Var
- MajorVersion : BYTE;
- MinorVersion : BYTE;
- Version : DWORD;
- Build : DWORD;
- Begin
- Version := GetVersion();
- MajorVersion := LOBYTE(LOWORD(Version));
- MinorVersion := HIBYTE(LOWORD(Version));
- If (Version and $80000000) = 0 Then
- Build := HIWORD(Version)
- else if (MajorVersion < 4) Then
- Build := HIWORD(Version) and $7FFF
- else
- Build := 0;
- Result := Build;
- End;
- { TCSystemInformation.GetWindowsID
- This routine is used to retrive Windows ID. }
- Function TCSystemInformation.GetWindowsID: String;
- Var
- gKEY : HKEY;
- gSize : Cardinal;
- gRegister : PChar;
- Begin
- GetMem(gRegister, MAX_PATH + 1);
- RegOpenKeyEx(HKEY_LOCAL_MACHINE, 'SoftWare\Microsoft\Windows\CurrentVersion\', 0, KEY_QUERY_VALUE, gKEY);
- gSize := 2048;
- RegQueryValueEx(gKey, 'ProductID', NIL, NIL, pByte(gRegister), @gSize);
- RegCloseKey(gKEY);
- Result := pChar(gRegister);
- FreeMem(gRegister);
- End;
- { TCSystemInformation.GetSerconnectionePack
- This routine is used to retrive the Serconnectione Pack. }
- Function TCSystemInformation.GetSerconnectionePack: String;
- Var
- VersionInfo : TOSVersionInfo;
- Begin
- VersionInfo.dwOSVersionInfoSize := SizeOf(VersionInfo);
- GetVersionEx(VersionInfo);
- With VersionInfo do
- begin
- If szCSDVersion <> '' Then
- Result := szCSDVersion;
- end;
- End;
- { TCSystemInformation.FindVolumeSerial
- This routine is used to retrive root disk serial number. }
- Function TCSystemInformation.FindVolumeSerial(const Drive : PChar): string;
- var
- VolumeSerialNumber : DWORD;
- MaximumComponentLength : DWORD;
- FileSystemFlags : DWORD;
- SerialNumber : String;
- begin
- Result := '';
- GetVolumeInformation(Drive, NIL, 0, @VolumeSerialNumber, MaximumComponentLength, FileSystemFlags, NIL, 0);
- SerialNumber := IntToHex(HiWord(VolumeSerialNumber), 4) + ' - ' + IntToHex(LoWord(VolumeSerialNumber), 4);
- Result := SerialNumber
- end;
- { TCSystemInformation.GetDefultBrowser
- This routine is used to retrive defult browser. }
- Function TCSystemInformation.GetDefultBrowser: String;
- Var
- gKEY : HKEY;
- gSize : Cardinal;
- gRegister : pChar;
- Begin
- GetMem(gRegister, MAX_PATH+1);
- RegOpenKeyEx(HKEY_LOCAL_MACHINE, 'Software\Classes\http\shell\open\command', 0, KEY_QUERY_VALUE, gKEY);
- gSize := 2048;
- RegQueryValueEX(gKEY, '', NIL, NIL, pByte(gRegister), @gSize);
- RegCloseKey(gKEY);
- Result := ExtractFileName(pChar(gRegister));
- Result := ChangeFileExt(pChar(Result), '');
- Result := UpperCase(Copy(pChar(Result), 1, 1)) + LowerCase(Copy(pChar(Result), 2, Length(pChar(Result))));
- FreeMem(gRegister);
- End;
- { TCSystemInformation.GetMACAdress
- This routine is used to retrice MAC adress. }
- Function TCSystemInformation.GetMACAdress: string;
- var
- NCB : PNCB;
- Adapter : PAdapterStatus;
- URetCode : PChar;
- RetCode : char;
- I : integer;
- Lenum : PlanaEnum;
- _SystemID : string;
- TMPSTR : string;
- begin
- Result := '';
- _SystemID := '';
- Getmem(NCB, SizeOf(TNCB));
- Fillchar(NCB^, SizeOf(TNCB), 0);
- Getmem(Lenum, SizeOf(TLanaEnum));
- Fillchar(Lenum^, SizeOf(TLanaEnum), 0);
- Getmem(Adapter, SizeOf(TAdapterStatus));
- Fillchar(Adapter^, SizeOf(TAdapterStatus), 0);
- Lenum.Length := chr(0);
- NCB.ncb_command := chr(NCBENUM);
- NCB.ncb_buffer := Pointer(Lenum);
- NCB.ncb_length := SizeOf(Lenum);
- RetCode := Netbios(NCB);
- i := 0;
- repeat
- Fillchar(NCB^, SizeOf(TNCB), 0);
- Ncb.ncb_command := chr(NCBRESET);
- Ncb.ncb_lana_num := lenum.lana[i];
- RetCode := Netbios(Ncb);
- Fillchar(NCB^, SizeOf(TNCB), 0);
- Ncb.ncb_command := chr(NCBASTAT);
- Ncb.ncb_lana_num := lenum.lana[i];
- Ncb.ncb_callname := '* ';
- Ncb.ncb_buffer := Pointer(Adapter);
- Ncb.ncb_length := SizeOf(TAdapterStatus);
- RetCode := Netbios(Ncb);
- if (RetCode = chr(0)) or (RetCode = chr(6)) then
- begin
- _SystemId := IntToHex(Ord(Adapter.adapter_address[0]), 2) + '-' +
- IntToHex(Ord(Adapter.adapter_address[1]), 2) + '-' +
- IntToHex(Ord(Adapter.adapter_address[2]), 2) + '-' +
- IntToHex(Ord(Adapter.adapter_address[3]), 2) + '-' +
- IntToHex(Ord(Adapter.adapter_address[4]), 2) + '-' +
- IntToHex(Ord(Adapter.adapter_address[5]), 2);
- end;
- Inc(i);
- until (I >= Ord(Lenum.Length)) or (_SystemID <> '00-00-00-00-00-00');
- FreeMem(NCB);
- FreeMem(Adapter);
- FreeMem(Lenum);
- GetMacAdress := _SystemID;
- end;
- end.