{****************Delphi常用获取系统信息的函数*********************}
unit GetSysInfo;
interface
uses
Windows, SysUtils, ShellAPI, WinSock, Registry;
const
VER_NT_WORKSTATION = $00000001;
VER_NT_DOMAIN_CONTROLLER = $00000002;
VER_NT_SERVER = $00000003;
VER_SERVER_NT = $80000000;
VER_WORKSTATION_NT = $40000000;
VER_SUITE_SMALLBUSINESS = $00000001;
VER_SUITE_ENTERPRISE = $00000002;
VER_SUITE_BACKOFFICE = $00000004;
VER_SUITE_COMMUNICATIONS = $00000008;
VER_SUITE_TERMINAL = $00000010;
VER_SUITE_SMALLBUSINESS_RESTRICTED = $00000020;
VER_SUITE_DATACENTER = $00000080;
VER_SUITE_SINGLEUSERTS = $00000100;
VER_SUITE_PERSONAL = $00000200;
VER_SUITE_BLADE = $00000400;
type
POSVersionInfoEx = ^TOSVersionInfoEx;
OSVERSIONINFOEXA = record
dwOSVersionInfoSize: DWORD;
dwMajorVersion: DWORD;
dwMinorVersion: DWORD;
dwBuildNumber: DWORD;
dwPlatformId: DWORD;
szCSDVersion: array[0..127] of AnsiChar;
wServicePackMajor: WORD;
wServicePackMinor: WORD;
wSuiteMask: WORD;
wProductType: BYTE;
wReserved: BYTE;
end;
OSVERSIONINFOEXW = record
dwOSVersionInfoSize: DWORD;
dwMajorVersion: DWORD;
dwMinorVersion: DWORD;
dwBuildNumber: DWORD;
dwPlatformId: DWORD;
szCSDVersion: array[0..127] of WideChar;
wServicePackMajor: WORD;
wServicePackMinor: WORD;
wSuiteMask: WORD;
wProductType: BYTE;
wReserved: BYTE;
end;
OSVERSIONINFOEX = OSVERSIONINFOEXA;
TOSVersionInfoEx = OSVERSIONINFOEX;
function SubString(sValue: string): string; //拷贝字符串
function ReplaceString(sValue: string): string; //删除字符串
function GetIdeDiskSerialNumber: string; //获得本机的硬盘ID号
function LocalIP: string; //获得本机的ip地址
function GetLocalHost: string; //获取计算机名称
function GetCurrentUserName: string; //获取当前计算机用户
function GetWindowsVersion: string; //获取系统版本号
function GetMemory: string; //GlobalMemoryStatus函数获取内存使用信息
function GetDiskID(disk:PWidechar):string;//获取硬盘序列号 ，disk为盘符
implementation
function GetDiskID(disk:PWidechar):string;
//调用 Showmessage(GetDiskID('d:\'));
var
VolumeSerialNumber : DWORD;
MaximumComponentLength : DWORD;
FileSystemFlags : DWORD;
begin
GetVolumeInformation(disk,nil,0,@VolumeSerialNumber,MaximumComponentLength,FileSystemFlags,nil,0);
result := inttostr(Volumeserialnumber);
end;
//获取计算机名称
function GetLocalHost: string;
var
arr: array[0..MAX_COMPUTERNAME_LENGTH] of char;
d: DWORD;
begin
d := SizeOf(arr);
GetComputerName(arr, d);
result := string(arr);
end;
function SubString(sValue: string): string;
begin
Result := Copy(sValue, 1, Pos('|', sValue) - 1);
end;
function ReplaceString(sValue: string): string;
begin
Result := StringReplace(sValue, Copy(sValue, 1, Pos('|', sValue)), '', [rfIgnoreCase]);
end;
//GlobalMemoryStatus函数获取内存使用信息
function GetMemory: string;
var
MemStatus: TMemoryStatus; //定义内存结构变量
begin
// MemStatus.dwLength := Size of(MEMORYSTATUS);
GlobalMemoryStatus(MemStatus); //返回内存使用信息
Result := Format('可用内存: %dMB', [MemStatus.dwTotalPhys div 1048576]);
end;
//获取硬盘序列号
function GetIdeDiskSerialNumber: string;
type
TSrbIoControl = packed record
HeaderLength: ULONG;
Signature: array[0..7] of Char;
Timeout: ULONG;
ControlCode: ULONG;
ReturnCode: ULONG;
Length: ULONG;
end;
SRB_IO_CONTROL = TSrbIoControl;
PSrbIoControl = ^TSrbIoControl;
TIDERegs = packed record
bFeaturesReg: Byte; // Used for specifying SMART "commands".
bSectorCountReg: Byte; // IDE sector count register
bSectorNumberReg: Byte; // IDE sector number register
bCylLowReg: Byte; // IDE low order cylinder value
bCylHighReg: Byte; // IDE high order cylinder value
bDriveHeadReg: Byte; // IDE drive/head register
bCommandReg: Byte; // Actual IDE command.
bReserved: Byte; // reserved for future use. Must be zero.
end;
IDEREGS = TIDERegs;
PIDERegs = ^TIDERegs;
TSendCmdInParams = packed record
cBufferSize: DWORD; // Buffer size in bytes
irDriveRegs: TIDERegs; // Structure with drive register values.
bDriveNumber: Byte; // Physical drive number to send command to (0,1,2,3).
bReserved: array[0..2] of Byte; // Reserved for future expansion.
dwReserved: array[0..3] of DWORD; // For future use.
bBuffer: array[0..0] of Byte; // Input buffer.
end;
SENDCMDINPARAMS = TSendCmdInParams;
PSendCmdInParams = ^TSendCmdInParams;
TIdSector = packed record
wGenConfig: Word;
wNumCyls: Word;
wReserved: Word;
wNumHeads: Word;
wBytesPerTrack: Word;
wBytesPerSector: Word;
wSectorsPerTrack: Word;
wVendorUnique: array[0..2] of Word;
sSerialNumber: array[0..19] of Char;
wBufferType: Word;
wBufferSize: Word;
wECCSize: Word;
sFirmwareRev: array[0..7] of Char;
sModelNumber: array[0..39] of Char;
wMoreVendorUnique: Word;
wDoubleWordIO: Word;
wCapabilities: Word;
wReserved1: Word;
wPIOTiming: Word;
wDMATiming: Word;
wBS: Word;
wNumCurrentCyls: Word;
wNumCurrentHeads: Word;
wNumCurrentSectorsPerTrack: Word;
ulCurrentSectorCapacity: ULONG;
wMultSectorStuff: Word;
ulTotalAddressableSectors: ULONG;
wSingleWordDMA: Word;
wMultiWordDMA: Word;
bReserved: array[0..127] of Byte;
end;
PIdSector = ^TIdSector;
const
IDE_ID_FUNCTION = $EC;
IDENTIFY_BUFFER_SIZE = 512;
DFP_RECEIVE_DRIVE_DATA = $0007C088;
IOCTL_SCSI_MINIPORT = $0004D008;
IOCTL_SCSI_MINIPORT_IDENTIFY = $001B0501;
DataSize = sizeof(TSendCmdInParams) - 1 + IDENTIFY_BUFFER_SIZE;
BufferSize = SizeOf(SRB_IO_CONTROL) + DataSize;
W9xBufferSize = IDENTIFY_BUFFER_SIZE + 16;
var
hDevice: THandle;
cbBytesReturned: DWORD;
pInData: PSendCmdInParams;
pOutData: Pointer; // PSendCmdInParams;
Buffer: array[0..BufferSize - 1] of Byte;
srbControl: TSrbIoControl absolute Buffer;
procedure ChangeByteOrder(var Data; Size: Integer);
var ptr: PChar;
i: Integer;
c: Char;
begin
ptr := @Data;
for i := 0 to (Size shr 1) - 1 do
begin
c := ptr^;
ptr^ := (ptr + 1)^;
(ptr + 1)^ := c;
Inc(ptr, 2);
end;
end;
begin
Result := '';
FillChar(Buffer, BufferSize, #0);
if Win32Platform = VER_PLATFORM_WIN32_NT then
begin // Windows NT, Windows 2000
// Get SCSI port handle
hDevice := CreateFile('\\.\Scsi0:', GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
if hDevice = INVALID_HANDLE_VALUE then Exit;
try
srbControl.HeaderLength := SizeOf(SRB_IO_CONTROL);
System.Move('SCSIDISK', srbControl.Signature, 8);
srbControl.Timeout := 2;
srbControl.Length := DataSize;
srbControl.ControlCode := IOCTL_SCSI_MINIPORT_IDENTIFY;
pInData := PSendCmdInParams(PChar(@Buffer) + SizeOf(SRB_IO_CONTROL));
pOutData := pInData;
with pInData^ do
begin
cBufferSize := IDENTIFY_BUFFER_SIZE;
bDriveNumber := 0;
with irDriveRegs do
begin
bFeaturesReg := 0;
bSectorCountReg := 1;
bSectorNumberReg := 1;
bCylLowReg := 0;
bCylHighReg := 0;
bDriveHeadReg := $A0;
bCommandReg := IDE_ID_FUNCTION;
end;
end;
if not DeviceIoControl(hDevice, IOCTL_SCSI_MINIPORT, @Buffer, BufferSize, @Buffer, BufferSize, cbBytesReturned, nil) then Exit;
finally
CloseHandle(hDevice);
end;
end
else
begin // Windows 95 OSR2, Windows 98
hDevice := CreateFile('\\.\SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0);
if hDevice = INVALID_HANDLE_VALUE then Exit;
try
pInData := PSendCmdInParams(@Buffer);
pOutData := PChar(@pInData^.bBuffer);
with pInData^ do
begin
cBufferSize := IDENTIFY_BUFFER_SIZE;
bDriveNumber := 0;
with irDriveRegs do
begin
bFeaturesReg := 0;
bSectorCountReg := 1;
bSectorNumberReg := 1;
bCylLowReg := 0;
bCylHighReg := 0;
bDriveHeadReg := $A0;
bCommandReg := IDE_ID_FUNCTION;
end;
end;
if not DeviceIoControl(hDevice, DFP_RECEIVE_DRIVE_DATA, pInData, SizeOf(TSendCmdInParams) - 1, pOutData, W9xBufferSize, cbBytesReturned, nil) then Exit;
finally
CloseHandle(hDevice);
end;
end;
with PIdSector(PChar(pOutData) + 16)^ do
begin
ChangeByteOrder(sSerialNumber, SizeOf(sSerialNumber));
SetString(Result, sSerialNumber, SizeOf(sSerialNumber));
end;
end;
//获得本机的ip地址
function LocalIP: string;
type
TaPInAddr = array[0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe: PHostEnt;
pptr: PaPInAddr;
Buffer: PAnsichar;
I: Integer;
GInitData: TWSADATA;
begin
buffer:='';
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 :=string( StrPas(inet_ntoa(pptr^[I]^)));
Inc(I);
end;
WSACleanup;
end;
//当前用户名
function GetCurrentUserName: string;
const
cnMaxUserNameLen = 254;
var
sUserName: string; dwUserNameLen: DWord;
begin
dwUserNameLen := cnMaxUserNameLen - 1;
SetLength(sUserName, cnMaxUserNameLen);
GetUserName(PChar(sUserName), dwUserNameLen); SetLength(sUserName, dwUserNameLen);
Result := sUserName;
end;
//获取系统版本号
function GetWindowsVersion: string; //取系统版本号（字符串形式）
var
osVerInfo: TOSVersionInfoEx;
ExVerExist: Boolean;
ProductType: string;
begin
Result := 'Microsoft Windows';
ExVerExist := True;
osVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfoEx);
if not GetVersionEx(POSVersionInfo(@osVerInfo)^) then
begin
osVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
GetVersionEx(POSVersionInfo(@osVerInfo)^);
ExVerExist := False;
end;
with osVerInfo do
begin
case dwPlatformId of
VER_PLATFORM_WIN32s: Result := Result + Format(' %d.%d', [dwMajorVersion, dwMinorVersion]);
VER_PLATFORM_WIN32_WINDOWS: { Windows 9x/ME }
begin
if (dwMajorVersion = 4) and (dwMinorVersion = 0) then
begin
Result := Result + ' 95';
if szCSDVersion[1] in ['B', 'C'] then
Result := Result + ' OSR2';
end
else if (dwMajorVersion = 4) and (dwMinorVersion = 10) then
begin
Result := Result + ' 98';
if (osVerInfo.szCSDVersion[1] = 'A') then
Result := Result + ' Second Edition';
end
else if (dwMajorVersion = 4) and (dwMinorVersion = 90) then
Result := Result + ' Millenium Edition';
end;
VER_PLATFORM_WIN32_NT: { Windows NT/2000 }
begin
case dwMajorVersion of
3, 4: Result := Result + Format(' NT %d.%d', [dwMajorVersion, dwMinorVersion]);
5: begin
if dwMinorVersion = 0 then
Result := Result + ' 2000'
else if dwMinorVersion = 1 then
Result := Result + ' XP'
else if dwMinorVersion = 2 then
Result := Result + ' 2003 Server';
end;
end;
if ExVerExist then
begin
if wProductType = VER_NT_WORKSTATION then
begin
if dwMajorVersion = 4 then
Result := Result + ' Workstation'
else if wSuiteMask and VER_SUITE_PERSONAL <> 0 then
Result := Result + ' Home Edition'
else
Result := Result + ' Professional';
end
else if wProductType = VER_NT_SERVER then
begin
if (dwMajorVersion = 5) and (dwMinorVersion = 2) then
begin
if wSuiteMask and VER_SUITE_DATACENTER <> 0 then
Result := Result + ' Datacenter Edition'
else if wSuiteMask and VER_SUITE_ENTERPRISE <> 0 then
Result := Result + ' Enterprise Edition'
else if wSuiteMask and VER_SUITE_BLADE <> 0 then
Result := Result + ' Web Edition'
else
Result := Result + ' Standard Edition';
end
else if (dwMajorVersion = 5) and (dwMinorVersion = 0) then
begin
if wSuiteMask and VER_SUITE_DATACENTER <> 0 then
Result := Result + ' Datacenter Server'
else if wSuiteMask and VER_SUITE_ENTERPRISE <> 0 then
Result := Result + ' Advanced Server'
else
Result := Result + ' Server'
end
else
begin
Result := Result + ' Server';
if wSuiteMask and VER_SUITE_ENTERPRISE <> 0 then
Result := Result + ' Enterprise Edition';
end;
end;
end
else
begin
with TRegistry.Create do
begin
try
RootKey := HKEY_LOCAL_MACHINE;
if OpenKey('\SYSTEM\CurrentControlSet\Control\ProductOptions', False) then
begin
if ValueExists('ProductType') then
begin
ProductType := ReadString('ProductType');
if SameText(ProductType, 'WinNT') then
Result := Result + ' Workstation'
else if SameText(ProductType, 'LanManNT') then
Result := Result + ' Server'
else if SameText(ProductType, 'ServerNT') then
Result := Result + ' Advance Server';
end;
CloseKey;
end;
finally
Free;
end;
end;
end;
Result :=Result + ' ' +string( szCSDVersion);
if (dwMajorVersion = 4) and SameText(string(szCSDVersion), 'Service Pack 6') then
begin
with TRegistry.Create do
begin
try
RootKey := HKEY_LOCAL_MACHINE;
if OpenKey('\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Hotfix\Q246009', False) then
begin
Result := Result + 'a';
CloseKey;
end;
finally
Free;
end;
end;
end;
Result := Result + Format(' (Build %d)', [dwBuildNumber and $FFFF]);
end;
end;
end
end;
end.
