VBScript ADO, OLEobject

[tgreer]

First, sorry for posting this here, but I couldn't find a VBScript forum on Daniweb (which I find surprising).

I'm working with binary data in several different projects. Below is an example of code that works to retrieve a static map image (PNG) from Google:

strFileURL = "http://maps.google.com/maps/api/staticmap?markers=2200+S+Western+Ave+Lisle+IL&zoom=14&size=400x400&sensor=false"

Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
Set objFSO = Createobject("Scripting.FileSystemObject")

objXMLHTTP.open "GET", strFileURL, false
objXMLHTTP.send()

If objXMLHTTP.Status = 200 Then
  Set objADOStream = CreateObject("ADODB.Stream")
  objADOStream.Type = 1 'adTypeBinary
  objADOStream.Open

  objADOStream.Write objXMLHTTP.ResponseBody
  objADOStream.Position = 0

  Set tempfolder = objFSO.GetSpecialFolder(2)
  tempname = tempfolder & "\" & objFSO.GetTempName

  If objFSO.Fileexists(tempname) Then objFSO.DeleteFile tempname
  objADOStream.SaveToFile tempname
  objADOStream.Close
  Set objADOStream = Nothing
End if

Set objXMLHTTP = Nothing
Set objFSO = Nothing

That works fine. My next task is to retrieve binary data from an OLEobject field in Access. Modifying the code as follows:

dim conn
set conn = CreateObject("ADODB.Connection")
conn.Open "provider=microsoft.jet.oledb.4.0;data source=C:\db\db1.mdb"

dim rs
dim NewDoc
set rs = CreateObject("ADODB.Recordset")
rs.Open "Tom", conn

rs.MoveFirst

while not rs.EOF
  Set objADOStream = CreateObject("ADODB.Stream")
  objADOStream.Type = 1 'adTypeBinary

  objADOStream.Open()
  objADOStream.Position = 0    'Set the stream position to the start

  objADOStream.Write(rs.fields("ATTACHMENT_FILE").Value)

  Set tempfolder = objFSO.GetSpecialFolder(2)
  tempname = tempfolder & "\" & objFSO.GetTempName

  If objFSO.Fileexists(tempname) Then objFSO.DeleteFile tempname

  objADOStream.SaveToFile tempname
  objADOStream.Close
  Set objADOStream = Nothing

  rs.MoveNext
wend

I get an error on the Write statement:

"Error 0 on line 21, column 3: ADODB.Stream: Arguments are of the wrong type, are out of acceptable range, or are in conflict with one another."

I am not an Access pro, so my searching has been a bit haphazard. I've seen information that tells me I must strip the OLE Header... a lot of VBA or VB.NET code, but nothing which is specific to VBScript or explains why, OLE wrapper or not, I cannot at the very least save the binary object to disk.

I've also tried to first "size" the field value (.ActualSize) and instead of referencing the .Value property on the Write statement, use .GetChunk(size), with the same error.

So to word my question specifically: How does one write the contents of an Access OLEobject Field to disk using VBScript?

More specifically, I know that in this case the field contains a PDF, so information about the OLE Wrapper Access places around OLEobjects, and how to work with that wrapper (how big is it? What type is it? How to remove it?), again using VBScript, would be very much appreciated.

[AndreRet]

You'll find the scripting menus under Web Development at the top of this page.

The following code is saving and retrieving a picture from access database in VB6. It might not be 100% what you are looking for, but might put you on the right track, because it works with binary data, size chunks etc.

Option Explicit

Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long

'Purpose     :  Saves pictures in image boxes (or similiar) to a field in a recordset
'Inputs      :  oPictureControl                 A control containing an image
'               adoRS                           ADO recordset to add the image to
'               sFieldName                      The field name in adoRS, to add the image to
'Outputs     :  Returns True if succeeded in updating the recordset
'Notes       :  The field specified in sFieldName, must have a binary field type (ie. OLE Object in access)
'               Save the image at the currect cursor location in the recordset.
'Revisions   :

