We help IT Professionals succeed at work.

Check out our new AWS podcast with Certified Expert, Phil Phillips! Listen to "How to Execute a Seamless AWS Migration" on EE or on your favorite podcast platform. Listen Now

x

can any one help me to make this code into an application

peacer3434
peacer3434 asked
on
Medium Priority
296 Views
Last Modified: 2010-04-17
hey can anyone make this coding into an application, that can be use in Oracle database. As i have only the function one is the BLOBTOFILE and another one is FILETOBLOB.

for the BLOBTOFILE right, i want it to retrieve and put into a folder and not a file. As for the FILETOBLOB is from a folder to Oracle Database.

CODING:

BLOBTOFILE:

Public Function BLOBToFile(ByVal strFullPath As String, ByRef objField As ADODB.Field, Optional ByVal bUseStream As Boolean = True, Optional ByVal lngChunkSize As Long = 8192) As Boolean
    On Error Resume Next
    Dim objStream As ADODB.Stream
    Dim intFreeFile As Integer
    Dim lngBytesLeft As Long
    Dim lngReadBytes As Long
    Dim byBuffer() As Byte

    If bUseStream Then
        Set objStream = New ADODB.Stream

        With objStream
            .Type = adTypeBinary
            .Open
            .Write objField.Value
            .SaveToFile strFullPath, adSaveCreateOverWrite
        End With

        DoEvents
        Else

            If Dir(strFullPath) <> "" Then
                Kill strFullPath
            End If
            lngBytesLeft = objField.ActualSize
            intFreeFile = FreeFile
            Open strFullPath For Binary As #intFreeFile

            Do Until lngBytesLeft <= 0
                lngReadBytes = lngBytesLeft


                If lngReadBytes > lngChunkSize Then
                    lngReadBytes = lngChunkSize
                End If
                byBuffer = objField.GetChunk(lngReadBytes)
                Put #intFreeFile, , byBuffer
                lngBytesLeft = lngBytesLeft - lngReadBytes

                DoEvents
                Loop
                Close #intFreeFile
            End If

            If Err.Number <> 0 Or Err.LastDllError <> 0 Then
                BLOBToFile = False
            Else
                BLOBToFile = True
            End If
        End Function

CODING:

FILETOBLOB:

Public Function FileToBLOB(ByVal strFullPath As String, ByRef objField As ADODB.Field, Optional ByVal bUseStream As Boolean = True, Optional ByVal lngChunkSize As Long = 8192) As Boolean
    On Error Resume Next
    Dim objStream As ADODB.Stream
    Dim intFreeFile As Integer
    Dim lngBytesLeft As Long
    Dim lngReadBytes As Long
    Dim byBuffer() As Byte
    Dim varChunk As Variant


    If bUseStream Then
        Set objStream = New ADODB.Stream


        With objStream
            .Type = adTypeBinary
            .Open
            .LoadFromFile strFullPath
            objField.Value = .Read(adReadAll)
        End With
    Else


        With objField
            '<<--If the field does not support
            '     Long Binary data'-->>
            '<<--then we cannot load the data
            '     into the field.-->>


            If (.Attributes And adFldLong) <> 0 Then
                intFreeFile = FreeFile
                Open strFullPath For Binary Access Read As #intFreeFile
                lngBytesLeft = LOF(intFreeFile)


                Do Until lngBytesLeft <= 0


                    If lngBytesLeft > lngChunkSize Then
                        lngReadBytes = lngChunkSize
                    Else
                        lngReadBytes = lngBytesLeft
                    End If
                    ReDim byBuffer(lngReadBytes)
                    Get #intFreeFile, , byBuffer()
                    objField.AppendChunk byBuffer()
                    lngBytesLeft = lngBytesLeft - lngReadBytes


                    DoEvents
                    Loop
                    Close #intFreeFile
                Else
                    Err.Raise -10000, "FileToBLOB", "The Database Field does Not support Long Binary Data."
                End If
            End With
        End If
       


        If Err.Number <> 0 Or Err.LastDllError <> 0 Then
            FileToBLOB = False
        Else
            FileToBLOB = True
        End If
    End Function
=====
END
=====

these are the two functions i have...hope anyone kind enough to help make into an application...

peacer3434
Comment
Watch Question

Commented:
Unlock this solution with a free trial preview.
(No credit card required)
Get Preview
Unlock the solution to this question.
Thanks for using Experts Exchange.

Please provide your email to receive a free trial preview!

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.