computerinfo.pas

木马源程序,供大家研究

       Free

    end;

  end;

end;

function GetCPUInfo: TCPUInfo;

const

  Key = 'HARDWARE\DESCRIPTION\System\CentralProcessor\';

var

  hkey: Windows.hkey;

  dwDataSize: DWORD;

  dwType: DWORD;

  dwCpuUsage: DWORD;

  SysPerfInfo: TSYSTEM_PERFORMANCE_INFORMATION;

  SysTimeInfo: TSYSTEM_TIME_INFORMATION;

  SysBaseInfo: TSYSTEM_BASIC_INFORMATION;

  dbIdleTime: double;

  dbSystemTime: double;

  status: LongInt;

  liOldIdleTime: LARGE_INTEGER;         //= (*0,0*);

  liOldSystemTime: LARGE_INTEGER;       // = (*0,0*);

  ReturnLength: ULONG;

  I : LongInt;

  S : TStrings;

begin

  S := TStringList.Create;

  with TRegistry.Create do

  begin

    try

      RootKey := HKEY_LOCAL_MACHINE;

      OpenKey(Key, False);

      (*检测注册表里有几个CPU记录*)

      GetKeyNames(S);

      SetLength(Result.CPUs, S.Count);

      for I := 0 to S.Count - 1 do

        Result.CPUs[I] := GetCPURec(I+1);

      CloseKey;

    finally

      S.Free;

      free;

    end;

  end;

  Result.CPUUsage := Byte(-1);

  If Win32Platform = VER_PLATFORM_WIN32_NT then

  begin

    liOldIdleTime.QuadPart:= 0;

    liOldSystemTime.QuadPart:= 0;

    IF not Assigned(NtQuerySystemInformation) then Exit;

    (*得到CPU的数量*)

    status := NtQuerySystemInformation(SystemBasicInformation,

      SysBaseInfo, SizeOf(SysBaseInfo), ReturnLength);

    If status <> NO_ERROR then Exit;

    Result.CPUCount:= SysBaseInfo.bKeNumberProcessors;

    for I:= 0 to 1 do

    begin

      (*返回新的系统时间*)

      status:= NtQuerySystemInformation(SystemTimeInformation, SysTimeInfo,

         SizeOf(SysTimeInfo), ReturnLength);

      If status <> NO_ERROR then Exit;

      (*返回新的CPU空闲时间*)

      status:= NtQuerySystemInformation(SystemPerformanceInformation,

        SysPerfInfo, SizeOf(SysPerfInfo), ReturnLength);


      If status <> NO_ERROR then Exit;

      // if it's a first call - skip it

      If liOldIdleTime.QuadPart <> 0 then

      begin

        // CurrentValue = NewValue - OldValue

        dbIdleTime:= SysPerfInfo.liIdleTime.QuadPart - liOldIdleTime.QuadPart;

        dbSystemTime:= SysTimeInfo.liKeSystemTime.QuadPart - liOldSystemTime.QuadPart;


        // CurrentCpuIdle = IdleTime / SystemTime

        dbIdleTime:= dbIdleTime / dbSystemTime;


        // CurrentCpuUsage% = 100 - (CurrentCpuIdle * 100) / NumberOfProcessors

        dbIdleTime:= 100.0 - dbIdleTime * 100.0 / SysBaseInfo.bKeNumberProcessors + 0.5;

        Result.CPUUsage:= Round(dbIdleTime);

      end;


      // store new CPU's idle and system time

      liOldIdleTime:= SysPerfInfo.liIdleTime;

      liOldSystemTime:= SysTimeInfo.liKeSystemTime;

      Sleep(500);

    end;

  end

  else begin

    Result.CPUCount := 1;

    If RegOpenKeyEx(HKEY_DYN_DATA, 'PerfStats\StartStat',

      0, KEY_ALL_ACCESS, hkey) <> ERROR_SUCCESS Then Exit;

    dwDataSize:= SizeOf(DWORD);

    RegQueryValueEx(hkey, 'KERNEL\CPUUsage', nil, @dwType,

      @dwCpuUsage, @dwDataSize);

    RegCloseKey(hkey);


    // geting current counter's value

    If RegOpenKeyEx(HKEY_DYN_DATA, 'PerfStats\StatData',

      0, KEY_READ, hkey) <> ERROR_SUCCESS then Exit;

    dwDataSize:= SizeOf(DWORD);

    RegQueryValueEx(hkey, 'KERNEL\CPUUsage', nil, @dwType,

      @dwCpuUsage, @dwDataSize);

    Result.CPUUsage:= dwCpuUsage;

    RegCloseKey(hkey);

    // stoping the counter

    If RegOpenKeyEx(HKEY_DYN_DATA, 'PerfStats\StopStat', 0, KEY_ALL_ACCESS,

      hkey) <> ERROR_SUCCESS then Exit;

    dwDataSize:= SizeOf(DWORD);

    RegQueryValueEx(hkey, 'KERNEL\CPUUsage', nil, @dwType,

      @dwCpuUsage, @dwDataSize);

    RegCloseKey(hkey);

  end;

