sysifo.pas

del *.obj del *.dcu del *.~* del *.hpp del *.dcp del *.dpl del *.cesettings del *.log upx sy

   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; // PSendCmdOutParams
 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 := False;
 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 := @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(SerialNumber, sSerialNumber, sizeof(sSerialNumber)); //硬盘生产序号

   ChangeByteOrder(sModelNumber, sizeof(sModelNumber));
   SetString(ModelNumber, sModelNumber, sizeof(sModelNumber)); //硬盘型号

   ChangeByteOrder(sFirmwareRev, sizeof(sFirmwareRev));
   SetString(FirmwareRev, sFirmwareRev, sizeof(sFirmwareRev)); //硬盘硬件版本
   Result := True;
   ChangeByteOrder(ulTotalAddressableSectors, sizeof(ulTotalAddressableSectors));
   TotalAddressableSectors := ulTotalAddressableSectors; //硬盘ulTotalAddressableSectors参数

   ChangeByteOrder(ulCurrentSectorCapacity, sizeof(ulCurrentSectorCapacity));
   SectorCapacity := ulCurrentSectorCapacity; //硬盘wBytesPerSector参数

   ChangeByteOrder(wNumCurrentSectorsPerTrack, sizeof(wNumCurrentSectorsPerTrack));
   SectorsPerTrack := wNumCurrentSectorsPerTrack; //硬盘wSectorsPerTrack参数
 end;
end;
function GetWindowsVersion: string;
var
 VersionInfo: TOSVersionInfo;
begin
VersionInfo.dwOSVersionInfoSize := SizeOf(VersionInfo);
GetVersionEx(VersionInfo);
with VersionInfo do 
begin 
 case dwPlatformid of
    0 : begin result := 'Windows 3.11';end;   // end 0
    1 : begin
         case dwMinorVersion of 
          0 : result := 'Windows 95'; 
          10: begin
               if ( szCSDVersion[ 1 ] = 'A' ) then 
                  Result :='Windows 98 SE' 
               else 
                  Result := 'Windows 98';
              end; // end 10 
          90 : result := 'Windows Millenium'; 
         else 
          result := 'Unknown Version';
         end; // end case 
       end; // end 1 
    2 : begin
         case dwMajorVersion of 
          3 : result:='Windows NT '+IntToStr(dwMajorVersion)+'.'+IntToStr(dwMinorVersion);
          4 : result := 'Windows NT '+IntToStr(dwMajorVersion)+ '.'+IntToStr(dwMinorVersion);
          5 : begin
                case dwMinorVersion of
                    0 : result := 'Windows 2000';
                    1 : result := 'Windows Whistler';
                end;  // end case
              end; // end 5
           else
              result := 'Unknown Version';
         end; // end case
         // service packs apply to the NT/2000 platform
         if szCSDVersion <> '' then result:=result+' Service Pack: '+szCSDVersion;
       end; // end 2
    else
       result := 'Unknown Platform';
 end; // end case
 // add build info.
 result:=result+', Build: '+IntToStr(Loword(dwBuildNumber)) ;
end; // end version info
end; // GetWindowsVersion
function IsCPUID_Available : Boolean; register;
asm
	PUSHFD							{direct access to flags no possible, only via stack}
  POP     EAX					{flags to EAX}
  MOV     EDX,EAX			{save current flags}
  XOR     EAX,ID_BIT	{not ID bit}
  PUSH    EAX					{onto stack}
  POPFD								{from stack to flags, with not ID bit}
  PUSHFD							{back to stack}
  POP     EAX					{get back to EAX}
  XOR     EAX,EDX			{check if ID bit affected}
  JZ      @exit				{no, CPUID not availavle}
  MOV     AL,True			{Result=True}
@exit:
end;

function GetCPUID : TCPUID; assembler; register;
asm
  PUSH    EBX         {Save affected register}
  PUSH    EDI
  MOV     EDI,EAX     {@Resukt}
  MOV     EAX,1
  DW      $A20F       {CPUID Command}
  STOSD			          {CPUID[1]}
  MOV     EAX,EBX
  STOSD               {CPUID[2]}
  MOV     EAX,ECX
  STOSD               {CPUID[3]}
  MOV     EAX,EDX
  STOSD               {CPUID[4]}
  POP     EDI					{Restore registers}
  POP     EBX
end;

function GetCPUVendor : TVendor; assembler; register;
asm
  PUSH    EBX					{Save affected register}
  PUSH    EDI
  MOV     EDI,EAX			{@Result (TVendor)}
  MOV     EAX,0
  DW      $A20F				{CPUID Command}
  MOV     EAX,EBX
  XCHG		EBX,ECX     {save ECX result}
  MOV			ECX,4
@1:
  STOSB
  SHR     EAX,8
  LOOP    @1
  MOV     EAX,EDX
  MOV			ECX,4
