VB代码。
Function KeyGen(kNamev As Variant, kPass As String, kType As Integer) As String
'****************************************************************************
'* KeyGen v2.01 Build 01 *
'* Copyright ?2000 W.G.Griffiths *
'* *
'* Url: http://www.webdreams.org.uk *
'* E-Mail: [email protected] *
'* *
'* kNamev = Any text String, Object, String() *
'* kPass = Developer Password as String *
'* *
'* kType = 1 Numeric Key *
'* ktype = 2 Alphanumeric Key *
'* kType = 3 Hex Key *
'* *
'* This function returns a Software Key for a given *
'* name and password *
'* *
'* NOTE: Watch www.webdreams.org.uk over the next few months.... *
'****************************************************************************On Error Resume Next 'still here just as a precautionDim cTable(512) As Integer 'character map
Dim nKeys(16) As Integer 'xor keys used for pArray(x) xor nkeys(x)
Dim s0(512) As Integer 'swap-box data used to map character table
Dim nArray(16) As Integer 'name array data
Dim pArray(16) As Integer 'password array data
Dim n As Integer 'for next loop counter
Dim nPtr As Integer 'name pointer (used for counting)
Dim cPtr As Integer 'character pointer (used for counting)
Dim cFlip As Boolean 'character flip (used to flip between numeric and alpha)
Dim sIni As Integer 'holds s-box values
Dim temp As Integer 'holds s-box values
Dim rtn As Integer 'holds generated key values used agains chr map
Dim gKey As String 'generated key as string
Dim nLen As Integer 'number of chr's in name
Dim pLen As Integer 'number of chr's in password
Dim kPtr As Integer 'key pointer
Dim sPtr As Integer 'space pointer (used in hex key)
Dim nOffset As Integer 'name offset
Dim pOffset As Integer 'password offset
Dim tOffset As Integer 'total offset
Dim KeySize As Integer 'the size of the key to makeConst nXor As Integer = 18 'name xor value
Const pXor As Integer = 25 'password xor value
Const cLw As Integer = 65 'character lower limit 65 = A ** do not change **
Const nLw As Integer = 48 'number lower limit 48 = 0 ** do not change **
Const sOffset As Integer = 0 'character map offset'****************************************************************************
'Thanks to Chris Fournier for his suggestions for adding support for *
'Strings, Objects and String() as arrays *
'Your comments please *
'****************************************************************************
Dim VarType As String
Dim kName As String
Dim AryCtl As Integer
Dim AryCtrl As ControlVarType = TypeName(kNamev)Select Case VarType
Case "String"
kName = kNamev
Case "TextBox"
kName = kNamev.Text
Case "Object"
For Each AryCtrl In kNamev
If AryCtrl.Text <> "" Then
kName = kName & AryCtrl.Text & "|"
End If
Next
kName = Left(kName, Len(kName) - 1)
Case "String()"
For AryCtl = LBound(kNamev) To UBound(kNamev)
If kNamev(AryCtl) <> "" Then
kName = kName & kNamev(AryCtl) & "|"
End If
Next
kName = Left(kName, Len(kName) - 1)
Case Else
MsgBox VarType & " is an unsupported type to be passed to KeyGen"
End Select
'****************************************************************************nLen = Len(kName)
pLen = Len(kPass)'password xor keys ** change to make keygen unique **
nKeys(1) = 46
nKeys(2) = 89
nKeys(3) = 142
nKeys(4) = 63
nKeys(5) = 231
nKeys(6) = 32
nKeys(7) = 129
nKeys(8) = 51
nKeys(9) = 28
nKeys(10) = 97
nKeys(11) = 248
nKeys(12) = 41
nKeys(13) = 136
nKeys(14) = 53
nKeys(15) = 78
nKeys(16) = 164sIni = 0'set s boxes
For n = 0 To 512
s0(n) = n
Next nFor n = 0 To 512
sIni = (sOffset + sIni + n) Mod 256
temp = s0(n)
s0(n) = s0(sIni)
s0(sIni) = temp
Next nIf kType = 1 Then '(numeric)
nPtr = 0
KeySize = 16
gKey = String(16, " ")
For n = 0 To 512
cTable(s0(n)) = (nLw + (nPtr))
nPtr = nPtr + 1
If nPtr = 10 Then nPtr = 0
Next n
ElseIf kType = 2 Then '(alphanumeric)
nPtr = 0
cPtr = 0
KeySize = 16
gKey = String(16, " ")
cFlip = False
For n = 0 To 512
If cFlip Then
cTable(s0(n)) = (nLw + nPtr)
nPtr = nPtr + 1
If nPtr = 10 Then nPtr = 0
cFlip = False
Else
cTable(s0(n)) = (cLw + cPtr)
cPtr = cPtr + 1
If cPtr = 26 Then cPtr = 0
cFlip = True
End If
Next n
Else '(hex) KeySize = 8
gKey = String(19, " ")
End IfkPtr = 1For n = 1 To nLen 'name
nArray(kPtr) = nArray(kPtr) + Asc(Mid(kName, n, 1)) Xor nXor
nOffset = nOffset + nArray(kPtr)
kPtr = kPtr + 1
If kPtr = 9 Then kPtr = 1
Next nFor n = 1 To pLen 'password
pArray(kPtr) = pArray(kPtr) + Asc(Mid(kPass, n, 1)) Xor pXor
pOffset = pOffset + pArray(kPtr)
kPtr = kPtr + 1
If kPtr = 9 Then kPtr = 1
Next ntOffset = (nOffset + pOffset) Mod 512kPtr = 1
sPtr = 1
For n = 1 To KeySize
pArray(n) = pArray(n) Xor nKeys(n)
rtn = Abs(((nArray(n) Xor pArray(n)) Mod 512) - tOffset)
If kType = 3 Then 'hex key
If rtn < 16 Then
Mid(gKey, kPtr, 2) = "0" & Hex(rtn)
Else
Mid(gKey, kPtr, 2) = Hex(rtn)
End If
If sPtr = 2 And kPtr < 18 Then
kPtr = kPtr + 1
Mid(gKey, kPtr + 1, 1) = "-"
End If
kPtr = kPtr + 2
sPtr = sPtr + 1
If sPtr = 3 Then sPtr = 1
Else 'numeric - alphanumeric key
Mid(gKey, n, 1) = Chr(cTable(rtn))
End If
NextKeyGen = gKeyEnd Function
Function KeyGen(kNamev As Variant, kPass As String, kType As Integer) As String
'****************************************************************************
'* KeyGen v2.01 Build 01 *
'* Copyright ?2000 W.G.Griffiths *
'* *
'* Url: http://www.webdreams.org.uk *
'* E-Mail: [email protected] *
'* *
'* kNamev = Any text String, Object, String() *
'* kPass = Developer Password as String *
'* *
'* kType = 1 Numeric Key *
'* ktype = 2 Alphanumeric Key *
'* kType = 3 Hex Key *
'* *
'* This function returns a Software Key for a given *
'* name and password *
'* *
'* NOTE: Watch www.webdreams.org.uk over the next few months.... *
'****************************************************************************On Error Resume Next 'still here just as a precautionDim cTable(512) As Integer 'character map
Dim nKeys(16) As Integer 'xor keys used for pArray(x) xor nkeys(x)
Dim s0(512) As Integer 'swap-box data used to map character table
Dim nArray(16) As Integer 'name array data
Dim pArray(16) As Integer 'password array data
Dim n As Integer 'for next loop counter
Dim nPtr As Integer 'name pointer (used for counting)
Dim cPtr As Integer 'character pointer (used for counting)
Dim cFlip As Boolean 'character flip (used to flip between numeric and alpha)
Dim sIni As Integer 'holds s-box values
Dim temp As Integer 'holds s-box values
Dim rtn As Integer 'holds generated key values used agains chr map
Dim gKey As String 'generated key as string
Dim nLen As Integer 'number of chr's in name
Dim pLen As Integer 'number of chr's in password
Dim kPtr As Integer 'key pointer
Dim sPtr As Integer 'space pointer (used in hex key)
Dim nOffset As Integer 'name offset
Dim pOffset As Integer 'password offset
Dim tOffset As Integer 'total offset
Dim KeySize As Integer 'the size of the key to makeConst nXor As Integer = 18 'name xor value
Const pXor As Integer = 25 'password xor value
Const cLw As Integer = 65 'character lower limit 65 = A ** do not change **
Const nLw As Integer = 48 'number lower limit 48 = 0 ** do not change **
Const sOffset As Integer = 0 'character map offset'****************************************************************************
'Thanks to Chris Fournier for his suggestions for adding support for *
'Strings, Objects and String() as arrays *
'Your comments please *
'****************************************************************************
Dim VarType As String
Dim kName As String
Dim AryCtl As Integer
Dim AryCtrl As ControlVarType = TypeName(kNamev)Select Case VarType
Case "String"
kName = kNamev
Case "TextBox"
kName = kNamev.Text
Case "Object"
For Each AryCtrl In kNamev
If AryCtrl.Text <> "" Then
kName = kName & AryCtrl.Text & "|"
End If
Next
kName = Left(kName, Len(kName) - 1)
Case "String()"
For AryCtl = LBound(kNamev) To UBound(kNamev)
If kNamev(AryCtl) <> "" Then
kName = kName & kNamev(AryCtl) & "|"
End If
Next
kName = Left(kName, Len(kName) - 1)
Case Else
MsgBox VarType & " is an unsupported type to be passed to KeyGen"
End Select
'****************************************************************************nLen = Len(kName)
pLen = Len(kPass)'password xor keys ** change to make keygen unique **
nKeys(1) = 46
nKeys(2) = 89
nKeys(3) = 142
nKeys(4) = 63
nKeys(5) = 231
nKeys(6) = 32
nKeys(7) = 129
nKeys(8) = 51
nKeys(9) = 28
nKeys(10) = 97
nKeys(11) = 248
nKeys(12) = 41
nKeys(13) = 136
nKeys(14) = 53
nKeys(15) = 78
nKeys(16) = 164sIni = 0'set s boxes
For n = 0 To 512
s0(n) = n
Next nFor n = 0 To 512
sIni = (sOffset + sIni + n) Mod 256
temp = s0(n)
s0(n) = s0(sIni)
s0(sIni) = temp
Next nIf kType = 1 Then '(numeric)
nPtr = 0
KeySize = 16
gKey = String(16, " ")
For n = 0 To 512
cTable(s0(n)) = (nLw + (nPtr))
nPtr = nPtr + 1
If nPtr = 10 Then nPtr = 0
Next n
ElseIf kType = 2 Then '(alphanumeric)
nPtr = 0
cPtr = 0
KeySize = 16
gKey = String(16, " ")
cFlip = False
For n = 0 To 512
If cFlip Then
cTable(s0(n)) = (nLw + nPtr)
nPtr = nPtr + 1
If nPtr = 10 Then nPtr = 0
cFlip = False
Else
cTable(s0(n)) = (cLw + cPtr)
cPtr = cPtr + 1
If cPtr = 26 Then cPtr = 0
cFlip = True
End If
Next n
Else '(hex) KeySize = 8
gKey = String(19, " ")
End IfkPtr = 1For n = 1 To nLen 'name
nArray(kPtr) = nArray(kPtr) + Asc(Mid(kName, n, 1)) Xor nXor
nOffset = nOffset + nArray(kPtr)
kPtr = kPtr + 1
If kPtr = 9 Then kPtr = 1
Next nFor n = 1 To pLen 'password
pArray(kPtr) = pArray(kPtr) + Asc(Mid(kPass, n, 1)) Xor pXor
pOffset = pOffset + pArray(kPtr)
kPtr = kPtr + 1
If kPtr = 9 Then kPtr = 1
Next ntOffset = (nOffset + pOffset) Mod 512kPtr = 1
sPtr = 1
For n = 1 To KeySize
pArray(n) = pArray(n) Xor nKeys(n)
rtn = Abs(((nArray(n) Xor pArray(n)) Mod 512) - tOffset)
If kType = 3 Then 'hex key
If rtn < 16 Then
Mid(gKey, kPtr, 2) = "0" & Hex(rtn)
Else
Mid(gKey, kPtr, 2) = Hex(rtn)
End If
If sPtr = 2 And kPtr < 18 Then
kPtr = kPtr + 1
Mid(gKey, kPtr + 1, 1) = "-"
End If
kPtr = kPtr + 2
sPtr = sPtr + 1
If sPtr = 3 Then sPtr = 1
Else 'numeric - alphanumeric key
Mid(gKey, n, 1) = Chr(cTable(rtn))
End If
NextKeyGen = gKeyEnd Function
解决方案 »
- DELPHI 2007都没解决的问题: 万恶的 DLL-4K 内存泄漏(转贴)
- 请问这几句话是什么意思,请帮忙看看
- 一个如何处理两个数据库的一对多查询?
- ActiveForm里怎样读取 它所在HTML页里的param参数?
- 请教右键功能的实现(复制,粘贴,剪切,刷新)?
- 在windows2000 下insert into 整型字段问题?
- 两个TreeView,怎么相互赋值?
- Delphi中使用SQL,汉字显示不正常。
- 怎样查询一段时间
- 这个东西怎么和vb不同,我怎么获得enter键信息?
- delphi2005中ASP.net程序中不能显示web control 组件
- RadioGroup1 删除 问题
我改的DELPHI代码。
function ReplaceSubString(var SourceString:String;SubString:string;BeginIndex,SubLength:integer):boolean;
var
i:integer;
begin
if (Length(SubString) <> (SubLength)) or (Length(SourceString) < BeginIndex + SubLength) or (BeginIndex < 1) then
begin
result:= false;
exit;
end;
for i:=1 to SubLength do
SourceString[i+BeginIndex]:= SubString[i];
result:= true;
end;
function KeyGen(kNamev: string; kPass: string; kType: Integer): string;
//****************************************************************************
//* KeyGen v2.01 Build 01 *
//* Copyright ?2000 W.G.Griffiths *
//* *
//* Url: http://www.webdreams.org.uk *
//* E-Mail: [email protected] *
//* *
//* kNamev = Any text String *
//* kPass = Developer Password as String *
//* *
//* kType = 1 Numeric Key *
//* ktype = 2 Alphanumeric Key *
//* kType = 3 Hex Key *
//* *
//* This function returns a Software Key for a given *
//* name and password *
//* *
//* NOTE: Watch www.webdreams.org.uk over the next few months.... *
//****************************************************************************
var
cTable:array[0..512] of Integer; //character map
nKeys:array[1..16] of Integer; //xor keys used for pArray(x) xor nkeys(x)
s0:array[0..512] of Integer; //swap-box data used to map character table
nArray:array[0..16] of Integer; //name array data
pArray:array[0..16] of Integer; //password array data
n: Integer; //for next loop counter
nPtr: Integer; //name pointer (used for counting)
cPtr: Integer; //character pointer (used for counting)
cFlip: Boolean; //character flip (used to flip between numeric and alpha)
sIni: Integer; //holds s-box values
temp: Integer; //holds s-box values
rtn: Integer; //holds generated key values used agains chr map
gKey: String; //generated key: string
nLen: Integer; //number of chr's in name
pLen: Integer; //number of chr's in password
kPtr: Integer; //key pointer
sPtr: Integer; //space pointer (used in hex key)
nOffset: Integer; //name offset
pOffset: Integer; //password offset
tOffset: Integer; //total offset
KeySize: Integer; //the size of the key to make //****************************************************************************
//Thanks to Chris Fournier for his suggestions for adding support for *
//Strings, Objects and String(): arrays *
//Your comments please *
//**************************************************************************** kName: String;
AryCtl: Integer;
tempstr: string;
//AryCtrl: Control;
const
nXor: Integer = 18; //name xor value
pXor: Integer = 25; //password xor value
cLw: Integer = 65; //character lower limit 65 = A ** do not change **
nLw: Integer = 48; //number lower limit 48 = 0 ** do not change **
sOffset: Integer = 0; //character map offset
begin
kName:= kNamev;
nLen:= Length(kName);
pLen:= Length(kPass); //password xor keys ** change to make keygen unique **
nKeys[1]:= 46;
nKeys[2]:= 89;
nKeys[3]:= 142;
nKeys[4]:= 63;
nKeys[5]:= 231;
nKeys[6]:= 32;
nKeys[7]:= 129;
nKeys[8]:= 51;
nKeys[9]:= 28;
nKeys[10]:= 97;
nKeys[11]:= 248;
nKeys[12]:= 41;
nKeys[13]:= 136;
nKeys[14]:= 53;
nKeys[15]:= 78;
nKeys[16]:= 164; sIni:= 0; //set s boxes
for n:= 0 to 512 do
s0[n]:= n; for n:= 0 to 512 do
begin
sIni:= (sOffset + sIni + n) mod 256;
temp:= s0[n];
s0[n]:= s0[sIni];
s0[sIni]:= temp;
end; if kType = 1 then //(numeric)
begin
nPtr:= 0;
KeySize:= 16;
gKey:= StringOfChar(' ',16);
for n:= 0 to 512 do
begin
cTable[s0[n]]:= (nLw + (nPtr));
nPtr:= nPtr + 1;
if nPtr = 10 then nPtr:= 0;
end;
end
else if kType = 2 then //(alphanumeric)
begin
nPtr:= 0;
cPtr:= 0;
KeySize:= 16;
gKey:= StringOfChar(' ',16);
cFlip:= False;
for n:= 0 to 512 do
begin
if cFlip then
begin
cTable[s0[n]]:= (nLw + nPtr);
nPtr:= nPtr + 1;
If nPtr = 10 Then nPtr:= 0;
cFlip:= False;
end
else begin
cTable[s0[n]]:= (cLw + cPtr);
cPtr:= cPtr + 1;
If cPtr = 26 Then cPtr:= 0;
cFlip:= True;
end;
end;
end
else begin //(hex)
KeySize:= 8;
gKey:= StringOfChar(' ',19);
end; kPtr:= 1; for n:= 1 to nLen do //name
begin
tempstr := Midstr(kName, n, 1);
nArray[kPtr]:= nArray[kPtr] + ord(tempstr[1]) xor nXor;
nOffset:= nOffset + nArray[kPtr];
kPtr:= kPtr + 1;
if kPtr = 9 then kPtr:= 1;
end; for n:= 1 to pLen do //password
begin
tempstr := MidStr(kPass, n, 1);
pArray[kPtr]:= pArray[kPtr] + ord(tempstr[1]) xor pXor;
pOffset:= pOffset + pArray[kPtr];
kPtr:= kPtr + 1;
if kPtr = 9 then kPtr:= 1;
end; tOffset:= (nOffset + pOffset) mod 512; kPtr:= 1;
sPtr:= 1;
for n:= 1 to KeySize do
begin
pArray[n]:= pArray[n] xor nKeys[n];
rtn:= Abs(((nArray[n] xor pArray[n]) mod 512) - tOffset); If kType = 3 Then //hex key
begin
if rtn < 16 then
begin
ReplaceSubString(gKey,'0' + inttohex(rtn,1),kptr,2);
//Delete(gKey,kptr,2);
//Insert('0' + inttohex(rtn,1),gKey,kptr);
end
else
begin
ReplaceSubString(gKey,inttohex(rtn,2),kPtr,2);
//Delete(gKey,kPtr,2);
//Insert(inttohex(rtn,2),gKey,kPtr);
end;
if (sPtr = 2) And (kPtr < 18) then
begin
kPtr:= kPtr + 1;
ReplaceSubString(gKey,'-',kPtr + 1, 1);
//Delete(gKey,kPtr + 1, 1);
//Insert('-',gKey,kPtr+1);
end;
kPtr:= kPtr + 2;
sPtr:= sPtr + 1;
if sPtr = 3 Then sPtr:= 1;
end
else //numeric - alphanumeric key
begin
ReplaceSubString(gKey,Chr(cTable[rtn]),n,1);
//Delete(gKey,n,1);
//Insert(Chr(cTable[rtn]),gKey,n);
end;
end;
KeyGen:= gKey;
end;