Delphi ProgramReg.pas

unit ProgramReg;

interface


uses StdCtrls, Buttons, Controls, Classes,
  Windows, Messages, SysUtils, Variants, Graphics,  Forms,
  Dialogs,Nb30,md5;

type
    TGetSN =function(HardType: integer):WideString; stdcall;
    TForm_ProgReg = class(TForm)
    grp2: TGroupBox;
    lbl7: TLabel;
    lbl6: TLabel;
    lbl8: TLabel;
    edtRegKey: TEdit;
    edtRegUser: TEdit;
    edtRegIdeId: TEdit;
    grp1: TGroupBox;
    grp3: TGroupBox;
    Label2: TLabel;
    btnReg: TBitBtn;
    BitBtn2: TBitBtn;
    Button1: TButton;
    procedure BitBtn2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
 
private
    { Private declarations }
public
    { Public declarations }
  end;
function GetIdeSerialNumber: pchar;//获取第一个IDE硬盘序列号函数
function GetIDEDiskDriveInfo(Drive: Char; InfoID: Byte): String; //获取盘符序列号
function NbGetMac():string ;
function GetCPUInfo(InfoID:Byte=1) : String;//取CPU信息:1、CPU序列号;2、CPU 频率;3、CPU 厂商

function RivestStr(Str: string): string;

var
  Form_ProgReg: TForm_ProgReg;

implementation


{$R *.dfm}


procedure TForm_ProgReg.BitBtn2Click(Sender: TObject);
begin
close;
end;




//-----------------------------------------------------------------------
//获取CPU硬件信息
//-----------------------------------------------------------------------
//参数:
// InfoID:=1 获取CPU序列号
// InfoID:=2 获取CPU 频率
// InfoID:=3 获取CPU厂商
//-----------------------------------------------------------------------
function GetCPUInfo(InfoID: Byte): String;
var
  _eax, _ebx, _ecx, _edx: Longword;
  i: Integer;
  b: Byte;
//  b1: Word;
  s, s1, s2, s3, s_all: string;
