home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / Code_Forma186302392005.psc / Class / cFileUtilities.cls < prev   
Encoding:
Visual Basic class definition  |  2005-03-08  |  14.7 KB  |  415 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsFileUtilities"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. '//************************************
  15. '//     Author: Morgan Haueisen
  16. '//             morganh@hartcom.net
  17. '//     Copyright (c) 1996-2004
  18. '//************************************
  19. 'Legal:
  20. '   This is intended for and was uploaded to www.planetsourcecode.com
  21. '
  22. '   Redistribution of this code, whole or in part, as source code or in binary form, alone or
  23. '   as part of a larger distribution or product, is forbidden for any commercial or for-profit
  24. '   use without the author's explicit written permission.
  25. '
  26. '   Redistribution of this code, as source code or in binary form, with or without
  27. '   modification, is permitted provided that the following conditions are met:
  28. '
  29. '   Redistributions of source code must include this list of conditions, and the following
  30. '   acknowledgment:
  31. '
  32. '   This code was developed by Morgan Haueisen.  <morganh@hartcom.net>
  33. '   Source code, written in Visual Basic, is freely available for non-commercial,
  34. '   non-profit use at www.planetsourcecode.com.
  35. '
  36. '   Redistributions in binary form, as part of a larger project, must include the above
  37. '   acknowledgment in the end-user documentation.  Alternatively, the above acknowledgment
  38. '   may appear in the software itself, if and wherever such third-party acknowledgments
  39. '   normally appear.
  40. '
  41. '
  42. '// Examples:
  43. '// VBGetOpenFileName(sFile, , True, , , , "All Icon Files
  44. '   (*.EXE;*.DLL;*.ICO)|*.EXE;*.DLL;*.ICO|Icon Files
  45. '  (*.ICO)|*.ICO|Executables (*.EXE;*.DLL)|*.EXE;*.DLL|All Files (*.*)|*.*", 1, , , "ICO", Me.hWnd)
  46.  
  47. '// VBGetSaveFileName(sFile, , , "ICO Files (*.ICO)|*.ICO|All Files (*.*)|*.*", , , , "ICO",
  48. '   Me.hWnd)
  49.  
  50. Option Explicit
  51.  
  52. Private Type SHFILEOPSTRUCT
  53.    HWND                  As Long
  54.    wFunc                 As Long
  55.    pFrom                 As String
  56.    pTo                   As String
  57.    fFlags                As Integer
  58.    fAnyOperationsAborted As Boolean
  59.    hNameMappings         As Long
  60.    lpszProgressTitle     As String '//  only used if FOF_SIMPLEPROGRESS
  61. End Type
  62.  
  63. Private Declare Function SHFileOperation Lib "shell32.dll" _
  64.       Alias "SHFileOperationA" ( _
  65.       ByRef lpFileOp As SHFILEOPSTRUCT) As Long
  66.  
  67. Private Const FO_MOVE               As Long = &H1
  68. Private Const FO_COPY               As Long = &H2
  69. Private Const FO_DELETE             As Long = &H3
  70. Private Const FO_RENAME             As Long = &H4
  71.  
  72. Private Const FOF_MULTIDESTFILES    As Long = &H1
  73. Private Const FOF_SILENT            As Long = &H4 '//  don't create progress/report
  74. Private Const FOF_RENAMEONCOLLISION As Long = &H8
  75. Private Const FOF_NOCONFIRMATION    As Long = &H10 '//  Don't prompt the user.
  76. Private Const FOF_WANTMAPPINGHANDLE As Long = &H20 '//  Fill in SHFILEOPSTRUCT.hNameMappings
  77. Private Const FOF_ALLOWUNDO         As Long = &H40
  78. Private Const FOF_FILESONLY         As Long = &H80 '//  on *.*, do only files
  79. Private Const FOF_SIMPLEPROGRESS    As Long = &H100 '//  means don't show names of Files
  80. Private Const FOF_NOCONFIRMMKDIR    As Long = &H200 '//  don't confirm making any needed dirs
  81.  
  82. '// This API returns The Attrbiutes of the File
  83. Private Declare Function GetFileAttributes Lib "kernel32.dll" _
  84.       Alias "GetFileAttributesA" ( _
  85.       ByVal lpFileName As String) As Long
  86.  
  87. Private Const C_lngMAX_PATH As Long = 260&
  88. Private Const C_lngMAX_FILE As Long = 260&
  89.  
  90. Private Type OPENFILENAME
  91.    lStructSize                    As Long    '// Filled with UDT size
  92.    hWndOwner                      As Long    '// Tied to Owner
  93.    hInstance                      As Long    '// Ignored (used only by templates)
  94.    lpstrFilter                    As String '// Tied to Filter
  95.    lpstrCustomFilter              As String '// Ignored (exercise for reader)
  96.    nMaxCustFilter                 As Long    '// Ignored (exercise for reader)
  97.    nFilterIndex                   As Long    '// Tied to FilterIndex
  98.    lpstrFile                      As String '// Tied to FileName
  99.    nMaxFile                       As Long    '// Handled internally
  100.    lpstrFileTitle                 As String '// Tied to FileTitle
  101.    nMaxFileTitle                  As Long    '// Handled internally
  102.    lpstrInitialDir                As String '// Tied to InitDir
  103.    lpstrTitle                     As String '// Tied to DlgTitle
  104.    Flags                          As Long    '// Tied to Flags
  105.    nFileOffset                    As Integer '// Ignored (exercise for reader)
  106.    nFileExtension                 As Integer '// Ignored (exercise for reader)
  107.    lpstrDefExt                    As String '// Tied to DefaultExt
  108.    lCustData                      As Long    '// Ignored (needed for hooks)
  109.    lpfnHook                       As Long    '// Ignored (good luck with hooks)
  110.    lpTemplateName                 As Long    '// Ignored (good luck with templates)
  111. End Type
  112.  
  113. Private Declare Function CommDlgExtendedError Lib "COMDLG32.DLL" () As Long
  114. Private Declare Function GetOpenFileName Lib "COMDLG32.DLL" _
  115.       Alias "GetOpenFileNameA" ( _
  116.       ByRef pOpenfilename As OPENFILENAME) As Long
  117. Private Declare Function GetSaveFileName Lib "COMDLG32.DLL" _
  118.       Alias "GetSaveFileNameA" ( _
  119.       ByRef pOpenfilename As OPENFILENAME) As Long
  120. Private Declare Function lstrlen Lib "kernel32.dll" _
  121.       Alias "lstrlenA" ( _
  122.       ByVal lpString As String) As Long
  123.  
  124. Public Enum enuOpenFile
  125.    OFN_ReadOnly = &H1
  126.    OFN_OverWritePrompt = &H2
  127.    OFN_HideReadOnly = &H4
  128.    OFN_NOCHANGEDIR = &H8
  129.    OFN_SHOWHELP = &H10
  130.    OFN_ENABLEHOOK = &H20
  131.    OFN_ENABLETEMPLATE = &H40
  132.    OFN_ENABLETEMPLATEHANDLE = &H80
  133.    OFN_NOVALIDATE = &H100
  134.    OFN_ALLOWMULTISELECT = &H200
  135.    OFN_EXTENSIONDIFFERENT = &H400
  136.    OFN_PATHMUSTEXIST = &H800
  137.    OFN_FileMustExist = &H1000
  138.    OFN_CREATEPROMPT = &H2000
  139.    OFN_SHAREAWARE = &H4000
  140.    OFN_NOREADONLYRETURN = &H8000
  141.    OFN_NOTESTFILECREATE = &H10000
  142.    OFN_NONETWORKBUTTON = &H20000
  143.    OFN_NOLONGNAMES = &H40000
  144.    OFN_EXPLORER = &H80000
  145.    OFN_NODEREFERENCELINKS = &H100000
  146.    OFN_LONGNAMES = &H200000
  147. End Enum
  148.  
  149. Private Type BrowseInfo
  150.    hWndOwner      As Long
  151.    pIDLRoot       As Long
  152.    pszDisplayName As Long
  153.    lpszTitle      As Long
  154.    ulFlags        As Long
  155.    lpfnCallback   As Long
  156.    lParam         As Long
  157.    iImage         As Long
  158. End Type
  159.  
  160. Private Declare Function lstrcat Lib "kernel32.dll" _
  161.       Alias "lstrcatA" ( _
  162.       ByVal lpString1 As String, _
  163.       ByVal lpString2 As String) As Long
  164. Private Declare Function SHBrowseForFolder Lib "shell32.dll" ( _
  165.       ByRef lpbi As BrowseInfo) As Long
  166. Private Declare Function SHGetPathFromIDList Lib "shell32" ( _
  167.       ByVal pidList As Long, _
  168.       ByVal lpBuffer As String) As Long
  169.  
  170. Private Const BIF_STATUSTEXT        As Long = &H4
  171. Private Const BIF_RETURNONLYFSDIRS  As Long = &H1
  172. Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
  173. Private Const BIF_NEWDIALOGSTYLE    As Long = &H40
  174. Private Const BIF_USENEWUI          As Long = BIF_NEWDIALOGSTYLE
  175.  
  176. Private Declare Function GetShortPathName Lib "kernel32.dll" _
  177.       Alias "GetShortPathNameA" ( _
  178.       ByVal lpszLongPath As String, _
  179.       ByVal lpszShortPath As String, _
  180.       ByVal cchBuffer As Long) As Long
  181.  
  182. '// Required for changing a File's Date & Time
  183.  
  184. Private Type FILETIME
  185.    dwLowDateTime    As Long
  186.    dwHighDateTime   As Long
  187. End Type
  188.  
  189. Private Type SYSTEMTIME
  190.    wYear            As Integer
  191.    wMonth           As Integer
  192.    wDayOfWeek       As Integer
  193.    wDay             As Integer
  194.    wHour            As Integer
  195.    wMinute          As Integer
  196.    wSecond          As Integer
  197.    wMilliseconds    As Integer
  198. End Type
  199.  
  200. Private Const GENERIC_WRITE    As Long = &H40000000
  201. Private Const OPEN_EXISTING    As Long = 3
  202. Private Const FILE_SHARE_READ  As Long = &H1
  203. Private Const FILE_SHARE_WRITE As Long = &H2
  204.  
  205. Private Declare Function CreateFile Lib "kernel32" _
  206.       Alias "CreateFileA" ( _
  207.       ByVal lpFileName As String, _
  208.       ByVal dwDesiredAccess As Long, _
  209.       ByVal dwShareMode As Long, _
  210.       ByVal lpSecurityAttributes As Long, _
  211.       ByVal dwCreationDisposition As Long, _
  212.       ByVal dwFlagsAndAttributes As Long, _
  213.       ByVal hTemplateFile As Long) As Long
  214. Private Declare Function SetFileTime Lib "kernel32" ( _
  215.       ByVal hFile As Long, _
  216.       ByRef lpCreationTime As FILETIME, _
  217.       ByRef lpLastAccessTime As FILETIME, _
  218.       ByRef lpLastWriteTime As FILETIME) As Long
  219. Private Declare Function SystemTimeToFileTime Lib "kernel32" ( _
  220.       ByRef lpSystemTime As SYSTEMTIME, _
  221.       ByRef lpFileTime As FILETIME) As Long
  222. Private Declare Function CloseHandle Lib "kernel32" ( _
  223.       ByVal hObject As Long) As Long
  224. Private Declare Function LocalFileTimeToFileTime Lib "kernel32" ( _
  225.       ByRef lpLocalFileTime As FILETIME, _
  226.       ByRef lpFileTime As FILETIME) As Long
  227.  
  228. '// CompactPath
  229. Private Declare Function PathCompactPath Lib "shlwapi.dll" _
  230.       Alias "PathCompactPathA" ( _
  231.       ByVal hDC As Long, _
  232.       ByVal pszPath As String, _
  233.       ByVal dx As Long) As Long
  234.  
  235. '// create new folder
  236. Private Type WIN32_FIND_DATA
  237.    dwFileAttributes As Long
  238.    ftCreationTime   As FILETIME
  239.    ftLastAccessTime As FILETIME
  240.    ftLastWriteTime  As FILETIME
  241.    nFileSizeHigh    As Long
  242.    nFileSizeLow     As Long
  243.    dwReserved0      As Long
  244.    dwReserved1      As Long
  245.    cFileName        As String * C_lngMAX_PATH
  246.    cAlternate       As String * 14
  247. End Type
  248.  
  249. Private Type SECURITY_ATTRIBUTES
  250.    nLength              As Long
  251.    lpSecurityDescriptor As Long
  252.    bInheritHandle       As Long
  253. End Type
  254.  
  255. Private Declare Function CreateDirectory Lib "kernel32" _
  256.       Alias "CreateDirectoryA" ( _
  257.       ByVal lpPathName As String, _
  258.       ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
  259. 'Private Declare Function FindNextFile Lib "kernel32" _
  260.       Alias "FindNextFileA" ( _
  261.       ByVal hFindFile As Long, _
  262.       ByRef lpFindFileData As WIN32_FIND_DATA) As Long
  263. Private Declare Function FindFirstFile Lib "kernel32" _
  264.       Alias "FindFirstFileA" ( _
  265.       ByVal lpFileName As String, _
  266.       ByRef lpFindFileData As WIN32_FIND_DATA) As Long
  267.       
  268. Private mlngApiReturn       As Long
  269. Private mlngExtendedError   As Long
  270. Private mlngNoConfirmation  As Long
  271.  
  272. Private Sub Class_Initialize()
  273.  
  274.    mlngNoConfirmation = FOF_NOCONFIRMATION
  275.  
  276. End Sub
  277.  
  278. Public Function CompactPath(ByVal vstrFullPath As String, _
  279.                             ByVal vlngWidth As Long, _
  280.                             Optional ByVal hDC As Long = 0&) As String
  281.  
  282.   Dim lngZeroPos As Long
  283.    
  284.    On Error GoTo Err_Proc
  285.  
  286.    '// Compact
  287.    Call PathCompactPath(hDC, vstrFullPath, vlngWidth)
  288.  
  289.    '// Remove all trailing Chr$(0)'s
  290.    lngZeroPos = InStr(1, vstrFullPath, vbNullChar)
  291.  
  292.    If lngZeroPos > 0 Then
  293.       CompactPath = Left$(vstrFullPath, lngZeroPos - 1)
  294.    Else
  295.       CompactPath = vstrFullPath
  296.    End If
  297.  
  298. Exit_Proc:
  299.    Exit Function
  300.  
  301. Err_Proc:
  302.    Err_Handler True, Err.Number, Err.Description, "CompactPath"
  303.    Err.Clear
  304.    Resume Exit_Proc
  305.  
  306. End Function
  307.  
  308. Public Function CopyDir(ByVal vstrSPath As String, _
  309.                         ByVal vstrDPath As String, _
  310.                         Optional ByVal vblnNoShow As Boolean = False, _
  311.                         Optional ByVal vblnNoConformation As Boolean = False) As Boolean
  312.  
  313.   Dim lngTemp As Long
  314.    
  315.    On Error GoTo Err_Proc
  316.    lngTemp = mlngNoConfirmation
  317.  
  318.    If vblnNoConformation Then
  319.       mlngNoConfirmation = FOF_NOCONFIRMATION
  320.    Else
  321.       mlngNoConfirmation = 0
  322.    End If
  323.  
  324.    If Right$(vstrSPath, 1) = "\" Then vstrSPath = Left$(vstrSPath, Len(vstrSPath) - 1)
  325.    If Right$(vstrDPath, 1) = "\" Then vstrDPath = Left$(vstrDPath, Len(vstrDPath) - 1)
  326.    
  327.    Call CreateDir(vstrDPath)
  328.  
  329.    If LCase$(Me.RetOnlyPath(vstrSPath, False)) = LCase$(vstrDPath) Then
  330.       CopyDir = False
  331.    Else
  332.       CopyDir = CopyMoveSingle(vstrSPath, vstrDPath, FO_COPY, False, vblnNoShow)
  333.    End If
  334.  
  335.    mlngNoConfirmation = lngTemp
  336.  
  337. Exit_Proc:
  338.    Exit Function
  339.  
  340. Err_Proc:
  341.    Err_Handler True, Err.Number, Err.Description, "CopyDir"
  342.    Err.Clear
  343.    Resume Exit_Proc
  344.  
  345. End Function
  346.  
  347. Public Function CopyFile(ByVal vstrSPathFile As String, _
  348.                          ByVal vstrDPathFile As String, _
  349.                          Optional ByVal vblnOnlyNewer As Boolean = False, _
  350.                          Optional ByVal vblnNoShow As Boolean = True) As Boolean
  351.  
  352.    On Error GoTo Err_Proc
  353.  
  354.    If LCase$(vstrSPathFile) = LCase$(vstrDPathFile) Then
  355.       CopyFile = False
  356.    Else
  357.       CopyFile = CopyMoveSingle(vstrSPathFile, vstrDPathFile, FO_COPY, vblnOnlyNewer, vblnNoShow)
  358.    End If
  359.  
  360. Exit_Proc:
  361.    Exit Function
  362.  
  363. Err_Proc:
  364.    Err_Handler True, Err.Number, Err.Description, "CopyFile"
  365.    Err.Clear
  366.    Resume Exit_Proc
  367.  
  368. End Function
  369.  
  370. Private Function CopyMoveMulti(ByVal vstrSPath As String, _
  371.                                ByVal vstrDPath As String, _
  372.                                ByRef vntFileName() As String, _
  373.                                ByVal vlngAction As Long, _
  374.                                Optional ByVal vblnOnlyNewer As Boolean = False, _
  375.                                Optional ByVal vblnNoShow As Boolean = False) As Boolean
  376.  
  377.   Dim udtOptions    As SHFILEOPSTRUCT
  378.   Dim lngI          As Long
  379.   Dim strSFileNames As String
  380.   Dim strDFileNames As String
  381.  
  382.    On Local Error GoTo Function_Error
  383.  
  384.    If Right$(vstrSPath, 1) <> "\" Then vstrSPath = vstrSPath & "\"
  385.    If Right$(vstrDPath, 1) <> "\" Then vstrDPath = vstrDPath & "\"
  386.  
  387.    For lngI = LBound(vntFileName) To UBound(vntFileName)
  388.  
  389.       If LenB(vntFileName(lngI)) Then
  390.          If vblnOnlyNewer Then
  391.             If NotTheSame(vstrSPath & vntFileName(lngI), vstrDPath & vntFileName(lngI)) Then
  392.                strSFileNames = strSFileNames & vstrSPath & vntFileName(lngI) & vbNullChar
  393.             End If
  394.  
  395.          Else
  396.             strSFileNames = strSFileNames & vstrSPath & vntFileName(lngI) & vbNullChar
  397.          End If
  398.  
  399.       End If
  400.    Next lngI
  401.  
  402.    If LenB(strSFileNames) Then
  403.  
  404.       strSFileNames = strSFileNames & vbNullChar
  405.       strDFileNames = Left$(vstrDPath, Len(vstrDPath) - 1) & vbNullChar
  406.  
  407.       With udtOptions
  408.          .HWND = 0
  409.          .wFunc = vlngAction
  410.          .pFrom = strSFileNames
  411.          .pTo = strDFileNames
  412.          .fFlags = FOF_ALLOWUNDO
  413.          If vblnNoShow Then .fFlags = .fFlags Or FOF_SILENT
  414.          If vblnOnlyNewer Then
  415.             .fFlags = .fFlags Or FOF_          If NotTheSalags blnOnlyNewlf Ng) & vbNuh    Optional ByValCir_ProcklChenf Ng) & vbNuh