1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
|
Option Compare Database
Option Explicit
Const BLOCKSIZE = 32768
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'FUNCTION: fncReadBLOB()
'
'PURPOSE:
' Reads a BLOB from a file and stores it in specified table and field.
'
'PREREQUISITES:
' Table with the Image field to contain the binary data must
' be opened using Visual Basic for Applications code and the correct
' record navigated to, prior to calling the fncReadBLOB() function.
'
'ARGUMENTS:
' strSource - Path and filename of external file to be read and stored.
' rstTable - The table object to store the data in.
' strField - The Image field in table rstTable to store the data in.
'
'RETURN:
' The number of bytes read from the Source file.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function fncReadBLOB(strSource As String, rstTable As ADODB.Recordset, _
strField As String)
Dim intNumBlocks As Integer, intSourceFile As Integer, intI As Integer
Dim lngFileLength As Long, lngLeftOver As Long
Dim strFileData As String
Dim varRetVal As Variant
On Error GoTo Err_ReadBLOB
'Open the source file.
intSourceFile = FreeFile
Open strSource For Binary Access Read As intSourceFile
'Get the length of the file.
lngFileLength = LOF(intSourceFile)
'File is invalid if length equals zero.
If lngFileLength = 0 Then
fncReadBLOB = 0
Exit Function
End If
'Calculate the number of blocks to read and the leftover bytes.
intNumBlocks = lngFileLength \ BLOCKSIZE
lngLeftOver = lngFileLength Mod BLOCKSIZE
'Read the leftover data, writing it to the table.
strFileData = String$(lngLeftOver, 32)
'Read data from the external file.
Get intSourceFile, , strFileData
'Write the data to the Image field.
rstTable(strField).AppendChunk (strFileData)
'Read the remaining blocks of data, writing them to the table.
strFileData = String$(BLOCKSIZE, 32)
For intI = 1 To intNumBlocks
Get intSourceFile, , strFileData
rstTable(strField).AppendChunk (strFileData)
Next intI
'Update the record and terminate the function.
rstTable.Update
Close intSourceFile
fncReadBLOB = lngFileLength
Exit Function
Err_ReadBLOB:
fncReadBLOB = -Err
Exit Function
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'FUNCTION: fncWriteBLOB()
'
'PURPOSE:
' Writes the BLOB stored in table and field to specified disk file.
'
'PREREQUISITES:
' Table with the Image field containing the binary data must be opened
' using Visual Basic for Applications code and the correct record
' navigated to prior to calling the fncWriteBLOB() function.
'
'ARGUMENTS:
' rstTable - The table object containing the binary information.
' strField - Image field in table containing binary information to
' write.
' strDestination - Path and filename to write the binary information to.
'
'RETURN:
' The number of bytes written to the destination file.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function fncWriteBLOB(rstTable As ADODB.Recordset, strField As String, _
strDestination As String)
Dim intNumBlocks As Integer, intDestFile As Integer, intI As Integer
Dim lngFileLength As Long, lngLeftOver As Long
Dim strFileData As String
Dim varRetVal As Variant
On Error GoTo Err_WriteBLOB
'Get the size of the field.
lngFileLength = rstTable(strField).ActualSize
'Cancel if field is empty.
If lngFileLength = 0 Then
fncWriteBLOB = 0
Exit Function
End If
'Calculate number of blocks to write and the leftover bytes.
intNumBlocks = lngFileLength \ BLOCKSIZE
lngLeftOver = lngFileLength Mod BLOCKSIZE
'Create pointer for to destination file.
intDestFile = FreeFile
Open strDestination For Output As intDestFile
Close intDestFile
'Open the destination file.
Open strDestination For Binary As intDestFile
'Write the leftover data to the output file.
strFileData = rstTable(strField).GetChunk(lngLeftOver)
'Write data to the external file.
Put intDestFile, , strFileData
'Read the leftover chunks and write it to output file.
For intI = 1 To intNumBlocks
strFileData = rstTable(strField).GetChunk((intI - 1) * _
BLOCKSIZE + lngLeftOver)
Put intDestFile, , strFileData
Next intI
'Close the external file and terminate the function.
Close intDestFile
fncWriteBLOB = lngFileLength
Exit Function
Err_WriteBLOB:
If Err.Number = 94 Then
Resume Next
Else
fncWriteBLOB = -Err
Exit Function
End If
End Function
Sub test()
Dim varBytesRead As Variant, varBytesWritten As Variant
Dim strMsg As String
Dim Conn As New ADODB.Connection
Dim rstTable As New ADODB.Recordset
'Create connection and open the tblBlob table.
Set Conn = CurrentProject.Connection
rstTable.Open "FICHIER", Conn, adOpenDynamic, adLockOptimistic
'Create a new record and move to it.
rstTable.AddNew
rstTable("Nom") = "test"
rstTable.Update
'Call the Read Blob function.
varBytesRead = fncReadBLOB("c:\test.doc", rstTable, "Fiche")
End Sub |
Ouverture d'un fichier stockée dans un champ image
Répondre avec citation
Partager