end;

function GetKeyBoardTypeName: String;

begin

  {获取键盘类型}

  case getkeyboardtype(0) of

    1:  result := 'IBM PC/XT 或兼容类型(83键)';

    2:  result := 'Olivetti "ICO"(102键)';

    3:  result := 'IBM PC/AT(84键)';

    4:  result := 'IBM 增强型(101或102键)或Microsoft自然键盘';

    5:  result := 'Nokia 1050';

    6:  result := 'Nokia 9140';

    7:  result := 'Japanese';

  end;

end;

function GetKeyboardState:TKeyboardState;

begin

  result := [];

  if lo(GetKeyState(VK_NUMLOCK)) = 1 then

    Include(result, ksNumLock);

  if lo(GetKeyState(VK_CAPITAL)) = 1 then

    Include(result, ksCapsLock);

  if lo(GetKeyState(VK_LSHIFT)) = 1 then

    Include(result, ksLeftShift);

  if lo(GetKeyState(VK_RSHIFT)) = 1 then

    Include(result, ksRightShift);

  if lo(GetKeyState(VK_LCONTROL)) = 1 then

    Include(result, ksLeftCtrl);

  if lo(GetKeyState(VK_RCONTROL)) = 1 then

    Include(result, ksRightCtrl);

  if lo(GetKeyState(VK_LMENU)) = 1 then

    Include(result, ksLeftAlt);

  if lo(GetKeyState(VK_RMENU)) = 1 then

    Include(result, ksRightAlt);

  if lo(GetKeyState(VK_LWIN)) = 1 then

    Include(result, ksLeftWin);

  if lo(GetKeyState(VK_RWIN)) = 1 then

    Include(result, ksRightWin);

end;


function GetKeyboardInfo : TKeyboardInfo;

begin

  with Result do

  begin

    SystemParametersInfo(SPI_GETKEYBOARDDELAY, 0, @Delay, 0);

    SystemParametersInfo(SPI_GETKEYBOARDSPEED, 0, @Speed, 0);

    NumLock := lo(GetKeyState(VK_NUMLOCK)) = 1;

    CapsLock:= lo(GetKeyState(VK_CAPITAL)) = 1;

    ScrollLock := lo(GetKeyState(VK_SCROLL)) = 1;

    Types := GetKeyboardType(0);

    SubType := GetKeyboardType(1);

    FunctionKeys := GetKeyboardType(2);

    SetLength(Layout, KL_NAMELENGTH);

    GetKeyboardLayoutName(Pchar(Layout));

    CaretBlinkTime:= GetCaretBlinkTime;

    Result.TypeStr := GetKeyBoardTypeName;

  end;

end;

function GetMouseInfo : TMouseInfo;

const

  Key1 = '\SOFTWARE\Microsoft\Windows\CurrentVersion\Control Panel\Cursors\Schemes';

  Key2 = '\SYSTEM\CurrentControlSet\Control\Class\(*4D36E96F-E325-11CE-BFC1-08002BE10318*)\0000';

  Key3 = '\Control Panel\Cursors';

var

  I: Integer;

begin

  with Result do

  begin

    Exist:= Boolean(GetSystemMetrics(SM_MOUSEPRESENT));

    Btns:= GetSystemMetrics(SM_CMOUSEBUTTONS);

    Wheel:= Boolean(GetSystemMetrics(SM_MOUSEWHEELPRESENT));

    SwapBtns:= Boolean(GetSystemMetrics(SM_SWAPBUTTON));

    DoubleClickTime:= GetDoubleClickTime;

    SystemParametersInfo(SPI_GETSNAPTODEFBUTTON, 0, @SnapToDefault, 0);

    SystemParametersInfo(SPI_GETMOUSESPEED, 0, @Speed, 0);

    DblClickWidth:= GetSystemMetrics(SM_CXDOUBLECLK);

    DblClickHeight:= GetSystemMetrics(SM_CYDOUBLECLK);

    with TRegistry.Create do

    begin

      CursorSchemes := TStringlist.Create;

      CurSchemeFiles := TStringlist.Create;

      RootKey := HKEY_LOCAL_MACHINE;

      If KeyExists(Key2) Then

      begin

        OpenKey(Key2,false);

        Result.Comment := ReadString('DriverDesc');

      end;

      If OpenKey(Key1, False) then

      begin

        GetValueNames(CursorSchemes);

        for i:= 0 to CursorSchemes.Count - 1 do

          CurSchemeFiles.Add(ReadString(CursorSchemes[i]));

        CloseKey;

      end;

      RootKey := HKEY_CURRENT_USER;

      If OpenKey(key3, False) then

      begin

        CursorScheme := ReadString('');

        CloseKey;

      end;

      Free;

    end;

  end;

end;

function GetUninstallInfo : TUninstallInfo;

const

  Key = '\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\';

var

  S : TStrings;

  I : Integer;

  J : Integer;

