Delphi实现U盘加密狗

原帖见：http://hi.baidu.com/hacklzt/blog/item/3ab6a81f99b43817413417ca.html

转过来做为参考之用。

效果，只有当指定U盘插入才能打开该程序。该U盘的硬件序列号作为解密的密匙。代码如下：

procedure TForm1.GetDiskKey;
const
     drivers:array[0..25] of string=('A:/','B:/','C:/','D:/','E:/','F:/','G:/','H:/','I:/','J:/','K:/','L:/','M:/','N:/','O:/','P:/','Q:/','R:/','S:/','T:/','U:/','V:/','W:/','X:/','Y:/','Z:/');
var  i,sresult:integer;
     isKey:boolean;
begin
  isKey := false;
for I := 0 to 25 do
  begin
  sresult:=getdrivetype(pchar(drivers[i]));
  if (sresult=drive_removable) then
  begin
    if  (GetDiskID(PWidechar(drivers[i]))='876986194') then
    begin
    isKey := true;
    break;
    end;
  end;
  end;
if not isKey then   Application.Terminate;
end;

其中包含有GetDiskID函数：
unit GetSysInfo;

interface

uses
Windows, SysUtils, ShellAPI, WinSock, Registry;

const
VER_NT_WORKSTATION = $00000001;
VER_NT_DOMAIN_CONTROLLER = $00000002;
VER_NT_SERVER = $00000003;

VER_SERVER_NT = $80000000;
VER_WORKSTATION_NT = $40000000;

VER_SUITE_SMALLBUSINESS = $00000001;
VER_SUITE_ENTERPRISE = $00000002;
VER_SUITE_BACKOFFICE = $00000004;
VER_SUITE_COMMUNICATIONS = $00000008;
VER_SUITE_TERMINAL = $00000010;
VER_SUITE_SMALLBUSINESS_RESTRICTED = $00000020;
VER_SUITE_DATACENTER = $00000080;
VER_SUITE_SINGLEUSERTS = $00000100;
VER_SUITE_PERSONAL = $00000200;
VER_SUITE_BLADE = $00000400;

type
POSVersionInfoEx = ^TOSVersionInfoEx;
OSVERSIONINFOEXA = record
    dwOSVersionInfoSize: DWORD;
    dwMajorVersion: DWORD;
    dwMinorVersion: DWORD;
    dwBuildNumber: DWORD;
    dwPlatformId: DWORD;
    szCSDVersion: array[0..127] of AnsiChar;
    wServicePackMajor: WORD;
    wServicePackMinor: WORD;
    wSuiteMask: WORD;
    wProductType: BYTE;
    wReserved: BYTE;
end;
OSVERSIONINFOEXW = record
    dwOSVersionInfoSize: DWORD;
    dwMajorVersion: DWORD;
    dwMinorVersion: DWORD;
    dwBuildNumber: DWORD;
    dwPlatformId: DWORD;
    szCSDVersion: array[0..127] of WideChar;
    wServicePackMajor: WORD;
    wServicePackMinor: WORD;
    wSuiteMask: WORD;
    wProductType: BYTE;
    wReserved: BYTE;
end;
OSVERSIONINFOEX = OSVERSIONINFOEXA;
TOSVersionInfoEx = OSVERSIONINFOEX;

function SubString(sValue: string): string; //拷贝字符串
function ReplaceString(sValue: string): string; //删除字符串
function GetIdeDiskSerialNumber: string; //获得本机的硬盘ID号
function LocalIP: string; //获得本机的ip地址
function GetLocalHost: string; //获取计算机名称
function GetCurrentUserName: string; //获取当前计算机用户
function GetWindowsVersion: string; //获取系统版本号
function GetMemory: string; //GlobalMemoryStatus函数获取内存使用信息
function GetDiskID(disk:PWidechar):string;//获取硬盘序列号 ，disk为盘符

implementation

function GetDiskID(disk:PWidechar):string;
//调用    Showmessage(GetDiskID('d:/'));
var
  VolumeSerialNumber : DWORD;
  MaximumComponentLength : DWORD;
  FileSystemFlags : DWORD;
