Solved

I converted a VB 6.0 project to .NET 2005,had some errors:

Posted on 2008-10-02
6
1,139 Views
Last Modified: 2013-11-26

Hi!
This VB 6.0 code
aData = StrConv(strIn, vbFromUnicode)

And this how it get converted ti .NET 2005
aData = System.Text.UnicodeEncoding.Unicode.GetBytes(StrConv(strIn, vbFromUnicode))

This was not converted
Decode = StrConv(m_oXMLElement.nodetypedvalue, vbUnicode)

Decode = StrConv(m_oXMLElement.nodetypedvalue, vbUnicode)

These don't work!
What is a correct conversion in .NET to these

These are parts of this Base64 class  http://www.webdictionary.fi/kuvat/Base64.zip
If it's needed as "whole picture" here

Matti
0
Comment
Question by:Matti
  • 4
  • 2
6 Comments
 
LVL 3

Expert Comment

by:tasky
ID: 22626391
What data type is m_oXMLElement.nodetypedvalue?
0
 
LVL 14

Author Comment

by:Matti
ID: 22626528
Hi!

The whole class is here:

Option Strict Off
Option Explicit On
Imports VB = Microsoft.VisualBasic
Friend Class Base64
      
      Public Event BlockRead(ByVal lngCurrentBlock As Integer, ByVal lngTotalBlocks As Integer, ByVal lBlockMode As enBlockMode, ByRef bCancel As Boolean)
      Public Event FileDecodeComplete(ByRef strOriginalFile As String, ByRef strDecodedFile As String)
      Public Event FileEncodeComplete(ByRef strOriginalFile As String, ByRef strEncodedFile As String)
      Public Event ErrorOccured(ByVal lngCode As Integer, ByVal strDescription As String)
      Public Event BeforeFileOpenIn(ByVal strFileName As String, ByRef bCancel As Boolean)
      Public Event BeforeFileOpenOut(ByVal strFileName As String, ByRef bCancel As Boolean)
      Public Event AfterFileCloseIn(ByVal strFileName As String)
      Public Event AfterFileCloseOut(ByVal strFileName As String)
      
      Private m_oXMLDoc As Object
      Private m_oXMLElement As Object
      Private m_bXMLObjectOK As Boolean
      
      Private m_lngLastErrorCode As Integer
      Private m_strLastErrorDesc As String
      Private m_lngEncBlockSize As Integer
      Private m_lngDecBlockSize As Integer
      Private m_bCancel As Boolean
      
      Public Enum enBlockMode
            b64Encode
            b64Decode
      End Enum


      Private Const cMSXMLDom As String = "MSXML.DomDocument"
      Private Const cDefBlockSize As Integer = 1048576 'Default block size: 1Mb
      
      'UPGRADE_NOTE: Class_Initialize was upgraded to Class_Initialize_Renamed. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="A9E4979A-37FA-4718-9994-97DD76ED70A7"'
      Private Sub Class_Initialize_Renamed()
            m_oXMLDoc = fCreateObject(cMSXMLDom)
            ClearError()
            m_bXMLObjectOK = Not m_oXMLDoc Is Nothing
            If Not m_bXMLObjectOK Then
                  'This error will never be raised, because we are in the _Initialize event...
                  'However, it WILL store the last error...
                  RaiseError(CInt("90001"), "Error creating required '" & cMSXMLDom & "' object")
            Else
                  'UPGRADE_WARNING: Couldn't resolve default property of object m_oXMLDoc.createElement. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
                  m_oXMLElement = m_oXMLDoc.createElement("TmpBase64")
                  'UPGRADE_WARNING: Couldn't resolve default property of object m_oXMLElement.dataType. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
                  m_oXMLElement.dataType = "bin.base64"
            End If
            'Initialize blocksizes to approx. 1Mb
            Me.BlockSize = cDefBlockSize
      End Sub
      Public Sub New()
            MyBase.New()
            Class_Initialize_Renamed()
      End Sub
      
      'UPGRADE_NOTE: Class_Terminate was upgraded to Class_Terminate_Renamed. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="A9E4979A-37FA-4718-9994-97DD76ED70A7"'
      Private Sub Class_Terminate_Renamed()
            'Free objects
            'UPGRADE_NOTE: Object m_oXMLElement may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
            m_oXMLElement = Nothing
            'UPGRADE_NOTE: Object m_oXMLDoc may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
            m_oXMLDoc = Nothing
      End Sub
      Protected Overrides Sub Finalize()
            Class_Terminate_Renamed()
            MyBase.Finalize()
      End Sub
      
      Public Function Encode(ByVal strIn As String) As String
            'Encode a string to base64
            Dim oElement As Object
            Dim sData As String
            Dim aData() As Byte
            
            On Error GoTo errEncode
        If m_bXMLObjectOK And Len(strIn) > 0 Then
            'UPGRADE_ISSUE: Constant vbFromUnicode was not upgraded. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="55B59875-9A95-4B71-9D6A-7C294BF7139D"'
            'UPGRADE_TODO: Code was upgraded to use System.Text.UnicodeEncoding.Unicode.GetBytes() which may not have the same behavior. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="93DD716C-10E3-41BE-A4A8-3BA40157905B"'
            aData = System.Text.UnicodeEncoding.Unicode.GetBytes(StrConv(strIn, vbFromUnicode)) 'vbFromUnicode            'aData = StrConv(strIn, vbFromUnicode)
            'UPGRADE_WARNING: Couldn't resolve default property of object m_oXMLElement.nodetypedvalue. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
            'UPGRADE_TODO: Code was upgraded to use System.Text.UnicodeEncoding.Unicode.GetString() which may not have the same behavior. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="93DD716C-10E3-41BE-A4A8-3BA40157905B"'
            m_oXMLElement.nodetypedvalue = System.Text.UnicodeEncoding.Unicode.GetString(aData)
            'UPGRADE_WARNING: Couldn't resolve default property of object m_oXMLElement.Text. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
            Encode = m_oXMLElement.Text
            'UPGRADE_WARNING: Couldn't resolve default property of object m_oXMLElement.Text. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
            m_oXMLElement.Text = "" 'Free memory
        End If
            Exit Function
