关于机器码的问题(送分)

机器码是根据电脑的硬件设备（如硬盘、CPU、主板、网卡等）的特征码，再根据自己设计的某种运算而得到的结果。也就是说某一软件所获取的“机器码”并不是纯粹的硬件设备特征码，而是以特征码（或特征码子串）为参数的函数（运算结果）至于特征码的提取，网上有大量的代码，随便搜索一下一大把

可以是硬件的特征码也可以是系统的SID，然后经过自定义函数处理得来的~~

unit Unit1;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, StdCtrls,nb30; {重要引用}type
    PASTAT = ^TASTAT;
    TASTAT = record
    adapter : TAdapterStatus;
    name_buf : TNameBuffer;
end;    TForm1 = class(TForm)
      Button1: TButton;
      Edit1: TEdit;
      Edit2: TEdit;
      Edit3: TEdit;
      Edit4: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
      procedure Button1Click(Sender: TObject);

    private
      { Private declarations }
    public
      { Public declarations }
    end;var
    Form1: TForm1;implementation{$R *.dfm}type
    TCPUID = array[1..4] of Longint;//取硬盘系列号:
function GetIdeSerialNumber: pchar;    //获取硬盘的出厂系列号；
const IDENTIFY_BUFFER_SIZE = 512;
type
     TIDERegs = packed record
       bFeaturesReg: BYTE;
       bSectorCountReg: BYTE;
       bSectorNumberReg: BYTE;
       bCylLowReg: BYTE;
       bCylHighReg: BYTE;
       bDriveHeadReg: BYTE;
       bCommandReg: BYTE;
       bReserved: BYTE;
    end;    TSendCmdInParams = packed record
      cBufferSize: DWORD;
      irDriveRegs: TIDERegs;
      bDriveNumber: BYTE;
      bReserved: array[0..2] of Byte;
      dwReserved: array[0..3] of DWORD;
      bBuffer: array[0..0] of Byte;
    end;    TIdSector = packed record
      wGenConfig: Word;
      wNumCyls: Word;
      wReserved: Word;
      wNumHeads: Word;
      wBytesPerTrack: Word;
      wBytesPerSector: Word;
      wSectorsPerTrack: Word;
      wVendorUnique: array[0..2] of Word;
      sSerialNumber: array[0..19] of CHAR;
      wBufferType: Word;
      wBufferSize: Word;
      wECCSize: Word;
      sFirmwareRev: array[0..7] of Char;
      sModelNumber: array[0..39] of Char;
      wMoreVendorUnique: Word;
      wDoubleWordIO: Word;
      wCapabilities: Word;
      wReserved1: Word;
      wPIOTiming: Word;
      wDMATiming: Word;
      wBS: Word;
      wNumCurrentCyls: Word;
      wNumCurrentHeads: Word;
      wNumCurrentSectorsPerTrack: Word;
      ulCurrentSectorCapacity: DWORD;
      wMultSectorStuff: Word;
      ulTotalAddressableSectors: DWORD;
      wSingleWordDMA: Word;
      wMultiWordDMA: Word;
      bReserved: array[0..127] of BYTE;
    end;    PIdSector = ^TIdSector;
    TDriverStatus = packed record
      bDriverError: Byte;
      bIDEStatus: Byte;
      bReserved: array[0..1] of Byte;
      dwReserved: array[0..1] of DWORD;
    end;    TSendCmdOutParams = packed record
      cBufferSize: DWORD;
      DriverStatus: TDriverStatus;
      bBuffer: array[0..0] of BYTE;
    end;
var
    hDevice: Thandle;
    cbBytesReturned: DWORD;
    SCIP: TSendCmdInParams;
    aIdOutCmd: array[0..(SizeOf(TSendCmdOutParams) + IDENTIFY_BUFFER_SIZE-1)-1] of Byte;
    IdOutCmd: TSendCmdOutParams absolute aIdOutCmd;

接上面procedure ChangeByteOrder(var Data; Size: Integer);//函数中的过程
var
    ptr: Pchar;
    i: Integer;
    c: Char;
begin
    ptr := @Data;
    for I := 0 to (Size shr 1) - 1 do begin
      c := ptr^;
      ptr^ := (ptr + 1)^;
      (ptr + 1)^ := c;
      Inc(ptr, 2);
    end;
