codefinger
Programmer
Attempting to upload binary image files from a VB6 application to a VB.Net web service, I am using the following code, which seems to work ok for a jpg file, but not for a tif file. With the tif file, I try to remove the last equals signs (assuming they don't belong in the file, but then I throw an exception: "invalid length for a base64
character array" during the conversion. If I don't remove the equals sign then the tif file is at least displayable, but my image previewer can't see an end to it. That is, a two "page" tif file now has lets me display the same pages again and again, instead of greying out the little "next" arrow at the top when I reach the end of the file.
This does not happen with the original file.
My boss expects this service to be able to upload ANY kind of file -- tif, jpg, bmp, ico, txt, etc.
Any assistance with this problem would be greatly appreciated.
VB6
-----------------------------
character array" during the conversion. If I don't remove the equals sign then the tif file is at least displayable, but my image previewer can't see an end to it. That is, a two "page" tif file now has lets me display the same pages again and again, instead of greying out the little "next" arrow at the top when I reach the end of the file.
This does not happen with the original file.
My boss expects this service to be able to upload ANY kind of file -- tif, jpg, bmp, ico, txt, etc.
Any assistance with this problem would be greatly appreciated.
VB6
-----------------------------
Code:
Public Sub wsStoreObject()
Dim xXMLHTTP As New XMLHTTP
Dim xResponse As String
Dim xURL As String 'Web service url
Dim xSendParms As String
'>>> Web service parameters
Dim iBinStream As String
Dim iDirectory As String
Dim iName As String
Dim iOverwrite As String
Dim iOptions As String
Dim iFileLen As Long
Dim iFileType As String
On Error GoTo oops:
'>>> Set web service url
xURL = "[URL unfurl="true"]http://localhost/wsChartContentMS/CCMSService.asmx/StoreObject"[/URL]
'>>> set XMLHTTP object
xXMLHTTP.Open "POST", xURL
xXMLHTTP.setRequestHeader "Content-Type", "application/x-[URL unfurl="true"]www-form-urlencoded"[/URL]
'>>> Set web service send parameters
' iBinStream = SerializeImageToXML "c:\accepted\sweater.jpg")
iBinStream = SerializeImageToXML("c:\accepted\2001.tif")
iDirectory = "Note"
iName = "NewFile.tif"
iOverwrite = "FALSE"
iOptions = "TheOptions"
iFileType = "TIF"
'>>> Concatenate individual parms into the xSendParms variable
xSendParms = "iBinStream=" & iBinStream & "&"
xSendParms = xSendParms & "iDirectory=" & iDirectory & "&"
xSendParms = xSendParms & "iName=" & iName & "&"
xSendParms = xSendParms & "iFileType=" & iFileType & "&"
xSendParms = xSendParms & "iOverwrite=" & iOverwrite & "&"
xSendParms = xSendParms & "iOptions=" & iOptions
'>>> Call web service and pass its parameters
xXMLHTTP.send xSendParms
'>>> Loop until the call comes back
Do Until xXMLHTTP.readyState = 4
DoEvents
Loop
'>>> When exiting the loop, get the response from the webservice
xResponse = xXMLHTTP.responseText
MsgBox "Completed"
Set xXMLHTTP = Nothing
Exit Sub
oops:
MsgBox Err.Description
End Sub
Public Function SerializeImageToXML(ByVal iImage As String) As String
Dim XDOM As New MSXML2.DOMDocument30
Dim xroot As IXMLDOMNode
Dim oElement As IXMLDOMElement
XDOM.loadXML "<DOCUMENT />"
Set xroot = XDOM.documentElement
Set oElement = XDOM.createElement("IMAGE")
oElement.dataType = "bin.base64"
oElement.nodeTypedValue = ReadBinData(iImage)
xroot.appendChild oElement
SerializeImageToXML = XDOM.xml
Set XDOM = Nothing
Set xroot = Nothing
End Function
Function ReadBinData(ByVal strFileName As String) As Variant
Dim lLen As Long
Dim iFile As Integer
Dim arrBytes() As Byte
Dim lCount As Long
Dim strOut As String
Dim replace As Byte
'Read from disk
iFile = FreeFile()
Open strFileName For Binary Access Read As iFile
lLen = FileLen(strFileName)
gfilelen = lLen
ReDim arrBytes(lLen - 1)
Get iFile, , arrBytes
Close iFile
ReadBinData = arrBytes
End Function
Webservice Class Code:
-----------------------------------------------------
Public Function StoreObject(ByVal iBinStream As String, _
ByVal iDirectory As String, _
ByVal iName As String, _
ByVal iFileType As String, _
ByVal iOverwrite As String, _
ByVal iOptions As String _
) As ChartContentMS.doStoreObject.Result
Dim xResult As New ChartContentMS.doStoreObject.Result()
Dim lfilelen As Long
Dim fs_new_file_name As String
Dim ls_dirname As String
Dim fs_64 As String
Try
ls_dirname = System.Configuration.ConfigurationSettings.AppSettings("MAINDIR") + iDirectory
fs_new_file_name = ls_dirname + "\" + iName
If UCase(iOverwrite) <> "TRUE" Then
fs_new_file_name = GetNewFileName(fs_new_file_name)
Else
If System.IO.File.Exists(fs_new_file_name) Then
System.IO.File.Delete(fs_new_file_name)
End If
End If
Dim xDoc As New MSXML2.DOMDocument()
Dim xnode As MSXML2.IXMLDOMNode
xDoc.loadXML(iBinStream)
xnode = xDoc.selectSingleNode("DOCUMENT/IMAGE")
Dim xbase64String As String
xbase64String = xnode.text
'Note the massaging that must be done here...
'works for jpg file, but tif file says "invalid length for a base64
'character array.
If iFileType = "JPG" Then
xbase64String = xbase64String.Replace(" ", "+")
End If
If iFileType = "TIF" Then
xbase64String = xbase64String.Replace(" ", "+")
Dim equalsign As Long
equalsign = InStr(xbase64String, "=")
While equalsign > 0
xbase64String = Left(xbase64String, equalsign - 1)
equalsign = InStr(xbase64String, "=")
End While
End If
xDoc = Nothing
xnode = Nothing
Dim xByteArray() As Byte
xByteArray = System.Convert.FromBase64String(xbase64String)
Dim xFileStream As New _
System.IO.FileStream(fs_new_file_name, System.IO.FileMode.Create)
Dim xBinWrite As System.IO.BinaryWriter = New System.IO.BinaryWriter(xFileStream)
xBinWrite.Write(xByteArray, 0, xByteArray.Length - 1)
xBinWrite.Flush()
xBinWrite.Close()
xFileStream.Close()
'Validate the completed file
Dim finfo As New System.IO.FileInfo(fs_new_file_name)
If finfo.Length = 0 Then
System.IO.File.Delete(fs_new_file_name)
xResult.Exception.Code = -1
xResult.Message = fs_new_file_name & " failed length validation. File was not retained."
xResult.Stored = False
Return xResult
End If
xResult.Stored = True
xResult.Message = fs_new_file_name + " was stored."
xResult.NewfileName = fs_new_file_name
Return xResult
Catch ex As Exception
xResult.Message = "StoreObject failed: " + ex.Message
xResult.Exception.Msg = ex.Message
xResult.Exception.Code = -1
Return xResult
End Try
End Function