errEncode:
            RaiseError(Err.Number, Err.Description)
      End Function
      
      Public Function Decode(ByVal strIn As String) As String
            'Decode a base64 string
            Dim oElement As Object
            
            On Error GoTo errDecode
            If m_bXMLObjectOK And Len(strIn) > 0 Then
                  'UPGRADE_WARNING: Couldn't resolve default property of object m_oXMLElement.Text. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
                  m_oXMLElement.Text = strIn
                  'UPGRADE_ISSUE: Constant vbUnicode was not upgraded. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="55B59875-9A95-4B71-9D6A-7C294BF7139D"'
                  'UPGRADE_WARNING: Couldn't resolve default property of object m_oXMLElement.nodetypedvalue. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
            '''''Decode = StrConv(m_oXMLElement.nodetypedvalue, 64) 'vbUnicode
            Decode = StrConv(m_oXMLElement.nodetypedvalue, vbUnicode)

            'UPGRADE_WARNING: Couldn't resolve default property of object m_oXMLElement.Text. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
                  m_oXMLElement.Text = "" 'Free memory
            End If
            Exit Function
errDecode:
            RaiseError(Err.Number, Err.Description)
      End Function
      
      Public Function EncodeFile(ByRef strInFile As String, ByRef strOutFile As String) As Boolean
            'Read blocks of the file in a multiple of 54 bits. This ensures, that because
            'of base64 is 3:4 the output will always be 72bits (+ 8 bits for a LineFeed)
            'Return True if succesful, else false
            'UPGRADE_WARNING: Couldn't resolve default property of object EncDecFile(). Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
            EncodeFile = EncDecFile(strInFile, strOutFile, True)
      End Function
      
      Public Function DecodeFile(ByRef strInFile As String, ByRef strOutFile As String) As Boolean
            'Read the file in a multiple of 584bits (73 bytes). When filesize is NOT a
            'multiple of 73bytes it will be invalid anyway (Base64 encoded data is always
            'a multiple of 73 bytes). These chunks can be decoded.
            'Return True if succesful, else false
            'UPGRADE_WARNING: Couldn't resolve default property of object EncDecFile(). Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
            DecodeFile = EncDecFile(strInFile, strOutFile, False)
      End Function
      
      Public ReadOnly Property LastErrorCode() As Integer
            Get
                  'Returns the last error that occured. 0 = no error
                  LastErrorCode = m_lngLastErrorCode
            End Get
      End Property
      
      Public ReadOnly Property LastErrorDescription() As String
            Get
                  'Returns the last error description that occured. "" = no error
                  LastErrorDescription = m_strLastErrorDesc
            End Get
      End Property
      
      Public WriteOnly Property BlockSize() As Integer
            Set(ByVal Value As Integer)
                  'Round to next 54bit boundary
                  m_lngEncBlockSize = ((Value \ 54)) * 54 + IIf(IsOnBoundary(Value, 54), 0, 54)
                  'Round to next 584bit boundary
                  m_lngDecBlockSize = ((Value \ 584)) * 584 + IIf(IsOnBoundary(Value, 584), 0, 584)
            End Set
      End Property
      
      Public Sub ClearError()
            'Clear last error
            m_lngLastErrorCode = 0
            m_strLastErrorDesc = ""
      End Sub
      
      Private Function IsOnBoundary(ByRef lLen As Integer, ByRef lBoundary As Integer) As Boolean
            'Returns if a bytelength is exactly on a boundary of a chunk
            IsOnBoundary = lLen Mod lBoundary = 0
      End Function
      
      Private Sub RaiseError(ByVal lngCode As Integer, ByVal strDescription As String)
            'Store the error and raise the event
            m_lngLastErrorCode = lngCode
            m_strLastErrorDesc = strDescription
            RaiseEvent ErrorOccured(lngCode, strDescription)
      End Sub
      
      Private Function fCreateObject(ByRef sObject As String) As Object
            'Tries to create an object (using createobject) but returns nothing when createobject fails
            On Error GoTo errCreateObject
            fCreateObject = CreateObject(sObject)
            On Error GoTo 0
            Exit Function
            
errCreateObject:
            'UPGRADE_NOTE: Object fCreateObject may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
            fCreateObject = Nothing
      End Function
      
      Private Function EncDecFile(ByRef strInFile As String, ByRef strOutFile As String, ByRef bEncode As Boolean) As Object
            'Encodes/decodes a file to/from base64
            Dim lBlockCount As Integer
            Dim lSize As Integer
            Dim lMaxBlocks As Integer
            Dim lRest As Integer
            Dim strTMP As String
            Dim FFIn As Short
            Dim FFOut As Short
            Dim lBlockSize As Integer
            Dim strOut As String
            
            On Error GoTo errEncDecFile
            If bEncode Then lBlockSize = m_lngEncBlockSize Else lBlockSize = m_lngDecBlockSize
            
            m_bCancel = False
            lBlockCount = 0 'Number of read blocks so far
            'UPGRADE_WARNING: Dir has a new behavior. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
            If Len(Dir(strInFile)) > 0 Then 'Does the file exist?
                  RaiseEvent BeforeFileOpenIn(strInFile, m_bCancel)
                  If m_bCancel Then Exit Function
                  
                  FFIn = FreeFile 'Get a free file handle
                  FileOpen(FFIn, strInFile, OpenMode.Binary)
                  
                  RaiseEvent BeforeFileOpenOut(strOutFile, m_bCancel)
                  If m_bCancel Then
                        FileClose(FFIn) 'Close already opened file handle
                        Exit Function
                  End If
                  
                  FFOut = FreeFile
                  FileOpen(FFOut, strOutFile, OpenMode.Binary)
                  
                  lSize = LOF(FFIn) 'Get size of file
                  lMaxBlocks = lSize \ lBlockSize 'Get number of blocks to read
                  lRest = lSize - (lMaxBlocks * lBlockSize) 'Number of bytes left to read when all complete chunks have been read
                  strTMP = New String(Chr(0), lBlockSize) 'Initialize buffer
                  While Not EOF(FFIn) And (lBlockCount < lMaxBlocks) And (Not m_bCancel) 'Read entire file
                        'UPGRADE_WARNING: Get was upgraded to FileGet and has a new behavior. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
                        FileGet(FFIn, strTMP) 'Read a chunk
                        If bEncode Then strOut = Me.Encode(strTMP) & IIf(lRest > 0, vbLf, "") Else strOut = Me.Decode(strTMP)
                        'UPGRADE_WARNING: Put was upgraded to FilePut and has a new behavior. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
                        FilePut(FFOut, strOut)
                        lBlockCount = lBlockCount + 1 'Count chunks
                        RaiseEvent BlockRead(lBlockCount, lMaxBlocks + IIf(lRest > 0, 1, 0), IIf(bEncode, enBlockMode.b64Encode, enBlockMode.b64Decode), m_bCancel)
                  End While
                  If (lRest > 0) And (Not EOF(FFIn)) And (Not m_bCancel) Then 'Read rest if required
                        strTMP = New String(Chr(0), lRest) 'Initialize buffer
                        'UPGRADE_WARNING: Get was upgraded to FileGet and has a new behavior. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
                        FileGet(FFIn, strTMP) 'Read a chunk
                        If bEncode Then strOut = Me.Encode(strTMP) Else strOut = Me.Decode(strTMP)
                        'UPGRADE_WARNING: Put was upgraded to FilePut and has a new behavior. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
                        FilePut(FFOut, strOut)
                        RaiseEvent BlockRead(lBlockCount + 1, lMaxBlocks + 1, IIf(bEncode, enBlockMode.b64Encode, enBlockMode.b64Decode), m_bCancel)
                  End If
                  FileClose(FFOut)
                  RaiseEvent AfterFileCloseOut(strOutFile)
                  
                  FileClose(FFIn)
                  RaiseEvent AfterFileCloseIn(strInFile)
                  If bEncode Then
                        RaiseEvent FileEncodeComplete(strInFile, strOutFile)
                  Else
                        RaiseEvent FileDecodeComplete(strInFile, strOutFile)
                  End If
                  'UPGRADE_WARNING: Couldn't resolve default property of object EncDecFile. Click for more: 'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
                  EncDecFile = True
            Else
                  RaiseError(90002, "File does not exist / error opening file:" & strInFile)
            End If
            Exit Function
            
errEncDecFile:
            RaiseError(Err.Number, Err.Description)
      End Function
End Class
0
 
LVL 3

Accepted Solution

by:
tasky earned 500 total points
ID: 22626709
Well I have to ask why you are using a class for Base64 conversion. .NET has support for base64 using the Convert.ToBase64String and Convert.FromBase64String (or CharArray). The conversion has support for byte arrays. So why bother with the old VB6 base64 class?
0
3 Use Cases for Connected Systems

Our Dev teams are like yours. They’re continually cranking out code for new features/bugs fixes, testing, deploying, testing some more, responding to production monitoring events and more. It’s complex. So, we thought you’d like to see what’s working for us.

 
LVL 3

Assisted Solution

by:tasky
tasky earned 500 total points
ID: 22626756
You can try this though:


    Public Function Encode(ByVal strIn As String) As String

        'Encode a string to base64

        Dim oElement As Object

        Dim sData As String

        Dim aData() As Byte
 

        On Error GoTo errEncode

        If m_bXMLObjectOK And Len(strIn) > 0 Then

            aData = System.Text.UnicodeEncoding.Unicode.GetBytes(strIn)

            m_oXMLElement.nodetypedvalue = System.Text.UnicodeEncoding.Unicode.GetString(aData)

            Encode = m_oXMLElement.Text

            m_oXMLElement.Text = "" 'Free memory

        Else

            Return ""

        End If

        Exit Function

errEncode:

        RaiseError(Err.Number, Err.Description)

    End Function
 

    Public Function Decode(ByVal strIn As String) As String

        'Decode a base64 string

        Dim oElement As Object
 

        On Error GoTo errDecode

        If m_bXMLObjectOK And Len(strIn) > 0 Then

            m_oXMLElement.Text = strIn

            Decode = System.Text.UnicodeEncoding.Unicode.GetString(m_oXMLElement.nodetypedvalue)

            m_oXMLElement.Text = "" 'Free memory

        End If

        Exit Function

errDecode:

        RaiseError(Err.Number, Err.Description)

    End Function

Open in new window

0
 
LVL 14

Author Closing Comment

by:Matti
ID: 31502507
Thanks!

I'm saving email attachments in my project.
It was a bit stupid to use old VB class, The .Net had a function for it.
I'm just learning .NET I don't remember all it's namespaces.

Imports System.Convert

Dim strUnBASE64 As String
Dim strUnBASE64b() As Byte

Some code here

strUnBASE64b = Convert.FromBase64String(strUnBASE64)
strUnBASE64 = System.Text.Encoding.Default.GetString(strUnBASE64b)


And this I can save to file.


It works OK even when there are multible attacments and it was faster than this old class.

There is some for tasky to a good try

Matti
0
 
LVL 3

Expert Comment

by:tasky
ID: 22627242
Ah, fear not, we all had to make the switch to .NET sometime. And believe it or not, I did the same thing (tried to port a VB6 class to .NET---for base64) before I decided to google an answer. By the way, welcome to the wonderful world of .NET!
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Wouldn’t it be nice if you could test whether an element is contained in an array by using a Contains method just like the one available on List objects? Wouldn’t it be good if you could write code like this? (CODE) In .NET 3.5, this is possible…
Today I had a very interesting conundrum that had to get solved quickly. Needless to say, it wasn't resolved quickly because when we needed it we were very rushed, but as soon as the conference call was over and I took a step back I saw the correct …
This Micro Tutorial hows how you can integrate  Mac OSX to a Windows Active Directory Domain. Apple has made it easy to allow users to bind their macs to a windows domain with relative ease. The following video show how to bind OSX Mavericks to …
Internet Business Fax to Email Made Easy - With eFax Corporate (http://www.enterprise.efax.com), you'll receive a dedicated online fax number, which is used the same way as a typical analog fax number. You'll receive secure faxes in your email, fr…

895 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now