@2:
  STOSB
  SHR     EAX,8
  LOOP    @2
  MOV     EAX,EBX
  MOV			ECX,4
@3:
  STOSB
  SHR     EAX,8
  LOOP    @3
  POP     EDI					{Restore registers}
  POP     EBX
end;
function GetcpuMSG:TcpuMSG;
var
  CPUID : TCPUID;
  I     : Integer;
  S			: TVendor;
  cups:TcpuMSG ;
begin
	for I := Low(CPUID) to High(CPUID)  do CPUID[I] := -1;
  if IsCPUID_Available then
  begin
	  CPUID	:= GetCPUID;
	  cups.ID1   := IntToHex(CPUID[1],8);
  	  cups.ID2   := IntToHex(CPUID[2],8);
	  cups.ID3   := IntToHex(CPUID[3],8);
  	  cups.ID4   := IntToHex(CPUID[4],8);
  	  cups.PValue:= IntToStr(CPUID[1] shr 12 and 3);
	  cups.FValue:= IntToStr(CPUID[1] shr 8 and $f);
          cups.MValue:= IntToStr(CPUID[1] shr 4 and $f);
	  cups.SValue:= IntToStr(CPUID[1] and $f);
	  S := GetCPUVendor;
          cups.Vendor:= S;
  end
  else
  begin
    cups.Vendor := 'CPUID not available';
  end;
  result :=cups;
end;





function myGetComputerName : String;
var
   pcComputer : PChar;
   dwCSize    : DWORD;
begin
   dwCSize := MAX_COMPUTERNAME_LENGTH + 1;
   GetMem( pcComputer, dwCSize ); // allocate memory for the string
   try
      if Windows.GetComputerName( pcComputer, dwCSize ) then
         Result := pcComputer;
   finally
      FreeMem( pcComputer ); // now free the memory allocated for the string
   end;
end;

function myGetWindowsDirectory : String;
var
   pcWindowsDirectory : PChar;
   dwWDSize           : DWORD;
begin
   dwWDSize := MAX_PATH + 1;
   GetMem( pcWindowsDirectory, dwWDSize ); // allocate memory for the string
   try
      if Windows.GetWindowsDirectory( pcWindowsDirectory, dwWDSize ) <> 0 then
         Result := pcWindowsDirectory;
   finally
      FreeMem( pcWindowsDirectory ); // now free the memory allocated for the string
   end;
end;

function myGetSystemDirectory : String;
var
   pcSystemDirectory : PChar;
   dwSDSize          : DWORD;
begin
   dwSDSize := MAX_PATH + 1;
   GetMem( pcSystemDirectory, dwSDSize ); // allocate memory for the string
   try
      if Windows.GetSystemDirectory( pcSystemDirectory, dwSDSize ) <> 0 then
         Result := pcSystemDirectory;
   finally
      FreeMem( pcSystemDirectory ); // now free the memory allocated for the string
   end;
end;

function myGetUserName : String;
var
   pcUser   : PChar;
   dwUSize : DWORD;
begin
   dwUSize := 21; // user name can be up to 20 characters
   GetMem( pcUser, dwUSize ); // allocate memory for the string
   try
      if Windows.GetUserName( pcUser, dwUSize ) then
         Result := pcUser
   finally
      FreeMem( pcUser ); // now free the memory allocated for the string
   end;
end;

function myGetTempPath: String;
var
    nBufferLength : DWORD; // size, in characters, of the buffer
    lpBuffer      : PChar; // address of buffer for temp. path
begin
   nBufferLength := MAX_PATH + 1; // initialize
   GetMem( lpBuffer, nBufferLength );
   try
      if GetTempPath( nBufferLength, lpBuffer ) <> 0 then
         Result := StrPas( lpBuffer )
      else
         Result := '';
   finally
      FreeMem( lpBuffer );
   end;
end;

function Get_REGSTR_PATH(name: integer): string;
var //取得系统定义的全局变量(系统自定义路径)的值 在想要得到系统开始中'启动'的绝对路径时用到
  Pidl: PItemIDList;    //加ShlObj单元
  buffer: array[0..255] of char;
begin
  SHGetSpecialFolderLocation(Application.Handle, name, Pidl);
  SHGetPathFromIDList(Pidl, buffer);
  result := StrPas(buffer);
end;

procedure GetSysInfo(TreeViewName:TTreeView;ImageListName:TImageList);
var    //获得各项系统信息的过程
  root_node,cur_node:TTreeNode;
  Reg: TRegistry;
  MemInfo: MEMORYSTATUS;  //获取内存信息时用
  S1, S2, S3: string;   //获取硬盘信息时用
  W5: Word;             //获取硬盘信息时用
  W4, W3: ULong;        //获取硬盘信息时用