begin
case InfoID of  //获取CPU序列号
 1:
 begin
   asm
    mov eax,1
    db $0F,$A2
    mov _eax,eax
    mov _ebx,ebx
    mov _ecx,ecx
    mov _edx,edx
  end;
  s := IntToHex(_eax, 8);
  s1 := IntToHex(_edx, 8);
  s2 := IntToHex(_ecx, 8); 
  Insert('-', s, 5);
  Insert('-', s1, 5);
  Insert('-', s2, 5);
  result:=s + '-' + s1 + '-' + s2;
 end;
 2: //获取 CPU 频率
 begin
  asm     //execute the extended CPUID inst. 
    mov eax,$80000000   //sub. func call 
    db $0F,$A2 
    mov _eax,eax 
  end; 
  if _eax > $80000000 then  //any other sub. funct avail. ? 
  begin
    asm     //get brand ID
      mov eax,$80000002
      db $0F
      db $A2
      mov _eax,eax
      mov _ebx,ebx
      mov _ecx,ecx
      mov _edx,edx
    end; 
    s  := ''; 
    s1 := ''; 
    s2 := ''; 
    s3 := ''; 
    for i := 0 to 3 do 
    begin 
      b := lo(_eax); 
      s3:= s3 + chr(b); 
      b := lo(_ebx); 
      s := s + chr(b); 
      b := lo(_ecx); 
      s1 := s1 + chr(b); 
      b := lo(_edx); 
      s2 := s2 + chr(b); 
      _eax := _eax shr 8; 
      _ebx := _ebx shr 8; 
      _ecx := _ecx shr 8; 
      _edx := _edx shr 8; 
    end;
    s_all := trim(s3 + s + s1 + s2);
    asm 
      mov eax,$80000003 
      db $0F 
      db $A2 
      mov _eax,eax 
      mov _ebx,ebx 
      mov _ecx,ecx 
    mov _edx,edx 
    end; 
    s  := ''; 
    s1 := ''; 
    s2 := ''; 
    s3 := ''; 
    for i := 0 to 3 do 
    begin 
      b := lo(_eax); 
      s3 := s3 + chr(b); 
      b := lo(_ebx); 
      s := s + chr(b); 
      b := lo(_ecx); 
      s1 := s1 + chr(b); 
      b := lo(_edx); 
      s2 := s2 + chr(b); 
      _eax := _eax shr 8; 
      _ebx := _ebx shr 8; 
      _ecx := _ecx shr 8; 
      _edx := _edx shr 8; 
    end; 
    s_all := s_all + s3 + s + s1 + s2; 
    asm
      mov eax,$80000004
      db $0F
      db $A2
      mov _eax,eax
      mov _ebx,ebx
      mov _ecx,ecx
      mov _edx,edx
    end;
    s  := '';
    s1 := '';
    s2 := '';
    s3 := '';
    for i := 0 to 3 do
    begin
      b  := lo(_eax);
      s3 := s3 + chr(b);
      b := lo(_ebx);
      s := s + chr(b);
      b := lo(_ecx);
      s1 := s1 + chr(b);
      b  := lo(_edx);
      s2 := s2 + chr(b);
      _eax := _eax shr 8;
      _ebx := _ebx shr 8;
      _ecx := _ecx shr 8;
      _edx := _edx shr 8;
    end;
    if s2[Length(s2)] = #0 then setlength(s2, Length(s2) - 1);
    result:= s_all + s3 + s + s1 + s2;
  end
  else
    result:= '';

 end;
 3: //获取 CPU厂商
 begin
  asm                //asm call to the CPUID inst.
    mov eax,0         //sub. func call
    db $0F,$A2         //db $0F,$A2 = CPUID instruction
    mov _ebx,ebx
    mov _ecx,ecx
    mov _edx,edx
  end;
  for i := 0 to 3 do   //extract vendor id 
  begin
    b := lo(_ebx);
    s := s + chr(b);
    b := lo(_ecx);
    s1:= s1 + chr(b);
    b := lo(_edx);
    s2:= s2 + chr(b);
    _ebx := _ebx shr 8;
    _ecx := _ecx shr 8;
    _edx := _edx shr 8;
  end;
  result:=s + s2 + s1;
 end;
 else
  result:='错误的信息标识!';
end;

end;

