Help converting vb2008 code to vb6

[davidck88]

Hi all i got a CreateR1 function that takes name and hard drive serial number and supposed to return R1 value. The function was actually written on vb2008 but i want some help converting it to vb6. When i post the code on vb6 visual studio some parts of the code shows on red( as i pointed in the code below). So i be happy if you guys help me convert those part to vb6.
Thanks in advance.

Private Function DecryptPass(ByVal sNic As String, ByVal sSerial As String, ByVal sEncryptedPass As String) As String
        'Create R1 Encryption Key
        Dim R1 As String 
        R1= CreateR1(sNic, sSerial)
        'Decrypt Password
        DecryptedPass(R1, sEncryptedPass)
    End Function

vb2008 code:

Private Function CreateR1(ByVal Nic As String, ByVal Serial As String) As String
        ''Dim s As String = String.Empty
        Dim s As String
            s = vbNullString
        Dim i As Integer
        i = 0
        If Nic.Length > Serial.Length Then
            For Each c As Char In Nic ======================>Shows on red
                Dim sTemp As String
                Try
                    sTemp = Serial.Chars(i)
                    s = s & Nic.Chars(i) & sTemp
                Catch
                    s = s & Nic.Chars(i)
                End Try            ======================>Shows on red
                i = i + 1
            Next
        Else
            For Each c As Char In Serial ======================>Shows on red
                Dim sTemp As String
                Try
                    sTemp = Nic.Chars(i)
                    s = s & sTemp & Serial.Chars(i)
                Catch
                    s = s & Serial.Chars(i)
                End Try                ======================>Shows on red
                i = i + 1
            Next
        End If
       '' Return s.Substring(s.Length - 1) & s.Substring(0, s.Length - 1)
        CreateR1 = s.Substring(s.Length - 1) & s.Substring(0, s.Length - 1)
    End Function

CreateR1

 

[Disferente]

Something like this should do it:

Dim s As String
s = vbNullString
Dim i As Integer
i = 0
dim nicbytes() as byte
dim serialbytes() as byte
nicbytes=strconv(nic,vbFromUnicode)
serialbytes=strconv(serial,vbFromUnicode)
dim c as variant
If len(Nic) > len(Serial) Then
For Each c In Nic
if ubound(serialbytes)=>i then
s = s & chr(Nicbytes(i)) & chr(serialbytes(i))
else
s = s & chr(Nicbytes(i))
End if
i = i + 1
Next
Else
For Each c In Serialbytes
if ubound(nicbytes)=>i then
s = s & chr(nicbytes(i)) & chr(Serialbytes(i))
else
s = s & chr(Serialbytes(i))
End if
i = i + 1
Next
End If
CreateR1 = right(s,1) & mid(s,1, len(s) - 1)

 

[davidck88]

Disferente thanks for code. But "For Each c In Nic" is not vb6 code !!For the following sample data i should get R1 = 2a1s8s7a5dC2D25 at the end of CreateR1 function. i don't know how to convert "For eah in Nic " and "Catch" :-(
So i be happy if you help me convert tht function.Thanks

Sample data:
nick: assad22
VolumeSerial: 1875CD52
R1 = 2a1s8s7a5dC2D25

 

[davidck88]

i tried your code i get this error:

compile error:

For each may only iterate overe a collection object or an arry

 

[strongm]

If we were to generalise it to create r1 from any two strings, we might be able to use something like:

[blue]Private Function CreateR1(ByVal str1 As String, ByVal str2 As String) As String
    Dim lp As Long
    Dim s As String
    Dim temp As String 
    If Len(str2) > Len(str1) Then
        temp = str1
        str1 = str2
        str2 = temp
    End If
    For lp = 1 To Len(str1)
        s = s & Mid(str1, lp, 1) & IIf(lp <= Len(str2), Mid(str2, lp, 1), "")
    Next
    CreateR1 = Right$(s, 1) & Mid$(s, 1, Len(s) - 1)
End Function[/blue]

 

[davidck88]

strong that i run your code and it produced the right R1 value for me for the given sample data above. Do you think your code will handle the cases when nic string is smaller then serial too just the orginal vb2006 code ? or does it need further adjustments?

Furthermore , I be happpy if you help me convert(to vb6) the last function which is also written in vb2008. DecryptedPass funtion takes vale of R1 and encryted pass and process it and produce result. It is called like this :

DecryptedPass(R1, sEncryptedPass)

