lazarus 获取硬件ID的函数,适用于linux和win,只需调用GetHWID就可以返回相应的ID。
unit HWTools; {$mode ObjFPC}{$H+} interface uses Classes, SysUtils,process; function GetHWID:String; implementation function GetHWID:String; var s:string; function GetInfo(cmd,s1,s2:string):string; var Output:String; i,j:integer; str:string; readdmi:TStringList; begin result:=''; readdmi:=TStringList.Create; {$ifdef linux} RunCommand(cmd ,Output); readdmi.Text:=Output; j:=0; str:=''; for i:=1 to readdmi.Count-1 do begin if pos(s1, readdmi[i])>0 then j:=1; //CPU Info if (pos(s2, readdmi[i])>0) and (j=1) then begin str:=trim(copy(readdmi[i],pos(s2, readdmi[i])+Length(s2),Length(readdmi[i]))); str:=StringReplace(str,' ','',[rfReplaceAll]); str:=StringReplace(str,':','',[rfReplaceAll]); str:=StringReplace(str,'-','',[rfReplaceAll]); Break; end; end; {$endif} {$ifdef windows} RunCommand(cmd ,Output); readdmi.Text:=Output; j:=0; for i:=1 to readdmi.Count-1 do begin Output:=readdmi.Strings[i]; if Length(Output)>17 Then begin Output:=Copy(Output,length(output)-16,17); if (output[3]='-') and (output[6]='-') and (output[9]='-') and (output[12]='-') and (output[15]='-') and (j=0) Then begin j:=1; str:=Output; str:=StringReplace(str,' ','',[rfReplaceAll]); str:=StringReplace(str,':','',[rfReplaceAll]); str:=StringReplace(str,'-','',[rfReplaceAll]); break; end; end; end; {$endif} readdmi.Free; result:=trim(str).ToUpper; end; function GetCPUID:string; var str:String; i,j:integer; o:TStringList; begin Result:=''; o:=TStringList.Create; o.LoadFromFile('/proc/cpuinfo'); j:=0; str:=''; for i:=1 to o.Count-1 do begin if (pos('Serial', o[i])>0) and (j=0) then begin str:=trim(copy(o[i],pos('Serial', o[i])+6,Length(o[i]))); str:=StringReplace(str,' ','',[rfReplaceAll]); str:=StringReplace(str,':','',[rfReplaceAll]); Break; end; end; o.Free; result:=str.ToUpper; end; begin result:=''; {$ifdef linux} s:=GetInfo('dmidecode','DMI type 4,','ID:');//CPU Info if s='' then s:=GetInfo('dmidecode','DMI type 2,','Serial Number:');//主板Info if s='' then s:=GetCPUID; if s='' then s:=copy(GetInfo('ifconfig','硬件地址','硬件地址'),1,12);//网卡MAC if s='' then s:=copy(GetInfo('ifconfig','ether','ether'),1,12);//网卡MAC if s='' then s:=copy(GetInfo('ifconfig','HWaddr','HWaddr'),1,12);//网卡MAC {$endif} {$ifdef windows} s:=copy(GetInfo('ipconfig /all','',''),1,12);//网卡MAC {$endif} result:=s; end; end.