frmMain.frm

 VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{36DBFD17-8A7D-4E36-A119-27B940B272CF}#1.1#0"; "VBZIP_~1.OCX"
Begin VB.Form frmMain
   BorderStyle     =   1  'Fixed Single
   ClientHeight    =   5145
   ClientLeft      =   2115
   ClientTop       =   1785
   ClientWidth     =   5805
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   5145
   ScaleWidth      =   5805
   Begin VB.CommandButton cmdChoice
      Height          =   560
      Index           =   2
      Left            =   5175
      Picture         =   "frmMain.frx":030A
      Style           =   1  'Graphical
      TabIndex        =   13
      TabStop         =   0   'False
      ToolTipText     =   "Display the About screen"
      Top             =   3825
      Width           =   560
   End
   Begin VB.CommandButton cmdChoice
      Height          =   560
      Index           =   1
      Left            =   5175
      Picture         =   "frmMain.frx":0614
      Style           =   1  'Graphical
      TabIndex        =   11
      ToolTipText     =   "Stop processing immediately"
      Top             =   3150
      Width           =   560
   End
   Begin VB.PictureBox Picture1
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   480
      Index           =   1
      Left            =   5175
      Picture         =   "frmMain.frx":0A56
      ScaleHeight     =   480
      ScaleWidth      =   480
      TabIndex        =   24
      Top             =   150
      Width           =   480
   End
   Begin VB.PictureBox Picture1
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   480
      Index           =   0
      Left            =   150
      Picture         =   "frmMain.frx":0D60
      ScaleHeight     =   480
      ScaleWidth      =   480
      TabIndex        =   23
      Top             =   150
      Width           =   480
   End
   Begin VB.Frame Frame2
      Height          =   1065
      Left            =   75
      TabIndex        =   19
      Top             =   3975
      Width           =   4965
      Begin VB.TextBox txtPath
         Height          =   360
         Left            =   150
         Locked          =   -1  'True
         TabIndex        =   28
         Text            =   "txtPath"
         Top             =   525
         Width           =   4665
      End
      Begin VB.PictureBox picProgBar
         AutoRedraw      =   -1  'True
         BackColor       =   &H00FFFFFF&
         FillColor       =   &H00FF0000&
         BeginProperty Font
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00000000&
         Height          =   350
         Left            =   150
         ScaleHeight     =   285
         ScaleWidth      =   4605
         TabIndex        =   20
         TabStop         =   0   'False
         Top             =   525
         Width           =   4665
      End
      Begin VB.Label lblFileCnt
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "/"
         BeginProperty Font
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   240
         Index           =   2
         Left            =   2550
         TabIndex        =   26
         Top             =   225
         Width           =   60
      End
      Begin VB.Label lblFileCnt
         Alignment       =   1  'Right Justify
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         BackStyle       =   0  'Transparent
         Caption         =   "0"
         BeginProperty Font
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   240
         Index           =   1
         Left            =   1200
         TabIndex        =   25
         Top             =   225
         Width           =   1215
      End
      Begin VB.Label lblFileCnt
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         BackStyle       =   0  'Transparent
         Caption         =   "0"
         BeginProperty Font
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   240
         Index           =   3
         Left            =   2700
         TabIndex        =   22
         Top             =   225
         Width           =   1215
      End
      Begin VB.Label lblFileCnt
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "File count"
         Height          =   195
         Index           =   0
         Left            =   375
         TabIndex        =   21
         Top             =   225
         Width           =   690
      End
   End
   Begin VBZip_Control.RichsoftVBZip VBZip
      Left            =   450
      Top             =   4875
      _ExtentX        =   1720
      _ExtentY        =   1720
   End
   Begin MSComDlg.CommonDialog CD
      Left            =   750
      Top             =   150
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Frame Frame1
      Caption         =   "Select directory or files"
      Height          =   1290
      Left            =   75
      TabIndex        =   18
      Top             =   900
      Width           =   5640
      Begin VB.TextBox txtPattern
         Height          =   345
         Left            =   225
         Locked          =   -1  'True
         TabIndex        =   27
         Text            =   "txtPattern"
         Top             =   300
         Width           =   5190
      End
      Begin VB.OptionButton optBrowse
         Caption         =   "Browse for one or more files"
         Height          =   240
         Index           =   1
         Left            =   300
         TabIndex        =   2
         Top             =   975
         Width           =   2340
      End
      Begin VB.OptionButton optBrowse
         Caption         =   "Browse for a folder"
         Height          =   240
         Index           =   0
         Left            =   300
         TabIndex        =   0
         Top             =   750
         Value           =   -1  'True
         Width           =   2115
      End
      Begin VB.CommandButton cmdBrowse
         Height          =   390
         Left            =   4875
         Picture         =   "frmMain.frx":106A
         Style           =   1  'Graphical
         TabIndex        =   3
         ToolTipText     =   "Browse for ZIP files"
         Top             =   750
         Width           =   465
      End
      Begin VB.CheckBox chkSubdDir
         Caption         =   "Include subfolders"
         Height          =   240
         Left            =   2775
         TabIndex        =   1
         Top             =   750
         Value           =   1  'Checked
         Width           =   2040
      End
   End
   Begin VB.Frame fraCustom
      Caption         =   "Custom date/time"
      Height          =   765
      Left            =   75
      TabIndex        =   17
      Top             =   3150
      Width           =   4965
      Begin MSComCtl2.DTPicker dtpTime
         BeginProperty DataFormat
            Type            =   1
            Format          =   "HH:mm"
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   1033
            SubFormatType   =   4
         EndProperty
         Height          =   315
         Left            =   2700
         TabIndex        =   9
         Top             =   300
         Width           =   1590
         _ExtentX        =   2805
         _ExtentY        =   556
         _Version        =   393216
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
            Name            =   "Arial"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         CalendarBackColor=   16776960
         CustomFormat    =   "HH:mm"
         Format          =   22544386
         CurrentDate     =   36494
      End
      Begin MSComCtl2.DTPicker dtpDate
         Height          =   315
         Left            =   600
         TabIndex        =   8
         Top             =   300
         Width           =   1590
         _ExtentX        =   2805
         _ExtentY        =   556
         _Version        =   393216
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
            Name            =   "Arial"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Format          =   22544385
         CurrentDate     =   29221
      End
   End
   Begin VB.CommandButton cmdChoice
      Height          =   560
      Index           =   3
      Left            =   5175
      Picture         =   "frmMain.frx":116C
      Style           =   1  'Graphical
      TabIndex        =   12
      ToolTipText     =   "Terminate this application"
      Top             =   4500
      Width           =   560
   End
   Begin VB.CommandButton cmdChoice
      Height          =   560
      Index           =   0
      Left            =   5175
      Picture         =   "frmMain.frx":1476
      Style           =   1  'Graphical
      TabIndex        =   10
      ToolTipText     =   "Start processing"
      Top             =   3150
      Width           =   560
   End
   Begin VB.Frame fraMain
      Caption         =   "Select date/time stamp method"
      Height          =   840
      Left            =   75
      TabIndex        =   15
      Top             =   2250
      Width           =   5640
      Begin VB.OptionButton optDate
         Caption         =   "Custom date/time"
         Height          =   240
         Index           =   3
         Left            =   2775
         TabIndex        =   7
         Top             =   525
         Width           =   2115
      End
      Begin VB.OptionButton optDate
         Caption         =   "Current system date/time"
         Height          =   240
         Index           =   2
         Left            =   2775
         TabIndex        =   6
         Top             =   300
         Width           =   2190
      End
      Begin VB.OptionButton optDate
         Caption         =   "Oldest date in archive"
         Height          =   240
         Index           =   1
         Left            =   300
         TabIndex        =   5
         Top             =   525
         Width           =   2190
      End
      Begin VB.OptionButton optDate
         Caption         =   "Most recent date in archive"
         Height          =   240
         Index           =   0
         Left            =   300
         TabIndex        =   4
         Top             =   300
         Value           =   -1  'True
         Width           =   2340
      End
   End
   Begin VB.Label lblAuthor
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "Freeware by Kenneth Ives   kenaso@home.com"
      Height          =   240
      Left            =   150
      TabIndex        =   16
      Top             =   600
      Width           =   5490
   End
   Begin VB.Label lblTitle
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      BeginProperty Font
         Name            =   "Times New Roman"
         Size            =   24
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      Height          =   690
      Left            =   150
      TabIndex        =   14
      Top             =   75
      Width           =   5490
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' ***************************************************************************
' Module:        fraMain
'
' Description:   Main display form for selecting and updating archive file
'                date/time stamps.
'
' Special thanks to:
'
'                VBZip_Control.ocx
'                created by Richsoft Computing 2001
'                Richard Southey
'                mailto:richsoftcomputing@btinternet.co.uk
'                http://www.richsoftcomputing.btinternet.co.uk
'                See routine "Process_Internal_Date" on how I used it.
'
' ===========================================================================
'    DATE      NAME / DESCRIPTION
' -----------  --------------------------------------------------------------
' 22-MAR-2001  Kenneth Ives  kenaso@home.com
' ***************************************************************************

