versionid.~pas

Delphi源码：获取计算机系统的逻辑硬盘号、物理硬盘号、Cpu号、Bios号等等。

unit VersionId;

interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, jpeg, ExtCtrls,inifiles ,Nb30,Registry;
Const
    ConstKey = '\Software\MorningStar\SpokenTest\CurrentVersion' ;
    ServerVersionId =       'TestServerVersion' ;
    MakeQuestionVersionId = 'MakeQuestionVersion' ;
    SingleMarkVersionId =   'SingleMarkVersion' ;
    MainVersionId =         'MainVersion' ;
    ServerDate    = 'SystemDate' ;

    //=True:个人版； =False:网络版
    PersonalVersion = False ;

    NameId =         'RegNameID' ;
    CodeId =         'RegCodeID' ;
    ErrorMsg =       'ErrorMessage'  ;
    
    ServerVersionKey =       'Server' ;
    MakeQuestionVersionKey = 'Make' ;
    SingleMarkVersionKey =   'SingleMark' ;
    MainVersionKey =         'Main' ;

    ServerProgName = 'server\Server.exe';
    MakeQuestionProgName = 'make\MakeQuestion.exe' ;
    SingleMakeProgName = 'mark\SingleMark.exe' ;

    const_rootkey=HKEY_LOCAL_MACHINE ;

type
    TNBLanaResources = (lrAlloc, lrFree);
type
    PMACAddress = ^TMACAddress;
    TMACAddress = array[0..5] of Byte;
function GetHDserial:string ;
function GetVersionStr(fns:string):string;
function GetMACAddress(LanaNum: Byte; MACAddress: PMACAddress): Byte;
function GetLanaEnum(LanaEnum: PLanaEnum): Byte;
function ResetLana(LanaNum, ReqSessions, ReqNames: Byte;
  LanaRes: TNBLanaResources): Byte;

function NbGetMac():string ;
function WinVersion:Cardinal;//获得操作系统版本
Function kbGetCpuID():string;
function GetCpuInfo:string;
function BiosInfo:string;
function GetBiosInfoAsText: string;