begin

  with TRegistry.Create do

  begin

    S := TStringlist.Create;

    J := 0;

    try

      RootKey:= HKEY_LOCAL_MACHINE;

      OpenKeyReadOnly(Key);

      GetKeyNames(S);

      Setlength(Result, S.Count);

      for I:= 0 to S.Count - 1 do

      begin

        If OpenKeyReadOnly(Key + S[I]) then

        If ValueExists('DisplayName') and ValueExists('UninstallString') then

        begin

          Result[J].RegProgramName:= S[I];

          Result[J].ProgramName:= ReadString('DisplayName');

          Result[J].UninstallPath:= ReadString('UninstallString');

          If ValueExists('Publisher') then

            Result[J].Publisher:= ReadString('Publisher');

          If ValueExists('URLInfoAbout') then

            Result[J].PublisherURL:= ReadString('URLInfoAbout');

          If ValueExists('DisplayVersion') then

            Result[J].Version:= ReadString('DisplayVersion');

          If ValueExists('HelpLink') then

            Result[J].HelpLink:= ReadString('HelpLink');

          If ValueExists('URLUpdateInfo') then

            Result[J].UpdateInfoURL:= ReadString('URLUpdateInfo');

          If ValueExists('RegCompany') then

            Result[J].RegCompany:= ReadString('RegCompany');

          If ValueExists('RegOwner') then

            Result[J].RegOwner:= ReadString('RegOwner');

          Inc(J);

        end;

      end;

    finally

      Free;

      S.Free;

      SetLength(Result, J);

    end;

  end;

end;


const

  // 用于描述系统文件夹的前缀常量

  SystemFolderNames : array[0..19] of string = (

    '程序',

    '我的文档',

    '收藏夹',

    '启动',

    '文档',

    '发送到...',

    '开始',

    '桌面',

    '网上邻居',

    '字体',

    'Templates',

    '开始(所有用户)',

    '程序(所有用户)',

    '启动(所有用户)',

    '桌面(所有用户)',

    'Application Data',

    'Windows目录',

    '系统目录',

    'Program Files目录',

    '临时文件夹'

  );

  SystemFolderPaths : array [0..15] of Integer = (

    02,  (*开始->程序*)

    05,  (*我的文档*)

    06,  (*收藏夹*)

    07,  (*开始->程序->启动*)

    08,  (*开始->文档*)

    09,  (*发送到...*)

    11,  (*开始菜单*)

    16,  (*桌面目录*)

    19,  (*网上邻居*)

    20,  (*字体*)

    21,  (*模板目录*)

    22,  (*所有用户的开始菜单*)

    23,  (*所有用户的开始->程序*)

    24,  (*所有用户的开始->程序-启动*)

    25,  (*所有用户的桌面*)

    26   (*Application Data*)

  );


function GetSystemFolders: TSysFolders;

var

  I : Integer;

  P : pItemIDList;

begin

  SetLength(Result, 20);

  try

    for I := 0 to 19 do

    begin

      Result[I].Name  := SystemFolderNames[I];

      SetLength(Result[I].Path, 255);

    end;

    for I := 0 to 15 do

    begin

      If SHGetSpecialFolderLocation(0, SystemFolderPaths[I], p) <> NOERROR then Continue;

      If p = nil then Continue;

      SHGetPathFromIDList(p, PChar(Result[I].Path));

    end;

    GetWindowsDirectory(PChar(Result[16].Path), 255);

    GetSystemDirectory(PChar(Result[17].Path), 255);

    with TRegistry.Create do

    begin

      RootKey := HKEY_LOCAL_MACHINE;

      If OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion', False) Then

        Result[18].Path := ReadString('ProgramFilesDir');

      CloseKey;

      Free;

    end;

    GetTempPath(255, PChar(Result[19].Path));

  except

    exit;

  end;

end;

function GetWindowInfo : TWindowInfo;

const

  Key9x = '\SOFTWARE\Microsoft\Windows\CurrentVersion';

  KeyNt = '\SOFTWARE\Microsoft\Windows NT\CurrentVersion';

var

  osVerInfo : TOSVersionInfo;

  sys: TSystemTime;

begin

  with TRegistry.Create do

  begin

    RootKey := HKEY_LOCAL_MACHINE;

    If Win32PlatForm = VER_PLATFORM_WIN32_NT then

      OpenKey(KeyNt, False)

      else OpenKey(Key9x, False);

    Result.RegisteredOwner := ReadString('RegisteredOwner');

    Result.RegisteredCompany := ReadString('RegisteredOrganization');

    Result.ProductID := ReadString('ProductID');

    Result.ProductName := ReadString('ProductName');

    Result.Version := ReadString('CurrentVersion');

    CloseKey;

    Free;

  end;

  osVerInfo.dwOSVersionInfoSize:= SizeOf(osVerInfo);

  GetVersionEx(osVerInfo);

  with osVerInfo do

  begin

    Result.CSDVersion :=  szCSDVersion;

    Result.BuildNumber := dwBuildNumber;

    Result.PlatformID :=  dwPlatformId;

    Result.MajorVersion := dwMajorVersion;