Get Size (Byte) Of Directory VB6 | DASAR PROGRAMER

Get Size (Byte) Of Directory VB6

Berikut ini adalah cara mengetahui ukuran (size) suatu direktori dalam hitungan bytes di visual basic 6, untuk mempraktekannya siapkan :
1. Buat 1 Project baru dengan 1 Form, 1 Module, dan 1 Commandbutton.
2. Copy-kan coding berikut ke editor form yang bertalian.

          '--- Coding ini di Module...
          Public Const MAX_PATH = 260
          Public Type FILETIME
            dwLowDateTime As Long

            dwHighDateTime As Long
          End Type

          Public Type WIN32_FIND_DATA

            dwFileAttributes As Long
            ftCreationTime As FILETIME
            ftLastAccessTime As FILETIME
            ftLastWriteTime As FILETIME
            nFileSizeHigh As Long

            nFileSizeLow As Long
            dwReserved0 As Long
            dwReserved1 As Long
            cFileName As String * MAX_PATH

            cAlternate As String * 14
          End Type

          Declare Function FindFirstFile Lib "kernel32" _
             Alias "FindFirstFileA" (ByVal lpFileName As String, _
             lpFindFileData As WIN32_FIND_DATA) As Long
           
          Declare Function FindNextFile Lib "kernel32" _
             Alias "FindNextFileA" (ByVal hFindFile As Long, _
             lpFindFileData As WIN32_FIND_DATA) As Long
           
          Declare Function FindClose Lib "kernel32" _
             (ByVal hFindFile As Long) As Long

          '--- Akhir coding di Module...

          '--- Coding ini di Form...
          Public Function SizeOf(ByVal DirPath As String) As Double

          Dim hFind As Long
          Dim fdata As WIN32_FIND_DATA
          Dim dblSize As Double
          Dim sName As String
          Dim x As Long

          On Error Resume Next
            x = GetAttr(DirPath)
            If Err Then SizeOf = 0: Exit Function
            If (x And vbDirectory) = vbDirectory Then

               dblSize = 0

               Err.Clear
               sName = Dir$(EndSlash(DirPath) & "*.*", vbSystem Or vbHidden Or vbDirectory)

               If Err.Number = 0 Then
                  hFind = FindFirstFile(EndSlash(DirPath) & "*.*", fdata)
                  If hFind = 0 Then Exit Function
                  Do
                    If (fdata.dwFileAttributes And vbDirectory) = vbDirectory Then

                      sName = Left$(fdata.cFileName, InStr(fdata.cFileName, vbNullChar) - 1)
                      If sName <> "." And sName <> ".." Then
                         dblSize = dblSize + SizeOf(EndSlash(DirPath) & sName)
                      End If

                    Else
                      dblSize = dblSize + fdata.nFileSizeHigh * 65536 + fdata.nFileSizeLow
                    End If
                    DoEvents

                  Loop While FindNextFile(hFind, fdata) <> 0
                  hFind = FindClose(hFind)
               End If
            Else
               On Error Resume Next

               dblSize = FileLen(DirPath)
            End If
            SizeOf = dblSize
          End Function

          Private Function EndSlash(ByVal PathIn As String) As String
            If Right$(PathIn, 1) = "\" Then
               EndSlash = PathIn

            Else
               EndSlash = PathIn & "\"
            End If
          End Function

          Private Sub Command1_Click()
            'Ganti 'C:\Windows' di bawah dengan nama direktori
            'yang ingin Anda ketahui ukurannya.
            MsgBox "Ukuran direktori C:\Windows = " _

                   & Format(SizeOf("C:\Windows"), "#,#") & " bytes", _
                   vbInformation, "Ukuran Direktori"
          End Sub
          '--- Akhir coding di Form..

Tags:
contoh program vb6, contoh fungsi di vb6, cara penggunaan fungsi vb, tutorial vb6, download tutorial vb6, vb6 tutorial download, dasar dasar vb6, belajar vb6, cara mudah belajar vb6, vb6 artikel download, vb6 blog, contoh program vb6, artikel vb6, semua tentang vb6, vb6 api, cara menggunakan module, cara menggunakan class module
Jika Anda menyukai Artikel di blog ini, Silahkan klik disini untuk berlangganan gratis via email, dengan begitu Anda akan mendapat kiriman artikel setiap ada artikel yang terbit di dasarprogrammer.blogspot.com

0 komentar:

Posting Komentar