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
解决方案 »
- 帮我看看函数为什么编译不过去。
- 有关ADOquery的问题
- 如何让子窗口最大化的时候自动调整
- MDI窗体的WindowMenu只能设为Dephi带的菜单吗?如果用了第三方菜单怎么办?
- 能否实现在窗体上画线,再次打开是这几条线还在?
- sock线程,高手来啊,高分求教~~~~~~~~~~~~~~~~
- 如何在画布上画一个带箭头的直线.
- 如何将文本清单 添加到 combobox ?
- 低价出售P2P即时通讯源码,无加密,组件齐全,调试非常简单方便!
- 如何在设计期获得该应用程序所保存的路径?
- 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;