' ---------------------------------------------------------------------------
' Define module level variables
' ---------------------------------------------------------------------------
  Private m_strDate       As String   ' Custome date entry
  Private m_strTime       As String   ' Custom time entry
  Private m_strPath       As String   ' used for display purposes only
  Private m_strFilename   As String   ' used for display purposes only
  Private m_arFileList()  As String   ' holds the full path and archive filenames
  Private cFDT            As clsFileDate
 
  Private WithEvents cFSO As clsFSO
Attribute cFSO.VB_VarHelpID = -1
 
Private Sub ProgessBar(ByVal lngCurrAmt As Long, ByVal lngMaxAmt As Long)

' ***************************************************************************
' Routine:       ProgessBar
'
' Description:   Progress bar with percentage output.  This routine will draw
'                a 3D progress bar using the PictureBox control.  picProgBar
'                is the name given the control.
'
'                Microsoft wrote this code and distributed it to all of those
'                that are coding in Visual Basic.  I merely extracted the code
'                and documented it.  Look in the Setup directory for VB and
'                you will find some *.frm and *.bas files.  There are a lot
'                of hidden goodies here.  Just take the time to walk thru the
'                code.
'
' Syntax:        ProgessBar 1, 25000
'                Current amount is 1, max amount is 25000
'
' Parameters:    lngCurrAmt - current count
'                lngMaxAmt  - Maximum allowed value
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 22-MAR-2001  Kenneth Ives  kenaso@home.com
'              Routine created
' ***************************************************************************

' ---------------------------------------------------------------------------
' Define local variables
' ---------------------------------------------------------------------------
  Dim strPerCent    As String
  Dim intPerCent    As Integer
  Dim lngLeft       As Long
  Dim lngTop        As Long
  Dim lngRight      As Long
  Dim lngBottom     As Long
  Dim lngLineWidth  As Long
  Dim lngCalcAmt    As Long      ' Calculated by lngMaxAmt - lngCurrAmt

' ---------------------------------------------------------------------------
' these are used to create the 3D effect
' ---------------------------------------------------------------------------
  Const DGREYcolor As Long = &H808080
  Const LGREYcolor As Long = &HC0C0C0
  Const WHITEcolor As Long = &HFFFFFF
  Const COPYPEN    As Long = 13
  Const XORPEN     As Long = 7
 
' ---------------------------------------------------------------------------
' Calculate the percentage based on the current value and the maximum
' allowable value.
' ---------------------------------------------------------------------------
  If lngCurrAmt >= lngMaxAmt Then
      lngCurrAmt = lngMaxAmt - 1
  End If
 
  lngCalcAmt = lngMaxAmt - lngCurrAmt
  intPerCent = 100 - Int((100 * lngCalcAmt) \ lngMaxAmt)
 
' ---------------------------------------------------------------------------
' validate percentage
' ---------------------------------------------------------------------------
  If intPerCent < 0 Then
      intPerCent = 0
  Else
      If intPerCent > 100 Then
          intPerCent = 100
      End If
  End If

' ---------------------------------------------------------------------------
' save the percentage into the Tag property - we can use this to repaint the
' ProgessBar if AutoRedraw is set to False
' ---------------------------------------------------------------------------
  picProgBar.Tag = intPerCent
  strPerCent = CStr(intPerCent) & "%"

' ---------------------------------------------------------------------------
' Set the number of twips per pixel into a variable
' NOTE:  The picture control and the form it is on are expected to have their
'        scale mode set to Twips
' ---------------------------------------------------------------------------
  picProgBar.DrawMode = COPYPEN
  lngLineWidth = Screen.TwipsPerPixelX

' ---------------------------------------------------------------------------
' Leave the BorderStyle set to 1 at design time so that the control is easy
' to find, but at run time we want the border to be invisible; however, just
' switching the border off will actually trigger a refresh of the control
' which is of no use if AutoRedraw is set to False because that will trigger
' this code to run which will trigger another refresh which will develope an
' endless loop.
' ---------------------------------------------------------------------------
  If picProgBar.BorderStyle <> 0 Then
      picProgBar.BorderStyle = 0
  End If