Vb2008 code:

    Private Function DecryptedPass(ByVal R1 As String, ByVal sEncrypted As String) As String
        'create counter to track place in password
        Dim iCount As Integer = 0
        'create string for 4 digit groupings
        Dim PassBits As String = String.Empty
        'Create string to hold password as it is decrypted
        Dim sDecrypted As String = String.Empty
        'create integer to hold char val for each decrypted leter
        Dim iPassLetter As Integer = 0

        'make sure R1 EncryptionKey is long enough
        If sEncrypted.Length / 4 > R1.Length Then
            'create temp Encryption Key
            Dim tempR1 As String = R1
lblAddKeyLen:
            'add original Encryption Key to end of temp Key
            tempR1 = tempR1 & R1
            'make sure temp EncryptionKey is long enough
            If sEncrypted.Length / 4 > tempR1.Length Then GoTo lblAddKeyLen
            'use new Encryption Key that is long enough
            R1 = tempR1
        End If

  

        'Decrypt each grouping of 4 digits in the Encrypted password
        Do While iCount < (sEncrypted.Length / 4)
            'fill PassBits with first 3 digits of 4 digit grouping
            PassBits = sEncrypted.Substring((iCount * 4), 3)
            'get integer char value for each letter
            iPassLetter = Integer.Parse(PassBits) - Asc(R1.Chars(iCount)) - iCount - 122
            'add each Decrypted letter to the Decrypted password
            sDecrypted = sDecrypted & Chr(iPassLetter)
            'increment Count
            iCount += 1
        Loop
        Return sDecrypted
    End Function

 

[strongm]

>Do you think your code will handle the cases when nic string is smaller then serial

Yes

>does it need further adjustments?

Shouldn't do

>DecryptedPass

Strikes me that you may be reinventing the wheel here. VB6 can access the Cryptography API, and VB.NET has access to a cryptography framework, which does better encryption and decryption than you or I are likely to write.

 

[davidck88]

strongm may be i am reinventing the wheel .But it is because i don't
know how to use VB6 to access the Cryptography API . Can you show me how to use vb6
Cryptography API to do the exact thing that the DecryptedPass function do ?I realy
have to do this on vb6 as i don't know know vb2008!!

Furthermore,I tried to modify the funtion but i keep getting this error:

Run-time error 5
Invalid procedure call or argument
[code]

pointing at this line
[code]
 iPassLetter = CDbl(PassBits) - Asc(Mid$(R1, 0, iCount)) - iCount - 122

 Private Function DecryptedPass(ByVal R1 As String, ByVal sEncrypted As String) As String
        'create counter to track place in password
        Dim iCount As Integer
        iCount = 0
        'create string for 4 digit groupings
    ''Dim PassBits As String = String.Empty
        Dim PassBits As String
            PassBits = vbNullString
        'Create string to hold password as it is decrypted
       '' Dim sDecrypted As String = String.Empty
        Dim sDecrypted As String
            sDecrypted = vbNullString
        'create integer to hold char val for each decrypted leter
        Dim iPassLetter As Integer
        iPassLetter = 0

        'make sure R1 EncryptionKey is long enough
        ''If sEncrypted.Length / 4 > R1.Length Then
        If Len(sEncrypted) / 4 > Len(R1) Then
            'create temp Encryption Key
            Dim tempR1 As String
            tempR1 = R1
lblAddKeyLen:
            'add original Encryption Key to end of temp Key
            tempR1 = tempR1 & R1
            'make sure temp EncryptionKey is long enough
            ''If sEncrypted.Length / 4 > tempR1.Length Then GoTo lblAddKeyLen
             If Len(sEncrypted) / 4 > Len(tempR1) Then GoTo lblAddKeyLen
            'use new Encryption Key that is long enough
            R1 = tempR1
        End If



        'Decrypt each grouping of 4 digits in the Encrypted password
        Do While iCount < (Len(sEncrypted) / 4)
            'fill PassBits with first 3 digits of 4 digit grouping
            ''PassBits = sEncrypted.Substring((iCount * 4), 3)
           PassBits = Mid$(sEncrypted, 3, (iCount * 4))
            'get integer char value for each letter
           '' iPassLetter = Integer.Parse(PassBits) - Asc(R1.Chars(iCount)) - iCount - 122
               iPassLetter = CDbl(PassBits) - Asc(Mid$(R1, 0, iCount)) - iCount - 122
            'add each Decrypted letter to the Decrypted password
            sDecrypted = sDecrypted & Chr(iPassLetter)
            'increment Count
            iCount = iCount + 1
        Loop
        'Return sDecrypted
        DecryptedPalPass = sDecrypted
    End Function

 

[HarleyQuinn]

I started writing a generalised version of this myself yesterday but had to leave work before I finished it, and darn, I get back and strongm's posted one!

