Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations wOOdy-Soft on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

VB6 Binary Upload to WebService Corrupts File -- Why?

Status
Not open for further replies.

codefinger

Programmer
Feb 2, 2002
14
US
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
-----------------------------
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 &quot;<DOCUMENT />&quot;

    Set xroot = XDOM.documentElement
 
    Set oElement = XDOM.createElement(&quot;IMAGE&quot;)
    
    oElement.dataType = &quot;bin.base64&quot;
    
    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(&quot;MAINDIR&quot;) + iDirectory
            fs_new_file_name = ls_dirname + &quot;\&quot; + iName
            If UCase(iOverwrite) <> &quot;TRUE&quot; 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(&quot;DOCUMENT/IMAGE&quot;)
            Dim xbase64String As String
            xbase64String = xnode.text

'Note the massaging that must be done here...
'works for jpg file, but tif file says &quot;invalid length for a base64
'character array.

            If iFileType = &quot;JPG&quot; Then
                xbase64String = xbase64String.Replace(&quot; &quot;, &quot;+&quot;)
            End If

            If iFileType = &quot;TIF&quot; Then
                xbase64String = xbase64String.Replace(&quot; &quot;, &quot;+&quot;)
                Dim equalsign As Long
                equalsign = InStr(xbase64String, &quot;=&quot;)
                While equalsign > 0
                    xbase64String = Left(xbase64String, equalsign - 1)
                    equalsign = InStr(xbase64String, &quot;=&quot;)
                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 & &quot; failed length validation.  File was not retained.&quot;
                xResult.Stored = False
                Return xResult
            End If

            xResult.Stored = True
            xResult.Message = fs_new_file_name + &quot; was stored.&quot;
            xResult.NewfileName = fs_new_file_name
            Return xResult

        Catch ex As Exception

            xResult.Message = &quot;StoreObject failed:   &quot; + ex.Message
            xResult.Exception.Msg = ex.Message
            xResult.Exception.Code = -1

            Return xResult
        End Try


    End Function
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top