{
    ****************Delphi常用获取系统信息的函数*********************}///unit untFunctionSysInfo;interfaceusesWindows, SysUtils, ShellAPI, WinSock, Registry;constVER_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;typePOSVersionInfoEx = ^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函数获取内存使用信息implementation{
    ****************常用的获取计算机系统信息*********************}//获取计算机名称function GetLocalHost: string;varComputername: Pchar;Size: cardinal;beginSize := MAX_COMPUTERNAME_LENGTH + 1;Getmem(Computername, Size);if Getcomputername(Computername, Size) then    result := StrPas(Computername)else    result := '';Freemem(Computername);end;function SubString(sValue: string): string;beginResult := Copy(sValue, 1, Pos('|', sValue) - 1);end;function ReplaceString(sValue: string): string;beginResult := StringReplace(sValue, Copy(sValue, 1, Pos('|', sValue)), '', [rfIgnoreCase]);end;//GlobalMemoryStatus函数获取内存使用信息function GetMemory: string;varMemStatus: TMemoryStatus; //定义内存结构变量begin// MemStatus.dwLength := Size of(MEMORYSTATUS);GlobalMemoryStatus(MemStatus); //返回内存使用信息Result := Format('可用内存: %dMB', [MemStatus.dwTotalPhys div 1048576]);end;//获取硬盘序列号function GetIdeDiskSerialNumber: string;typeTSrbIoControl = 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;constIDE_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;varhDevice: 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;beginResult := '';FillChar(Buffer, BufferSize, #0);if Win32Platform = VER_PLATFORM_WIN32_NT thenbegin // 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;endelsebegin // 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)^ dobegin    ChangeByteOrder(sSerialNumber, SizeOf(sSerialNumber));    SetString(Result, sSerialNumber, SizeOf(sSerialNumber));end;end;//获得本机的ip地址function LocalIP: string;typeTaPInAddr = array[0..10] of PInAddr;PaPInAddr = ^TaPInAddr;varphe: PHostEnt;pptr: PaPInAddr;Buffer: array[0..63] of char;I: Integer;GInitData: TWSADATA;beginWSAStartup($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;//当前用户名function GetCurrentUserName: string;constcnMaxUserNameLen = 254;varsUserName: string; dwUserNameLen: DWord;begindwUserNameLen := cnMaxUserNameLen - 1;SetLength(sUserName, cnMaxUserNameLen);GetUserName(PChar(sUserName), dwUserNameLen); SetLength(sUserName, dwUserNameLen);Result := sUserName;end;//获取系统版本号function GetWindowsVersion: string; //取系统版本号（字符串形式）varosVerInfo: TOSVersionInfoEx;ExVerExist: Boolean;ProductType: string;beginResult := 'Microsoft Windows';ExVerExist := True;osVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfoEx);if not GetVersionEx(POSVersionInfo(@osVerInfo)^) thenbegin    osVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);    GetVersionEx(POSVersionInfo(@osVerInfo)^);    ExVerExist := False;end;with osVerInfo dobegin    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 + ' ' + szCSDVersion;          if (dwMajorVersion = 4) and SameText(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;endend;