Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Is there an external VFP wrapper??
Message
From
22/01/2002 07:11:28
 
 
To
21/01/2002 10:09:06
General information
Forum:
Visual FoxPro
Category:
COM/DCOM and OLE Automation
Miscellaneous
Thread ID:
00607741
Message ID:
00608292
Views:
23
I found it doesn't work in VFP to pull the data out of blobs on oracle with ADO
so I had to use a VB dll to do this. Try the same code in VB and see what happens? But I'm not sure I understand exactly what you are experiencing?!


Here is the vb .cls file:

Hope it helps.
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Blobhandler"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Public oPropertyBag As Integer
' Test function VFP Call:
' oBlobHandler = CreateObject("VBBLOB.blobhandler")
' Print oBlobHandler.test

Public Function test() As Integer
    test = 12
End Function

'test vfp call
'Public OConnection
'OConnection = CreateObject("adodb.connection")
'OConnection.Provider = "SQLOLEDB"
'OConnection.ConnectionString = "Persist Security Info=False;Password=quest;User ID=quest;Data Source=TJM"
'OConnection.Open
'oBlobHandler = CreateObject("VBBLOB.blobhandler")

Public Function Connection(oConnection) As String
    Dim oRs As ADODB.Recordset
    Set oRs = CreateObject("ADODB.recordset")
    
    oRs.Open "select * from oleobjs", oConnection, adOpenForwardOnly, adLockReadOnly, adCmdText
    Connection = oRs.Fields("OLEID").Value
End Function

'execute a SQL statement (update,delete or insert)
'Public OConnection
'OConnection = CreateObject("adodb.connection")
'OConnection.Provider = "SQLOLEDB"
'OConnection.ConnectionString = "Persist Security Info=False;Password=quest;User ID=quest;Data Source=TJM"
'OConnection.Open
'oBlobHandler = CreateObject("VBBLOB.blobhandler")
'oBlobHandler.Execute(oConnection,"update test set x=12")

Public Function Execute(oConnection, lcsql) As Integer

Dim oCmd As ADODB.Command
Dim AffectedRecords
    
    Set oCmd = CreateObject("ADODB.Command")
    oCmd.ActiveConnection = oConnection
    oCmd.CommandText = lcsql
    oCmd.Prepared = False
    oCmd.CommandType = adCmdText
    oCmd.Execute AffectedRecords
    
    Execute = AffectedRecords
   
    Set oCmd = Nothing
    Set AffectedRecords = Nothing
  
End Function

'Write a blob to the DB
'Public OConnection
'OConnection = CreateObject("adodb.connection")
'OConnection.Provider = "SQLOLEDB"
'OConnection.ConnectionString = "Persist Security Info=False;Password=quest;User ID=quest;Data Source=TJM"
'OConnection.Open
'oBlobHandler = CreateObject("VBBLOB.blobhandler")
'oBlobHandler.BlobtoDB(oConnection,"c:\temp\test.png","00001","PNG")

Public Function BlobtoDB(oConnection, filename, ID, filetype) As String

    Dim oRs        As ADODB.Recordset
    Dim oCmd        As ADODB.Command
    Dim bytChunk(512)   As Byte
    Dim varChunk        As Variant
    Dim linsert As Boolean
    
    ' already connected...
    Set oRs = CreateObject("ADODB.Recordset")
    Set oCmd = CreateObject("ADODB.command")
    
    With oCmd
        .ActiveConnection = oConnection
        .CommandText = "select * from oleobjs where OLEID=?"
        .CommandType = adCmdText
    
        ' create the parameters
        .Parameters.Append .CreateParameter("OLEID", adVarChar, adParamInput, Len(ID), ID)
      
    End With
    
    
    With oRs
        .Open oCmd, , adOpenStatic, adLockOptimistic, adCmdText
        If .EOF Then
            linsert = True
        Else
            linsert = False
        End If
    End With
        
      
            'do an insert
                With oCmd
                    .ActiveConnection = oConnection
                      If linsert Then
                        .CommandText = "insert into oleobjs (oleid,oletype,oleobj) values(?,?,?)"
                      Else
                         .CommandText = "update oleobjs set oleid=? ,oletype=?,oleobj=?"
                      End If
                      .CommandType = adCmdText
         ''one param stil remains...
                    .Parameters.Delete 0
                     
        ' create the parameters
                     .Parameters.Append .CreateParameter("OLEID", adVarChar, adParamInput, Len(ID), ID)
                     .Parameters.Append .CreateParameter("OLETYPE", adVarChar, adParamInput, Len(filetype), filetype)
        ' loop, getting small chunks of the image, and
        ' appending them to the parameter
                    .Parameters.Append .CreateParameter("OLEOBJ", adBinary, adParamInput, 2147483647)
    
                    Open filename For Binary As #1
                     While Not EOF(1)
                      Get #1, , bytChunk()
                      .Parameters("OLEOBJ").AppendChunk bytChunk()
                     Wend
                     .Execute
                 End With
       

    Close #1
    
    Set oRs = Nothing
    Set oCmd = Nothing
    
End Function


'Public OConnection
'OConnection = CreateObject("adodb.connection")
'OConnection.Provider = "SQLOLEDB"
'OConnection.ConnectionString = "Persist Security Info=False;Password=quest;User ID=quest;Data Source=TJM"
'OConnection.Open
'oBlobHandler = CreateObject("VBBLOB.blobhandler")
'oBlobHandler.DBtoFile(oConnection,"c:\temp\test.png","00001")

Public Function DBtoFile(oConnection, filename, ID) As String

    Dim oRs        As ADODB.Recordset
    Dim oCmd        As ADODB.Command
    Dim bytChunk()  As Byte
    Dim varChunk        As Variant
    
    ' already connected...
    Set oRs = CreateObject("ADODB.Recordset")
    Set oCmd = CreateObject("ADODB.command")
    
    With oCmd
        .ActiveConnection = oConnection
        .CommandText = "select * from oleobjs where OLEID=?"
        .CommandType = adCmdText
    
        ' create the parameters
        .Parameters.Append .CreateParameter("OLEID", adVarChar, adParamInput, Len(ID), ID)
      
    End With
    
    
    With oRs
        .Open oCmd, , adOpenStatic, adLockOptimistic, adCmdText
        If Not .EOF Then
            
           Open filename For Binary As #1
           varChunk = oRs("OLEOBJ").GetChunk(512)
           While Not IsNull(varChunk)
                bytChunk = varChunk
                Put #1, , bytChunk()
                varChunk = oRs("OLEOBJ").GetChunk(512)
             Wend
              
        End If
    End With
        
      
    Close #1
    
    Set oRs = Nothing
    Set oCmd = Nothing
    
End Function
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform