程序员经验分享-hwhale

获取硬件信息的delphi源码（CPUID、操作系统、Mac物理地址、计算机名称、IP地址、用户名）

2023-11-10

转载请保留本文链接地址：http://blog.csdn.net/sushengmiyan/article/details/8545673

{-----------------------------------------------------------------------------
作者：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.

源码共享一下，希望大家能补充反馈给我点信息啥的。(*^__^*) 
免费下载地址：http://download.csdn.net/detail/sushengmiyan/5032146

本文内容由网友自发贡献，版权归原作者所有，本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容，请联系:hwhale#tublm.com(使用前将#替换为@)

Delphi

获取硬件信息的delphi源码（CPUID、操作系统、Mac物理地址、计算机名称、IP地址、用户名） 的相关文章

  • 如何使用 Gmail 的 SMTP 和 Indy 10 发送电子邮件？

    我正在使用 Delphi 2009 和 svn 中最新的 Indy 10 通过 SMTP 发送电子邮件 但它不适用于 Gmail Google Apps 托管域 当我尝试发送电子邮件时 我收到 必须首先发出 STARTTLS 命令 我尝试用

  • 打印 TDBGrid [重复]

    这个问题在这里已经有答案了 如何在不安装或下载组件的情况下打印 DBGrid OR 如何将 DBGrid 的数据放入 RichEdit 以便我可以从那里打印它 数据感知控件从 DataSource 属性获取数据 并使用它 不过 您必须手动遍

  • 从 Delphi VCL 样式获取特定字形

    我想从 VCL 样式获取特定的位图 并将其设置为按钮上的图像 它实际上是帮助问号 在位图样式编辑器中是来自表单的 btnHelp 图像 要从 VCL 样式获取视觉元素 字形 您必须使用GetElementDetails和TCustomSty

  • 将图像加载到 TImageList 并读取它们？

    我试图通过将 jpg 转换为 bmp 然后将其保存到 imagelist1 来将 jpg 加载到图像列表中 从上到下的代码片段 Selectdir 有效 fileexists 部分有效 这用于加载文件夹中的所有图像 所有图像都以 0 jpg

  • 如何比较枚举类型集

    从某个时刻开始 我厌倦了编写设定条件 and or 因为对于更多的条件或更长的变量名 重新编写会变得笨拙且烦人 所以我开始写助手这样我就可以写ASet ContainsOne ceValue1 ceValue2 代替 ceValue1 in

  • 使用 PutBlock 并将字节数组全部设置为零的 EIPHTTPProtocolExceptionPeer 异常

    使用 Delphi XE2 Update 3 我在将零字节块上传到 Azure 时遇到问题 当我说零字节时 我指的是每个元素设置为零的字节数组 不是零长度 例如 var ConInfo TAzureConnectionInfo RespIn

  • 从其可执行文件的路径获取服务名称

    我有一个可执行文件的路径 它是一个正在运行的服务应用程序 例如 C Program Files x86 Someapp somesvc exe 我想停止并启动它 为此我想我需要获取服务的名称 如下所示 this https stackove

  • Delphi 中表单分发与其生命周期相关的接口对象的安全方法？

    我有一个 Delphi 表单 它提供接口对象背后的功能 代码的其他部分也通过属于该表单的属性获取引用 我无法将接口功能委托给子对象 因为太多的功能是由表单上的控件 组件提供的 我无法使用 TAggregateObject 或 TContai

  • TXMLDocument.Active := False 导致 FastMM4 错误消息“FastMM 检测到块在释放后已被修改”

    我们在 FullDebugMode 下使用 Delphi XE8 和 FastMM4 版本 4 992 会产生奇怪的效果 要重现效果 只需创建一个新的 TForm 应用程序 将 FastMM4 放入 DPR 文件的第一行 在表单上放置一个按

  • 为什么 TImage 旋转我的图像？

    编写一个移动应用程序 它从安全网站提取图像 如下所示 第一个图像 提取不正确 注意网络版本与移动版本 第二个图像在网站上正确显示 但 Delphi TImage 由于某种原因正在旋转它我不明白为什么 旋转设置为 0 并且在 TImage 组

  • 使用 Delphi 10.2.1 Tokyo 的模态 Android 对话框

    我有以下用于在 Android 上显示模式消息的 Delphi 代码 该代码在 10 1 Berlin 上运行良好 但在 Delphi 10 2 1 Tokyo 上停止运行 此过程现在会挂起 Android 应用程序 procedure c

  • 使用远程数据编写 Android、iPad、iPhone 客户端的技术

    我需要探索世界 你写了一个杀手级应用程序 但你有 Android iPhone iPad 客户端吗 我的问题是 1 向这些设备发送数据的最佳方式是什么 按照建议进行肥皂和休息here https stackoverflow com ques

  • 德尔福和Doxygen

    我想使用 doxygen pas2dox 记录我的源代码 当我设置好所有内容 包括过滤器和提取选项 提取所有内容 时 doxygen 运行良好 但生成的文档仅包含源文件作为链接 并且没有提取类型 方法 过滤后的源看起来不错 有任何提示如何定

  • Delphi 应用程序被 Google Chrome 视为“危险”

    我经常用Delphi 2009制作数学软件 并将其发布在我的网站上 然而 去年左右 Google Chrome 开始认为我的一小部分 但数量不断增加 EXE 是 有害的 并且 Google Chrome 拒绝下载它们 例如 今天我编写了一个

  • Firebird 或 NexusDB

    我知道有很多与 Delphi 数据库相关的问题 但我只考虑这两个数据库 我需要查询大约 100 000 条记录 根据您的经验 哪个更快 作为嵌入式 as C S Thanks 我还没用过 Nexus tbh 但我经常使用 Firebird

  • 是否可以在虚拟树视图中选择多个列？

    我需要添加功能来复制节点和列的矩形选择 但我找不到任何方法来实际选择虚拟树视图中的多个列 除了 toFullRowSelect 之外 我只是错过了什么吗 如果没有 是否有一个后代具有类似网格的多列选择支持 经过一些测试后 我得出了以下结论

  • “已发布集 '%s' 的大小大于 4 字节”。如何修复这个编译器错误？

    我有一组包含 138 个值的枚举值 就像是 type TSomething sOne sTwo sThree sOnehundredAndThirtyeight TSomethings set of TSomething TSomethin

  • 如何将 Delphi Chromium Embedded (TChromium) 组件的声音静音？

    我需要将某个声音静音TChromium组件来制作无声浏览器 主要问题是在 Windows XP 上 当我将浏览器的声音静音时 它会静音整个系统的声音 有没有办法让电脑静音TChromium成分 我已经成功使用以下代码 procedure C

  • 指针^ 与 s[1]

    在读取数据的函数中 数据含义只字符串 从磁盘 我应该更喜欢哪个 哪个更好 A DiskStream Read Pointer s Count or B DiskStream Read s 1 Count Note 我知道两者都有相同的结果

  • Delphi：如何计算大文件的 SHA 哈希值

    您好 我需要生成 5 Gig 文件的 SHA 您知道有一个非基于字符串的 Delphi 库可以做到这一点吗 你应该使用DCPcrypt v2 http www cityinthesky co uk cryptography html读取缓冲

随机推荐

热门标签