MOSTRAR IMAGEM BLOB ORACLE

USUARIO.EXCLUIDOS 24/11/2004 22:20:04
#51861 Resposta escolhida

AS FUNÇÕES PARA LER E ESCREVER BLOB QUE EU USO ESTÃO Aà EM BAIXO , FUNCIONAM BEM PARA ORACLE , ACCESS OU QUALQUER OUTRO BANCO DE DADOS , LEMBRE-SE PORéM QUE O CAMPO DEVERà SER DO TIPO OBJETO INCORPORADO ( OLE ) .
ABRAÇO SINCERO,
ESPERO TER AJUDADO.



'**********************************************************************************
'FUNÇÃO : READBLOB
'DESCRIÇÃO : LÃÅ  UM ARQUIVO NO FORMATO BLOB ( objeto longo binário ) e grava no determinado campo de um recordset.
AUTOR : LEON GUILLIOD - 15/10/2003
'***********************************************************************************
Function ReadBLOB(ArquivoPath As String, CampoBlob As Field)
Dim NumBlocks As Integer, SourceFile As Integer, I As Integer
Dim FileLength As Long, LeftOver As Long
Dim FileData As String
Dim RetVal As Variant

On Error GoTo Err_ReadBLOB

' Abrir o arquivo para acesso binário
SourceFile = FreeFile
Open ArquivoPath For Binary Access Read As SourceFile

' Qual o tamanho do arquivo , se for 0 sai da função
FileLength = LOF(SourceFile)
If FileLength = 0 Then
ReadBLOB = 0
Exit Function
End If

' Calcula o número de blocos de bits e o resto.
NumBlocks = FileLength \ BlockSize
LeftOver = FileLength Mod BlockSize

' Usamos SysCmd para manipulas a barra de status
' RetVal = SysCmd(acSysCmdInitMeter, "Reading BLOB", _
FileLength \ 1000)


' Escreve o resto de bytes na tabela
FileData = String$(LeftOver, 32)
Get SourceFile, , FileData
CampoBlob.AppendChunk (FileData)

'RetVal = SysCmd(acSysCmdUpdateMeter, LeftOver / 1000)

' Escreve os outros bytes ( blocos ) na tabela.
FileData = String$(BlockSize, 32)
For I = 1 To NumBlocks
Get SourceFile, , FileData
CampoBlob.AppendChunk (FileData)

'RetVal = SysCmd(acSysCmdUpdateMeter, BlockSize * i / 1000)
Next I

' Sai da função >> Não se esqueça de dar um update no campo
' RetVal = SysCmd(acSysCmdRemoveMeter)
Close SourceFile
ReadBLOB = FileLength
Exit Function

Err_ReadBLOB:
ReadBLOB = -Err
Exit Function

End Function

'**************************************************************
''FUNÇÃO : WRITEBLOB
'DESCRIÇÃO : LÃÅ  UM CAMPO OLE COM CONTEÃÅ¡DO BLOB
AUTOR : LEON GUILLIOD - 15/10/2003
'**************************************************************
Function WriteBLOB(t As DAO.Recordset, ByVal sField As String, _
ByVal Destination As String)
Dim NumBlocks As Integer, DestFile As Integer, I As Integer
Dim FileLength As Long, LeftOver As Long
Dim FileData As String
Dim RetVal As Variant

On Error GoTo Err_WriteBLOB

' Tamanho do campo
FileLength = t(sField).FieldSize()
If FileLength = 0 Then
WriteBLOB = 0
Exit Function
End If

' Número de blocos e bites que sobram.
NumBlocks = FileLength \ BlockSize
LeftOver = FileLength Mod BlockSize

' Remove qualquer arquivo previamente selecionado como destino.
DestFile = FreeFile
Open Destination For Output As DestFile
Close DestFile

' Abre o arquivo de destino
Open Destination For Binary As DestFile



'Escreve os bites que são o resto , fora os blocos.
FileData = t(sField).GetChunk(0, LeftOver)
Put DestFile, , FileData


'Escreve os blocos principais no arquivo
For I = 1 To NumBlocks
' Reads a chunk and writes it to output file.
FileData = t(sField).GetChunk((I - 1) * BlockSize _
+ LeftOver, BlockSize)
Put DestFile, , FileData



' Finaliza fechando o arquivo recem criado
Close DestFile
WriteBLOB = FileLength
Exit Function

Err_WriteBLOB:
WriteBLOB = -Err
Exit Function

End Function