• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2400
  • Last Modified:

Code Request Encrypt and Decrypt using XOR for PHP And VB6

I have been looking around for an algorithm that will encrypt a string and decrypt a string using a key.

This would require 4 functions that impliment the same algorithm in VB6 and PHP

php_DecryptValue(Cypher,Key)
php_DecryptValue(Cypher,Key)
vb6_EncryptValue(Cypher,Key)
vb6_DecryptValue(Cypher,Key)

I've seen some XOR for encrypt in both langs but I just need something quick painless and not overly powerful that i can just drag and drop.  Can anyone help?
0
ShinZan
Asked:
ShinZan
  • 7
  • 4
3 Solutions
 
Beverley PortlockCommented:
If yur PHP installation has the mcrypt extension installed then that is probably what you need

http://www.php.net/mcrypt

http://uk3.php.net/manual/en/mcrypt.examples.php

0
 
Beverley PortlockCommented:
I should add that if you want to encrypt and pass from VB to PHP and then decrypt then you need a common cypher. Blowfish is common to both but a list of PHP cyphers is at http://uk3.php.net/manual/en/mcrypt.ciphers.php

If you merely want to pass info securely over HTTP then maybe using HTTPS would be an option?
0
 
ShinZanAuthor Commented:
I need a code sample as the above 4 procdure declarations
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
ShinZanAuthor Commented:
I know I need a common cypher i am looking for straight cut and paste code of a common cyper in VB6 and php it can use XOR and be simple
0
 
ShinZanAuthor Commented:
Doing it myself but maybe someone can point out a mistake here:

VB6/VBA Version

Public Function vb6_EncryptValue(strText As String, strKey As String) As String
'strText length should match strkey length for maximum strength

    Dim i As Integer            'Loop counter
    Dim intKeyChar As Integer   'Character within the key that we'll use to encrypt
    Dim strTemp As String       'Store the encrypted string as it grows
    Dim strChar1 As String * 1  'The first character to XOR
    Dim strChar2 As String * 1  'The second character to XOR
    Dim s

    
    'Loop through each character in the text
    For i = 1 To Len(strText)
        'Get the next character from the text
        strChar1 = Mid(strText, i, 1)
        'Find the current "frame" within the key
        intKeyChar = ((i - 1) Mod Len(strKey)) + 1
        'Get the next character from the key
        strChar2 = Mid(strKey, intKeyChar, 1)
        'Convert the charaters to ASCII, XOR them, and convert to a character again
        strTemp = strTemp & Chr(Asc(strChar1) Xor Asc(strChar2))
    Next i
    
    'Display the resultant encrypted string
    
    vb6_EncryptValue = strTemp

End Function

Open in new window


PHP Version:

function php_EncryptValue($cypher,$key){
 // Our output text
 $outText = '';
 
 // Iterate through each character
 for($i=0;$i<strlen($cypher);) // Dont need to increment here
 {
     for($j=0;$j<strlen($key);$j++,$i++)
     {
         $outText .= $cypher{$i} ^ $key{$j};
     }
 }
 
 return $outText;
}

Open in new window


so calls where they Text to encrypt is "Test" and the key is "0000" both results match "dUCD" Yay!
calls where the key is "XXXX" the VB6 has a funky non encoding character for the first one "  =+," and the php lists "=+," ommitting that first funky character which i assume this all to be an encoding issue.

How can i solve this or stick to safe keys that don't cause this problem?
0
 
ShinZanAuthor Commented:
of course the decrypt functions simply change the XOR operators around but i didn't post them
0
 
ShinZanAuthor Commented:
Yep Base64 Encoding Fixed me so


Private Const clOneMask = 16515072          '000000 111111 111111 111111
Private Const clTwoMask = 258048            '111111 000000 111111 111111
Private Const clThreeMask = 4032            '111111 111111 000000 111111
Private Const clFourMask = 63               '111111 111111 111111 000000

Private Const clHighMask = 16711680         '11111111 00000000 00000000
Private Const clMidMask = 65280             '00000000 11111111 00000000
Private Const clLowMask = 255               '00000000 00000000 11111111