One thing I did notice was that like mine yesterday (which I very nearly posted until I tested it last minute and saw it didn't quite replicate the VB2008 version) it doesn't quite handle the serial being longer than the nic the same way as the original code as it appears the nic always has to be appended first no matter whether it is the longest or not. Here's what I got (and a rarity for me, it's commented :

Private Function CreateR1(ByVal Nic As String, ByVal Serial As String) As String
        
        Dim s As String
        Dim a As String
        Dim b As String
        Dim c As Integer
        
        s = vbNullString
        
        ' set defaults
        
        a = Nic
        b = Serial
        
        If Len(Serial) > Len(Nic) Then ' if order not default then switch
            a = Serial
            b = Nic
            c = 1
        End If

        For i = 1 To Len(b) ' to the length of the shortest
            s = IIf(c = 0, s & Mid(a, i, 1) & Mid(b, i, 1), s & Mid(b, i, 1) & Mid(a, i, 1)) ' append two characters at position i to s
        Next
        
        ' take the right char of a, append s and the remainder of a not processed above,
        ' then take all but the last char of the whole lot
        
        CreateR1 = Left(Right(a, 1) & s & Right(a, Len(a) - Len(b)), Len(a) + Len(b))
        
End Function

I discovered that it needed updating when testing on the strings "HarleyQuinn" and "11HarleyQuinn22".

This is probably redundant now but wanted to post it anyway seems I'd spent a bit of time on it.

I have one question for the op though,

Do you think your code will handle the cases when nic string is smaller then serial too just the orginal vb2006 code

The easy answer to that question is to test the presented output with the expected output and see if they match, would only take two seconds and is how I spotted one of the errors in my code (not that I'm saying there is none now though )

I've also got to agree with strongm's reinventing the wheel comment about using the API

HarleyQuinn
---------------------------------
The most overlooked advantage to owning a computer is that if they foul up there's no law against wacking them around a little. - Joe Martin

Get the most out of Tek-Tips, read FAQ222-2244 before posting.

 

[HarleyQuinn]

Run-time error 5
Invalid procedure call or argument

pointing at this line

iPassLetter = CDbl(PassBits) - Asc(Mid$(R1, 0, iCount)) - iCount - 122

This is becasue you need to use 1 as the start for Mid() rather than 0.

Hope this helps

HarleyQuinn
---------------------------------
The most overlooked advantage to owning a computer is that if they foul up there's no law against wacking them around a little. - Joe Martin

Get the most out of Tek-Tips, read FAQ222-2244 before posting.

 

[davidck88]

Thanks HarleyQuinn for trying to help me.You are right that i need do more testing(CreateR1 function) but i got only
one set of sample data at this moment(given by author)!! Untill i don't get the DecryptedPass function working i realy can't
verify all the test data!! so i hope you guys help me fix these 2 functions or show me
how to do it using vb6 Cryptography API.

Sample data:
nick: assad22
VolumeSerial: 1875CD52
R1 = 2a1s8s7a5dC2D25 
DecryptPass=ataturk

HarleyQuinn i changed 0 to one but still same error!!I posted the orginal line too see if you see any problem in it!!


same error here :

iPassLetter = CDbl(PassBits) - Asc(Mid$(R1, 1, iCount)) - iCount - 122

orginal vb2008 code :

iPassLetter = Integer.Parse(PassBits) - Asc(R1.Chars(iCount)) - iCount - 122

 

[HarleyQuinn]

What value are you passing in for sEncrypted?

HarleyQuinn
---------------------------------
The most overlooked advantage to owning a computer is that if they foul up there's no law against wacking them around a little. - Joe Martin

Get the most out of Tek-Tips, read FAQ222-2244 before posting.

 

[strongm]

>to do the exact thing that the DecryptedPass

Well no. Mainly because DecryptedPass is specific to whatever implementation is encrypting the password in the first place. My point is that both the encryption and decryption could be done with the Crypto API

>i don't know know vb2008
>"For Each c In Nic" is not vb6 code !!

Yes, it is ... however it only works if Nic is the right variable type. Disferante actualy meant to use 'nicbytes' here, rather than 'Nic'

 

[davidck88]

DecryptedPass function gets R1=2a1s8s7a5dC2D25 and sEncrypted=2698 3368 2707 3561 2998 3567 2905
and should produce DecryptPass=ataturk!!

 

[HarleyQuinn]

You were almost there, you seemed to be getting in a bit of a muddle as to how to structure your Mid() function calls correctly but that's easily done. Have a look at this code and see if it makes sense:

PassBits = Mid$(sEncrypted, [red](iCount * 4) + 1, 3[/red])
            'get integer char value for each letter
           '' iPassLetter = Integer.Parse(PassBits) - Asc(R1.Chars(iCount)) - iCount - 122
               iPassLetter = CInt(PassBits) - Asc(Mid$(R1, [red]iCount + 1, 1[/red])) - iCount - 122

You basically had the start and length the wrong way round, and needed to add 1 to the incremental count so it could be used correctly in the Mid() calls. I've tried both functions with your suggested inputs and they seems to return what you are after (with no spaces in the encrypted password that is).

Now just don't tell anyone where you work as we now know the algorythm to decrypt your passwords (only joking )

Hope this helps

HarleyQuinn
---------------------------------
The most overlooked advantage to owning a computer is that if they foul up there's no law against wacking them around a little. - Joe Martin

Get the most out of Tek-Tips, read FAQ222-2244 before posting.

 

[davidck88]

Many thanks HarleyQuinn the funtionDecryptedPass is working well no(No error and produces right value or sample data).My only concern is CreatR1 function, if it handles all the cases as orginial vb2008.
I run your CreatR1 function and produces the right R1 for given sample.I looked at your code closly you use a diffrent logic to check if the nick is
shorter or longer then serial.so could you explain to me if your code handles all the cases ?Once again i thank you guys alot for help providing.

 

[HarleyQuinn]

It should handle all cases the same as the VB2008 version. It's handled all tests that I've thrown at it the same way as the VB2008 code but as it's not proper sample data I can't tell you 100% and I wouldn't want to claim that it definitely would.

The logic for checking the length of the Nic is the same but it's just condensed

I'll work through my logic used when creating the function to try and help clear up any fears you have (but the best way to do that would be to get someone to provide you some more sample data (or heck, even real data, you're not changing it) and for you to run your own tests against it, I can't stress this enough.

Here we go:

a = Nic
        b = Serial
        
        If Len(Serial) > Len(Nic) Then ' if order not default then switch
            a = Serial
            b = Nic
            c = 1
        End If

Basically what this does is try and make sure that a is always the longest string that is returned, this is important to the next part.

For i = 1 To Len(b) ' to the length of the shortest
            s = IIf(c = 0, s & Mid(a, i, 1) & Mid(b, i, 1), s & Mid(b, i, 1) & Mid(a, i, 1)) ' append two characters at position i to s
        Next

As a is the longest we only need to add characters up the the length of b (the shortest), we can then append the rest of a to the end. The iif statment is to check if we've changed from the default (nic a and serial = b) and as the nic always goes first in the creation of the R1. If we haven't we use the char from a and then b, else we use the chgar from b and then a.

Almost confused myself there, hopefully that should make some things a bit clearer for you.

Hope this helps

HarleyQuinn
---------------------------------
The most overlooked advantage to owning a computer is that if they foul up there's no law against wacking them around a little. - Joe Martin

Get the most out of Tek-Tips, read FAQ222-2244 before posting.

 

[strongm]

Assuming sEncrypted does have the spaces ...

[blue]Public Function CreateR1(ByVal str1 As String, ByVal str2 As String) As String
    Dim lp As Long
    Dim s As String
    Dim temp As String
    Dim MeFirst As Boolean
    If Len(str2) > Len(str1) Then
        temp = str1
        str1 = str2
        str2 = temp
        MeFirst = True
    End If
    For lp = 1 To Len(str1)
        If MeFirst Then
            s = s & Mid(str2, lp, 1) & IIf(lp <= Len(str1), Mid(str1, lp, 1), "")
        Else
            s = s & Mid(str1, lp, 1) & IIf(lp <= Len(str2), Mid(str2, lp, 1), "")
        End If
    Next
    CreateR1 = Right$(s, 1) & Mid$(s, 1, Len(s) - 1)
End Function

Public Function DecryptedPass(ByVal R1 As String, ByVal sEncrypted As String) As String
    Dim iCount As Long
    Dim sDecrypted As String

    Dim myR1() As Byte
    Dim myTemp() As String
    
    myR1 = StrConv(R1, vbFromUnicode)
    myTemp = Split(sEncrypted, " ")
    For iCount = 0 To UBound(myTemp)
        sDecrypted = sDecrypted & Chr(Val(Left$(myTemp(iCount), 3)) - myR1(iCount Mod (UBound(myTemp) + 1)) - iCount - 122)
    Next
    
    DecryptedPass = sDecrypted
End Function[/blue]

And can be quickly tested with:

? DecryptedPass(CreateR1("assad22","1875CD52"),"2698 3368 2707 3561 2998 3567 2905")

 

[HarleyQuinn]

Like the reworking of DecryptedPass strongm

HarleyQuinn
---------------------------------
The most overlooked advantage to owning a computer is that if they foul up there's no law against wacking them around a little. - Joe Martin

Get the most out of Tek-Tips, read FAQ222-2244 before posting.

 

[strongm]

Makes it a little clearer that this is a Vigenère cipher