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

解决方案 »

  1.   

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

  2.   

    VB当中的Integer对应的是Delphi的SmallInt或者Word
      

  3.   

    另外有一些东西,在Delphi当中是无法与之相对应的.只能读懂VB的代码,并修改出相近似的,可以完成相同功能的Delphi代码.