zoukankan      html  css  js  c++  java
  • 获取硬件信息的delphi源码CPUID、操作系统、Mac物理地址、计算机名称、IP地址、用户名

    {-----------------------------------------------------------------------------
    作者:sushengmiyan 2013.01.26
    备注:
    功能:硬件信息获取单元
    -----------------------------------------------------------------------------}

    unit ApplicationHardWareInfo;

    interface
    uses
    Windows, SysUtils, Classes, Registry, Nb30, WinSock;

    type
    TCPUID = array[1..4] of Longint;
    function GetCPUID: TCPUID; assembler; register;
    type

    //CPUID信息类
    TCPUIDInfo = class
    private
    FCPUID: TCPUID;
    FCPUIDStr: string;
    procedure SetCPU(AHandle: THandle; CpuNo: Integer);
    function CPUIDTostr(ACPUID: TCPUID): string;
    function GetComputerBasicFrequency: string;
    function GetCPUType: string;
    public
    function GetCPUIDstr: string;
    property CPUFrequency: string read GetComputerBasicFrequency;
    property ProcessorType: string read GetCPUType;
    constructor Create;
    end;

    //mac地址信息类
    TMacAdressInfo = class
    private
    FMacAdress: string;
    function GetMacPhysicalAddress(Alana: Integer = 0): string;
    function GetMacAddress: string;
    public
    property MacAdrress: string read GetMacAddress;
    constructor Create;
    end;

    //用户信息类
    TPCUserInfo = class
    private
    function GetUserName: string;
    function GetHostIP: string;
    function GetWindowsVertion: string;
    public
    property UserName: string read GetUserName;
    property HostIP: string read GetHostIP;
    property WindowsVertion: string read GetWindowsVertion;
    constructor Create;
    end;

    implementation

    { TCPUIDInfo }
    {-----------------------------------------------------------------------------
    作者:sushengmiyan 2013.01.26
    参数:None
    返回:TCPUID
    功能:汇编方式获取CPUID
    -----------------------------------------------------------------------------}

    function GetCPUID: TCPUID;
    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;

    {-----------------------------------------------------------------------------
    作者:sushengmiyan 2013.01.26
    参数:ACPUID: TCPUID
    返回:string
    功能:将十六进制的CPUID转换为字符串
    -----------------------------------------------------------------------------}

    function TCPUIDInfo.CPUIDTostr(ACPUID: TCPUID): string;
    begin
    Result := '';
    Result := IntToHex(ACPUID[1] , 8) + IntToHex(ACPUID[2] , 8) + IntToHex(ACPUID[3]
    , 8) + IntToHex(ACPUID[4] , 8);
    end;

    {-----------------------------------------------------------------------------
    作者:sushengmiyan 2013.01.26
    参数:None
    返回:string
    功能:处理器类型
    -----------------------------------------------------------------------------}

    function TCPUIDInfo.GetCPUType: string;
    var
    systeminfo: SYSTEM_INFO;
    begin
    //获得CPU型号
    GetSystemInfo(systeminfo);
    Result := IntToStr(systeminfo.dwProcessorType)
    end;

    {-----------------------------------------------------------------------------
    作者:sushengmiyan 2013.01.26
    参数:None
    返回:string
    功能:CPU频率
    -----------------------------------------------------------------------------}

    function TCPUIDInfo.GetComputerBasicFrequency: string;
    const
    DelayTime = 500;
    var
    TimerHi, TimerLo: DWORD;
    PriorityClass, Priority: Integer;
    dSpeed: Double;
    begin
    PriorityClass := GetPriorityClass(GetCurrentProcess);
    Priority := GetThreadPriority(GetCurrentThread);
    SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
    SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
    Sleep(10);
    asm
    dw 310Fh // RDTSC指令
    mov TimerLo, eax
    mov TimerHi, edx
    end;
    Sleep(DelayTime);
    asm
    dw 310Fh // rdtsc
    sub eax, TimerLo
    sbb edx, TimerHi
    mov TimerLo, eax
    mov TimerHi, edx
    end;
    SetThreadPriority(GetCurrentThread, Priority);
    SetPriorityClass(GetCurrentProcess, PriorityClass);
    dSpeed := TimerLo / (1000.0 * DelayTime);
    Result := FormatFloat('0.00' , dSpeed / 1024) + ' GHz';
    end;

    {-----------------------------------------------------------------------------
    作者:sushengmiyan 2013.01.26
    参数:AOwner: TComponent
    返回:None
    功能:初始化
    -----------------------------------------------------------------------------}

    constructor TCPUIDInfo.Create;
    begin
    FCPUID := GetCPUID;
    FCPUIDStr := CPUIDTostr(FCPUID);
    end;

    {-----------------------------------------------------------------------------
    作者:sushengmiyan 2013.01.26
    参数:None
    返回:string CPUID字符串
    功能:对外函数,调用这个方法就能得到CPUID
    -----------------------------------------------------------------------------}

    function TCPUIDInfo.GetCPUIDstr: string;
    begin
    SetCPU(GetCurrentProcess , 1);
    Result := CPUIDTostr(GetCPUID);
    end;

    {-----------------------------------------------------------------------------
    作者:sushengmiyan 2013.01.26
    参数:AHandle: THandle; CpuNo: Integer
    返回:None
    功能:设置使用哪个cpu默认是第一个(推荐)
    -----------------------------------------------------------------------------}

    procedure TCPUIDInfo.SetCPU(AHandle: THandle; CpuNo: Integer);
    var
    ProcessAffinity: Cardinal;
    _SystemAffinity: Cardinal;
    begin
    //通过设置进程或线程的亲缘性(affinity),使进程或线程在指定的CPU(核)上运行
    GetProcessAffinityMask(AHandle , ProcessAffinity, _SystemAffinity) ;
    ProcessAffinity := CpuNo;
    SetProcessAffinityMask(AHandle , ProcessAffinity);
    end;

    { TMacAdressInfo }
    {-----------------------------------------------------------------------------
    作者:sushengmiyan 2013.01.26
    参数:None
    返回:None
    功能:初始化
    -----------------------------------------------------------------------------}

    constructor TMacAdressInfo.Create;
    begin
    FMacAdress := GetMacPhysicalAddress;
    end;

    {-----------------------------------------------------------------------------
    作者:sushengmiyan 2013.01.26
    参数:None
    返回:string
    功能:返回Mac地址
    -----------------------------------------------------------------------------}

    function TMacAdressInfo.GetMacAddress: string;
    begin
    Result := FMacAdress;
    end;

    {-----------------------------------------------------------------------------
    作者:sushengmiyan 2013.01.26
    参数:Alana: Integer = 0
    返回:string
    功能:通过LANA号获取Mac物理地址 (内存方式获取),整体步骤如下:
    一、枚举系统上可用的所有LANA编号
    二、重置计划使用的每个LANA编号
    三、适配器命令获取网卡地址
    -----------------------------------------------------------------------------}

    function TMacAdressInfo.GetMacPhysicalAddress(Alana: Integer = 0): string;
    var
    NCB: TNCB;//Netbios控制块
    AdapterStatus: TAdapterStatus;//取网卡状态
    LanaEnum: TLanaEnum; //LANA枚举值
    I: Integer;
    begin
    Result := '';
    Try
    { http://blog.csdn.net/sushengmiyan/article/details/8543811
    一、枚举LANA值
    ①.申请分配一个TNCB结构 NCB: TNCB;
    ②.将TNCB结构变量初始化成O ZeroMemory(@NCB , SizeOf(NCB));
    ③.置命令为NCBENUM NCB.ncb_Command := chr(NCBENUM);
    ④.为ncb_buffer分配LANA_ENUM NCB.ncb_buffer := @LANAENUM;
    ⑤.为NCB_length制定长度 NCB.NCB_length := Sizeof(LANAENUM);
    ⑥.调用Netbios函数获取Netbios CRC := NetBios(@NCB);
    ⑦.返回值NRC_GOODRET表示成功 NCB.ncb_retcode = Chr(NRC_GOODRET)
    }
    ZeroMemory(@NCB , SizeOf(NCB));
    NCB.ncb_Command := Chr(NCBENUM);
    NCB.ncb_buffer := @LANAENUM;
    NCB.NCB_length := Sizeof(LANAENUM);
    NetBios(@NCB);
    if not (NCB.ncb_retcode = Chr(NRC_GOODRET)) then Exit;


    { http://blog.csdn.net/sushengmiyan/article/details/8543811
    二、重置计划使用的每个LANA编号
    ①.申请分配一个TNCB结构 NCB: TNCB;
    ②.将TNCB结构变量初始化成O ZeroMemory(@NCB , SizeOf(NCB));
    ③.置命令为NCBRESET NCB.ncb_Command := chr(NCBRESET);
    ④.给命令设置LANA编号 NCB.ncb_lana_num := LanaEnum.lana[Alana];
    ⑤.调用Netbios函数获取Netbios CRC := NetBios(@NCB);
    ⑥.返回值NRC_GOODRET表示成功 NCB.ncb_retcode = Chr(NRC_GOODRET)
    }
    ZeroMemory(@NCB , SizeOf(NCB));
    NCb.ncb_Command := Chr(NCBRESET);
    NCB.ncb_lana_num := LanaEnum.lana[Alana];
    Netbios(@NCB);
    if not (NCB.ncb_retcode = Chr(NRC_GOODRET)) then Exit;

    { http://blog.csdn.net/sushengmiyan/article/details/8543811
    三、使用TAdapterStatus结构获取网卡地址
    ①.申请分配一个TNCB结构 NCB: TNCB;
    ②.将TNCB结构变量初始化成O ZeroMemory(@NCB , SizeOf(NCB));
    ③.置命令为NCBASTAT NCB.ncb_Command := chr(NCBASTAT);
    ④.为ncb_buffer分配LANA_ENUM NCB.ncb_buffer := @LANAENUM;
    ⑤.设置ncb_callname NCB.ncb_callname := '* ' + #0;
    ⑥.为ncb_buffer分配AdapterStatus NCB.ncb_buffer := @AdapterStatus;
    ⑦.为NCB_length制定长度 NCB.NCB_length := Sizeof(AdapterStatus);
    ⑧.调用Netbios函数获取Netbios CRC := NetBios(@NCB);
    }
    ZeroMemory(@NCB , SizeOf(NCB));
    NCb.ncb_Command := chr(NCBASTAT);
    NCB.ncb_lana_num := LANAENUM.lana[Alana];
    NCB.ncb_callname[0] := '*';
    //不明白为何如此设置,*代表啥子?
    //有懂的可以邮件分享 429119108@qq.com O(∩_∩)O谢谢
    NCB.ncb_buffer := @AdapterStatus;
    NCB.ncb_length := SizeOf(AdapterStatus);
    NetBios(@NCB);

    //获取形如AA-BB-CC-DD-EE-FF形式的mac物理地址字符串
    Result := '';
    for I := 0 to 5 do
    if SameStr(Result , '') then
    Result := Result + IntToHex(Integer(AdapterStatus.adapter_address[I]) , 2)
    else
    Result := Result + '-' + IntToHex(Integer(AdapterStatus.adapter_address[I]) , 2);
    Finally

    End;
    end;

    { TPCUserInfo }


    {-----------------------------------------------------------------------------
    作者:sushengmiyan 2013.01.26
    参数:None
    返回:None
    功能:创建
    -----------------------------------------------------------------------------}

    constructor TPCUserInfo.Create;
    begin

    end;

    {-----------------------------------------------------------------------------
    作者:sushengmiyan 2013.01.26
    参数:None
    返回:string
    功能:得到主机IP
    -----------------------------------------------------------------------------}

    function TPCUserInfo.GetHostIP: string;
    var
    sHostName: string;
    WSAData: TWSAData;
    HostEnt: PHostEnt;
    begin
    sHostName := UserName;
    Result := '';
    WSAStartup(2 , WSAData);
    HostEnt := GetHostByName(PChar(sHostName));
    if HostEnt <> nil then
    begin
    with HostEnt^ do
       Result:= Format('%d.%d.%d.%d' , [Byte(h_addr^[0]) , Byte(h_addr^[1])
    , Byte(h_addr^[2]) , Byte(h_addr^[3])]);
     end;
     WSACleanup;
    end;

    {-----------------------------------------------------------------------------
    作者:sushengmiyan 2013.01.26
    参数:None
    返回:None
    功能:获取用户名
    -----------------------------------------------------------------------------}

    function TPCUserInfo.GetUserName;
    var
    Name: PChar;
    Size: DWORD;
    begin
    GetMem(Name , 255);//申请内存
    Size := 255;
    GetComputerName(Name , Size);
    Result := Name;
    FreeMem(Name); //记得释放内存
    end;

    {-----------------------------------------------------------------------------
    作者:sushengmiyan 2013.01.26
    参数:None
    返回:string
    功能:返回操作系统类型
    -----------------------------------------------------------------------------}

    function TPCUserInfo.GetWindowsVertion: string;
    function GetWindowsVersionString: string;
    var
    oSVersion: TOSVersionInfoA;
    begin
    Result := '';
    oSversion.dwOSVersionInfoSize := SizeOf(TOSVersionInfoA);
    if GetVersionExA(oSVersion) then
    with oSVersion do
    Result := Trim(Format('%s', [szCSDVersion]));
    end;
    var
    AWin32Version: Extended;
    sWin: string;
    begin
    sWin := 'Windows';
    AWin32Version := StrToFloat(Format('%d.%d', [Win32MajorVersion, Win32MinorVersion]));
    case Win32Platform of
    VER_PLATFORM_WIN32s:
    Result := sWin + '32';
    VER_PLATFORM_WIN32_WINDOWS:
    begin
    if AWin32Version = 4.0 then
    Result := sWin + '95'
    else if AWin32Version = 4.1 then
    Result := sWin + '98'
    else if AWin32Version = 4.9 then
    Result := sWin + 'Me'
    else
    Result := sWin + '9x';
    end;
    VER_PLATFORM_WIN32_NT:
    begin
    if AWin32Version = 3.51 then
    Result := sWin + 'NT 3.51'
    else if AWin32Version = 4.0 then
    Result := sWin + 'NT 4.0'
    else if AWin32Version = 5.0 then
    Result := sWin + '2000'
    else if AWin32Version = 5.1 then
    Result := sWin + 'XP'
    else if AWin32Version = 5.2 then
    Result := sWin + '2003'
    else if AWin32Version = 6.0 then
    Result := sWin + 'Vista'
    else if AWin32Version = 6.1 then
    Result := sWin + '7'
    else
    Result := sWin;
    end
    else
    Result := sWin;
    end;
    Result := Result + ' ' + GetWindowsVersionString;
    end;

    end.

  • 相关阅读:
    函数输出参数 双重指针
    NotePad++ 支持日语字体
    C++ 前置操作符与后置操作符
    用js判断 iPhone6 iPhone6 plus iphonex?
    从浏览器输入一个地址到渲染出网页这个过程发生了什么???
    对.Net 垃圾回收Finalize 和Dispose的理解
    在.NET环境中使用单元测试工具NUnit
    信道
    asp.net 获取当前URL的正确方法
    ASP.NET中常用输出JS脚本的类
  • 原文地址:https://www.cnblogs.com/blogpro/p/11446132.html
Copyright © 2011-2022 走看看