' ---------------------------------------------------------------------------
' Calculate the coordinates for the percentage bar
' ---------------------------------------------------------------------------
  lngLeft = lngLineWidth
  lngTop = lngLineWidth
  lngRight = picProgBar.ScaleWidth - lngLineWidth
  lngBottom = picProgBar.ScaleHeight - lngLineWidth

' ---------------------------------------------------------------------------
' Erase everything and then redraw the background
' ---------------------------------------------------------------------------
  picProgBar.Line (lngLeft, lngTop)-(lngRight, lngBottom), picProgBar.BackColor, BF
 
' ---------------------------------------------------------------------------
' Calculate the centering of the text.  Change the FontBold property in the
' Picture control to FALSE if you want this to be non-bold.
' ---------------------------------------------------------------------------
  With picProgBar
       .CurrentX = (.ScaleWidth - .TextWidth(strPerCent)) / 2
       .CurrentY = (.ScaleHeight - .TextHeight(strPerCent)) / 2
       picProgBar.Print strPerCent
  End With
 
' ---------------------------------------------------------------------------
' Do the two color bar by setting the DrawMode XOr then draw the bar in the
' fillcolor, if this overlaps the text then that portion of the text will get
' inverted, then XOr it again in the background color, if you use the same
' color for the FillColor and ForeColor then the text will invert nicely, but
' you can get some funny effects if you use two different colors.
'
' NOTE:  Use BF in the call to the Line method. (Draw a filled box)
'
' These are the fill colors in the picturebox.  This is where you can change
' the color display.
' ---------------------------------------------------------------------------
  If intPerCent > 0 Then
      ' XOr the pen
      With picProgBar
           .DrawMode = XORPEN
           picProgBar.Line (lngLeft, lngTop)-((lngRight / 100) * intPerCent, lngBottom), vbBlack, BF
           picProgBar.Line (lngLeft, lngTop)-((lngRight / 100) * intPerCent, lngBottom), vbWhite, BF
      End With
  End If
 
' ---------------------------------------------------------------------------
' The 3D look around the box (right, bottom, top, left)
' ---------------------------------------------------------------------------
  With picProgBar
       .DrawMode = COPYPEN
       picProgBar.Line (lngRight, lngLineWidth)-(lngRight, lngBottom), vbWhite, BF
       picProgBar.Line (lngLineWidth, lngBottom)-(lngRight, lngBottom), vbWhite, BF
       picProgBar.Line (0, 0)-(lngRight, 0), DGREYcolor, BF
       picProgBar.Line (0, 0)-(0, lngBottom), DGREYcolor, BF
  End With
 
' ---------------------------------------------------------------------------
' This adds an additional grey border around the inside of the picturebox to
' accentuate the 3D border.
' ---------------------------------------------------------------------------
  picProgBar.Line (lngLeft, lngTop)-(lngRight - lngLineWidth, lngBottom - lngLineWidth), LGREYcolor, B

End Sub

Private Sub cFSO_CountFiles(dblCount As Double, strPath As String)

' ---------------------------------------------------------------------------
' The reference for this routine is to the WithEvents in the declarations
' section of this form.  the actual skeleton for this routine is generated
' when the class is instantsiated.  It's purpose is to display the file count
' and the file name as they are found.
' ---------------------------------------------------------------------------
  lblFileCnt(3).Caption = Format$(dblCount, "#,0")
 
' ---------------------------------------------------------------------------
' The 2 space buffer is so the name is not jammed against the left side.
' ---------------------------------------------------------------------------
  txtPath.Text = Space$(2) & cFSO.Shrink_2_Fit(strPath, 40)
 
End Sub

Private Sub cmdBrowse_Click()
 
' ---------------------------------------------------------------------------
' Define local variables
' ---------------------------------------------------------------------------
  Dim blnSearchSubfolders As Boolean
 
' ---------------------------------------------------------------------------
' Reset the counters
' ---------------------------------------------------------------------------
  Reset_Counters
 
' ---------------------------------------------------------------------------
' See whether the user opted to browse for a folder or particular files
' ---------------------------------------------------------------------------
  If optBrowse(0).Value = True Then  ' Browse for folders
      blnSearchSubfolders = CBool(chkSubdDir.Value)
      BrowseForFolder blnSearchSubfolders
  Else
      blnSearchSubfolders = False
      BrowseForFiles
  End If
 
End Sub

Private Sub BrowseForFolder(blnSearchSubfolders As Boolean)

' ***************************************************************************
' Routine:       BrowseForFolder
'
' Description:   This routine will open the "File Open" dialog box so the
'                user can select one or more files in the same folder for
'                processing.
'
' Parameters:    blnSearchSubfolders - flag [TRUE] to designate whether or
'                       not to process files in the subfolders.
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 22-MAR-2001  Kenneth Ives  kenaso@home.com
'              Routine created
' ***************************************************************************

' ---------------------------------------------------------------------------
' Define local variables
' ---------------------------------------------------------------------------
  Dim strFolder     As String
  Dim strDrive      As String
  Dim lngDriveType  As Long
 
' ---------------------------------------------------------------------------
' initialize array
' ---------------------------------------------------------------------------
  txtPattern.Text = ""
  strFolder = ""
  Erase m_arFileList()        ' Empty the module array
  ReDim m_arFileList(1)
  Reset_Counters

' ---------------------------------------------------------------------------
' Browse for a folder
' ---------------------------------------------------------------------------
  strFolder = cFSO.BrowseForFolder(frmMain)
  lngDriveType = 0

' ---------------------------------------------------------------------------
' See what was captured
' ---------------------------------------------------------------------------
  If Len(Trim$(strFolder)) > 0 Then
       
      strDrive = Left$(strFolder, 2)   ' capture just the drive letter and colon
     
      ' Make sure this is not a CD-Rom drive
      If cFSO.Drive_Exist(strDrive, lngDriveType) Then
         
          ' if an invalid drive, display a message and leave
          If lngDriveType < 1 Or lngDriveType > 4 Then
              MsgBox "Cannot process files on this drive.", _
                    vbInformation + vbOKOnly, "Invalid drive"
              Exit Sub
          End If
         
          ' is the drive accessible
          If Not cFSO.IsDriveReady(strDrive) Then
              MsgBox "This drive cannot be accessed.", _
                    vbInformation + vbOKOnly, "Drive not ready"
              Exit Sub
          End If
         
          ' is this area restricted (do we have update authority?)
          If cFSO.IsThisRestricted(strFolder) Then
              MsgBox "This folder is restricted.  You do not have update authority.", _
                    vbInformation + vbOKOnly, "Restricted folder"
              Exit Sub
          End If
      Else
          MsgBox "This drive cannot be accessed.", _
                 vbInformation + vbOKOnly, "Drive not ready"
          Exit Sub
      End If
               
      ' prepare the search string
      strFolder = cFSO.Add_Trailing_Slash(strFolder) & "*.zip"
      m_arFileList(0) = strFolder
     
      ' save for display purposes
      m_strFilename = strFolder
     
      ' load folder name into the text box
      txtPattern.Text = Space$(2) & cFSO.Shrink_2_Fit(m_strFilename, 45)
  Else
      txtPattern.Text = ""
  End If
 
