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

.

Delphi实现U盘加密狗相关推荐

python加密狗的制作_如何使用U盘制作Windows系统开机加密狗图文教程
U盘等移动设备除了可以用来储存文件,装系统以外,还可以用来制作加密狗.这篇文章中所指的加密狗仅指针对Windows系统开机的加密狗.它的作用是为了避免他人随便开启自己的电脑查看自己的私密信息,除了设置 ...
关于使用U盘制作简单windows开机加密狗
今天因为客户提到了,为定制产品设置加密狗,增强其安全防护性. 经过在网上查询资料,找到了几篇相同类容的文章,经过自己亲手实验,发现了参考文章中不足,经过总结,写成本文. 1.首先,在需要设置开机加密狗 ...
利用个人U盘制作简易加密狗
首先声明下,虽然使用了简易加密狗制作这样的标题,不过娱乐的成份居多,网上出售的程序加密狗哪怕是最简单的都比本文提到的原理复杂.商业的加密狗中除了软件开发者在程序里经常检查dongle中的单元(Cell ...
DAM2加密狗克隆的具体解决方案
Safengine(NP外壳)是一个具有反调试.反附加.动态自效验等功能,同时提供了对代码的变形.乱序和虚拟化等功能的应用程序保护壳,是一款加密强度高.简单易用的软件保护工具.支持.net外壳加密. ...
Sentinel圣天诺加密狗简单使用教程(Linux)
前言:帮学校的学长做了个Ubuntu的软件,需要给软件加密,用到了加密狗,在网上挑了很多,大都不支持Linux下ELF文件的加密,最后终于找到了Sentinel加密狗支持我们的需求,当然这个进口货也很 ...
linux u盘新建文件夹加密,linux磁盘的加密保护以及u盘加密的方法。
经常可以看到某些企业的服务器上插着一个优盘,用户一般称之为加密狗.不插入这个优盘无法访问某某数据等等.在linux中实现这个功能的软件名为cryptsetup-luks. 使用方法如下在系统中创建一个 ...
加密狗是什么？一次性给您说全加密狗的概念
转自:https://zhuanlan.zhihu.com/p/114759935 加密狗,也称作加密锁,是一种用在计算机.智能硬件设备.工控机.云端系统等软硬件加密产品.软件开发商通过加密狗管理软件 ...
装几只“加密狗”都无妨：活用打印机共享器
前段时间,上级单位给学校下发了一套财务管理系统,会计室主任让我帮助安装该程序.根据安装说明,安装该系统时要先装上随盘附带的硬件加密狗.现在,电脑的打印口上已经有两只加密狗了,打印机电缆接在最外层加密狗 ...
eplan长时间不用打开后显示没有可激活合适的加密狗
1. 安装EPLAN软件 2. 将license文件 SN-U10066.EGF 拷贝到 C:\User\Public\Eplan\Common\ 文件夹下将 version.dll 拷贝到 C:\ ...

Delphi实现U盘加密狗

Delphi实现U盘加密狗相关推荐

最新文章

热门文章