begin
  GetVolumeInformation(disk,nil,0,@VolumeSerialNumber,MaximumComponentLength,FileSystemFlags,nil,0);
  result := inttostr(Volumeserialnumber);
end;

//获取计算机名称
function GetLocalHost: string;
var
arr: array[0..MAX_COMPUTERNAME_LENGTH] of char;
d: DWORD;
begin
d := SizeOf(arr);
GetComputerName(arr, d);
result := string(arr);
end;

function SubString(sValue: string): string;
begin
Result := Copy(sValue, 1, Pos('|', sValue) - 1);
end;

function ReplaceString(sValue: string): string;
begin
Result := StringReplace(sValue, Copy(sValue, 1, Pos('|', sValue)), '', [rfIgnoreCase]);
end;

//GlobalMemoryStatus函数获取内存使用信息
function GetMemory: string;
var
MemStatus: TMemoryStatus; //定义内存结构变量
begin
// MemStatus.dwLength := Size of(MEMORYSTATUS);
GlobalMemoryStatus(MemStatus); //返回内存使用信息
Result := Format('可用内存: %dMB', [MemStatus.dwTotalPhys div 1048576]);
end;

//获取硬盘序列号
function GetIdeDiskSerialNumber: string;
type
TSrbIoControl = packed record
    HeaderLength: ULONG;
    Signature: array[0..7] of Char;
    Timeout: ULONG;
    ControlCode: ULONG;
    ReturnCode: ULONG;
    Length: ULONG;
end;
SRB_IO_CONTROL = TSrbIoControl;
PSrbIoControl = ^TSrbIoControl;

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;
IDEREGS = TIDERegs;
PIDERegs = ^TIDERegs;

TSendCmdInParams = packed record
    cBufferSize: DWORD; // Buffer size in bytes
    irDriveRegs: TIDERegs; // Structure with drive register values.
    bDriveNumber: Byte; // Physical drive number to send command to (0,1,2,3).
    bReserved: array[0..2] of Byte; // Reserved for future expansion.
    dwReserved: array[0..3] of DWORD; // For future use.
    bBuffer: array[0..0] of Byte; // Input buffer.
end;
SENDCMDINPARAMS = TSendCmdInParams;
PSendCmdInParams = ^TSendCmdInParams;

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: ULONG;
    wMultSectorStuff: Word;
    ulTotalAddressableSectors: ULONG;
    wSingleWordDMA: Word;
    wMultiWordDMA: Word;
    bReserved: array[0..127] of Byte;
end;
PIdSector = ^TIdSector;

