CodeItBetter Programming Another VB Programming Blog

How to Get the correct size of large files

Posted on January 4, 2009
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
'File/Folder Handling -  How to Get the correct size of large files
'Put this code in a class:

Option Explicit
 
Public Enum enumCreationDisposition
    CREATE_NEW = 1
    CREATE_ALWAYS = 2
    OPEN_EXISTING = 3
    OPEN_ALWAYS = 4
    TRUNCATE_EXISTING = 5
End Enum
 
Public Enum enumFileAttribute
    FILE_ATTRIBUTE_READONLY = &H1
    FILE_ATTRIBUTE_HIDDEN = &H2
    FILE_ATTRIBUTE_SYSTEM = &H4
    FILE_ATTRIBUTE_DIRECTORY = &H10
    FILE_ATTRIBUTE_ARCHIVE = &H20
    FILE_ATTRIBUTE_DEVICE = &H40
    FILE_ATTRIBUTE_NORMAL = &H80
    FILE_ATTRIBUTE_TEMPORARY = &H100
    FILE_ATTRIBUTE_SPARSE_FILE = &H200
    FILE_ATTRIBUTE_REPARSE_POINT = &H400
    FILE_ATTRIBUTE_COMPRESSED = &H800
    FILE_ATTRIBUTE_OFFLINE = &H1000
    FILE_ATTRIBUTE_NOT_CONTENT_INDEXED = &H2000
    FILE_ATTRIBUTE_ENCRYPTED = &H4000
End Enum
 
Public Enum enumShareMode
    FILE_SHARE_READ = &H1
    FILE_SHARE_WRITE = &H2
    FILE_SHARE_READ_WRITE = &H3
    FILE_SHARE_DELETE = &H4
End Enum
 
Public Enum enumDesiredAccess
    GENERIC_WRITE = &H40000000
    GENERIC_READ = &H80000000
    GENERIC_READ_WRITE = &HC0000000
End Enum
 
Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type
 
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
    (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, _
    lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, _
    ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, _
    lpFileSizeHigh As Long) As Long
 
Private FHandle As Long
Private FName As String
 
Public Function OpenFile(Optional ByVal sFileName As String, _
    Optional ByVal Access As enumDesiredAccess = GENERIC_READ_WRITE, _
    Optional ByVal ShareMode As enumShareMode = FILE_SHARE_READ_WRITE, _
    Optional ByVal CreationDisposition As enumCreationDisposition = OPEN_ALWAYS, _
    Optional ByVal Attributes As enumFileAttribute = FILE_ATTRIBUTE_NORMAL) As Boolean
    Dim SA As SECURITY_ATTRIBUTES
 
    If sFileName = "" Then sFileName = FName
    If FHandle <> 0 Then Me.CloseFile
    FHandle = CreateFile(sFileName, Access, ShareMode, SA, CreationDisposition, Attributes, 0)
 
    OpenFile = FHandle <> -1
 
    If Not OpenFile Then
        FHandle = 0
    Else
        FName = sFileName
    End If
End Function
 
Public Function CloseFile() As Boolean
    If FHandle <> 0 Then CloseFile = CloseHandle(FHandle) <> 0
    If CloseFile Then FHandle = 0
End Function
 
Public Function FileSize(Optional ByRef SizeHigh As Long = 0) As Long
    If FHandle <> 0 Then
        FileSize = GetFileSize(FHandle, SizeHigh)
    End If
End Function
 
Public Function FileSizeDouble() As Double
    Dim SizeLow As Long, SizeHigh As Long
    SizeLow = FileSize(SizeHigh)
 
    FileSizeDouble = CDbl(SizeHigh) * (2 ^ 32) + LongToDouble(SizeLow)
End Function
 
Private Function LongToDouble(ByVal Lng As Long) As Double
    If Lng And &H80000000 = 0 Then
        LongToDouble = CDbl(Lng)
    Else
        LongToDouble = (Lng Xor &H80000000) + (2 ^ 31)
    End If
End Function
 
Private Sub Class_Terminate()
    CloseFile
End Sub
 
'To use it:
Option Explicit
 
Private Sub Form_Load()
    Dim A As New clsAPIFile
    Dim FSize As Double
    If A.OpenFile("C:\Temp\test8.mp3", , , OPEN_EXISTING) Then
        FSize = A.FileSizeDouble
        Debug.Print FSize
        A.CloseFile
    End If
End Sub
Comments (0) Trackbacks (0)

No comments yet.


Leave a comment


 

No trackbacks yet.