Source code for Issue Number 83

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. Source code may not be reproduced except for use in a compiled executable. All rights reserved. If you would like to reprint any or all of this code please email us at info@codeoftheweek.com

Code of the Week Home


Source Code

Create a new class module and paste this source code into it. You should name this class cBackupFiles. If you have any questions, email us at help@codeoftheweek.com

'----------------------------------------------------------------------
'
'   Module Name:    cBackupFiles
'   Issue #         83
'   Requires:       Issue #61 - ReverseInstr
'                   Issue #16 - AddBackslash
'                   COMPRESS.EXE program that is distributed with
'                   Visual Basic 5.0 and higher and probably earlier
'                   versions of VB.
'   Written By:     C&D Programming Corp.
'   Create Date:    3/99
'   Copyright:      Copyright 1998 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------

Option Explicit

Public Enum eCompressionType
    cmpNone
    cmpMicrosoft
    cmpZip          ' Not currently supported
End Enum

Private meCompType As eCompressionType
Private msCompressionLocation As String ' the loation of the COMPRESS.EXE file

Public Property Let CompressionType(eCompType As eCompressionType)
    meCompType = eCompType
End Property

Public Property Get CompressionType() As eCompressionType
    CompressionType = meCompType
End Property

Public Property Get MicrosoftCompressionEXELocation() As String
    MicrosoftCompressionEXELocation = msCompressionLocation
End Property

'   This routine uses the COMPRESS.EXE program that is distributed with
'   Visual Basic 5.0 and higher (I'm pretty sure it is distributed with
'   earlier versions as well).
'
'   This routine expects either the path that contains the compress.exe program
'   of a full path and filename of what you have renamed the compress.exe program
'   to.
'
'   For example:
'       MicrosoftCompressionEXELocation = App.Path
'   or
'       MicrosoftCompressionEXELocation = App.Path & "\COMPRESS.EXE"
'
'   If the file can not be found in the path or filename you have specified it
'   will raise an error.
'
Public Property Let MicrosoftCompressionEXELocation(ByVal sLocation As String)
    ' if the length is shorter than the filename then assume we are just
    ' receiving a path name.  Not the best assumption, but not a bad one
    ' either.
    If Dir(sLocation) <> "" Then ' we found the file so let's get outta here.
        msCompressionLocation = sLocation
        Exit Property
    End If
    If Len(sLocation) < 12 Then
        sLocation = sLocation & "\compress.exe"
    End If
    If Right(sLocation, 12) <> "compress.exe" Then
        msCompressionLocation = sLocation & "\compress.exe"
    Else
        msCompressionLocation = sLocation
    End If
    If Dir(msCompressionLocation) = "" Then
        Err.Raise 53, "MicrosoftCompressionEXELocation", "Could not locate the file " & msCompressionLocation
    End If
End Property
'
'   This backup routine will overwrite any existing files.  A future issue
'   might discuss checking for overwriting destination files.
'
'
'   If no error is raised from this routine it can be assumed that the
'   backup was successful.
'
Public Sub BackupFile(sSourceFile As String, sDestinationPath As String)
    Dim sFilename As String
    Dim lBackPos As Long

    On Error GoTo Handler

    ' make a backup of the data files.
    If Dir(sDestinationPath, vbDirectory) = "" Then
        On Error Resume Next
        MkDir sDestinationPath
        If Err Then
            Err.Raise Err.Number, "BackupFile", "Could not create or find the directory " & sDestinationPath
        End If
        On Error GoTo Handler
    End If
    ' make sure the source file exists.  If it doesn't then complain to the caller.
    If Dir(sSourceFile) = "" Then
        Err.Raise 53, "BackupFile", "Could not find the file " & sSourceFile
    End If
    Select Case CompressionType
        Case cmpNone
            ' find filename so we can tell FileCopy what filename to copy the
            ' file to.
            lBackPos = ReverseInstr(sSourceFile, "\", vbBinaryCompare)
            If lBackPos = 0 Then
                Err.Raise 53, "BackupFile", "Could not locate filename in " & sSourceFile
            End If
            sFilename = Mid$(sSourceFile, lBackPos + 1)
            FileCopy sSourceFile, AddBackslash(sDestinationPath) & sFilename
        Case cmpMicrosoft
            LZFileCopy sSourceFile, AddBackslash(sDestinationPath)
        Case cmpZip
            ' Add Zip routines here...
    End Select
    Exit Sub

Handler:
    Err.Raise Err.Number, "BackupFile", Err.Description
End Sub
'
'   This routine uses the COMPRESS.EXE program that is distributed with
'   Visual Basic 5.0 and higher (I'm pretty sure it is distributed with
'   earlier versions as well).  We could not locate any API calls that
'   provide the interface to a library of routines that are implemented
'   in COMPRESS.EXE
'
Private Sub LZFileCopy(sSourceFile As String, sDestinationPath As String)
    Dim lRet As Long

    On Error GoTo Handler
    lRet = Shell(MicrosoftCompressionEXELocation & " -r " & sSourceFile & " " & sDestinationPath, vbHide)
    Exit Sub

Handler:
    Err.Raise Err.Number, "LZFileCopy", Err.Description
End Sub

Private Sub Class_Initialize()
    CompressionType = cmpNone
End Sub