Public Function SavePictureToDB(oPictureControl As Object, adoRS As ADODB.Recordset, sFieldName As String) As Boolean
    Dim oPict As StdPicture
    Dim sDir As String, sTempFile As String
    Dim iFileNum As Integer
    Dim lFileLength As Long
    Dim abBytes() As Byte
    Dim iCtr As Integer
    
    On Error GoTo ErrHandler
    
    Set oPict = oPictureControl.Picture
    If oPict Is Nothing Then
        SavePictureToDB = False
        Exit Function
    End If

    'Save picture to temp file
    sTempFile = FileGetTempName
    SavePicture oPict, sTempFile
    
    'read file contents to byte array
    iFileNum = FreeFile
    Open sTempFile For Binary Access Read As #iFileNum
    lFileLength = LOF(iFileNum)
    ReDim abBytes(lFileLength)
    Get #iFileNum, , abBytes()
    'put byte array contents into db field
    adoRS.Fields(sFieldName).AppendChunk abBytes()
    Close #iFileNum
    
    'Don't return false if file can't be deleted
    On Error Resume Next
    Kill sTempFile
    SavePictureToDB = True
    Exit Function
    
ErrHandler:
    SavePictureToDB = False
    Debug.Print Err.Description
End Function


'Purpose     :  Loads a Picture, saved as binary data in a database, from a recordset into a picture control.
'Inputs      :  oPictureControl                 A control to load the image into
'               adoRS                           ADO recordset to add the image to
'               sFieldName                      The field name in adoRS, to add the image to
'Outputs     :  Returns True if succeeded in loading the image
'Notes       :  Loads the image at the currect cursor location in the recordset.


Public Function LoadPictureFromDB(oPictureControl As Object, adoRS As ADODB.Recordset, sFieldName As String) As Boolean
    Dim oPict As StdPicture
    Dim sDir As String
    Dim sTempFile As String
    Dim iFileNum As Integer
    Dim lFileLength As Long
    Dim abBytes() As Byte
    Dim iCtr As Integer
    
    On Error GoTo ErrHandler
    sTempFile = FileGetTempName
   
    iFileNum = FreeFile
    Open sTempFile For Binary As #iFileNum
    lFileLength = LenB(adoRS(sFieldName))
    
    abBytes = adoRS(sFieldName).GetChunk(lFileLength)
    Put #iFileNum, , abBytes()
    Close #iFileNum

    oPictureControl.Picture = LoadPicture(sTempFile)
    
    Kill sTempFile
    LoadPictureFromDB = True
    Exit Function
    
ErrHandler:
    LoadPictureFromDB = False
    Debug.Print Err.Description
End Function


'Purpose     :  The FileGetTempName function returns a name of a temporary file.
'Inputs      :  [sFilePrefix]               The prefix of the file name.
'Outputs     :  Returns the name of the next free temporary file name (and path).
'Notes       :  The filename is the concatenation of specified path and prefix strings,
'               a hexadecimal string formed from a specified integer, and the .TMP extension


Function FileGetTempName(Optional sFilePrefix As String = "TMP") As String
    Dim sTemp As String * 260, lngLen As Long
    Static ssTempPath As String
    
    If LenB(ssTempPath) = 0 Then
        'Get the temporary path
        lngLen = GetTempPath(260, sTemp)
        'strip the rest of the buffer
        ssTempPath = Left$(sTemp, lngLen)
        If Right$(ssTempPath, 1) <> "\" Then
            ssTempPath = ssTempPath & "\"
        End If
    End If
    
    'Get a temporary filename
    lngLen = GetTempFileName(ssTempPath, sFilePrefix, 0, sTemp)
    'Remove all the unnecessary chr$(0)'s
    FileGetTempName = Left$(sTemp, InStr(1, sTemp, Chr$(0)) - 1)
End Function


