Matti
asked on
I converted a VB 6.0 project to .NET 2005,had some errors:
Hi!
This VB 6.0 code
aData = StrConv(strIn, vbFromUnicode)
And this how it get converted ti .NET 2005
aData = System.Text.UnicodeEncodin
This was not converted
Decode = StrConv(m_oXMLElement.node
Decode = StrConv(m_oXMLElement.node
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
What data type is m_oXMLElement.nodetypedval ue?
ASKER
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/l ocal/redir ect.htm?ke yword="A9E 4979A-37FA -4718-9994 -97DD76ED7 0A7"'
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/l ocal/redir ect.htm?ke yword="6A5 0421D-15FE -4896-8A1B -2EC21E903 7B2"'
m_oXMLElement = m_oXMLDoc.createElement("T mpBase64")
'UPGRADE_WARNING: Couldn't resolve default property of object m_oXMLElement.dataType. Click for more: 'ms-help://MS.VSCC.v80/dv_ commoner/l ocal/redir ect.htm?ke yword="6A5 0421D-15FE -4896-8A1B -2EC21E903 7B2"'
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/l ocal/redir ect.htm?ke yword="A9E 4979A-37FA -4718-9994 -97DD76ED7 0A7"'
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/l ocal/redir ect.htm?ke yword="6E3 5BFF6-CD74 -4B09-9689 -3E1A43DF8 969"'
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/l ocal/redir ect.htm?ke yword="6E3 5BFF6-CD74 -4B09-9689 -3E1A43DF8 969"'
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/l ocal/redir ect.htm?ke yword="55B 59875-9A95 -4B71-9D6A -7C294BF71 39D"'
'UPGRADE_TODO: Code was upgraded to use System.Text.UnicodeEncodin g.Unicode. GetBytes() which may not have the same behavior. Click for more: 'ms-help://MS.VSCC.v80/dv_ commoner/l ocal/redir ect.htm?ke yword="93D D716C-10E3 -41BE-A4A8 -3BA401579 05B"'
aData = System.Text.UnicodeEncodin g.Unicode. GetBytes(S trConv(str In, vbFromUnicode)) 'vbFromUnicode 'aData = StrConv(strIn, vbFromUnicode)
'UPGRADE_WARNING: Couldn't resolve default property of object m_oXMLElement.nodetypedval ue. Click for more: 'ms-help://MS.VSCC.v80/dv_ commoner/l ocal/redir ect.htm?ke yword="6A5 0421D-15FE -4896-8A1B -2EC21E903 7B2"'
'UPGRADE_TODO: Code was upgraded to use System.Text.UnicodeEncodin g.Unicode. GetString( ) which may not have the same behavior. Click for more: 'ms-help://MS.VSCC.v80/dv_ commoner/l ocal/redir ect.htm?ke yword="93D D716C-10E3 -41BE-A4A8 -3BA401579 05B"'
m_oXMLElement.nodetypedval ue = System.Text.UnicodeEncodin g.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/l ocal/redir ect.htm?ke yword="6A5 0421D-15FE -4896-8A1B -2EC21E903 7B2"'
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/l ocal/redir ect.htm?ke yword="6A5 0421D-15FE -4896-8A1B -2EC21E903 7B2"'
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/l ocal/redir ect.htm?ke yword="6A5 0421D-15FE -4896-8A1B -2EC21E903 7B2"'
m_oXMLElement.Text = strIn
'UPGRADE_ISSUE: Constant vbUnicode was not upgraded. Click for more: 'ms-help://MS.VSCC.v80/dv_ commoner/l ocal/redir ect.htm?ke yword="55B 59875-9A95 -4B71-9D6A -7C294BF71 39D"'
'UPGRADE_WARNING: Couldn't resolve default property of object m_oXMLElement.nodetypedval ue. Click for more: 'ms-help://MS.VSCC.v80/dv_ commoner/l ocal/redir ect.htm?ke yword="6A5 0421D-15FE -4896-8A1B -2EC21E903 7B2"'
'''''Decode = StrConv(m_oXMLElement.node typedvalue , 64) 'vbUnicode
Decode = StrConv(m_oXMLElement.node typedvalue , vbUnicode)
'UPGRADE_WARNING: Couldn't resolve default property of object m_oXMLElement.Text. Click for more: 'ms-help://MS.VSCC.v80/dv_ commoner/l ocal/redir ect.htm?ke yword="6A5 0421D-15FE -4896-8A1B -2EC21E903 7B2"'
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/l ocal/redir ect.htm?ke yword="6A5 0421D-15FE -4896-8A1B -2EC21E903 7B2"'
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/l ocal/redir ect.htm?ke yword="6A5 0421D-15FE -4896-8A1B -2EC21E903 7B2"'
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/l ocal/redir ect.htm?ke yword="6E3 5BFF6-CD74 -4B09-9689 -3E1A43DF8 969"'
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/l ocal/redir ect.htm?ke yword="9B7 D5ADD-D8FE -4819-A36C -6DEDAF088 CC7"'
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(strOutFi le, 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/l ocal/redir ect.htm?ke yword="9B7 D5ADD-D8FE -4819-A36C -6DEDAF088 CC7"'
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/l ocal/redir ect.htm?ke yword="9B7 D5ADD-D8FE -4819-A36C -6DEDAF088 CC7"'
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/l ocal/redir ect.htm?ke yword="9B7 D5ADD-D8FE -4819-A36C -6DEDAF088 CC7"'
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/l ocal/redir ect.htm?ke yword="9B7 D5ADD-D8FE -4819-A36C -6DEDAF088 CC7"'
FilePut(FFOut, strOut)
RaiseEvent BlockRead(lBlockCount + 1, lMaxBlocks + 1, IIf(bEncode, enBlockMode.b64Encode, enBlockMode.b64Decode), m_bCancel)
End If
FileClose(FFOut)
RaiseEvent AfterFileCloseOut(strOutFi le)
FileClose(FFIn)
RaiseEvent AfterFileCloseIn(strInFile )
If bEncode Then
RaiseEvent FileEncodeComplete(strInFi le, strOutFile)
Else
RaiseEvent FileDecodeComplete(strInFi le, strOutFile)
End If
'UPGRADE_WARNING: Couldn't resolve default property of object EncDecFile. Click for more: 'ms-help://MS.VSCC.v80/dv_ commoner/l ocal/redir ect.htm?ke yword="6A5 0421D-15FE -4896-8A1B -2EC21E903 7B2"'
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
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_
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_
m_oXMLElement = m_oXMLDoc.createElement("T
'UPGRADE_WARNING: Couldn't resolve default property of object m_oXMLElement.dataType. Click for more: 'ms-help://MS.VSCC.v80/dv_
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_
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_
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_
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_
'UPGRADE_TODO: Code was upgraded to use System.Text.UnicodeEncodin
aData = System.Text.UnicodeEncodin
'UPGRADE_WARNING: Couldn't resolve default property of object m_oXMLElement.nodetypedval
'UPGRADE_TODO: Code was upgraded to use System.Text.UnicodeEncodin
m_oXMLElement.nodetypedval
'UPGRADE_WARNING: Couldn't resolve default property of object m_oXMLElement.Text. Click for more: 'ms-help://MS.VSCC.v80/dv_
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_
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_
m_oXMLElement.Text = strIn
'UPGRADE_ISSUE: Constant vbUnicode was not upgraded. Click for more: 'ms-help://MS.VSCC.v80/dv_
'UPGRADE_WARNING: Couldn't resolve default property of object m_oXMLElement.nodetypedval
'''''Decode = StrConv(m_oXMLElement.node
Decode = StrConv(m_oXMLElement.node
'UPGRADE_WARNING: Couldn't resolve default property of object m_oXMLElement.Text. Click for more: 'ms-help://MS.VSCC.v80/dv_
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_
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_
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_
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_
If Len(Dir(strInFile)) > 0 Then 'Does the file exist?
RaiseEvent BeforeFileOpenIn(strInFile
If m_bCancel Then Exit Function
FFIn = FreeFile 'Get a free file handle
FileOpen(FFIn, strInFile, OpenMode.Binary)
RaiseEvent BeforeFileOpenOut(strOutFi
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_
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_
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_
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_
FilePut(FFOut, strOut)
RaiseEvent BlockRead(lBlockCount + 1, lMaxBlocks + 1, IIf(bEncode, enBlockMode.b64Encode, enBlockMode.b64Decode), m_bCancel)
End If
FileClose(FFOut)
RaiseEvent AfterFileCloseOut(strOutFi
FileClose(FFIn)
RaiseEvent AfterFileCloseIn(strInFile
If bEncode Then
RaiseEvent FileEncodeComplete(strInFi
Else
RaiseEvent FileDecodeComplete(strInFi
End If
'UPGRADE_WARNING: Couldn't resolve default property of object EncDecFile. Click for more: 'ms-help://MS.VSCC.v80/dv_
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
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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(s trUnBASE64 )
strUnBASE64 = System.Text.Encoding.Defau lt.GetStri ng(strUnBA SE64b)
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
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(s
strUnBASE64 = System.Text.Encoding.Defau
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
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!