BlobToFile Calls one of the below routines to use GetChunk
WriteFromBinary Writes a LongVarBinary of known size to disk
WriteFromUnsizedBinary Writes a LongVarBinary on unknown size
WriteFromText Writes a LongVarChar of known size
WriteFromUnsizedText Writes a LongVarChar of unknown size
FileToBlob Calls one of the below routines to use AppendChunk
ReadToBinary Reads a file into a LongVarBinary column
ReadToText Reads a file into a LongVarChar column
Option Explicit
Private Sub CmdSave_Click()
Dim cn As ADODB.Connection, rs As ADODB.Recordset, SQL As String
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
cn.CursorLocation = adUseServer
cn.Open "dsn=nwind_jet" ' *** change this ***
SQL = "SELECT * FROM Employees WHERE LastName='Fuller'"
rs.Open SQL, cn, adOpenStatic, adLockReadOnly
'
' Save using GetChunk and known size.
' FieldSize (ActualSize) > Threshold arg (16384)
'
BlobToFile rs!Photo, "c:\photo1.dat", rs!Photo.ActualSize, 16384
BlobToFile rs!Notes, "c:\notes1.txt", rs!Notes.ActualSize, 16384
' Uncomment the next line of code, and comment the line above,
' to workaround Runtime error '94': Invalid use of Null
' BlobToFile rs!Notes, "c:\notes1.txt", rs!Notes.ActualSize \ 2, 16384
'
' Save using GetChunk and unknown size.
' FieldSize not specified.
'
BlobToFile rs!Photo, "c:\photo2.dat"
BlobToFile rs!Notes, "c:\notes2.txt"
'
' Save without using GetChunk
' FieldSize (ActualSize) < Threshold arg (defaults to 1Mb)
'
BlobToFile rs!Photo, "c:\photo3.dat", rs!Photo.ActualSize
BlobToFile rs!Notes, "c:\notes3.txt", rs!Notes.ActualSize
' Uncomment the next line of code, and comment the line above,
' to workaround Runtime error '94': Invalid use of Null
' BlobToFile rs!Notes, "c:\notes3.txt", rs!Notes.ActualSize \ 2
rs.Close
cn.Close
End Sub
Private Sub CmdLoad_Click()
Dim cn As ADODB.Connection, rs As ADODB.Recordset, SQL As String
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
cn.CursorLocation = adUseServer
cn.Open "dsn=ole_db_nwind_jet"
SQL = "SELECT * FROM Employees"
rs.Open SQL, cn, adOpenKeyset, adLockOptimistic
'
' Load using AppendChunk
'
rs.AddNew
rs!FirstName = "Test"
rs!LastName = "Fuller11"
FileToBlob "c:\photo1.dat", rs!Photo, 16384
FileToBlob "c:\notes1.txt", rs!Notes, 16384
rs.Update
rs.AddNew
rs!FirstName = "Test"
rs!LastName = "Fuller21"
FileToBlob "c:\photo2.dat", rs!Photo, 16384
FileToBlob "c:\notes2.txt", rs!Notes, 16384
rs.Update
rs.AddNew
rs!FirstName = "Test"
rs!LastName = "Fuller31"
FileToBlob "c:\photo3.dat", rs!Photo, 16384
FileToBlob "c:\notes3.txt", rs!Notes, 16384
rs.Update
'
' Load without using AppendChunk
'
rs.AddNew
rs!FirstName = "Test"
rs!LastName = "Fuller12"
FileToBlob "c:\photo1.dat", rs!Photo
FileToBlob "c:\notes1.txt", rs!Notes
rs.Update
rs.AddNew
rs!FirstName = "Test"
rs!LastName = "Fuller22"
FileToBlob "c:\photo2.dat", rs!Photo
FileToBlob "c:\notes2.txt", rs!Notes
rs.Update
rs.AddNew
rs!FirstName = "Test"
rs!LastName = "Fuller32"
FileToBlob "c:\photo3.dat", rs!Photo
FileToBlob "c:\notes3.txt", rs!Notes
rs.Update
rs.Close
cn.Close
End Sub
將新模組加入至專案 (Module1 中)，以下列程式碼：
Option Explicit
Const BLOCK_SIZE = 16384
Sub BlobToFile(fld As ADODB.Field, ByVal FName As String, _
Optional FieldSize As Long = -1, _
Optional Threshold As Long = 1048576)
'
' Assumes file does not exist
' Data cannot exceed approx. 2Gb in size
'
Dim F As Long, bData() As Byte, sData As String
F = FreeFile
Open FName For Binary As #F
Select Case fld.Type
Case adLongVarBinary
If FieldSize = -1 Then ' blob field is of unknown size
WriteFromUnsizedBinary F, fld
Else ' blob field is of known size
If FieldSize > Threshold Then ' very large actual data
WriteFromBinary F, fld, FieldSize
Else ' smallish actual data
bData = fld.Value
Put #F, , bData ' PUT tacks on overhead if use fld.Value
End If
End If
Case adLongVarChar, adLongVarWChar
If FieldSize = -1 Then
WriteFromUnsizedText F, fld
Else
If FieldSize > Threshold Then
WriteFromText F, fld, FieldSize
Else
sData = fld.Value
Put #F, , sData ' PUT tacks on overhead if use fld.Value
End If
End If
End Select
Close #F
End Sub
Sub WriteFromBinary(ByVal F As Long, fld As ADODB.Field, _
ByVal FieldSize As Long)
Dim Data() As Byte, BytesRead As Long
Do While FieldSize <> BytesRead
If FieldSize - BytesRead < BLOCK_SIZE Then
Data = fld.GetChunk(FieldSize - BLOCK_SIZE)
BytesRead = FieldSize
Else
Data = fld.GetChunk(BLOCK_SIZE)
BytesRead = BytesRead + BLOCK_SIZE
End If
Put #F, , Data
Loop
End Sub
Sub WriteFromUnsizedBinary(ByVal F As Long, fld As ADODB.Field)
Dim Data() As Byte, Temp As Variant
Do
Temp = fld.GetChunk(BLOCK_SIZE)
If IsNull(Temp) Then Exit Do
Data = Temp
Put #F, , Data
Loop While LenB(Temp) = BLOCK_SIZE
End Sub
Sub WriteFromText(ByVal F As Long, fld As ADODB.Field, _
ByVal FieldSize As Long)
Dim Data As String, CharsRead As Long
Do While FieldSize <> CharsRead
If FieldSize - CharsRead < BLOCK_SIZE Then
Data = fld.GetChunk(FieldSize - BLOCK_SIZE)
CharsRead = FieldSize
Else
Data = fld.GetChunk(BLOCK_SIZE)
CharsRead = CharsRead + BLOCK_SIZE
End If
Put #F, , Data
Loop
End Sub
Sub WriteFromUnsizedText(ByVal F As Long, fld As ADODB.Field)
Dim Data As String, Temp As Variant
Do
Temp = fld.GetChunk(BLOCK_SIZE)
If IsNull(Temp) Then Exit Do
Data = Temp
Put #F, , Data
Loop While Len(Temp) = BLOCK_SIZE
End Sub
Sub FileToBlob(ByVal FName As String, fld As ADODB.Field, _
Optional Threshold As Long = 1048576)
'
' Assumes file exists
' Assumes calling routine does the UPDATE
' File cannot exceed approx. 2Gb in size
'
Dim F As Long, Data() As Byte, FileSize As Long
F = FreeFile
Open FName For Binary As #F
FileSize = LOF(F)
Select Case fld.Type
Case adLongVarBinary
If FileSize > Threshold Then
ReadToBinary F, fld, FileSize
Else
Data = InputB(FileSize, F)
fld.Value = Data
End If
Case adLongVarChar, adLongVarWChar
If FileSize > Threshold Then
ReadToText F, fld, FileSize
Else
fld.Value = Input(FileSize, F)
End If
End Select
Close #F
End Sub
Sub ReadToBinary(ByVal F As Long, fld As ADODB.Field, _
ByVal FileSize As Long)
Dim Data() As Byte, BytesRead As Long
Do While FileSize <> BytesRead
If FileSize - BytesRead < BLOCK_SIZE Then
Data = InputB(FileSize - BytesRead, F)
BytesRead = FileSize
Else
Data = InputB(BLOCK_SIZE, F)
BytesRead = BytesRead + BLOCK_SIZE
End If
fld.AppendChunk Data
Loop
End Sub
Sub ReadToText(ByVal F As Long, fld As ADODB.Field, _
ByVal FileSize As Long)
Dim Data As String, CharsRead As Long
Do While FileSize <> CharsRead
If FileSize - CharsRead < BLOCK_SIZE Then
Data = Input(FileSize - CharsRead, F)
CharsRead = FileSize
Else
Data = Input(BLOCK_SIZE, F)
CharsRead = CharsRead + BLOCK_SIZE
End If
fld.AppendChunk Data
Loop
End Sub
重要：本文是以 Microsoft 機器翻譯軟體翻譯而成，而非使用人工翻譯而成。Microsoft 同時提供使用者人工翻譯及機器翻譯兩個版本的文章，讓使用者可以依其使用語言使用知識庫中的所有文章。但是，機器翻譯的文章可能不盡完美。這些文章中也可能出現拼字、語意或文法上的錯誤，就像外國人在使用本國語言時可能發生的錯誤。Microsoft 不為內容的翻譯錯誤或客戶對該內容的使用所產生的任何錯誤或損害負責。Microsoft也同時將不斷地就機器翻譯軟體進行更新。
Windows Live
Facebook
Twitter
Linkedin
Digg it
Yahoo
Delicious
StumbleUpon
Yammer
Reddit
Technorati
FriendFeed
Email
機器翻譯
回此頁最上方