End Sub

Private Function ValidData(strFilename As String) As Boolean

' ***************************************************************************
' Routine:       ValidData
'
' Description:   This routine will verify the drive, path existance.  Then
'                determines if we have update authority is this area. Called
'                from BrowseForFiles().
'
' Parameters:    strFilename - data string of fully qualified path\filenames
'
' Returns:       TRUE/FALSE
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 21-APR-2001  Kenneth Ives  kenaso@home.com
'              Routine created
' ***************************************************************************

' ---------------------------------------------------------------------------
' Define local variables
' ---------------------------------------------------------------------------
  Dim intCount      As Integer
  Dim intPosition   As Integer
  Dim strPath       As String
  Dim strDrive      As String
  Dim lngDriveType  As Long
 
' ---------------------------------------------------------------------------
' Preset flag to represent this is good data.  If any errors, flag will be
' reset to FALSE.
' ---------------------------------------------------------------------------
  ValidData = True
  lngDriveType = 0
      
' ---------------------------------------------------------------------------
' Count number of occurances of the word ".zip"
' Hopefully, no one is silly enough to name a file ".zip.zip"  :-)
' ---------------------------------------------------------------------------
  intCount = CInt(StrSearch(strFilename, ".zip", , , , True))
 
' ---------------------------------------------------------------------------
' if just one then only a single file was selected
' ---------------------------------------------------------------------------
  If intCount = 1 Then
      ' use VB function to parse backwards for the last backslash
      intPosition = InStrRev(strFilename, "", Len(strFilename))
  Else
      ' if more than one occurance then we know the folder is stored
      ' in the front part of the string
      intPosition = InStr(1, strFilename, Chr$(0))
  End If
 
' ---------------------------------------------------------------------------
' if we cannot capture our date, then something went wrong.
' ---------------------------------------------------------------------------
  If intPosition = 0 Then
      MsgBox "Found an improperly named file " & vbCrLf & vbCrLf & strFilename, _
             vbInformation + vbOKOnly, "Improperly name file"
      ValidData = False
      Exit Function
  End If
           
' ---------------------------------------------------------------------------
' capture the drive and folder information
' ---------------------------------------------------------------------------
  strPath = Left$(strFilename, intPosition - 1)
 
' ---------------------------------------------------------------------------
' capture just the drive letter and colon
' ---------------------------------------------------------------------------
  strDrive = Left$(strFilename, 2)
 
' ---------------------------------------------------------------------------
' First make sure the drive exist.  Then verify this is not a CD-Rom drive.
' They are read only.
' ---------------------------------------------------------------------------
  If cFSO.Drive_Exist(strDrive, lngDriveType) Then
     
      ' if an invalid drive, display a message and leave.
      ' Sometimes a CD-Rom rewriter will return a type = 4
      ' We should be able to determine this with one of
      ' the following tests.
      If lngDriveType < 1 Or lngDriveType > 4 Then
          MsgBox "Cannot process files on this drive.", _
                vbInformation + vbOKOnly, "Invalid drive"
          ValidData = False
      End If
     
      ' Is the drive accessible?
      If Not cFSO.IsDriveReady(strDrive) Then
          MsgBox "This drive cannot be accessed.", _
                vbInformation + vbOKOnly, "Drive not ready"
          ValidData = False
      End If
     
      ' Is this area restricted (do we have update authority?)
      If cFSO.IsThisRestricted(strPath) Then
          MsgBox "This is a restricted area.  " & vbCrLf & _
                 "No data updating allowed.", _
                vbInformation + vbOKOnly, "Restricted Area"
          ValidData = False
      End If
  Else
      MsgBox "This drive cannot be accessed.", _
             vbInformation + vbOKOnly, "Drive not ready"
          ValidData = False
  End If

End Function

Private Function ArrayLoaded(ByVal strData As String) As Boolean

' ***************************************************************************
' Routine:       ArrayLoaded
'
' Description:   This routine will parse the input data string and load an
'                array with the fully qualified path and filenames.  Called
'                from BrowseForFiles().
'
' Parameters:    strFilename - data string of fully qualified path\filenames
'
' Returns:       TRUE/FALSE
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 21-APR-2001  Kenneth Ives  kenaso@home.com
'              Routine created
' ***************************************************************************

' ---------------------------------------------------------------------------
' Define local variables
' ---------------------------------------------------------------------------
  Dim intCount      As Integer
  Dim intStart      As Integer
  Dim intPosition   As Integer
  Dim intIndex      As Integer
  Dim strPath       As String
  Dim strDrive      As String
  Dim strFilename   As String
  Dim arData()      As String
 
' ---------------------------------------------------------------------------
' Initialize variables
' ---------------------------------------------------------------------------
  txtPattern.Text = ""
  m_strFilename = ""
  strFilename = strData
  intStart = 1             ' Set pointer to the first position in the string
  Erase m_arFileList()     ' Empty the module array
  ReDim m_arFileList(50)   ' oversize the array to hold the filenames
                          
' ---------------------------------------------------------------------------
' load the returned data into an array
' ---------------------------------------------------------------------------
  arData = Split(strFilename, Chr$(0), Len(strFilename))
 
