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 .

  • 0
    点赞
  • 7
    收藏
    觉得还不错? 一键收藏
  • 1
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论 1
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值