Private Function DatabaseToFile(ByVal DataField As ADODB.Field, ByVal vSaveAs As String, ByVal vFileExpendName As String) As String
Dim fnum As Long, bytesleft As Long, bytes As Long
Dim lSumSize As Long, lNowSize As Long
Dim tmp() As Byte
On Error GoTo ErrHandleDatabaseToFile
If Trim(vSaveAs) = "" Then
DatabaseToFile = GetTempFileName(vFileExpendName)
Else
DatabaseToFile = Trim(vSaveAs)
End If
fnum = FreeFile
Open (DatabaseToFile) For Binary As fnum
bytesleft = DataField.ActualSize
lSumSize = CLng(bytesleft / 8192)
Do While bytesleft
bytes = bytesleft
If bytes > 8192 Then bytes = 8192
tmp = DataField.GetChunk(bytes)
Put #fnum, , tmp
bytesleft = bytesleft - bytes
lNowSize = lNowSize + 1
RaiseEvent TransmitData(lNowSize, lSumSize, False)
Loop
Close #fnum
Exit Function
ErrHandleDatabaseToFile:
DatabaseToFile = ""
Err.Clear
End FunctionPrivate Function FileToDatabase(ByVal vDataField As ADODB.Field, ByVal vFileName As String)
Dim fnum As Long, bytesleft As Long, bytes As Long
Dim lSumSize As Long, lNowSize As Long
Dim tmp() As Byte
On Error GoTo ErrHandleFileToDatabase
fnum = FreeFile
Open vFileName For Binary As fnum
bytesleft = LOF(fnum)
lSumSize = CLng(bytesleft / 8192)
Do While bytesleft
bytes = bytesleft
If bytes > 8192 Then bytes = 8192
ReDim tmp(1 To bytes) As Byte
Get #fnum, , tmp
vDataField.AppendChunk tmp
bytesleft = bytesleft - bytes
lNowSize = lNowSize + 1
DoEvents
RaiseEvent TransmitData(lNowSize, lSumSize, True)
Loop
Close #fnum
Exit Function
ErrHandleFileToDatabase:
Err.Clear
End Function
Dim fnum As Long, bytesleft As Long, bytes As Long
Dim lSumSize As Long, lNowSize As Long
Dim tmp() As Byte
On Error GoTo ErrHandleDatabaseToFile
If Trim(vSaveAs) = "" Then
DatabaseToFile = GetTempFileName(vFileExpendName)
Else
DatabaseToFile = Trim(vSaveAs)
End If
fnum = FreeFile
Open (DatabaseToFile) For Binary As fnum
bytesleft = DataField.ActualSize
lSumSize = CLng(bytesleft / 8192)
Do While bytesleft
bytes = bytesleft
If bytes > 8192 Then bytes = 8192
tmp = DataField.GetChunk(bytes)
Put #fnum, , tmp
bytesleft = bytesleft - bytes
lNowSize = lNowSize + 1
RaiseEvent TransmitData(lNowSize, lSumSize, False)
Loop
Close #fnum
Exit Function
ErrHandleDatabaseToFile:
DatabaseToFile = ""
Err.Clear
End FunctionPrivate Function FileToDatabase(ByVal vDataField As ADODB.Field, ByVal vFileName As String)
Dim fnum As Long, bytesleft As Long, bytes As Long
Dim lSumSize As Long, lNowSize As Long
Dim tmp() As Byte
On Error GoTo ErrHandleFileToDatabase
fnum = FreeFile
Open vFileName For Binary As fnum
bytesleft = LOF(fnum)
lSumSize = CLng(bytesleft / 8192)
Do While bytesleft
bytes = bytesleft
If bytes > 8192 Then bytes = 8192
ReDim tmp(1 To bytes) As Byte
Get #fnum, , tmp
vDataField.AppendChunk tmp
bytesleft = bytesleft - bytes
lNowSize = lNowSize + 1
DoEvents
RaiseEvent TransmitData(lNowSize, lSumSize, True)
Loop
Close #fnum
Exit Function
ErrHandleFileToDatabase:
Err.Clear
End Function
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货