' ---------------------------------------------------------------------------
' make sure the file extension eaual "zip"
' ---------------------------------------------------------------------------
  If StrComp(Right$(strData, 3), "zip", vbTextCompare) = 0 Then
      ' count the number of nulls
      Do
         intPosition = InStr(intStart, strFilename, Chr$(0)) ' find nulls
         If intPosition > 0 Then
             intStart = intPosition + 1     ' Reposition pointer in the string
         Else
             Exit Do                        ' exit the loop
         End If
      Loop
       
      ' See if we have a multi file selection
      If intStart > 1 Then
          strPath = cFSO.Add_Trailing_Slash(arData(0)) ' Capture the path from the first element
          intCount = 0                                 ' reset counter
          strFilename = ""
           
          ' load each element with full path and filename
          For intIndex = 1 To UBound(arData)
              If Len(Trim$(arData(intIndex))) > 0 Then
                  m_arFileList(intIndex - 1) = strPath & arData(intIndex)
                  m_strFilename = m_strFilename & Chr$(34) & arData(intIndex) & Chr$(34) & Chr$(32)
                  intCount = intCount + 1
                 
                  ' see if we have to increase the array size
                  If intCount = UBound(m_arFileList) Then
                      ' increase by 50 elements
                      ReDim Preserve m_arFileList(intCount + 50)
                  End If
              End If
          Next
      Else
          ' save the return value to the module array
          m_arFileList(0) = strFilename
          m_strFilename = strFilename
          intCount = 1
      End If
       
      ' resize the array to just what was used
      ReDim Preserve m_arFileList(intCount)
       
      ' save the generic information for display purposes only
      m_strFilename = Trim$(m_strFilename)
      txtPattern.Text = Trim$(Left$(m_strFilename, 100))
      lblFileCnt(3).Caption = Format$(intCount, "#,0")
      ArrayLoaded = True
  Else
      txtPattern.Text = ""
      ArrayLoaded = False
  End If

End Function

Private Sub BrowseForFiles()

' ***************************************************************************
' Routine:       BrowseForFiles
'
' Description:   This routine will open the "File Open" dialog box so the
'                user can select one or more files in the same folder for
'                processing.
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 22-MAR-2001  Kenneth Ives  kenaso@home.com
'              Routine created
' ***************************************************************************

' ---------------------------------------------------------------------------
' Define local variables
' ---------------------------------------------------------------------------
  Dim strFilename   As String
 
' ---------------------------------------------------------------------------
' Initialize variables
' ---------------------------------------------------------------------------
  txtPattern.Text = ""
  strFilename = ""
  Reset_Counters
                          
' ---------------------------------------------------------------------------
' CancelError is True.
' ---------------------------------------------------------------------------
  CD.CancelError = True
  On Error GoTo BrowseForFiles_ErrHandler
  
' ---------------------------------------------------------------------------
' Display "File Open" dialog box
' ---------------------------------------------------------------------------
   With CD
       ' set the flags for this dialog box.  Allow the user to select one or
       ' more file names.  Correctly display the long filenames.  Use the
       ' Explorer dialog window.
       .Flags = cdlOFNAllowMultiselect Or _
                cdlOFNLongNames Or _
                cdlOFNExplorer
      
       .MaxFileSize = 10240       ' maximum buffer to hold filenames.
       .FileName = ""             ' empty the receiving property
       .DefaultExt = "*.zip"               ' default extension to look for
       .Filter = "Zip Files (*.zip)|*.zip" ' Set file filter
       .ShowOpen                           ' Display the Open dialog box.
       strFilename = .FileName    ' save the selected filename(s) to variable
   End With
  
' ---------------------------------------------------------------------------
' ASee if anything was captured
' ---------------------------------------------------------------------------
  If Len(Trim$(strFilename)) > 0 Then
     
      ' Test the captured data
      If Not ValidData(strFilename) Then
          Exit Sub
      End If
     
      ' load the array with captured data
      If Not ArrayLoaded(strFilename) Then
          Exit Sub
      End If
  Else
      txtPattern.Text = ""
  End If
  
BrowseForFiles_ErrHandler:
' ---------------------------------------------------------------------------
' User pressed Cancel button or normal exit
' ---------------------------------------------------------------------------

End Sub

Private Sub cmdChoice_Click(Index As Integer)

' ---------------------------------------------------------------------------
' Define local variables
' ---------------------------------------------------------------------------
  Dim varDate       As Date
  Dim strDateStamp  As String
 
' ---------------------------------------------------------------------------
' Initialize variables
' ---------------------------------------------------------------------------
  strDateStamp = ""
 
' ---------------------------------------------------------------------------
' Based on button selected
' ---------------------------------------------------------------------------
  Select Case Index
         Case 0  ' process zip files according to date option selected
        
              ' see if there is anything to process
              If Len(Trim$(m_strFilename)) = 0 Then
                  Exit Sub
              End If
             
              ' See if we are going to process a folder
              If InStr(1, m_strFilename, "*") > 0 Then
                  ReDim m_arFileList(1)
                  m_arFileList(0) = m_strFilename
             End If

              ' swap the buttons and switches
              Swap_Buttons
              cFSO.Count = 0
              Screen.MousePointer = vbHourglass   ' show hourglass cursor
                           
              ' format the date/time stamp
              If optDate(0) Then              ' Most recent date in archive
                  Process_Internal_Date m_arFileList(), True, CBool(chkSubdDir.Value)
                 
              ElseIf optDate(1) Then          ' Oldest date in archive
                  Process_Internal_Date m_arFileList(), False, CBool(chkSubdDir.Value)
                 
              ElseIf optDate(2) Then          ' Current system date/time stamp
                  Process_External_Date m_arFileList(), , , CBool(chkSubdDir.Value)
                  
              ElseIf optDate(3) Then          ' Custom date/time stamp
                  ' concatenate date and time selected by user
                  strDateStamp = m_strDate & " " & m_strTime
                  varDate = CDate(strDateStamp)   ' convert string to date/time
                  Process_External_Date m_arFileList(), varDate, False, CBool(chkSubdDir.Value)
              End If
        
              ' reset the buttons and switches
              Init_Buttons
              Screen.MousePointer = vbNormal  ' change cursor back to normal
                      
         Case 1  ' Stop processing
             
              ' reset the buttons and switches
              Init_Buttons
              Screen.MousePointer = vbNormal  ' change cursor back to normal
        
         Case 2  ' About screen
              frmAbout.Show
              frmMain.Hide
             
         Case 3  ' Terminate application
             
              ' reset the buttons and switches
              Init_Buttons
              Screen.MousePointer = vbNormal  ' change cursor back to normal
              StopApplication
  End Select
   
End Sub
Private Sub Swap_Buttons()

' ---------------------------------------------------------------------------
' hide the GO button and show the STOP button
' ---------------------------------------------------------------------------
  cmdChoice(0).Enabled = False
  cmdChoice(0).Visible = False
  cmdChoice(1).Enabled = True
  cmdChoice(1).Visible = True
  cmdBrowse.Enabled = False
              
' ---------------------------------------------------------------------------
' set processing switches
' ---------------------------------------------------------------------------
  g_blnStopProcessing = False
  cFSO.CancelProcessing = False

End Sub
Private Sub Init_Buttons()

' ---------------------------------------------------------------------------
' hide the STOP button and show the GO button
' ---------------------------------------------------------------------------
  cmdChoice(0).Enabled = True
  cmdChoice(0).Visible = True
  cmdChoice(1).Enabled = False
  cmdChoice(1).Visible = False
  cmdBrowse.Enabled = True
  SetupPathLabel
 
