📄 tbsharereg.pas
字号:
{-----------------------------------------------------------------------------
Unit Name: TRRegistration
Purpose: 完成用户注册
History:
1.Start,2003-2-19;
2.2003-2-19,修改,注册号=计算机名+时间 ==〉计算机名+第一个IDE硬盘号;
3.2003-6-17, 修改,MD5的生成;
4.2003-7-7, 修改,加入时间的限制
-----------------------------------------------------------------------------}
unit TbShareReg;
interface
uses
Windows, SysUtils, Classes, Types, {HCMngr, }Registry, QStrings;
type
TTbRegState = (rsNone, rsCanUse, rsTimeOut);
TTbShareReg = class(TComponent)
private
{ Private declarations }
//HashManager: THashManager;
fAppName: string;
function WriteReg(KeyName, KeyValue : String) : Boolean;
function ReadReg(KeyName :String) : String;
function MD5Encode(AText : String):string;
function Asc2Hex(AText: string): string;
function Hex2Asc(AHex: string): string;
function TimeEncode(ATime: TDateTime): string;
function TimeDecode(sTime: string): TDateTime;
function UserId2KeyId(sUserId: string): string;
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(aowner: TComponent);override;
destructor Destroy; override;
function IsRegisted: Boolean;
function RegEncode2User(Guid: TGUID; IdeNo: string): string;overload;
function RegEncode2User: string;overload;
function RegEncode2Save(EndUseTime: TDateTime; Guid: TGUID; IdeNo: string): string;
//function RegUserCode2Save(sUser: string): string;
function RegUserCode2Save(EndUseDate: TDateTime; sUser: string): string;
function UpdateLastTime(sKeyId: string): Boolean;
function GetCurUserId(SavedUserId: string): string;
published
{ Published declarations }
property AppName: string
read fAppName
Write fAppName;
end;
procedure Register;
implementation
uses fReg, md5;
Const
//注册表常数
CompanyName = 'Treble Technology';
UserIdRegName = 'UserId';
KeyIdRegName = 'KeyId';
procedure Register;
begin
RegisterComponents('Treble', [TTbShareReg]);
end;
//获取第一个IDE硬盘的序列号
function GetIdeSerialNumber : string;
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;
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;
Result:= Trim(Result);
end;
{ TTbShareReg }
constructor TTbShareReg.Create(aowner: TComponent);
begin
inherited create(aowner);
fAppName:= 'Treble GPS';
end;
function TTbShareReg.MD5Encode(AText: String): string;
var
Md5Temp: MD5Digest;
sTemp: string;
begin
sTemp:= StringOfChar(#0, SizeOf(Md5Temp));
Md5Temp:= MD5String(AText);
Move(Md5Temp, sTemp[1], SizeOf(Md5Temp));
Result:= Q_Base64Encode(sTemp);
end;
destructor TTbShareReg.Destroy;
begin
inherited;
end;
function TTbShareReg.IsRegisted: Boolean;
//['{D270E606-240B-4B0C-A645-11E0B422A3AB}']
var
sSavedUserId, sSavedKeyId, sIdeNo: string;
sLastTime, sEndTime, sKeyId: string;
LastTime, EndTime: TDateTime;
sCurUserId, sCurKeyId, sUserId: string;
RegResult: TTbRegState;
frmRegister: TfrmReg;
begin
sSavedUserId:= ReadReg(UserIdRegName);
sSavedKeyId:= ReadReg(KeyIdRegName);
if (sSavedUserId='')or(sSavedKeyId='')
then RegResult:= rsNone
else begin
sLastTime:= Copy(sSavedKeyId, 1, 2* (SizeOf(TDateTime)));
sEndTime:= Copy(sSavedKeyId, 2* (SizeOf(TDateTime))+1, 2* (SizeOf(TDateTime)));
LastTime:= TimeDecode(sLastTime);
EndTime:= TimeDecode(sEndTime);
sKeyId:= Copy(sSavedKeyId, 4* (SizeOf(TDateTime))+1, MaxInt);
//判断是否注册
sIdeNo:= GetIdeSerialNumber;
if sIdeno<>''
then sCurUserId:= GetCurUserId(sSavedUserId)
else sCurUserId:= sSavedUserId;
//1.KeyId;
sCurKeyId:= UserId2KeyId(sCurUserId);
if sKeyId= sCurKeyId then begin
if (LastTime> now)or (LastTime> EndTime)
then //用户修改了时间
RegResult:= rsTimeOut
else begin
RegResult:= rsCanUse;
UpdateLastTime(sLastTime+ sEndTime+ sKeyId);
end;
end else RegResult:= rsNone;
end;
Result:= RegResult= rsCanUse;
// sTrueKeyId:= RegUserCode2Save(sCurUserId);
// Result:= (sTrueKeyId=sKeyId)and (sKeyId<>'');
if (not Result) then begin
{if sUserId='' then }sUserId:= RegEncode2User;
frmRegister:= TfrmReg.Create(Self);
if frmRegister.Execute(RegResult, sUserId, '') then begin
sUserId:= frmRegister.edtUserId.Text;
sKeyId:= frmRegister.edtKeyId.Text;
WriteReg(UserIdRegName, sUserId);
WriteReg(KeyIdRegName, sKeyId);
MessageBox(0, '注册信息写入硬盘已完成,请按确认键后,重试。',
'确认', MB_OK+ MB_ICONQUESTION);
end;
end;
end;
function TTbShareReg.ReadReg(KeyName: String): String;
var
Reg : TRegistryIniFile;
begin
Reg:= TRegistryIniFile.Create(CompanyName);
try
Result:= Reg.ReadString(fAppName, KeyName, '');
Result:= Q_Base64Decode(Result);
finally
Reg.Free;
end;
end;
function TTbShareReg.RegEncode2Save(EndUseTime: TDateTime;
Guid: TGUID; IdeNo: string): string;
var
sTemp, sMd5: string;
sCurTime, sEndTime: string;
begin
sCurTime:= TimeEncode(Now-100);
sEndTime:= TimeEncode(EndUseTime);
sTemp:= GUIDToString(Guid)+ ' '+ IdeNo;
sMd5:= Asc2Hex(MD5Encode(sTemp));
Result:= sCurTime+ sEndTime+ sMd5;
end;
function TTbShareReg.RegEncode2User(Guid: TGUID; IdeNo: string): string;
var
i: Integer;
sGuid, sTemp: string;
begin
sGuid:= GUIDToString(Guid);
i:= Pos('{', sGuid);
if i>0 then Delete(sGuid, i, 1);
i:= Pos('}', sGuid);
if i>0 then Delete(sGuid, i, 1);
sTemp:= Asc2Hex(IdeNo);
Result:= sTemp+ '-'+ sGuid;
end;
//function TTbShareReg.RegUserCode2Save(sUser: string): string;
//var
// i: Integer;
// Guid: TGuid;
// sIdeNo, sGuid: string;
//begin
// Result:= '';
// i:= Pos('-', sUser);
// if i=0 then Exit;
// sIdeNo:= Copy(sUser, 1, i-1);
// sIdeNo:= Hex2Asc(sIdeNo);
// Delete(sUser, 1, i);
// sGuid:= '{'+ sUser+ '}';
// try
// Guid:= StringToGUID(sGuid);
// Result:= RegEncode2Save(Guid, sIdeNo);
// except
// Result:= '不正确的用户序列号';
// end;
//end;
function TTbShareReg.WriteReg(KeyName, KeyValue: String): Boolean;
var
Reg : TRegistryIniFile;
sTemp: string;
begin
sTemp:= Q_Base64Encode(KeyValue);
Reg:= TRegistryIniFile.Create(CompanyName);
try
Reg.WriteString(fAppName, KeyName, sTemp);
Result:= True;
finally
Reg.Free;
end;
end;
function TTbShareReg.Asc2Hex(AText: string): string;
var
sTemp: string;
i: Integer;
begin
sTemp:= '';
for i:= 1 to Length(AText) do
sTemp:= sTemp+ IntToHex(Ord(AText[i]), 2);
Result:= sTemp;
end;
function TTbShareReg.Hex2Asc(AHex: string): string;
var
i: Integer;
sTemp: string;
begin
Result:= '';
for i:= 1 to Length(AHex)div 2 do begin
sTemp:= '$'+ Copy(AHex, 2*(i-1)+1, 2);
Result:= Result+ Chr(StrToIntDef(sTemp, 0));
end;
end;
function TTbShareReg.RegEncode2User: string;
var
Guid: TGuid;
sIdeNo: string;
begin
CreateGUID(Guid);
sIdeNo:= GetIdeSerialNumber;
Result:= RegEncode2User(Guid, sIdeNo);
end;
function TTbShareReg.GetCurUserId(SavedUserId: string): string;
var
sIdeNo: string;
i: Integer;
begin
sIdeNo:= Asc2Hex(GetIdeSerialNumber);
i:= Pos('-', SavedUserId);
if i>0 then begin
Delete(SavedUserId, 1, i-1);
Result:= sIdeNo+ SavedUserId;
end else Result:= '';
end;
function TTbShareReg.RegUserCode2Save(EndUseDate: TDateTime;
sUser: string): string;
var
i: Integer;
Guid: TGuid;
sIdeNo, sGuid: string;
begin
Result:= '不正确的用户序列号';
i:= Pos('-', sUser);
if i=0 then Exit;
sIdeNo:= Copy(sUser, 1, i-1);
sIdeNo:= Hex2Asc(sIdeNo);
Delete(sUser, 1, i);
sGuid:= '{'+ sUser+ '}';
try
Guid:= StringToGUID(sGuid);
Result:= RegEncode2Save(EndUseDate, Guid, sIdeNo);
except
Result:= '不正确的用户序列号';
end;
end;
function TTbShareReg.UpdateLastTime(sKeyId: string): Boolean;
var
sCurTime, sLastTime: string;
begin
sCurTime:= Copy(sKeyId, 1, 2*SizeOf(TDateTime));
sLastTime:= Copy(sKeyId, 2*SizeOf(TDateTime)+ 1, 2*SizeOf(TDateTime));
sKeyId:= Copy(sKeyId, 4* SizeOf(TDateTime)+1, MaxInt);
Result:= (Length(sCurTime)=2*SizeOf(TDateTime)) and
(Length(sLastTime)= 2*SizeOf(TDateTime));
sCurTime:= TimeEncode(Now);
sKeyId:= sCurTime+ sLastTime+ sKeyId;
WriteReg(KeyIdRegName, sKeyId);
end;
function TTbShareReg.TimeDecode(sTime: string): TDateTime;
var
ATime: array[0..SizeOf(TDateTime)-1]of char;
TempTime: TDateTime absolute ATime;
begin
sTime:= Hex2Asc(sTime);
if Length(sTime)>= SizeOf(TDateTime) then begin
Move(sTime[1], ATime, SizeOf(TDateTime));
Result:= TempTime;
end else Result:= 0;
end;
function TTbShareReg.TimeEncode(ATime: TDateTime): string;
var
sTime: array[0..SizeOf(TDateTime)-1]of char;
TempTime: TDateTime absolute sTime;
begin
TempTime:= ATime;
Result:= StringOfChar(' ', SizeOf(TDateTime));
Move(sTime, Result[1], SizeOf(TDateTime));
//Result:= Copy(sTime, 0, SizeOf(TDateTime));
Result:= Asc2Hex(Result);
end;
function TTbShareReg.UserId2KeyId(sUserId: string): string;
//UserId = IdeNo+ Guid;
var
sKeyId: string;
begin
sKeyId:= RegUserCode2Save(0, sUserId);
Result:= Copy(sKeyId, 4*SizeOf(TDateTime)+1 , MaxInt);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -