类模块FileSize.clsOption ExplicitPrivate m_sFile As String
Private m_iFile As Integer
Private m_iLen As Long
Private m_iOffset As LongPrivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)Public Property Get file() As String
file = m_sFile
End Property
Public Property Let file(ByVal sFile As String)
Dispose
m_sFile = sFile
Dim lErr As Long
If (FileExists(m_sFile, lErr)) Then
m_iFile = FreeFile
Open m_sFile For Binary Access Read Lock Write As #m_iFile
m_iLen = LOF(m_iFile)
Else
Err.Raise lErr, App.EXEName & ".File"
End If
End PropertyPrivate Function FileExists(ByVal sFile As String, ByRef lErr As Long) As Boolean
lErr = 0
On Error Resume Next
Dim sDir As String
sDir = Dir(sFile)
lErr = Err.Number
On Error GoTo 0
If (lErr = 0) Then
If (Len(sDir) > 0) Then
FileExists = True
Else
lErr = 53
End If
End If
End FunctionPublic Property Get Length() As Long
Length = m_iLen
End PropertyPublic Function Read( _
buffer() As Byte, _
ByVal readSize As Long _
) As Long
Dim lReadSize As Long
lReadSize = readSize
If (m_iOffset + lReadSize >= m_iLen) Then
readSize = m_iLen - m_iOffset
If (readSize > 0) Then
ReDim newBuffer(0 To readSize - 1) As Byte
Get #m_iFile, , newBuffer
CopyMemory buffer(0), newBuffer(0), readSize
Else
Dispose
End If
m_iOffset = m_iOffset + readSize
Else
' Can read
Get #m_iFile, , buffer
m_iOffset = m_iOffset + readSize
End If
Read = readSize
End FunctionPublic Sub Dispose()
If (m_iFile) Then
Close #m_iFile
m_iFile = 0
End If
End SubPrivate Sub Class_Terminate()
Dispose
End Sub
主程序
Private Sub Command1_Click()
Dim lFilesize As New FileSize
lFilesize.file = CommonDialog1.FileName
text1.text=lFilesize.Length
end sub
Private m_iFile As Integer
Private m_iLen As Long
Private m_iOffset As LongPrivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)Public Property Get file() As String
file = m_sFile
End Property
Public Property Let file(ByVal sFile As String)
Dispose
m_sFile = sFile
Dim lErr As Long
If (FileExists(m_sFile, lErr)) Then
m_iFile = FreeFile
Open m_sFile For Binary Access Read Lock Write As #m_iFile
m_iLen = LOF(m_iFile)
Else
Err.Raise lErr, App.EXEName & ".File"
End If
End PropertyPrivate Function FileExists(ByVal sFile As String, ByRef lErr As Long) As Boolean
lErr = 0
On Error Resume Next
Dim sDir As String
sDir = Dir(sFile)
lErr = Err.Number
On Error GoTo 0
If (lErr = 0) Then
If (Len(sDir) > 0) Then
FileExists = True
Else
lErr = 53
End If
End If
End FunctionPublic Property Get Length() As Long
Length = m_iLen
End PropertyPublic Function Read( _
buffer() As Byte, _
ByVal readSize As Long _
) As Long
Dim lReadSize As Long
lReadSize = readSize
If (m_iOffset + lReadSize >= m_iLen) Then
readSize = m_iLen - m_iOffset
If (readSize > 0) Then
ReDim newBuffer(0 To readSize - 1) As Byte
Get #m_iFile, , newBuffer
CopyMemory buffer(0), newBuffer(0), readSize
Else
Dispose
End If
m_iOffset = m_iOffset + readSize
Else
' Can read
Get #m_iFile, , buffer
m_iOffset = m_iOffset + readSize
End If
Read = readSize
End FunctionPublic Sub Dispose()
If (m_iFile) Then
Close #m_iFile
m_iFile = 0
End If
End SubPrivate Sub Class_Terminate()
Dispose
End Sub
主程序
Private Sub Command1_Click()
Dim lFilesize As New FileSize
lFilesize.file = CommonDialog1.FileName
text1.text=lFilesize.Length
end sub
Dim sFileName As String
Dim lFilesize As New FileSize
CommonDialog1.ShowOpen
sFileName = CommonDialog1.FileName
If sFileName = "" Then Exit Sub
lFilesize.file = sFileName
sBuff = lFilesize.Length
If lFilesize.Length < 1024 Then
Text1.Text = Str(lFilesize.Length) & "B"
ElseIf lFilesize.Length >= 1024 And lFilesize.Length < 1024 * 1024 Then
Text1.Text = Str(lFilesize.Length / 1024) & "KB"
Text1.Text = Str(lFilesize.Length) & "B"
ElseIf lFilesize.Length >= 1024 * 1024 Then
Text1.Text = Str(lFilesize.Length / 1024 / 1024) & "MB"
End If
End Sub
Dim lFilesize As New FileSize
With CommonDialog1
.Filter = "所有类型(*.*)|*.*"
.ShowOpen
End With
lFilesize.file = CommonDialog1.FileName
Adodc1.Recordset.ActiveConnection.Execute "Insert Into ServerData(文件,CRC32) Values ('" & CommonDialog1.FileTitle & "' , '" & lFilesize.Length & "')"
End Sub