' ---------------------------------------------------------------------------
' set processing switches
' ---------------------------------------------------------------------------
  g_blnStopProcessing = True
  cFSO.CancelProcessing = True
 
End Sub
Private Sub dtpDate_Validate(Cancel As Boolean)

' ---------------------------------------------------------------------------
' only active if Custom option selected
' ---------------------------------------------------------------------------
  m_strDate = dtpDate.Value   ' capture the date selected

End Sub

Private Sub dtpTime_Validate(Cancel As Boolean)
 
' ---------------------------------------------------------------------------
' only active if Custom option selected
' ---------------------------------------------------------------------------
  m_strTime = dtpTime.Value   ' Capture the time selected

End Sub

Private Sub Form_Initialize()

' ---------------------------------------------------------------------------
' Center form on the screen.  I use this statement here because of a bug in
' the Form property "Startup Position".  In the VB IDE, under
' Tools\Options\Advanced, when you place a checkmark in the SDI Development
' Environment check box and set the form property to startup in the center
' of the screen, it works while in the IDE.  Whenever you leave the IDE, the
' property reverts back to the default [0-Manual].  This is a known bug with
' Microsoft.
' ---------------------------------------------------------------------------
  Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2

End Sub

Private Sub Form_Load()

' ---------------------------------------------------------------------------
' Set up default options
' ---------------------------------------------------------------------------
  Set cFSO = New clsFSO        ' instantsiate global class objects
  Set cFDT = New clsFileDate
  optDate_Click 0              ' verify the default option
  Init_Buttons                 ' reset the buttons and switches
  ReDim m_arFileList(0)        ' initialize the array
             
' ---------------------------------------------------------------------------
' Prepare display label at bottom
' ---------------------------------------------------------------------------
  Reset_Counters
  SetupPathLabel
 
' ---------------------------------------------------------------------------
' Set up screen display
' ---------------------------------------------------------------------------
  With Me
       .Caption = g_strVersion
       .txtPattern.Text = ""
       .lblTitle.Caption = g_strVersion
       .dtpDate.Value = Format$(Now(), "Short Date")
       .Show
  End With
 
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

' ---------------------------------------------------------------------------
' Free objects from memory
' ---------------------------------------------------------------------------
  Set cFSO = Nothing    ' free class objects from memory
  Set cFDT = Nothing
 
' ---------------------------------------------------------------------------
' Based on the the unload code the system passes, we determine what to do.
'
' Unloadmode codes
'     0 - Close from the control-menu box or Upper right "X"
'     1 - Unload method from code elsewhere in the application
'     2 - Windows Session is ending
'     3 - Task Manager is closing the application
'     4 - MDI Parent is closing
' ---------------------------------------------------------------------------
  Select Case UnloadMode
         Case 0: StopApplication
         Case Else: ' Fall thru. Something else is shutting us down.
  End Select

End Sub

Private Sub optBrowse_Click(Index As Integer)

' ---------------------------------------------------------------------------
' Based on browse option selected
' ---------------------------------------------------------------------------
  Select Case Index
        
         Case 0  ' Browse for a folder
              optBrowse(0).Value = True     ' <-- Selected
              optBrowse(1).Value = False
              chkSubdDir.Enabled = True     ' <-- Activate subdir check box
             
         Case 1  ' Browse for files
              optBrowse(0).Value = False
              optBrowse(1).Value = True     ' <-- Selected
              chkSubdDir.Enabled = False
  End Select
 
  txtPattern.Text = ""
 
End Sub

Private Sub optDate_Click(Index As Integer)
   
' ---------------------------------------------------------------------------
' Based on date option selected
' ---------------------------------------------------------------------------
  Select Case Index
         Case 0  ' Most recent entry in the archive [DEFAULT]
              optDate(0).Value = True     ' <-- Selected
              optDate(1).Value = False
              optDate(2).Value = False
              optDate(3).Value = False
              dtpDate.Enabled = False
              dtpTime.Enabled = False
             
         Case 1  ' Oldest entry in the archive
              optDate(0).Value = False
              optDate(1).Value = True     ' <-- Selected
              optDate(2).Value = False
              optDate(3).Value = False
              dtpDate.Enabled = False
              dtpTime.Enabled = False
        
         Case 2  ' Current date/time stamp
              optDate(0).Value = False
              optDate(1).Value = False
              optDate(2).Value = True     ' <-- Selected
              optDate(3).Value = False
              dtpDate.Enabled = False
              dtpTime.Enabled = False
             
         Case 3  ' Custom selection
              optDate(0).Value = False
              optDate(1).Value = False
              optDate(2).Value = False
              optDate(3).Value = True     ' <-- Selected
              dtpDate.Enabled = True      ' <-- Activate Date selection
              dtpTime.Enabled = True      ' <-- Activate Time selection
             
  End Select
 
End Sub

Private Sub Process_Internal_Date(arFileList() As String, _
                                  Optional blnUseNewestEntry As Boolean = True, _
                                  Optional blnSearchSubfolders As Boolean = True)

' ***************************************************************************
' Routine:       Process_Internal_Date
'
' Description:   This routine will process updating the archive file date/time
'                stamp based on either the most recent date in the archive or
'                or the oldest date in the archive.
'
' Parameters:    arFileList() - an array of fully qualified path\filenames
'                varDate - [OPTIONAL] Customized date is passed else we use
'                          a default date of "01/01/1980 12:00 AM"
'                blnUseNewestEntry [OPTIONAL] TRUE-[DEFAULT] Use the date/time
'                          of the newest entry in the archive
'                          FALSE - Use the date/time stamp of the oldest entry
'                          in the archive
'                blnSearchSubfolders [OPTIONAL] TRUE-[DEFAULT] Search designated
'                          folder and any subfolders
'                          FALSE - Search designated folder only, do not
'                          search any subfolders
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 22-MAR-2001  Kenneth Ives  kenaso@home.com
'              Routine created
' 21-APR-2001  Kenneth Ives  kenaso@home.com
'              Added reference to file name display routines
' ***************************************************************************

' ---------------------------------------------------------------------------
' Define local variables
' ---------------------------------------------------------------------------
  Dim varDate          As Date
  Dim varTestDate      As Date
  Dim strFolder        As String
  Dim strFilename      As String
  Dim strFileList      As String
  Dim arFiles          As Variant
  Dim lngMax           As Long
  Dim lngIndex1        As Long
  Dim lngIndex2        As Long
  Dim lngCount         As Long
  Dim colErrorList     As Collection
  Dim Entry            As ZipFileEntry
 
