请帮忙把一个VB的函数改成DELPHI的(我改后得到的结果不正确)(100分)

  • 主题发起人 小佳佳
  • 开始时间

小佳佳

Unregistered / Unconfirmed
GUEST, unregistred user!
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: w.g.griffiths@telinco.co.uk *
'* *
'* 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 precaution

Dim 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 make

Const 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 Control

VarType = 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 &amp
AryCtrl.Text &amp
"|"
End If
Next
kName = Left(kName, Len(kName) - 1)
Case "String()"
For AryCtl = LBound(kNamev) To UBound(kNamev)
If kNamev(AryCtl) <> "" Then
kName = kName &amp
kNamev(AryCtl) &amp
"|"
End If
Next
kName = Left(kName, Len(kName) - 1)
Case Else
MsgBox VarType &amp
" 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) = 164

sIni = 0

'set s boxes
For n = 0 To 512
s0(n) = n
Next n

For n = 0 To 512
sIni = (sOffset + sIni + n) Mod 256
temp = s0(n)
s0(n) = s0(sIni)
s0(sIni) = temp
Next n

If 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 If

kPtr = 1

For 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 n

For 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 n

tOffset = (nOffset + pOffset) Mod 512

kPtr = 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" &amp
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
Next

KeyGen = gKey

End Function
 
、、、、、、、、、、、、、、、、、、、、、、、、、、、、
我改的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

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: w.g.griffiths@telinco.co.uk *
//* *
//* 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;
 
你自己调试过吗?在VB和Delphi里跟踪一遍看看哪里有问题,这样才有针对性,你把巨大的代码贴出来,我看得头晕啊。
 
太长了 估计没人搞
 
别说你测试的字符串包含中文。
 
顶部