'****File System Object Class*****
'   Coded by Nemlim (I return!)
'*********************************
'  Please not remove this header
' Contribute with the Open Source
'        www.gedzac.com
'     www.hispavirus.com.ar
'   21 September 2005 = Spring


Option Explicit
Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type
Private Type SHFILEOPSTRUCT
    hWnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAborted As Boolean
    hNameMaps As Long
    sProgress As String
End Type
Public Enum Method
   WriteMethod = &H40000000
   ReadMethod = &H80000000
End Enum
Public Enum DiskEnum
   [Removable] = 1
   [Drive Fixed] = 2
   [Remote] = 3
   [Cd-Rom] = 4
   [Ram disk] = 5
   [Unrecognized] = 6
End Enum
Public Enum SpecialFolderConst
   SystemFolder = 1
   TemporaryFolder = 2
   WindowsFolder = 0
End Enum
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Private 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 * 260
    cAlternate As String * 14
End Type
Const FILE_BEGIN = 0
Const FILE_SHARE_READ = &H1
Const FILE_SHARE_WRITE = &H2
Const FO_DELETE = &H3
Const OF_READ = &H0&
Const ERROR_NO_MORE_FILES = 18&
Const INVALID_HANDLE_VALUE = -1
Const DDL_DIRECTORY = &H10
Const OPEN_ALWAYS = 4
Const OPEN_EXISTING = 3

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Function PathAppend Lib "shlwapi.dll" Alias "PathAppendA" (ByVal pszPath As String, ByVal pMore As String) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function APICopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Private Declare Function APICreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Private Declare Function APIDeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Private Declare Function APISHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Private Declare Function APIPathFileExists Lib "shlwapi.dll" Alias "PathFileExistsA" (ByVal pszPath As String) As Long
Private Declare Function APIPathIsDirectory Lib "shlwapi.dll" Alias "PathIsDirectoryA" (ByVal pszPath As String) As Long
Private Declare Function APIlOpen Lib "kernel32" Alias "_lopen" (ByVal lpPathName As String, ByVal iReadWrite As Long) As Long
Private Declare Function APIlclose Lib "kernel32" Alias "_lclose" (ByVal hFile As Long) As Long
Private Declare Function APIGetFileSize Lib "kernel32" Alias "GetFileSize" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function APIGetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function APIGetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function APIGetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function APIPathStripToRoot Lib "shlwapi.dll" Alias "PathStripToRootA" (ByVal pszPath As String) As Long
Private Declare Function APIPathAddBackslash Lib "shlwapi.dll" Alias "PathAddBackslashA" (ByVal pszPath As String) As Long
Private Declare Function APIGetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function APIGetLogicalDrives Lib "kernel32" Alias "GetLogicalDrives" () As Long
Private Declare Sub APIPathStripPath Lib "shlwapi.dll" Alias "PathStripPathA" (ByVal pszPath As String)

Public Function BuildPath(Path As String, name As String)
Dim b As String
b = Path & String(Len(name), 0)
PathAppend b, name
BuildPath = b
End Function

Public Sub CopyFile(Source As String, Destination As String, Optional OverWriteFiles As Boolean = True)
APICopyFile Source, Destination, OverWriteFiles
End Sub

Public Sub CopyFolders(ByVal Source As String, ByVal Destination As String, Optional OverWriteFiles As Boolean = True)
Dim ret As Long
If GetAttr(Source) And vbDirectory Then
   Source = GetAbsolutePathName(Source)
   Destination = GetAbsolutePathName(Destination)
   Dim s As SECURITY_ATTRIBUTES
   ret = APICreateDirectory(Destination, s)
   SUBCopyFiles Source, Destination
Else
   CopyFile Source, Destination
End If
End Sub

Public Function DriveExists(ByVal DriveSpec As String) As Boolean
Select Case APIGetDriveType(DriveSpec)
Case 2
DriveExists = True
Case 3
DriveExists = True
Case Is = 4
DriveExists = True
Case Is = 5
DriveExists = True
Case Is = 6
DriveExists = True
Case Else
DriveExists = False
End Select
End Function

Public Function DriverType(ByVal DriveSpec As String) As DiskEnum
DriverType = APIGetDriveType(DriveSpec) - 1
End Function

Public Function GetAbsolutePathName(ByVal Path As String) As String
Path = Path + String(100, 0)
APIPathAddBackslash Path
GetAbsolutePathName = StripTerminator(Path)
End Function