' ---------------------------------------------------------------------------
' Initialize variables
' ---------------------------------------------------------------------------
  Set colErrorList = New Collection
  strFolder = ""
  strFilename = ""
  strFileList = ""
  lngMax = 0
 
' ---------------------------------------------------------------------------
' Display shortened path on top of the progress bas
' ---------------------------------------------------------------------------
  SetupPathLabel
   
' ---------------------------------------------------------------------------
' see if there is an asterik (wildcard) in the first element.  If so, then
' we are processing a folder.
' ---------------------------------------------------------------------------
  If InStr(1, arFileList(0), "*") > 0 Then
      ' capture folder name
      strFolder = cFSO.Get_Path(arFileList(0))
     
      ' Get the list of files
      strFileList = cFSO.Get_FileList(strFolder, blnSearchSubfolders, "*.zip")
     
      ' load the files into an array
      arFiles = Split(strFileList, ";", Len(strFileList))
  Else
      ReDim arFiles(UBound(arFileList))
      arFiles = arFileList()
  End If
 
' ---------------------------------------------------------------------------
' Capture maximum number of elements in the array
' ---------------------------------------------------------------------------
  If Not g_blnStopProcessing Then
      lngMax = UBound(arFiles)
  End If
 
' ---------------------------------------------------------------------------
' See if there were any ZIP files found or the STOP button was clicked
' ---------------------------------------------------------------------------
  If lngMax < 1 Then
      g_blnStopProcessing = True   ' stop the processing
  Else
      lngCount = lngMax
      ProgessBar 1, 1
      txtPath.Visible = False
      picProgBar.Visible = True
  End If

' ---------------------------------------------------------------------------
' for debugging only.  Let's see what we got.
' ---------------------------------------------------------------------------
'  Open "D:\dnload\a.txt" For Output As #1
'  For lngIndex1 = 0 To lngMax - 1
'      Print #1, arFiles(lngIndex1)
'  Next
'  Close #1
'  Stop
 
' ---------------------------------------------------------------------------
' Loop thru file array and update the archive file date/time stamp
'
' ZipFileEntry          <- Properties
'      .Filename
'      .FileDateTime
'      .UncompressedSize
'      .CompressedSize
'      .CompressionMethod
'      .CRC32
'      .ExtraFieldLength
'      .FileNameLength
'      .Flag
'      .Version
' ---------------------------------------------------------------------------
  For lngIndex1 = 0 To lngMax - 1
     
      ' see if the STOP button was clicked
      DoEvents
      If g_blnStopProcessing Then
          Exit For
      End If
     
      On Error Resume Next
     
      ' Prepare the test date for comparison
      If blnUseNewestEntry Then
          varTestDate = CDate(DEFAULT_DATE) ' Use 01/01/1980 date
      Else
          varTestDate = CDate(Now())        ' use current system date
      End If
     
      strFilename = arFiles(lngIndex1) ' get a filename from the array
      VBZip.FileName = strFilename     ' pass the filename to the VBZip control
     
      With VBZip
           ' loop and gather all file information within this archive.
           ' .GetEntryNum = number of files in archive
           For lngIndex2 = 1 To .GetEntryNum
          
               Set Entry = .GetEntry(lngIndex2)        ' Get a file within the archive
              
               If Entry.FileName <> "" Then            ' make sure we have a filename
                  
                   varDate = CDate(Entry.FileDateTime) ' capture the date information (dd/mm/yyyy)
                  
                   If blnUseNewestEntry Then
                       ' if we are using the newest date in the archive, we test to
                       ' see if the archive date is greater than our test date.  If so,
                       ' save the archive date for our next test.
                       If varDate > varTestDate Then
                           varTestDate = varDate
                       End If
                   Else
                       ' if we are using the oldest date in the archive, we test to
                       ' see if the archive date is less than our test date.  If so,
                       ' save the archive date for our next test.
                       If varDate < varTestDate Then
                           varTestDate = varDate
                       End If
                   End If
               End If
           Next 'lngIndex2
      End With
     
      ' reset the archive file date/time stamp to whatever date we have saved
      If Not cFDT.Set_File_Date(strFilename, varTestDate, False) Then
          colErrorList.Add strFilename       ' add to error list
      End If
     
      On Error GoTo 0
     
      ' update file countdown and progress bar
      lngCount = lngCount - 1
      lblFileCnt(1) = Format$(lngCount, "#,0")
      ProgessBar lngIndex1, lngMax
     
      ' see if the STOP button was clicked
      DoEvents
      If g_blnStopProcessing Then
          Exit For
      End If
     
  Next 'lngIndex1

' ---------------------------------------------------------------------------
' see if the STOP button was clicked
' ---------------------------------------------------------------------------
  DoEvents
  If g_blnStopProcessing Then
      Reset_Counters
  Else
      ' If not, see if there were any errors
      If colErrorList.Count > 0 Then
          lngMax = lngMax - colErrorList.Count
          DisplayBadFiles colErrorList
     
          ' empty the collection
          For lngIndex1 = 1 To colErrorList.Count
              ' there will always be a first record until empty
              colErrorList.Remove 1
          Next
      End If
     
      ' Free collection from memory and reset progress bar
      Set colErrorList = Nothing
      ProgessBar 1, 1
     
      ' Display a completion message
      MsgBox "Successfully finished updating " & _
             Trim$(CStr(lngMax)) & " files.", _
             vbInformation + vbOKOnly, "Processing Finished"
  End If
 
End Sub

Private Sub Process_External_Date(arFileList() As String, _
                                  Optional varDate As Date = DEFAULT_DATE, _
                                  Optional blnUseSystemTime As Boolean = True, _
                                  Optional blnSearchSubfolders As Boolean = True)

' ***************************************************************************
' Routine:       Process_External_Date
'
' Description:   This routine will process updating the archive file date/time
'                stamp based on either the current system date or a date
'                entered by the user.
'
' Parameters:    arFileList() - an array of fully qualified path\filenames
'                varDate - [OPTIONAL] Customized date is passed else we use
'                          a default date of "01/01/1980 12:00 AM"
'                blnUseSystemTime [OPTIONAL] TRUE-[DEFAULT] use the current
'                          system date/time
'                          FALSE - date to use is passed in varDate variable
'                blnSearchSubfolders [OPTIONAL] TRUE-[DEFAULT] Search designated
'                          folder and any subfolders
'                          FALSE - Search designated folder only, do not
'                          search any subfolders
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 22-MAR-2001  Kenneth Ives  kenaso@home.com
'              Routine created
' 21-APR-2001  Kenneth Ives  kenaso@home.com
'              Added reference to file name display routines
' ***************************************************************************