implementation
function GetBiosInfoAsText: string;
  var
    p, q: pchar; 
  begin 
    q := nil; 
    p := PChar(Ptr($FE000)); 
    repeat 
      if q <> nil then begin 
        if not (p^ in [#10, #13, #32..#126, #169, #184]) then begin 
          if (p^ = #0) and (p - q >= 8) then begin 
            Result := Result + TrimRight(String(q)) + #13#10; 
          end; 
          q := nil; 
        end; 
      end else 
        if p^ in [#33..#126, #169, #184] then 
          q := p; 
      inc(p); 
    until p > PChar(Ptr($FFFFF)); 
    Result := TrimRight(Result); 
  end; 


function GetVersionStr(fns:string):string ;
var
    ver,v1,v2:Cardinal ;
begin
  if fileexists(fns) then
  begin
    Ver:=GetFIleVersion(fns);
    v1:=(ver and $FFFF0000) shr 16 ;
    v2:=(ver and $0000FFFF) ; ;
//    v3:=(ver and $0000FF00) shr 8 ;
//    v4:=(ver and $000000FF) ;
    result:=inttostr(v1)+'.'+inttostr(v2);//+'.'+inttostr(v3)+'.'+inttostr(v4);
  end else result:='' ;
end ;
function GetMACAddress(LanaNum: Byte; MACAddress: PMACAddress): Byte;
var
  AdapterStatus: PAdapterStatus;
  StatNCB: PNCB;
begin
  //个人版取硬盘号
  if PersonalVersion then begin Result := 255 ; exit ; end ;

  New(StatNCB);
  ZeroMemory(StatNCB, SizeOf(TNCB));
  StatNCB.ncb_length := SizeOf(TAdapterStatus) + 255 * SizeOf(TNameBuffer);
  GetMem(AdapterStatus, StatNCB.ncb_length);
try
    with StatNCB^ do
    begin
      ZeroMemory(MACAddress, SizeOf(TMACAddress));
      ncb_buffer := PChar(AdapterStatus);
      ncb_callname := '* ' + #0;
      ncb_lana_num := Char(LanaNum);
      ncb_command := Char(NCBASTAT);
      NetBios(StatNCB);
      Result := Byte(ncb_cmd_cplt);
      if Result = NRC_GOODRET then
      MoveMemory(MACAddress, AdapterStatus, SizeOf(TMACAddress));
    end;
finally
    FreeMem(AdapterStatus);
    Dispose(StatNCB);
    end;
end;
function ResetLana(LanaNum, ReqSessions, ReqNames: Byte;
  LanaRes: TNBLanaResources): Byte;
var
  ResetNCB: PNCB;
begin
  New(ResetNCB);
  ZeroMemory(ResetNCB, SizeOf(TNCB));
  try
    with ResetNCB^ do
    begin
      ncb_lana_num := Char(LanaNum);        // Set Lana_Num
      ncb_lsn := Char(LanaRes);             // Allocation of new resources
      ncb_callname[0] := Char(ReqSessions); // Query of max sessions
      ncb_callname[1] := #0;                // Query of max NCBs (default)
      ncb_callname[2] := Char(ReqNames);    // Query of max names
      ncb_callname[3] := #0;                // Query of use NAME_NUMBER_1
      ncb_command  := Char(NCBRESET);
      NetBios(ResetNCB);
      Result := Byte(ncb_cmd_cplt);
    end;
  finally
    Dispose(ResetNCB);
  end;
end;
function GetLanaEnum(LanaEnum: PLanaEnum): Byte;
var
  LanaEnumNCB: PNCB;
begin
  New(LanaEnumNCB);
  ZeroMemory(LanaEnumNCB, SizeOf(TNCB));
  try
    with LanaEnumNCB^ do
    begin
      ncb_buffer := PChar(LanaEnum);
      ncb_length := SizeOf(TLanaEnum);
      ncb_command  := Char(NCBENUM);
      NetBios(LanaEnumNCB);
      Result := Byte(ncb_cmd_cplt);
    end;
  finally
    Dispose(LanaEnumNCB);
  end;
end;



function NbGetMac():string ;
  function hexbl(by:byte):string;
    begin
      result:=format('%x',[by]);
      if length(result)<2 then
        result:='0'+result;
    end;
var
  ncb:Tncb;
  i,j:integer;
  adapter:TAdapterstatus;
  lanaenum:TLanaEnum;
  strx:string;
begin
  zeromemory(@ncb,sizeof(ncb));
  ncb.ncb_command:=chr(ncbenum);
  netbios(@ncb);
  ncb.ncb_buffer:=@lanaenum;
  ncb.ncb_length:=sizeof(lanaenum);
  ncb.ncb_command :=chr(ncbenum);
  netbios(@ncb);
  strx:='' ;
  for i:=0 to ord(lanaenum.length)-1 do
  begin
      zeromemory(@ncb,sizeof(ncb));
      ncb.ncb_command:=chr(ncbreset);
      ncb.ncb_lana_num:=lanaenum.lana[i];
      netbios(@ncb);
      zeromemory(@ncb,sizeof(ncb));
      ncb.ncb_command:=chr(ncbastat);
      ncb.ncb_lana_num:=lanaenum.lana[i];
      strcopy(ncb.ncb_callname,'*');
      ncb.ncb_buffer :=@adapter;
      ncb.ncb_length :=sizeof(adapter);
      netbios(@ncb);
      for j:=0 to 5 do
      begin
         //if j>0 then strx:=strx+'-';
         strx:=strx+hexbl(byte(adapter.adapter_address[j]));
      end;
      strx:=strx + ';' ;
   end;
   if strx<>'' then strx:=copy(strx,1,length(strx) - 1) ;
   result:=strx;
end;

function WinVersion:Cardinal;//获得操作系统版本
var
  OSVI : OSVERSIONINFO;
begin
  ReSult := 4;//其他操作系统
  OSVI.dwOSVersionInfoSize:=SizeOf(OSVERSIONINFO);
  GetVersionEx(OSVI);
  if OSVI.dwPlatformId=2 then
    begin
      case OSVI.dwMajorVersion of
      4:Result:=2;
      5:Result:=3;
      end;
    end
  else
    Result:=OSVI.dwPlatformId;
//  返回值: 为0表示为win3x系统; 为1表示为win9x系统; 为2表示为winNT;  为3表示为win2000系统;
//if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then  //VER_PLATFORM_WIN32_NT
//      Copyfile(Pchar(strSyspath + 'SMARTVSD.VXD'),Pchar(strSyspath+'iosubsys\SMARTVSD.VXD'),False);
end;

//取CPU序号
Function kbGetCpuID():string;
type
  TCPUID = array[1..4] of Longint;
var
   CPUIDinfo : TCPUID;
    function IsCPUID_Available : Boolean;
    asm
      PUSHFD       {direct access to flags no possible, only via stack}
      POP     EAX     {flags to EAX}
      MOV     EDX,EAX   {save current flags}
      XOR     EAX,$200000; {not ID bit}
      PUSH    EAX     {onto stack}
      POPFD        {from stack to flags, with not ID bit}
      PUSHFD       {back to stack}
      POP     EAX     {get back to EAX}
      XOR     EAX,EDX   {check if ID bit affected}
      JZ      @exit    {no, CPUID not availavle}
      MOV     AL,True   {Result=True}
      @exit:
    end;
    function GetCPUIDSN : TCPUID; assembler;
    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;
begin
    if IsCPUID_Available then
       begin
         CPUIDinfo:=GetCPUIDSN;
       end
    else begin       //早期cpu无ID
       CPUIDinfo[1] := 0136;     
       CPUIDinfo[4] := 66263155;
       Result := '';
    end;
    result:=IntToHex((CPUIDinfo[1]+CPUIDinfo[2]+CPUIDinfo[3]+CPUIDinfo[4]),8);
end;

function GetCpuInfo:string;
var
   R: array[0..19] of Char;
   CpuID: Integer;
begin
  CpuID:=0 ;
  FillChar(R, 20, 0);
  asm