'SAMPLE USAGE
'NOTE : Add a PictureBox control to a form before running this code
Sub TestLoadPicture()
    Dim sConn As String
    Dim oConn As New ADODB.Connection
    Dim oRs As New ADODB.Recordset
    
    On Error GoTo ErrFailed
    sConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=\\192.168.0.199\cserver\EmployeeCopies.MDB;Persist Security Info=False"
    
    oConn.Open sConn
    oRs.Open "SELECT * FROM Copies", oConn, adOpenKeyset, adLockOptimistic
    'If oRs.EOF = False Then
        LoadPictureFromDB Picture2, oRs, "EmpPhoto"
    'End If
    oRs.Close
    Exit Sub
ErrFailed:
    MsgBox "Error " & Err.Description
End Sub

'SAMPLE USAGE
'NOTE : Add a PictureBox control to a form before running this code
Sub TestSavePicture()
    Dim sConn As String
    Dim oConn As New ADODB.Connection
    Dim oRs As New ADODB.Recordset
    
    On Error GoTo ErrFailed
    sConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=\\192.168.0.199\cserver\EmployeeCopies.MDB;Persist Security Info=False"
    
    oConn.Open sConn
    oRs.Open "SELECT * FROM Copies", oConn, adOpenKeyset, adLockOptimistic
    'If oRs.EOF = False Then
        oRs.AddNew
        SavePictureToDB Picture1, oRs, "EmpPhoto"
        oRs.Update
        MsgBox "saved"
    'End If
    oRs.Close
    Exit Sub
ErrFailed:
    MsgBox "Error " & Err.Description
End Sub

Private Sub Command1_Click()
Call TestLoadPicture
End Sub

Private Sub Command2_Click()
Call TestSavePicture
End Sub

[tgreer]

Thanks for the reply.

I'm sorry, but this isn't a Web Development task at all, so I thought of the choices I had, "Software Development" in the VB family forum made the most sense.

As a scripting task, this will have no user interface, so VB6 form code isn't precisely relevant. Also, the core issue is that VBScript doesn't have a Byte() data type, which is why one must resort to AD0.

So to rephrase my question in the context of your post, how does one use the ADODB library, in VBScript, to store the contents of a binary file to disk?

Actually, I can do that, as shown in my first code snippet. So I have to revert to my original question, which is, to paraphrase, why doesn't the ADO Write() method work with the contents of an OLEobject Field? Or, more generally, "Yo... what am I doing wrong?"

[tgreer]

Update: apparently in my first code snippet, objXMLHTTP.ResponseBody is a byte array, which is what the ADODB.Stream Write() method expects, so it runs.

However, the OLEobject field contains a value of datatype "205", which must be converted into a byte array. Since VBscript doesn't have a byte() data type, I must

1. Convert the 205 value to an array of variants()
2. Cast the variant() to byte()

I know how to do the second task, using (ironically) ADODB.Stream! But how does one accomplish the first task?

Given an ADODB.RecordSet Field that contains an OLEobject, datatype 205, how does one covert this to an array of Variants? Thanks.

[AndreRet]

I think the following link might have your answer. This was about as close as I could get to the question (Sample code included in vbscript) -

http://www.motobit.com/tips/detpg_binarytostring/

Did this help?

[Nick Evan]

>> First, sorry for posting this here, but I couldn't find a VBScript forum on Daniweb (which I find surprising)

I was also surprised. I could've sworn we had a forum for this in the past. I've started a thread about it in the behind-the-scene forums, so I'll get back to you about this.
So everybody can stop reporting this post now please :)

Offtopic: tgreer: Did you buy this account or is Dani's favorite critic really back?

[edit]
Peter moved it to the legacy forum.

[tgreer]

Nick - yes it's really me. VBscript isn't "Legacy", however. This most properly belongs in the Shell Scripting forum, as I'm working within an encapsulation of the Windows Script Host, but that forum seems dedicated to Unix.

Andre - I'd seen that page in your link in my searches on the topic, and it illustrates a lot of concepts except the one I need. It shows turning strings into bytes and into 205s, but not the reverse!