Public Function GetExtensionName(ByVal Path As String) As String
APIPathStripPath Path
Path = StripTerminator(Path)
If InStr(Path, ".") <> 0 Then
Path = Mid(Path, CLng(InStrRev(Path, ".")) + 1)
Else
Path = ""
End If
GetExtensionName = Path
End Function

Public Function CreateFolder(Path As String)
Dim Security As SECURITY_ATTRIBUTES
Dim ret As Long
ret = APICreateDirectory(Path, Security)
If ret = 0 Then MsgBox "Error : Couldn't create directory !", vbCritical + vbOKOnly
End Function

Public Sub DeleteFile(FileSpec As String)
    APIDeleteFile FileSpec
End Sub

Public Sub DeleteFolder(FileSpec As String)
Dim SHDirOp As SHFILEOPSTRUCT
    With SHDirOp
        .wFunc = FO_DELETE
        .pFrom = FileSpec
    End With
    APISHFileOperation SHDirOp
End Sub

Public Function FileExists(FileSpec As String) As Boolean
FileExists = CBool(APIPathFileExists(FileSpec))
End Function

Public Function FolderExists(FolderSpec As String) As Boolean
FolderExists = CBool(APIPathIsDirectory(FolderSpec))
End Function

Public Function GetBaseName(ByVal Path As String) As String
APIPathStripPath Path
Path = StripTerminator(Path)
If InStr(Path, ".") <> 0 Then
Path = Mid(Path, 1, CLng(InStrRev(Path, ".")) - 1)
Else
Path = ""
End If
GetBaseName = Path
End Function

Public Function GetDriveName(ByVal Path As String) As String
APIPathStripToRoot Path
GetDriveName = StripTerminator(Path)
End Function

Function GetFileName(ByVal Path As String) As String
APIPathStripPath Path
GetFileName = StripTerminator(Path)
End Function

Public Function GetFileSize(Path As String) As Long
    Dim Pointer As Long, sizeofthefile As Long
    Pointer = APIlOpen(Path, OF_READ)
    sizeofthefile = APIGetFileSize(Pointer, 0)
    APIlclose Pointer
    GetFileSize = sizeofthefile
End Function

Function GetSpecialFolder(SpecialFolder As SpecialFolderConst) As String
    Dim sSave As String, ret As Long
    sSave = Space(255)
    If SpecialFolder = SystemFolder Then
      ret = APIGetSystemDirectory(sSave, 255)
      sSave = Left$(sSave, ret)
    ElseIf SpecialFolder = WindowsFolder Then
      ret = APIGetWindowsDirectory(sSave, 255)
      sSave = Left$(sSave, ret)
    ElseIf SpecialFolder = TemporaryFolder Then
      ret = APIGetTempPath(255, sSave)
      sSave = Left$(sSave, ret)
    End If
    GetSpecialFolder = sSave
End Function

Public Function OpenFileFor(FileName As String, forWhat As Method, Optional Create As Boolean = False) As Long
Dim hNewFile As Long
If Create Then
   OpenFileFor = CreateFile(FileName, forWhat, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, 4, 0, 0)
Else
   OpenFileFor = CreateFile(FileName, forWhat, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, 3, 0, 0)
End If
SetFilePointer OpenFileFor, 0, 0, FILE_BEGIN
If OpenFileFor <= 0 Then
  MsgBox "Error : Couldn't open file !", vbCritical + vbOKOnly
  Err.Raise 0, 0, "Couldn't open file !"
End If
End Function

Public Function WriteInFile(Handle As Long, data As String)
Dim bBytes() As Byte
Dim ret As Long
If Handle > 0 Then
   bBytes = StrConv(data, vbFromUnicode)
   WriteFile Handle, bBytes(0), Len(data), ret, ByVal 0&
'If Ret <> UBound(bBytes) Then MsgBox "Error writing file ..."
End If
End Function

Public Function ReadInFile(Handle As Long) As String
Dim bBytes() As Byte
Dim ret As Long
Dim nSize As Long
If Handle > 0 Then
   nSize = APIGetFileSize(Handle, 0)
   ReDim bBytes(nSize)
   ReadFile Handle, bBytes(0), UBound(bBytes), ret, ByVal 0&
   ReadInFile = StrConv(bBytes, vbUnicode)
End If
End Function

Public Function CloseFile(Handle As Long)
CloseHandle Handle
End Function

