peacer3434
asked on
can any one help me to make this code into an application
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(lngReadB ytes)
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
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(lngReadB
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
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.