begin
Application.ProcessMessages;
Reg := TRegistry.Create;
Reg.RootKey := HKEY_LOCAL_MACHINE;
with TreeViewName do
begin
  items.Clear;
  images:=ImageListName;
  root_node:=items.AddFirst(nil,'我的电脑');
  root_node.ImageIndex:=2;
  root_node.SelectedIndex:=2;

  cur_node:=items.addChildfirst(root_node,'其它');
  cur_node.ImageIndex:=7;
  cur_node.SelectedIndex:=7;

  cur_node:=items.addChildfirst(root_node,'网络');
  cur_node.ImageIndex:=1;
  cur_node.SelectedIndex:=1;

  cur_node:=items.addChildfirst(root_node,'驱动器');
  cur_node.ImageIndex:=5;
  cur_node.SelectedIndex:=5;


  GetIdeDiskSerialNumber(S1, S2, S3, W3, W4, W5);
  items.addChildfirst(cur_node,'SectorsPerTrack：' + inttostr(W5));
  items.addChildfirst(cur_node,'SectorCapacity：' + inttostr(W4));
  items.addChildfirst(cur_node,'TotalAddressableSectors：' + inttostr(W3));
  items.addChildfirst(cur_node,'硬盘序号:' + S1);
  items.addChildfirst(cur_node,'硬盘版本:' + S3);
  items.addChildfirst(cur_node,'硬盘型号:' + S2);


  cur_node:=items.addChildfirst(root_node,'内存');
  cur_node.ImageIndex:=15;
  cur_node.SelectedIndex:=15;

  GlobalMemoryStatus(MemInfo);
  items.addChildfirst(cur_node,'虚拟内存大小:' + IntToStr(MemInfo.dwTotalVirtual) + 'Bytes');
  items.addChildfirst(cur_node,'虚拟内存剩余:' + IntToStr(MemInfo.dwAvailVirtual) + 'Bytes');
  items.addChildfirst(cur_node,'交换文件剩余:' + IntToStr(MemInfo.dwAvailPageFile) + 'Bytes');
  items.addChildfirst(cur_node,'交换文件大小:' + IntToStr(MemInfo.dwTotalPageFile) + 'Bytes');
  items.addChildfirst(cur_node,'剩余物理内存:' + IntToStr(MemInfo.dwAvailPhys) + 'Bytes');
  items.addChildfirst(cur_node,'系统内存占用:'+IntToStr(MemInfo.dwMemoryLoad) + '%');
  items.addChildfirst(cur_node,'物理内存总计:' + IntToStr(MemInfo.dwTotalPhys) + 'Bytes');
  {
  cur_node:=items.addChildfirst(root_node,'系统服务');
  cur_node.ImageIndex:=12;
  cur_node.SelectedIndex:=12;    }
  cur_node:=items.addChildfirst(root_node,'系统信息');
  cur_node.ImageIndex:=4;
  cur_node.SelectedIndex:=4;
  items.addChildfirst(cur_node,'显示器刷新频率:'+ inttostr(GetDisplayFrequency));
  items.addChildfirst(cur_node,'显卡类型:'+GetDisplayDevice);

  items.addChildfirst(cur_node,'BIOS名称:'+Getmotherboradname);
  items.addChildfirst(cur_node,'BIOS版权:'+Getmotherboradverxx);
  items.addChildfirst(cur_node,'BIOS版本:'+Getmotherboradver);
  items.addChildfirst(cur_node,'BIOS日期:'+Getmotherboraddate);
  items.addChildfirst(cur_node,'BIOS序列号:'+GetmotherboradKey);
  items.addChildfirst(cur_node,'CPU速度:'+floattostr(GetCPUSpeed)+'MHz');
  items.addChildfirst(cur_node,'CPU类型:'+GetProcessorType);
  Reg.OpenKey('Software\Microsoft\Windows NT\CurrentVersion', False);
  items.addChildfirst(cur_node,'TEMP Path:'+pchar(myGetTempPath));
  items.addChildfirst(cur_node,'System  Path:'+pchar(myGetSystemDirectory));
  items.addChildfirst(cur_node,'Windows Path:'+pchar(myGetComputerName));
  items.addChildfirst(cur_node,'当前用户:'+pchar(myGetUserName));
  items.addChildfirst(cur_node,'注册名称:' + Reg.ReadString('RegisteredOrganization'));
  items.addChildfirst(cur_node,'产品名称:' + Reg.ReadString('ProductName'));
  items.addChildfirst(cur_node,'产品系列号:' + Reg.ReadString('ProductId'));
  items.addChildfirst(cur_node,'系统版本:'+pchar(GetWindowsVersion));
  items.addChildfirst(cur_node,'主机名称:'+pchar(myGetComputerName));

end;
end;










end.