end;begin            //函数主体
      Result := '';
      if SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT then
         begin // Windows NT, Windows 2000
           hDevice := CreateFile('\\.\PhysicalDrive0', GENERIC_READ or GENERIC_WRITE,
           FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
         end
      else // Version Windows 95 OSR2, Windows 98
         hDevice := CreateFile('\\.\SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0);
      if hDevice = INVALID_HANDLE_VALUE then Exit;
      try
        FillChar(SCIP, SizeOf(TSendCmdInParams) - 1, #0);
        FillChar(aIdOutCmd, SizeOf(aIdOutCmd), #0);
        cbBytesReturned := 0;
        with SCIP do
        begin
          cBufferSize := IDENTIFY_BUFFER_SIZE;
          with irDriveRegs do
          begin
            bSectorCountReg := 1;
            bSectorNumberReg := 1;
            bDriveHeadReg := $A0;
            bCommandReg := $EC;
          end;
        end;
        if not DeviceIoControl(hDevice, $0007C088, @SCIP, SizeOf(TSendCmdInParams) - 1,@aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, nil) then Exit;
      finally
        CloseHandle(hDevice);
      end;
      with PIdSector(@IdOutCmd.bBuffer)^ do
      begin
        ChangeByteOrder(sSerialNumber, SizeOf(sSerialNumber));
        (Pchar(@sSerialNumber) + SizeOf(sSerialNumber))^:= #0;
        Result := Pchar(@sSerialNumber);
      end;
end;
//=================================================================//CPU系列号:
FUNCTION GetCPUID : TCPUID; assembler; register;
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;function GetCPUIDStr:String;
var
    CPUID:TCPUID;
begin
    CPUID:=GetCPUID;
    Result:=IntToHex(CPUID[1],8)+IntToHex(CPUID[2],8)+IntToHex(CPUID[3],8)+IntToHex(CPUID[4],8);
end;///==================================================================================///取MAC(非集成网卡):function NBGetAdapterAddress(a: Integer): string;
var
    NCB: TNCB; // Netbios control block //NetBios控制块
    ADAPTER: TADAPTERSTATUS; // Netbios adapter status//取网卡状态
    LANAENUM: TLANAENUM; // Netbios lana
    intIdx: Integer; // Temporary work value//临时变量
    cRC: Char; // Netbios return code//NetBios返回值
    strTemp: string; // Temporary string//临时变量
begin
    // Initialize
    Result := '';
    try
      // Zero control blocl
      ZeroMemory(@NCB, SizeOf(NCB));
      // Issue enum command
      NCB.ncb_command := Chr(NCBENUM);
      cRC := NetBios(@NCB);
      // Reissue enum command
      NCB.ncb_buffer := @LANAENUM;
      NCB.ncb_length := SizeOf(LANAENUM);
      cRC := NetBios(@NCB);
      if Ord(cRC) <> 0 then
        exit;
      // Reset adapter
      ZeroMemory(@NCB, SizeOf(NCB));
      NCB.ncb_command := Chr(NCBRESET);
      NCB.ncb_lana_num := LANAENUM.lana[a];
      cRC := NetBios(@NCB);
      if Ord(cRC) <> 0 then
        exit;
      // Get adapter address
      ZeroMemory(@NCB, SizeOf(NCB));
      NCB.ncb_command := Chr(NCBASTAT);
      NCB.ncb_lana_num := LANAENUM.lana[a];
      StrPCopy(NCB.ncb_callname, '*');
      NCB.ncb_buffer := @ADAPTER;
      NCB.ncb_length := SizeOf(ADAPTER);
      cRC := NetBios(@NCB);
      // Convert it to string
      strTemp := '';
      for intIdx := 0 to 5 do
        strTemp := strTemp + InttoHex(Integer(ADAPTER.adapter_address[intIdx]), 2);
      Result := strTemp;
    finally
    end;
end;
//==========================================================================
//取MAC地址(集成网卡和非集成网卡):function Getmac:string;
var
    ncb : TNCB;
    s:string;
    adapt : TASTAT;
    lanaEnum : TLanaEnum;
    i, j, m : integer;
    strPart, strMac : string;
begin
FillChar(ncb, SizeOf(TNCB), 0);
    ncb.ncb_command := Char(NCBEnum);
    ncb.ncb_buffer := PChar(@lanaEnum);
    ncb.ncb_length := SizeOf(TLanaEnum);
    s:=Netbios(@ncb);
    for i := 0 to integer(lanaEnum.length)-1 do
    begin
      FillChar(ncb, SizeOf(TNCB), 0);
      ncb.ncb_command := Char(NCBReset);
      ncb.ncb_lana_num := lanaEnum.lana[i];
      Netbios(@ncb);
      Netbios(@ncb);
      FillChar(ncb, SizeOf(TNCB), 0);
      ncb.ncb_command := Chr(NCBAstat);
      ncb.ncb_lana_num := lanaEnum.lana[i];
      ncb.ncb_callname := '*';
      ncb.ncb_buffer := PChar(@adapt);
      ncb.ncb_length := SizeOf(TASTAT);
      m:=0;
      if (Win32Platform = VER_PLATFORM_WIN32_NT) then
      m:=1;
      if m=1 then
      begin
      if Netbios(@ncb) = Chr(0) then
        strMac := '';
        for j := 0 to 5 do
        begin
          strPart := IntToHex(integer(adapt.adapter.adapter_address[j]), 2);
          strMac := strMac + strPart + '-';
        end;
        SetLength(strMac, Length(strMac)-1);
      end;
    if m=0 then
      if Netbios(@ncb) <> Chr(0) then
      begin
        strMac := '';
        for j := 0 to 5 do
        begin
          strPart := IntToHex(integer(adapt.adapter.adapter_address[j]), 2);
          strMac := strMac + strPart + '-';
        end;
        SetLength(strMac, Length(strMac)-1);
      end;
    end;
result:=strmac;
end;function PartitionString(StrV,PrtSymbol: string): TStringList;
var
    iTemp: integer;
begin
    result := TStringList.Create;
    iTemp := pos(PrtSymbol,StrV);
    while iTemp>0 do begin
      if iTemp>1 then result.Append(copy(StrV,1,iTemp-1));
      delete(StrV,1,iTemp+length(PrtSymbol)-1);
      iTemp := pos(PrtSymbol,StrV);
    end;
    if Strv<>'' then result.Append(StrV);
end;function MacStr():String;
var
    Str:TStrings;
    i:Integer;
    MacStr:String;
begin
    MacStr:='';
    Str:=TStringList.Create;
    Str:=PartitionString(Getmac,'-');
    for i:=0 to Str.Count-1 do
      MacStr:=MacStr+Str[i];
    Result:=MacStr;
end;//==============================================//调用示例
procedure TForm1.Button1Click(Sender: TObject);
begin
    Edit3.Text:=strpas(GetIdeSerialNumber);//取硬盘号
    Edit2.text:=GetCPUIDStr;//CPU系列号
    edit4.Text:=NBGetAdapterAddress(12);//非集成网卡
    Edit1.text:=MacStr;//集成和非集成网卡end;

end.

//获取网卡MAC
function MacAddress: string;
var
   Lib: Cardinal;
   Func: function(GUID: PGUID): Longint; stdcall;
   GUID1, GUID2: TGUID;
begin
   Result := ';
   Lib := LoadLibrary('rpcrt4.dll');
   if Lib <> 0 then
   begin
     if Win32Platform <>VER_PLATFORM_WIN32_NT then
       @Func := GetProcAddress(Lib, 'UuidCreate')
       else @Func := GetProcAddress(Lib, 'UuidCreateSequential');
     if Assigned(Func) then
     begin
       if (Func(@GUID1) = 0) and
         (Func(@GUID2) = 0) and
         (GUID1.D4[2] = GUID2.D4[2]) and
         (GUID1.D4[3] = GUID2.D4[3]) and
         (GUID1.D4[4] = GUID2.D4[4]) and
         (GUID1.D4[5] = GUID2.D4[5]) and
         (GUID1.D4[6] = GUID2.D4[6]) and
         (GUID1.D4[7] = GUID2.D4[7]) then
       begin
         Result :=
          IntToHex(GUID1.D4[2], 2) + '-' +
          IntToHex(GUID1.D4[3], 2) + '-' +
          IntToHex(GUID1.D4[4], 2) + '-' +
          IntToHex(GUID1.D4[5], 2) + '-' +
          IntToHex(GUID1.D4[6], 2) + '-' +
          IntToHex(GUID1.D4[7], 2);
       end;
     end;
     FreeLibrary(Lib);
   end;
end; 机器码你可以用一个加密函数加密就成
加密解密有现成的控件:http://www.2ccc.com/article.asp?articleid=2915

支持，也可獲取CPUID，這是最好的機器碼

非常谢谢 hewei001 提供的程序，非常有用，谢谢

调试易

关于机器码的问题(送分)

解决方案 »