WindowFunc

unit WindowFunc;

interface


uses
  SysUtils, Windows, dialogs, winsock, Classes, ComObj, WinInet,
  Variants, Graphics, NB30, Registry, ShellAPI;

type
  TMemoryStatusEx = packed record
    dwLength: DWORD;
    dwMemoryLoad: DWORD;
    ullTotalPhys: Int64;
    ullAvailPhys: Int64;
    ullTotalPageFile: Int64;
    ullAvailPageFile: Int64;
    ullTotalVirtual: Int64;
    ullAvailVirtual: Int64;
    ullAvailExtendedVirtual: Int64;
  end;

function GlobalMemoryStatusEx(var lpBuffer: TMemoryStatusEx): BOOL; stdcall; external kernel32;

//取本机的计算机名
function GetComputerName(): string;

//取本机的 IP 地址
function ComputerLocalIP: string;

//取Windows登录用户名
function WinUserName: string;

//取本机的 mac 地址
function GetMACAdress: string;

//屏幕分辨率
function GetScreenMetrics(): string;

//获取IE版本号，如果本机没有安装ie，则返回空字符串
function GetIEVersionStr: string;

//获取CPU
function GetCPUStr: string;

// 获取内存使用信息
function GetMemoryStatus: string;

function GetMemoryStatus2: string;

//获取windows版本信息
function GetOSVersion: string;

function GetWindowsVersion: string;

implementation

{-------------------------------------------------------------}

function GetComputerName(): string;
var
  FStr: PChar;
  FSize: Cardinal;
begin
  try
    FSize := 255;
    GetMem(FStr, FSize);
    Windows.GetComputerName(FStr, FSize);
    Result := FStr;
    FreeMem(FStr);
  except
    Result := '';
  end;
end;


//取本机的 IP 地址

function ComputerLocalIP: string;
var
  ch: array[1..32] of char;
  wsData: TWSAData;
  myHost: PHostEnt;
  i: integer;
begin
  Result := '';
  if WSAstartup(2, wsData) <> 0 then Exit; // can’t start winsock
  try
    if GetHostName(@ch[1], 32) <> 0 then Exit; // getHostName failed
  except
    Exit;
  end;
  myHost := GetHostByName(@ch[1]); // GetHostName error
  if myHost = nil then exit;
  for i := 1 to 4 do
  begin
    Result := Result + IntToStr(Ord(myHost.h_addr^[i - 1]));
    if i < 4 then
      Result := Result + '.';
  end;
end;

//取Windows登录用户名
{ WinUserName }

function WinUserName: string;
var
  FStr: PChar;
  FSize: Cardinal;
begin
  FSize := 255;
  GetMem(FStr, FSize);
  GetUserName(FStr, FSize);
  Result := FStr;
  FreeMem(FStr);
end;

function GetMACAdress: string; //uses NB30;
var
  NCB: PNCB;
  Adapter: PAdapterStatus;
  URetCode: PAnsiChar;
  RetCode: AnsiChar;
  I: integer;
  Lenum: PlanaEnum;
  _SystemID: string;
  TMPSTR: string;
begin
  Result := '';
  _SystemID := '';
  Getmem(NCB, SizeOf(TNCB));
  Fillchar(NCB^, SizeOf(TNCB), 0);

  Getmem(Lenum, SizeOf(TLanaEnum));
  Fillchar(Lenum^, SizeOf(TLanaEnum), 0);

  Getmem(Adapter, SizeOf(TAdapterStatus));
  Fillchar(Adapter^, SizeOf(TAdapterStatus), 0);

  Lenum.Length := chr(0);
  NCB.ncb_command := chr(NCBENUM);
  NCB.ncb_buffer := Pointer(Lenum);
  NCB.ncb_length := SizeOf(Lenum);
  RetCode := Netbios(NCB);

  i := 0;
  repeat
    Fillchar(NCB^, SizeOf(TNCB), 0);
    Ncb.ncb_command := chr(NCBRESET);
    Ncb.ncb_lana_num := lenum.lana[I];
    RetCode := Netbios(Ncb);

    Fillchar(NCB^, SizeOf(TNCB), 0);
    Ncb.ncb_command := chr(NCBASTAT);
    Ncb.ncb_lana_num := lenum.lana[I];
    // Must be 16
    Ncb.ncb_callname := ('*');

    Ncb.ncb_buffer := Pointer(Adapter);

    Ncb.ncb_length := SizeOf(TAdapterStatus);
    RetCode := Netbios(Ncb);
    //---- calc _systemId from mac-address[2-5] XOR mac-address[1]...
    if (RetCode = chr(0)) or (RetCode = chr(6)) then
    begin
      _SystemId := IntToHex(Ord(Adapter.adapter_address[0]), 2) + '-' +
        IntToHex(Ord(Adapter.adapter_address[1]), 2) + '-' +
        IntToHex(Ord(Adapter.adapter_address[2]), 2) + '-' +
        IntToHex(Ord(Adapter.adapter_address[3]), 2) + '-' +
        IntToHex(Ord(Adapter.adapter_address[4]), 2) + '-' +
        IntToHex(Ord(Adapter.adapter_address[5]), 2);
    end;
    Inc(i);
  until (I >= Ord(Lenum.Length)) or (_SystemID <> '00-00-00-00-00-00');
  FreeMem(NCB);
  FreeMem(Adapter);
  FreeMem(Lenum);
  GetMacAdress := _SystemID;
end;


function GetScreenMetrics: string;
var
  pixW, pixH: Integer;
  msg: string;
