Trucos Varios II
GRABAR/OBTENER ARCHIVOS BINARIOS EN UNA BD
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
Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Function SaveBinary(sFileName As String, F As Field) As Boolean
Dim i As Long
Dim iFileNbr As Integer
Dim nChunkSize As Long
Dim nLenLeft As Long
Dim nPos As Long
Dim sBuffer As String
Dim FileName As String
FileName = GetFileName
FileCopy sFileName, FileName
iFileNbr = FreeFile
Open FileName For Binary As #iFileNbr
nChunkSize = 16380
nLenLeft = LOF(iFileNbr)
If nLenLeft < nChunkSize Then
nChunkSize = nLenLeft
End If
nPos = 1
Do
sBuffer = Space(nChunkSize)
Get #iFileNbr, nPos, sBuffer
F.AppendChunk sBuffer
nPos = nPos + nChunkSize
nLenLeft = nLenLeft - nChunkSize
If nLenLeft < nChunkSize Then
nChunkSize = nLenLeft
End If
Loop Until nLenLeft <= 0
Close #iFileNbr
Kill FileName
SaveBinary = True
End Function
Public Function GetBinary(F As Field, sSndFile As String)
Dim iFileNbr As Integer
'Dim sSndFile As String
Dim nChunkSize As Long
Dim nLenLeft As Long
Dim nPos As Long
Dim sBuffer As String
'//sSndFile = GetFileName()
If Len(sSndFile) = 0 Then
GetBinary = ""
Exit Function
Else
iFileNbr = FreeFile
Open sSndFile For Binary As #iFileNbr
End If
nLenLeft = F.FieldSize
nChunkSize = 16380
If nLenLeft < nChunkSize Then
nChunkSize = nLenLeft
End If
nPos = 0
Do
sBuffer = Space(nChunkSize)
sBuffer = F.GetChunk(nPos, nChunkSize)
Put #iFileNbr, , sBuffer
nPos = nPos + nChunkSize
nLenLeft = nLenLeft - nChunkSize
If nLenLeft < nChunkSize Then
nChunkSize = nLenLeft
End If
Loop Until nLenLeft <= 0
GetBinary = sSndFile
Close #iFileNbr
End Function
Public Function GetFileName() As String
Dim sTempPath As String
Dim nReturn As Long
Dim sFileName As String
sTempPath = Space(255)
sFileName = Space(255)
nReturn = GetTempPath(Len(sTempPath), sTempPath)
If nReturn <> 0 Then '// Don't do anything if they don't have PATH set
sTempPath = Left(sTempPath, nReturn) '// Trim extra characters off
nReturn = GetTempFileName(sTempPath, "SOS", 0, sFileName)
If nReturn <> 0 Then
GetFileName = Left(sFileName, InStr(sFileName, Chr$(0)) - 1)
End If
End If
End Function
|