Private Const cl2Exp18 = 262144             '2 to the 18th power
Private Const cl2Exp12 = 4096               '2 to the 12th
Private Const cl2Exp6 = 64                  '2 to the 6th
Private Const cl2Exp8 = 256                 '2 to the 8th
Private Const cl2Exp16 = 65536              '2 to the 16th
'end base64 functions



Public Function baseEncode64(sString As String) As String

    Dim bTrans(63) As Byte, lPowers8(255) As Long, lPowers16(255) As Long, bOut() As Byte, bIn() As Byte
    Dim lChar As Long, lTrip As Long, iPad As Integer, lLen As Long, lTemp As Long, lPos As Long, lOutSize As Long

    For lTemp = 0 To 63                                 'Fill the translation table.
        Select Case lTemp
            Case 0 To 25
                bTrans(lTemp) = 65 + lTemp              'A - Z
            Case 26 To 51
                bTrans(lTemp) = 71 + lTemp              'a - z
            Case 52 To 61
                bTrans(lTemp) = lTemp - 4               '1 - 0
            Case 62
                bTrans(lTemp) = 43                      'Chr(43) = "+"
            Case 63
                bTrans(lTemp) = 47                      'Chr(47) = "/"
        End Select
    Next lTemp

    For lTemp = 0 To 255                                'Fill the 2^8 and 2^16 lookup tables.
        lPowers8(lTemp) = lTemp * cl2Exp8
        lPowers16(lTemp) = lTemp * cl2Exp16
    Next lTemp

    iPad = Len(sString) Mod 3                           'See if the length is divisible by 3
    If iPad Then                                        'If not, figure out the end pad and resize the input.
        iPad = 3 - iPad
        sString = sString & String(iPad, Chr(0))
    End If

    bIn = StrConv(sString, vbFromUnicode)               'Load the input string.
    lLen = ((UBound(bIn) + 1) \ 3) * 4                  'Length of resulting string.
    lTemp = lLen \ 72                                   'Added space for vbCrLfs.
    lOutSize = ((lTemp * 2) + lLen) - 1                 'Calculate the size of the output buffer.
    ReDim bOut(lOutSize)                                'Make the output buffer.

    lLen = 0                                            'Reusing this one, so reset it.

    For lChar = LBound(bIn) To UBound(bIn) Step 3
        lTrip = lPowers16(bIn(lChar)) + lPowers8(bIn(lChar + 1)) + bIn(lChar + 2)    'Combine the 3 bytes
        lTemp = lTrip And clOneMask                     'Mask for the first 6 bits
        bOut(lPos) = bTrans(lTemp \ cl2Exp18)           'Shift it down to the low 6 bits and get the value
        lTemp = lTrip And clTwoMask                     'Mask for the second set.
        bOut(lPos + 1) = bTrans(lTemp \ cl2Exp12)       'Shift it down and translate.
        lTemp = lTrip And clThreeMask                   'Mask for the third set.
        bOut(lPos + 2) = bTrans(lTemp \ cl2Exp6)        'Shift it down and translate.
        bOut(lPos + 3) = bTrans(lTrip And clFourMask)   'Mask for the low set.
        If lLen = 68 Then                               'Ready for a newline
            bOut(lPos + 4) = 13                         'Chr(13) = vbCr
            bOut(lPos + 5) = 10                         'Chr(10) = vbLf
            lLen = 0                                    'Reset the counter
            lPos = lPos + 6
        Else
            lLen = lLen + 4
            lPos = lPos + 4
        End If
    Next lChar

    If bOut(lOutSize) = 10 Then lOutSize = lOutSize - 2 'Shift the padding chars down if it ends with CrLf.

    If iPad = 1 Then                                    'Add the padding chars if any.
        bOut(lOutSize) = 61                             'Chr(61) = "="
    ElseIf iPad = 2 Then
        bOut(lOutSize) = 61
        bOut(lOutSize - 1) = 61
    End If

    baseEncode64 = StrConv(bOut, vbUnicode)                 'Convert back to a string and return it.

End Function