//获取第一个IDE硬盘的序列号
function GetIdeSerialNumber : pchar;
const IDENTIFY_BUFFER_SIZE = 512;
type
   TIDERegs = packed record
    bFeaturesReg     : BYTE; // Used for specifying SMART "commands".
    bSectorCountReg  : BYTE; // IDE sector count register
    bSectorNumberReg : BYTE; // IDE sector number register
    bCylLowReg       : BYTE; // IDE low order cylinder value
    bCylHighReg      : BYTE; // IDE high order cylinder value
    bDriveHeadReg    : BYTE; // IDE drive/head register
    bCommandReg      : BYTE; // Actual IDE command.
    bReserved        : BYTE; // reserved for future use.  Must be zero.
  end;
  TSendCmdInParams = packed record
    // Buffer size in bytes
    cBufferSize  : DWORD;
    // Structure with drive register values.
    irDriveRegs  : TIDERegs;
    // Physical drive number to send command to (0,1,2,3).
    bDriveNumber : BYTE;
    bReserved    : Array[0..2] of Byte;
    dwReserved   : Array[0..3] of DWORD;
    bBuffer      : Array[0..0] of Byte;  // Input buffer.
  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
    // 驱动器返回的错误代码,无错则返回0
    bDriverError : Byte;
    // IDE出错寄存器的内容,只有当bDriverError 为 SMART_IDE_ERROR 时有效
    bIDEStatus   : Byte;
    bReserved    : Array[0..1] of Byte;
    dwReserved   : Array[0..1] of DWORD;
  end;
  TSendCmdOutParams = packed record
    // bBuffer的大小
    cBufferSize  : DWORD;
    // 驱动器状态
    DriverStatus : TDriverStatus;
    // 用于保存从驱动器读出的数据的缓冲区,实际长度由cBufferSize决定
    bBuffer      : Array[0..0] of BYTE;
  end;
  var hDevice : THandle;
      cbBytesReturned : DWORD;
    //  ptr : PChar;
      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
        // 提示! 改变名称可适用于其它驱动器,如第二个驱动器: '\\.\PhysicalDrive1\'
        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;
      // Set up data structures for IDENTIFY command.
      with SCIP do begin
        cBufferSize  := IDENTIFY_BUFFER_SIZE;
  //      bDriveNumber := 0;
        with irDriveRegs do begin
          bSectorCountReg  := 1;
          bSectorNumberReg := 1;
  //      if Win32Platform=VER_PLATFORM_WIN32_NT then bDriveHeadReg := $A0
  //      else bDriveHeadReg := $A0 or ((bDriveNum and 1) shl 4);
          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;

  // 更多关于 S.M.A.R.T. ioctl 的信息可查看:
  //  http://www.microsoft.com/hwdev/download/respec/iocltapi.rtf

  // MSDN库中也有一些简单的例子
  //  Windows Development -> Win32 Device Driver Kit ->
  //  SAMPLE: SmartApp.exe Accesses SMART stats in IDE drives

  // 还可以查看 http://www.mtgroup.ru/~alexk
  //  IdeInfo.zip - 一个简单的使用了S.M.A.R.T. Ioctl API的Delphi应用程序
  
  // 注意: 
  
  //  WinNT/Win2000 - 你必须拥有对硬盘的读/写访问权限
  
  //  Win98 
  //    SMARTVSD.VXD 必须安装到 \windows\system\iosubsys 
  //    (不要忘记在复制后重新启动系统)




  //-----------------------------------------------------------------------
//获取硬盘驱动器信息
//-----------------------------------------------------------------------
//参数:
// Drive 驱动器盘符 如C、D、E,不要带 :\
// InfoID =1 获取驱动器序列号  InfoID =2 获取卷标
//-----------------------------------------------------------------------
function GetIDEDiskDriveInfo(Drive: Char; InfoID: Byte): String;
var
  NotUsed:     DWORD;
  VolumeFlags: DWORD;
  VolumeInfo:  array[0..MAX_PATH] of Char;
  VolumeSerialNumber: DWORD;
begin
try
  GetVolumeInformation(PChar(Drive + ':\'),
    VolumeInfo, SizeOf(VolumeInfo), @VolumeSerialNumber, NotUsed,
    VolumeFlags, nil, 0);
  case InfoID of
  1: Result:= Format('%8.8X', [VolumeSerialNumber]);
  2: Result:= VolumeInfo;
 else
  result:='错误的信息标识!';
  end;
except on E: Exception do
result:='执行错误!';
end;
end;



//取得网卡MAC地址


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:[email protected];
  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 :[email protected];
      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  GetHDserial:string ;
var
  SerialNum : dword;
  a, b : dword;
  Buffer  ,fname : array [0..255] of char;
begin
  if GetVolumeInformation('c:\', Buffer, SizeOf(Buffer), @SerialNum, a, b, fname, sizeof(fname)) then
      result:= IntToStr(SerialNum) else
      result:= '' ;
end;


function RivestStr(Str: string): string;
begin
  Result := MD5Print(MD5String(Str));
end;


procedure TForm_ProgReg.Button1Click(Sender: TObject);

begin
edtRegIdeId.Text:=trim(GetCPUInfo(1));
//   edtRegIdeId.Text:=trim(GetIdeSerialNumber)+'-'+trim(NbGetMac)+'-'+trim(GetHDserial);
   edtRegKey.Text:= RivestStr(edtRegIdeId.Text+edtRegUser.Text);
end;


end.

You may also like...

发表评论

电子邮件地址不会被公开。 必填项已用*标注

网站搬迁至国外服务器,访问稍慢,请耐心等待! 忽略