begin
  pixW := GetSystemMetrics(SM_CXSCREEN);
  pixH := GetSystemMetrics(SM_CYSCREEN);
  msg := IntToStr(pixW) + 'X' + IntToStr(pixH);
  Result := msg;
end;

function GetIEVersionStr: string;
var
  Reg: Registry.TRegistry; // registry access object
begin
  Result := '';
  Reg := Registry.TRegistry.Create;
  try
    Reg.RootKey := Windows.HKEY_LOCAL_MACHINE;
    if Reg.OpenKeyReadOnly('Software\Microsoft\Internet Explorer') then
    begin
      if Reg.ValueExists('Version') then
        Result := 'IE ' + Reg.ReadString('Version');
    end;
  finally
    Reg.Free;
  end;
end;


function GetCPUStr: string;
var
  SysInfo: TSYSTEMINFO;
  Lbl_CPUName: string;
begin
  GetSystemInfo(SysInfo); //获得CPU信息
  Lbl_CPUName := 'CPU个数:' + IntToStr(Sysinfo.dwNumberOfProcessors)
    + ',CPU类型:' + IntToStr(Sysinfo.dwProcessorType);
  Result := Lbl_CPUName;
end;

function GetOSVersion: string;
var
  OSVI: OSVERSIONINFO;
begin
  OSVI.dwOSversioninfoSize := Sizeof(OSVERSIONINFO);
  GetVersionEx(OSVI);
  Result := IntToStr(OSVI.dwMinorVersion) + ','
    + IntToStr(OSVI.dwMinorVersion) + ','
    + IntToStr(OSVI.dwBuildNumber) + ','
    + IntToStr(OSVI.dwPlatformId) + ','
    + OSVI.szCSDVersion;
end;

//有问题：超过2G内存显示2G；
function GetMemoryStatus: string;
var
  MemInfo: MEMORYSTATUS;
begin
  MemInfo.dwLength := sizeof(MEMORYSTATUS);
  GlobalMemoryStatus(MemInfo);
 { 详细情况：
 Result := IntToStr(MemInfo.dwMemoryLoad)+'%的内存正在使用,'
 +'可使用的物理内存有'+IntToStr(MemInfo.dwAvailPhys)+'字节,'
 +'交换文件总大小为'+IntToStr(MemInfo.dwTotalPageFile)+'字节,'
 +'尚可交换文件大小为'+IntToStr(MemInfo.dwAvailPageFile)+'字节,'
 +'总虚拟内存有'+IntToStr(MemInfo.dwTotalVirtual)+'字节,'
 +'未用虚拟内存有'+IntToStr(MemInfo.dwAvailVirtual)+'字节';
 }
  Result := format('共有内存: %d MB,可用内存:%d MB',
    [MemInfo.dwTotalPhys div (1024 * 1024), MemInfo.dwAvailPhys div (1024 * 1024)]);

end;

//可用
function GetMemoryStatus2: string;
var
  MemoryStatusEx: TMemoryStatusEx;
begin
  MemoryStatusEx.dwLength := SizeOf(MemoryStatusEx);
  GlobalMemoryStatusEx(MemoryStatusEx);
  Result := format('物理内存总数: %d MB,可用内存:%d MB',
    [MemoryStatusEx.ullTotalPhys div (1024 * 1024), MemoryStatusEx.ullAvailPhys div (1024 * 1024)]);
  {
  //Result := FormatFloat('#,###', MemoryStatusEx.ullTotalPhys div (1024 * 1024));
  //如果真实内存超过4G  会显示真实内存 上限为3.5G。
  //当然 如果机器为64位会真实显示
  }
end;

function GetWindowsVersionString: AnsiString;
var
  VI: TOSVersionInfoA;
begin
  // 读取操作系统版本号
  VI.dwOSVersionInfoSize := SizeOf(TOSVersionInfoA);
  if GetVersionExA(VI) then
    with VI do
      Result := Trim(Format('%d.%d build %d %s',
        [dwMajorVersion, dwMinorVersion, dwBuildNumber, szCSDVersion]))
  else
    Result := '';
end;

function GetWindowsVersion: string;
var
  AWin32Version: Extended;
  os: string;
begin
  // 读取操作系统版本
  os := 'Windows ';
  AWin32Version := StrtoFloat(Format('%d.%d',
    [Win32MajorVersion, Win32MinorVersion]));

  case Win32Platform of
    VER_PLATFORM_WIN32s: Result := os + '32';
    VER_PLATFORM_WIN32_WINDOWS:
      begin
        if AWin32Version = 4.0 then
          Result := os + '95'
        else if AWin32Version = 4.1 then
          Result := os + '98'
        else if AWin32Version = 4.9 then
          Result := os + 'Me'
        else
          Result := os + '9x';
      end;
    VER_PLATFORM_WIN32_NT:
      begin
        if AWin32Version = 3.51 then
          Result := os + 'NT 3.51'
        else if AWin32Version = 4.0 then
          Result := os + 'NT 4.0'
        else if AWin32Version = 5.0 then
          Result := os + '2000'
        else if AWin32Version = 5.1 then
          Result := os + 'XP'
        else if AWin32Version = 5.2 then
          Result := os + '2003'
        else if AWin32Version = 6.0 then
          Result := os + 'Vista'
        else if AWin32Version = 6.1 then
          Result := os + '7'
        else
          Result := os;
      end;
  else Result := os + '??';
  end;

  Result := Result + '  ' + GetWIndowsVersionString;
end;







end.