const
IDE_ID_FUNCTION = $EC;
IDENTIFY_BUFFER_SIZE = 512;
DFP_RECEIVE_DRIVE_DATA = $0007C088;
IOCTL_SCSI_MINIPORT = $0004D008;
IOCTL_SCSI_MINIPORT_IDENTIFY = $001B0501;
DataSize = sizeof(TSendCmdInParams) - 1 + IDENTIFY_BUFFER_SIZE;
BufferSize = SizeOf(SRB_IO_CONTROL) + DataSize;
W9xBufferSize = IDENTIFY_BUFFER_SIZE + 16;
var
hDevice: THandle;
cbBytesReturned: DWORD;
pInData: PSendCmdInParams;
pOutData: Pointer; // PSendCmdInParams;
Buffer: array[0..BufferSize - 1] of Byte;
srbControl: TSrbIoControl absolute Buffer;

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 := '';
FillChar(Buffer, BufferSize, #0);
if Win32Platform = VER_PLATFORM_WIN32_NT then
begin // Windows NT, Windows 2000
      // Get SCSI port handle
    hDevice := CreateFile('//./Scsi0:', GENERIC_READ or GENERIC_WRITE,
      FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
    if hDevice = INVALID_HANDLE_VALUE then Exit;
    try
      srbControl.HeaderLength := SizeOf(SRB_IO_CONTROL);
      System.Move('SCSIDISK', srbControl.Signature, 8);
      srbControl.Timeout := 2;
      srbControl.Length := DataSize;
      srbControl.ControlCode := IOCTL_SCSI_MINIPORT_IDENTIFY;
      pInData := PSendCmdInParams(PChar(@Buffer) + SizeOf(SRB_IO_CONTROL));
      pOutData := pInData;
      with pInData^ do
      begin
        cBufferSize := IDENTIFY_BUFFER_SIZE;
        bDriveNumber := 0;
        with irDriveRegs do
        begin
          bFeaturesReg := 0;
          bSectorCountReg := 1;
          bSectorNumberReg := 1;
          bCylLowReg := 0;
          bCylHighReg := 0;
          bDriveHeadReg := $A0;
          bCommandReg := IDE_ID_FUNCTION;
        end;
      end;
      if not DeviceIoControl(hDevice, IOCTL_SCSI_MINIPORT, @Buffer, BufferSize, @Buffer, BufferSize, cbBytesReturned, nil) then Exit;
    finally
      CloseHandle(hDevice);
    end;
end
else
begin // Windows 95 OSR2, Windows 98
    hDevice := CreateFile('//./SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0);
    if hDevice = INVALID_HANDLE_VALUE then Exit;
    try
      pInData := PSendCmdInParams(@Buffer);
      pOutData := PChar(@pInData^.bBuffer);
      with pInData^ do
      begin
        cBufferSize := IDENTIFY_BUFFER_SIZE;
        bDriveNumber := 0;
        with irDriveRegs do
        begin
          bFeaturesReg := 0;
          bSectorCountReg := 1;
          bSectorNumberReg := 1;
          bCylLowReg := 0;
          bCylHighReg := 0;
          bDriveHeadReg := $A0;
          bCommandReg := IDE_ID_FUNCTION;
        end;
      end;
      if not DeviceIoControl(hDevice, DFP_RECEIVE_DRIVE_DATA, pInData, SizeOf(TSendCmdInParams) - 1, pOutData, W9xBufferSize, cbBytesReturned, nil) then Exit;
    finally
      CloseHandle(hDevice);
    end;
end;
with PIdSector(PChar(pOutData) + 16)^ do
begin
    ChangeByteOrder(sSerialNumber, SizeOf(sSerialNumber));
    SetString(Result, sSerialNumber, SizeOf(sSerialNumber));
end;
end;

//获得本机的ip地址
function LocalIP: string;
type
TaPInAddr = array[0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe: PHostEnt;
pptr: PaPInAddr;
Buffer: PAnsichar;
I: Integer;
GInitData: TWSADATA;
begin
buffer:='';
WSAStartup($101, GInitData);
Result := '';
GetHostName(Buffer, SizeOf(Buffer));
phe := GetHostByName(buffer);
if phe = nil then Exit;
pptr := PaPInAddr(Phe^.h_addr_list);
I := 0;
while pptr^[I] <> nil do begin
    result :=string( StrPas(inet_ntoa(pptr^[I]^)));
    Inc(I);
end;
WSACleanup;
end;

//当前用户名
function GetCurrentUserName: string;
const
cnMaxUserNameLen = 254;
var
sUserName: string; dwUserNameLen: DWord;
begin
dwUserNameLen := cnMaxUserNameLen - 1;
SetLength(sUserName, cnMaxUserNameLen);
GetUserName(PChar(sUserName), dwUserNameLen); SetLength(sUserName, dwUserNameLen);
Result := sUserName;
end;

//获取系统版本号
function GetWindowsVersion: string; //取系统版本号（字符串形式）
var
osVerInfo: TOSVersionInfoEx;
ExVerExist: Boolean;
ProductType: string;
begin
Result := 'Microsoft Windows';
ExVerExist := True;
osVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfoEx);
if not GetVersionEx(POSVersionInfo(@osVerInfo)^) then
begin
    osVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
    GetVersionEx(POSVersionInfo(@osVerInfo)^);
    ExVerExist := False;
end;
with osVerInfo do
begin
    case dwPlatformId of
      VER_PLATFORM_WIN32s: Result := Result + Format(' %d.%d', [dwMajorVersion, dwMinorVersion]);
      VER_PLATFORM_WIN32_WINDOWS: { Windows 9x/ME }
        begin
          if (dwMajorVersion = 4) and (dwMinorVersion = 0) then
          begin
            Result := Result + ' 95';
            if szCSDVersion[1] in ['B', 'C'] then
              Result := Result + ' OSR2';
          end
          else if (dwMajorVersion = 4) and (dwMinorVersion = 10) then
          begin
            Result := Result + ' 98';
            if (osVerInfo.szCSDVersion[1] = 'A') then
              Result := Result + ' Second Edition';
          end
          else if (dwMajorVersion = 4) and (dwMinorVersion = 90) then
            Result := Result + ' Millenium Edition';
        end;
      VER_PLATFORM_WIN32_NT: { Windows NT/2000 }
        begin
          case dwMajorVersion of
            3, 4: Result := Result + Format(' NT %d.%d', [dwMajorVersion, dwMinorVersion]);
            5: begin
                if dwMinorVersion = 0 then
                  Result := Result + ' 2000'
                else if dwMinorVersion = 1 then
                  Result := Result + ' XP'
                else if dwMinorVersion = 2 then
                  Result := Result + ' 2003 Server';
              end;
          end;

          if ExVerExist then
          begin
            if wProductType = VER_NT_WORKSTATION then
            begin
              if dwMajorVersion = 4 then
                Result := Result + ' Workstation'
              else if wSuiteMask and VER_SUITE_PERSONAL <> 0 then
                Result := Result + ' Home Edition'
              else
                Result := Result + ' Professional';
            end
            else if wProductType = VER_NT_SERVER then
            begin
              if (dwMajorVersion = 5) and (dwMinorVersion = 2) then
              begin
                if wSuiteMask and VER_SUITE_DATACENTER <> 0 then
                  Result := Result + ' Datacenter Edition'
                else if wSuiteMask and VER_SUITE_ENTERPRISE <> 0 then
                  Result := Result + ' Enterprise Edition'
                else if wSuiteMask and VER_SUITE_BLADE <> 0 then
                  Result := Result + ' Web Edition'
                else
                  Result := Result + ' Standard Edition';
              end
              else if (dwMajorVersion = 5) and (dwMinorVersion = 0) then
              begin
                if wSuiteMask and VER_SUITE_DATACENTER <> 0 then
                  Result := Result + ' Datacenter Server'
                else if wSuiteMask and VER_SUITE_ENTERPRISE <> 0 then
                  Result := Result + ' Advanced Server'
                else
                  Result := Result + ' Server'
              end
              else
              begin
                Result := Result + ' Server';
                if wSuiteMask and VER_SUITE_ENTERPRISE <> 0 then
                  Result := Result + ' Enterprise Edition';
              end;
            end;
          end
          else
          begin
            with TRegistry.Create do
            begin
              try
                RootKey := HKEY_LOCAL_MACHINE;
                if OpenKey('/SYSTEM/CurrentControlSet/Control/ProductOptions', False) then
                begin
                  if ValueExists('ProductType') then
                  begin
                    ProductType := ReadString('ProductType');
                    if SameText(ProductType, 'WinNT') then
                      Result := Result + ' Workstation'
                    else if SameText(ProductType, 'LanManNT') then
                      Result := Result + ' Server'
                    else if SameText(ProductType, 'ServerNT') then
                      Result := Result + ' Advance Server';
                  end;
                  CloseKey;
                end;
              finally
                Free;
              end;
            end;
          end;

          Result :=Result + ' ' +string( szCSDVersion);
          if (dwMajorVersion = 4) and SameText(string(szCSDVersion), 'Service Pack 6') then
          begin
            with TRegistry.Create do
            begin
              try
                RootKey := HKEY_LOCAL_MACHINE;
                if OpenKey('/SOFTWARE/Microsoft/Windows NT/CurrentVersion/Hotfix/Q246009', False) then
                begin
                  Result := Result + 'a';
                  CloseKey;
                end;
              finally
                Free;
              end;
            end;
          end;
          Result := Result + Format(' (Build %d)', [dwBuildNumber and $FFFF]);
        end;
    end;
end
end;

end.