'Example To Use:
'For Each strFile In ListFiles("C:\")
'  MsgBox strFile
'Next
Public Function ListFiles(ByVal Path As String, Optional WithSubDirectories As Boolean = True) As Collection
Dim Dirs    As Collection
Dim Fils    As Collection
Dim Buff    As Collection
Dim fName   As String
Dim sHNL    As Long
Dim W32FD   As WIN32_FIND_DATA
Dim i       As Integer
Dim ii      As Integer

Set Dirs = New Collection
Set Fils = New Collection
Path = GetAbsolutePathName(Path)
sHNL = FindFirstFile(Path & "*.*", W32FD)
If sHNL <> INVALID_HANDLE_VALUE Then
   Do
      fName = W32FD.cFileName
      fName = StripTerminator(fName)
      If fName <> "." And fName <> ".." Then
         If W32FD.dwFileAttributes And DDL_DIRECTORY Then
            Dirs.Add fName
         Else
            Fils.Add Path & fName
         End If
      End If
      If FindNextFile(sHNL, W32FD) = 0 Then Exit Do
   Loop
   FindClose sHNL
End If

If WithSubDirectories Then
   For i = 1 To Dirs.Count
      fName = Dirs(i)
      Set Buff = ListFiles(Path & fName)
      For ii = 1 To Buff.Count
         Fils.Add Buff(ii)
      Next ii
   Next i
End If
Set ListFiles = Fils
End Function

Public Function ListFolders(ByVal Path As String, Optional WithSubDirectories As Boolean = True) As Collection
Dim Dirs    As Collection
Dim Buff    As Collection
Dim fName   As String
Dim sHNL    As Long
Dim W32FD   As WIN32_FIND_DATA
Dim i       As Integer
Dim u       As Integer
Dim ii      As Integer

Set Dirs = New Collection
Path = GetAbsolutePathName(Path)
sHNL = FindFirstFile(Path & "*.*", W32FD)
If sHNL <> INVALID_HANDLE_VALUE Then
   Do
      fName = W32FD.cFileName
      fName = StripTerminator(fName)
      If fName <> "." And fName <> ".." Then
         If W32FD.dwFileAttributes And DDL_DIRECTORY Then
            Dirs.Add fName
         End If
      End If
      If FindNextFile(sHNL, W32FD) = 0 Then Exit Do
   Loop
   FindClose sHNL
End If

If WithSubDirectories Then
   u = Dirs.Count
   For i = 1 To u
      fName = Dirs(i)
      Set Buff = ListFolders(Path & fName)
      For ii = 1 To Buff.Count
         Dirs.Add Buff(ii)
      Next ii
   Next i
End If
Set ListFolders = Dirs
End Function

Public Function ListDisks() As Collection
Dim LDs As Long
Dim Cnt As Integer
Dim buf As New Collection
LDs = APIGetLogicalDrives
For Cnt = 0 To 25
   If (LDs And 2 ^ Cnt) <> 0 Then
      buf.Add Chr$(65 + Cnt) & ":\"
   End If
Next Cnt
Set ListDisks = buf
End Function

Private Function SUBCopyFiles(ByVal from_dir As String, ByVal to_dir As String) As Long
Dim Dirs    As Collection
Dim fName   As String
Dim sHNL    As Long
Dim W32FD   As WIN32_FIND_DATA
Dim i       As Integer

Set Dirs = New Collection
sHNL = FindFirstFile(from_dir & "*.*", W32FD)
If sHNL <> INVALID_HANDLE_VALUE Then
   Do
      fName = W32FD.cFileName
      fName = StripTerminator(fName)
      If fName <> "." And fName <> ".." Then
         If W32FD.dwFileAttributes And DDL_DIRECTORY Then
            Dim s As SECURITY_ATTRIBUTES
            Call APICreateDirectory(to_dir & fName, s)
            Dirs.Add fName
         Else
            CopyFile from_dir & fName, to_dir & fName
         End If
      End If
      If FindNextFile(sHNL, W32FD) = 0 Then Exit Do
   Loop
   FindClose sHNL
End If

For i = 1 To Dirs.Count
   fName = Dirs(i)
   SUBCopyFiles from_dir & fName & "\", to_dir & fName & "\"
Next i
End Function

Private Function StripTerminator(sInput As String) As String
    Dim ZeroPos As Long
    ZeroPos = InStr(1, sInput, Chr$(0))
    If ZeroPos > 0 Then
        StripTerminator = Left$(sInput, ZeroPos - 1)
    Else
        StripTerminator = sInput
    End If
End Function