Public Function baseDecode64(sString As String) As String

    Dim bOut() As Byte, bIn() As Byte, bTrans(255) As Byte, lPowers6(63) As Long, lPowers12(63) As Long
    Dim lPowers18(63) As Long, lQuad As Long, iPad As Integer, lChar As Long, lPos As Long, sOut As String
    Dim lTemp As Long

    sString = Replace(sString, vbCr, vbNullString)      'Get rid of the vbCrLfs.  These could be in...
    sString = Replace(sString, vbLf, vbNullString)      'either order.

    lTemp = Len(sString) Mod 4                          'Test for valid input.
    If lTemp Then
        Call Err.Raise(vbObjectError, "MyDecode", "Input string is not valid Base64.")
    End If

    If InStrRev(sString, "==") Then                     'InStrRev is faster when you know it's at the end.
        iPad = 2                                        'Note:  These translate to 0, so you can leave them...
    ElseIf InStrRev(sString, "=") Then                  'in the string and just resize the output.
        iPad = 1
    End If

    For lTemp = 0 To 255                                'Fill the translation table.
        Select Case lTemp
            Case 65 To 90
                bTrans(lTemp) = lTemp - 65              'A - Z
            Case 97 To 122
                bTrans(lTemp) = lTemp - 71              'a - z
            Case 48 To 57
                bTrans(lTemp) = lTemp + 4               '1 - 0
            Case 43
                bTrans(lTemp) = 62                      'Chr(43) = "+"
            Case 47
                bTrans(lTemp) = 63                      'Chr(47) = "/"
        End Select
    Next lTemp

    For lTemp = 0 To 63                                 'Fill the 2^6, 2^12, and 2^18 lookup tables.
        lPowers6(lTemp) = lTemp * cl2Exp6
        lPowers12(lTemp) = lTemp * cl2Exp12
        lPowers18(lTemp) = lTemp * cl2Exp18
    Next lTemp

    bIn = StrConv(sString, vbFromUnicode)               'Load the input byte array.
    ReDim bOut((((UBound(bIn) + 1) \ 4) * 3) - 1)       'Prepare the output buffer.

    For lChar = 0 To UBound(bIn) Step 4
        lQuad = lPowers18(bTrans(bIn(lChar))) + lPowers12(bTrans(bIn(lChar + 1))) + _
                lPowers6(bTrans(bIn(lChar + 2))) + bTrans(bIn(lChar + 3))           'Rebuild the bits.
        lTemp = lQuad And clHighMask                    'Mask for the first byte
        bOut(lPos) = lTemp \ cl2Exp16                   'Shift it down
        lTemp = lQuad And clMidMask                     'Mask for the second byte
        bOut(lPos + 1) = lTemp \ cl2Exp8                'Shift it down
        bOut(lPos + 2) = lQuad And clLowMask            'Mask for the third byte
        lPos = lPos + 3
    Next lChar

    sOut = StrConv(bOut, vbUnicode)                     'Convert back to a string.
    If iPad Then sOut = Left$(sOut, Len(sOut) - iPad)   'Chop off any extra bytes.
    baseDecode64 = sOut

End Function


so baseEncode64 the output in VB6 and of the xor encryption then base64_decode the string in PHP before running the decrypt functions.  Others have asked for this on EE and no answers so here is a solution no points on this since i got the answers myself
0
 
ShinZanAuthor Commented:
Cut and paste code what else can you ask for
0
 
Beverley PortlockCommented:
Your original question was not clear enough. I took it to mean that you needed a common set of encryption functions that work in both PHP and VB. I did not expect to write them from scratch.

Good luck with your project.

0
 
ShinZanAuthor Commented:
sorry but i even gave function delcarations and asked for copy paste code thats pretty clear i thought
0
 
Beverley PortlockCommented:
Function declarations like those you gave are often presented to us here as function prototypes or examples of how the data should be passed or what the OP is looking to do. The links I gave to PHP's mcrypt mirrors your function definitions which is what I though you were looking for. For example,

mcrypt_generic($td, $input);

php_DecryptValue(Cypher,Key)


Also your original post does not contain either of  the words copy or paste. Regardless of how you thought you had explained it, I am telling you how it read to me.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

  • 7
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now