' ---------------------------------------------------------------------------
' Define local variables
' ---------------------------------------------------------------------------
  Dim strFolder        As String
  Dim strFilename      As String
  Dim strFileList      As String
  Dim arFiles          As Variant
  Dim lngMax           As Long
  Dim lngCount         As Long
  Dim lngIndex         As Long
  Dim colErrorList     As Collection
 
' ---------------------------------------------------------------------------
' Initialize variables
' ---------------------------------------------------------------------------
  Set colErrorList = New Collection
  strFolder = ""
  strFilename = ""
  strFileList = ""
  lngMax = 0
 
' ---------------------------------------------------------------------------
' Display shortened path on top of the progress bas
' ---------------------------------------------------------------------------
  SetupPathLabel
   
' ---------------------------------------------------------------------------
' see if there is an asterik (wildcard) in the first element.  If so, then
' we are processing a folder.
' ---------------------------------------------------------------------------
  If InStr(1, arFileList(0), "*") > 0 Then
      ' Save the folder information from the first element of the array
      strFolder = cFSO.Get_Path(arFileList(0))  ' capture just the path info
     
      ' Get the list of files
      strFileList = cFSO.Get_FileList(strFolder, blnSearchSubfolders, "*.zip")
     
      ' load the files into an array
      arFiles = Split(strFileList, ";", Len(strFileList))
  Else
      ' save the list of files to be processed
      ReDim arFiles(UBound(arFileList))
      arFiles = arFileList()
  End If
 
' ---------------------------------------------------------------------------
' Hide the shortened path label
' ---------------------------------------------------------------------------
  RemovePathLabel
   
' ---------------------------------------------------------------------------
' Capture maximum number of elements in the array
' ---------------------------------------------------------------------------
  If Not g_blnStopProcessing Then
      lngMax = UBound(arFiles)
  End If
 
' ---------------------------------------------------------------------------
' See if there were any ZIP files found or the STOP button was clicked
' ---------------------------------------------------------------------------
  If lngMax < 1 Then
      g_blnStopProcessing = True   ' stop the processing
  Else
      lngCount = lngMax
      ProgessBar 1, 1
      txtPath.Visible = False
      picProgBar.Visible = True
  End If

' ---------------------------------------------------------------------------
' for debugging only.  Let's see what we got.
' ---------------------------------------------------------------------------
'  Open "D:\dnload\a.txt" For Output As #1
'  For lngIndex1 = 0 To lngMax - 1
'      Print #1, arFiles(lngIndex1)
'  Next
'  Close #1
'  Stop
 
' ---------------------------------------------------------------------------
' Loop thru file array and update the archive file date/time stamp
'
' ZipFileEntry          <- Properties
'      .Filename
'      .FileDateTime
'      .UncompressedSize
'      .CompressedSize
'      .CompressionMethod
'      .CRC32
'      .ExtraFieldLength
'      .FileNameLength
'      .Flag
'      .Version
' ---------------------------------------------------------------------------
  For lngIndex = 0 To lngMax - 1
     
      ' see if the STOP button was clilcked
      If g_blnStopProcessing Then
          Exit For
      End If
     
      On Error Resume Next
     
      strFilename = arFiles(lngIndex)  ' get a filename from the array
     
      ' reset the archive file date/time stamp to whatever date we have saved
      If Not cFDT.Set_File_Date(strFilename, varDate, blnUseSystemTime) Then
          ' add to error list
          colErrorList.Add strFilename
      End If
     
      On Error GoTo 0
     
      ' update file countdown and progress bar
      lngCount = lngCount - 1
      lblFileCnt(1).Caption = Format$(lngCount, "#,0")
      ProgessBar lngIndex, lngMax
      DoEvents
  Next

' ---------------------------------------------------------------------------
' see if the STOP button was clicked
' ---------------------------------------------------------------------------
  DoEvents
  If g_blnStopProcessing Then
      Reset_Counters
  Else
      ' If not, see if there were any errors
      If colErrorList.Count > 0 Then
          lngMax = lngMax - colErrorList.Count
          DisplayBadFiles colErrorList
     
          ' empty the collection
          For lngIndex = 1 To colErrorList.Count
              ' there will always be a first record until empty
              colErrorList.Remove 1
          Next
      End If
     
      ' Free collection from memory and reset progress bar
      Set colErrorList = Nothing
      ProgessBar 1, 1
     
      ' Display a completion message
      MsgBox "Successfully finished updating " & _
             Trim$(CStr(lngMax)) & " files.", _
             vbInformation + vbOKOnly, "Processing Finished"
  End If
 
End Sub

Private Sub DisplayBadFiles(colFiles As Collection)

' ***************************************************************************
' Routine:       DisplayBadFiles
'
' Description:   This routine will display in a message box a list of all
'                files in which an error occured.
'
' Parameters:    colFiles - collection of filenames to be displayed
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 22-MAR-2001  Kenneth Ives  kenaso@home.com
'              Routine created
' ***************************************************************************

' ---------------------------------------------------------------------------
' Define local variables
' ---------------------------------------------------------------------------
  Dim varMsg    As Variant
  Dim intIndex  As Integer
 
' ---------------------------------------------------------------------------
' Build the display message
' ---------------------------------------------------------------------------
  varMsg = "The following file(s) encountered an error:" & vbCrLf
 
  For intIndex = 1 To colFiles.Count
      varMsg = varMsg & Space$(5) & colFiles.Item(intIndex) & vbCrLf
  Next
 
' ---------------------------------------------------------------------------
' Display message
' ---------------------------------------------------------------------------
  MsgBox varMsg, vbInformation + vbOKOnly, "Zip Dater Error List"

End Sub

Private Sub SetupPathLabel()

' ---------------------------------------------------------------------------
' Calculate the coordinates for the percentage bar
' ---------------------------------------------------------------------------
  picProgBar.Visible = False
  With txtPath
       .Text = ""
       .Visible = True
  End With

End Sub

Private Sub RemovePathLabel()

' ---------------------------------------------------------------------------
' Calculate the coordinates for the percentage bar
' ---------------------------------------------------------------------------
  picProgBar.Visible = True
  With txtPath
       .Visible = False
       .Text = ""
  End With

End Sub

Private Sub Reset_Counters()
     
' ---------------------------------------------------------------------------
' Reset the file counters
' ---------------------------------------------------------------------------
  lblFileCnt(1).Caption = "0"
  lblFileCnt(3).Caption = "0"

' ---------------------------------------------------------------------------
' Reset the progress bar
' ---------------------------------------------------------------------------
  ProgessBar 1, 1
 
End Sub

Project Homepage: