[RESOLVED] Convert VB6 function and create C++ DLL

[Chris001]

Hello, I'm using the VB6 binary-to-text function below to encode 100kB - 600kB byte arrays to a string on-the-fly, right before sending them to a server that only accepts text. When uploading with a fast internet connection, there's quite a bit of speed loss due to this (slow) encoding with VB6. The function written in C++ would make it a bit faster and perhaps use less CPU as well.

I would kindly like to ask if somebody here, who knows both VB6 and C++, is willing to spend a moment of their time to convert this function to C++ and create a Win32 DLL for me (or just the code, then I'll search for a compiler myself).

Thank you.

Public Function EncodeArray(bIn() As Byte) As String

    Dim bOut() As Byte, lChar As Long, lPos As Long, bTest As Byte, lLine As Long
    Dim lMax As Long
    
    ReDim bOut(UBound(bIn) * 2)             'Make the output buffer.  Double size will almost always be enough.  2 extra
                                            'chars per 72 and worst case would be all characters escaped.  If so, use Base64.
    lMax = UBound(bIn)
    For lChar = 0 To lMax
        bTest = (bIn(lChar) + 42) Mod 256   'Try the prefered transform.
        Select Case bTest
            Case 1 To 8, 11 To 12, 14 To 45, 47 To 60, 62 To 255    'Normal processing
                bOut(lPos) = bTest
                lPos = lPos + 1
                lLine = lLine + 1
            Case 46                         'Test for column one, escape if in that col.
                If lLine <> 0 Then
                    bOut(lPos) = bTest
                    lPos = lPos + 1
                    lLine = lLine + 1
                Else
                    bOut(lPos) = 61
                    bOut(lPos + 1) = (bTest + 64) Mod 256
                    lPos = lPos + 2
                    lLine = lLine + 2
                End If
            Case Else                       'Critical char, needs to be escaped.
                bOut(lPos) = 61
                bOut(lPos + 1) = (bTest + 64) Mod 256
                lPos = lPos + 2
                lLine = lLine + 2
        End Select
        If lLine >= 128 Then           'Add a vbCrLf
            bOut(lPos) = 13
            bOut(lPos + 1) = 10
            lPos = lPos + 2
            lLine = 0
        End If
    Next lChar
    
    ReDim Preserve bOut(lPos - 1)           'Truncate the unused portion of the buffer.
    EncodeArray = StrConv(bOut, vbUnicode)      'Convert to a string and return it.
    
End Function

[si_the_geek]

There are ways you can almost certainly speed it up in VB, which may be good enough for you.


One is to re-order the Case's, so that fewer (and simpler) checks are needed, eg:

            Case 0, 9, 13, 61                       'Critical char, needs to be escaped.
...
            Case 46                         'Test for column one, escape if in that col.
...
            Case Else                        'Normal processing

Depending on how the "1 To 8" etc are implemented internally (perhaps ">=1 And <=8"?), this could reduce the amount of checks from a minimum of 15 (max 16) to a minimum of 4 (max 5), which should give some improvement.


There is a more efficient way of doing a Mod (there was a post in Office Development within the last week about it), but as your input is of a reasonable length (at a guess, around 1000 characters would be the minimum for it to be worthwhile), you should be able to get a significant speed gain by pre-calculating all values of (X + 42) Mod 256 and storing them in an array (same for(Y + 64) Mod 256 ).

It sounds like the routine is called multiple times, in which case those arrays can be pre-calculated when your program starts, rather than in the routine itself.


I don't know if this will be any faster, but due to the allowable values for lLine, the condition If lLine >= 128 Then could be re-written as If lLine And 128 Then


Note that there is no need for the lMax variable, as the loop isn't inside another you can put the UBound on the For line instead (it will only be checked once).

[Chris001]

Thank you. I've added the changes, but I have a problem with calculating "(X + 42) Mod 256" and storing it in the array. Something is wrong with it, but I have no idea what it is. When the byte array is decoded, it's not the same as the original byte array.

Screenshot: http://img198.imageshack.us/img198/2619/imagevri.png

Option Explicit

Private TBL(255) As Byte

Private Sub Form_Load()
Dim i As Long, bTest As Byte
    For i = 0 To 255
        bTest = (i + 42) And 255
        Select Case bTest
            Case 0, 9, 10, 13, 46, 61
                TBL(i) = 61
            Case Else
                TBL(i) = bTest
        End Select
    Next i
End Sub

Private Function EncodeArray(bIn() As Byte) As String

    Dim bOut() As Byte, lChar As Long, lPos As Long, bTest As Byte, lLine As Long

    ReDim bOut(UBound(bIn) * 1.2)             'Make the output buffer.  Double size will almost always be enough.  2 extra
                                            'chars per 72 and worst case would be all characters escaped.  If so, use Base64.
    For lChar = 0 To UBound(bIn)
        bTest = TBL(bIn(lChar)) ''(bIn(lChar) + 42) And 255   'Try the prefered transform.
        Select Case bTest
            Case 0, 9, 10, 13, 61                      'Critical char, needs to be escaped.
                bOut(lPos) = 61
                bOut(lPos + 1) = (bTest + 64) And 255
                lPos = lPos + 2
                lLine = lLine + 2
            Case 46                         'Test for column one, escape if in that col.
                If lLine <> 0 Then
                    bOut(lPos) = bTest
                    lPos = lPos + 1
                    lLine = lLine + 1
                Else
                    bOut(lPos) = 61
                    bOut(lPos + 1) = (bTest + 64) And 255
                    lPos = lPos + 2
                    lLine = lLine + 2
                End If
            Case Else                       'Normal processing
                bOut(lPos) = bTest
                lPos = lPos + 1
                lLine = lLine + 1
        End Select
        If lLine And 128 Then           'Add a vbCrLf
            bOut(lPos) = 13
            bOut(lPos + 1) = 10
            lPos = lPos + 2
            lLine = 0
        End If
    Next lChar

    ReDim Preserve bOut(lPos - 1)           'Truncate the unused portion of the buffer.
    yEncode = StrConv(bOut, vbUnicode)      'Convert to a string and return it.

End Function

[si_the_geek]

I haven't checked if x Mod 256 gives the same results as x And 255 , but for pre-calculating you should not worry about the speed - because it will only run 256 times for your entire program, instead of once for every character encoded (even if you only encode one 100kB byte array, that will be over 99k times less!)

It seems you to have tried to go a bit too far for a single step, and haven't taken enough care... you aren't storing the result of what you were using before, but something different and more complex. The pre-calculation should just have been like this:

    For i = 0 To 255
        TBL(i) = (i + 42) Mod 256
    Next i

However you could go even further with the pre-calculation, and basically store the end results of each input value, but for that to work you need to store several values - the calculated character to use in the output, whether or not it is a normal single character, and for '46' whether lLine<>0 needs to be checked (and if so, the extra character for that situation).

To store those values I would use an array of a Type (a 2d array or multiple 1d arrays would work, but be less readable and/or efficient), along these lines:

Option Explicit

Private Type EncoderValues
  Char As Byte
  IsSingleChar As Boolean
  CheckLine0 As Boolean
  Line0Char As Byte
End Type
Private m_EncoderTable(255) As EncoderValues


Private Sub Form_Load()
Dim lngInput As Long, bTest As Byte
    For lngInput = 0 To 255
        With m_EncoderTable(lngInput)
            bTest = (lngInput + 42) Mod 256
            Select Case bTest
              Case 1 To 8, 11 To 12, 14 To 45, 47 To 60, 62 To 255    'Normal processing
                  .Char = bTest
                  .IsSingleChar = True
              Case 46                                           'Test for column one, escape if in that col.
                  .Char = bTest
                  .IsSingleChar = False
                  .CheckLine0 = True
                  .Line0Char = (bTest + 64) Mod 256
              Case Else                                         'Critical char, needs to be escaped.
                  .Char = (bTest + 64) Mod 256
                  .IsSingleChar = False
            End Select
        End With
    Next lngInput
End Sub


Public Function EncodeArray(bIn() As Byte) As String

    Dim bOut() As Byte, lChar As Long, lPos As Long, bTest As Byte, lLine As Long
    
    ReDim bOut(UBound(bIn) * 2)             'Make the output buffer.  Double size will almost always be enough.  2 extra
                                            'chars per 72 and worst case would be all characters escaped.  If so, use Base64.
    For lChar = 0 To UBound(bIn)
        With m_EncoderTable(bIn(lChar))
            If .IsSingleChar Then             'Normal processing
                bOut(lPos) = .Char
                lPos = lPos + 1
                lLine = lLine + 1
            ElseIf .CheckLine0 Then           'Test for column one, escape if in that col.
                If lLine <> 0 Then
                    bOut(lPos) = .Char
                    lPos = lPos + 1
                    lLine = lLine + 1
                Else
                    bOut(lPos) = 61
                    bOut(lPos + 1) = .Line0Char
                    lPos = lPos + 2
                    lLine = lLine + 2
                End If
            Else                              'Critical char, needs to be escaped.
                bOut(lPos) = 61
                bOut(lPos + 1) = .Char
                lPos = lPos + 2
                lLine = lLine + 2
            End If
        End With
        If lLine >= 128 Then           'Add a vbCrLf
            bOut(lPos) = 13
            bOut(lPos + 1) = 10
            lPos = lPos + 2
            lLine = 0
        End If
    Next lChar

    ReDim Preserve bOut(lPos - 1)           'Truncate the unused portion of the buffer.
    EncodeArray = StrConv(bOut, vbUnicode)      'Convert to a string and return it.

End Function

I haven't tested this, but it should give the same results as your original code.

[Chris001]

Thank you very much
The encoding is quite a bit faster now.

Below is a screenshot of DU Meter (bandwidth monitor). The first green bar is with your code (flat) and the second green bar is with the original code and there's clearly a dropdown in upload speed every few seconds.




::edit::

Sorry, but I can't give you any Reputation. I get the message that I need to spread it around more before giving it to you again.