Use the class module you have created last week called cBackupFiles and add this source code to it. If you have any questions, email us at help@codeoftheweek.com
'----------------------------------------------------------------------
'
' Module Name: cBackupFiles
' Issue # 83/84
' Requires: Issue #61 - ReverseInstr
' Issue #16 - AddBackslash
' Issue #83 - Backing up data files
' 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 1999 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
Private Const OFS_MAXPATHNAME = 128
Private Const OF_READ = &H0
Private Const OF_CREATE = &H1000
Private Const OF_WRITE = &H1
Private Type OFSTRUCT
cBytes As Byte
fFixedDisk As Byte
nErrCode As Integer
Reserved1 As Integer
Reserved2 As Integer
szPathName As String * OFS_MAXPATHNAME
End Type
Private Declare Function LZOpenFile Lib "lz32.dll" Alias "LZOpenFileA" _
(ByVal lpszFile As String, lpOf As OFSTRUCT, ByVal style As Long) As Long
Private Declare Function LZCopy Lib "lz32.dll" _
(ByVal hfSource As Long, ByVal hfDest As Long) As Long
Private Declare Sub LZClose Lib "lz32.dll" (ByVal hfFile As Long)
Private Declare Function GetExpandedName Lib "lz32.dll" Alias "GetExpandedNameA" _
(ByVal lpszSource As String, ByVal lpszBuffer As String) As Long
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
Public Sub RestoreFile(sSourceFile As String, sDestinationPath As String)
Dim sFilename As String
Dim lBackPos As Long
On Error GoTo Handler
' Restore data files to destination path, make sure destination exists.
' If it doesn't, create it.
If Dir(sDestinationPath, vbDirectory) = "" Then
On Error Resume Next
MkDir sDestinationPath
If Err Then
Err.Raise Err.Number, "RestoreFile", "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, "RestoreFile", "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, "RestoreFile", "Could not locate filename in " & sSourceFile
End If
sFilename = Mid$(sSourceFile, lBackPos + 1)
FileCopy sSourceFile, AddBackslash(sDestinationPath) & sFilename
Case cmpMicrosoft
LZFileUnCopy sSourceFile, AddBackslash(sDestinationPath)
Case cmpZip
' Add Zip routines here...
End Select
Exit Sub
Handler:
Err.Raise Err.Number, "RestoreFile", Err.Description
End Sub
'
' This routine uncompresses a file that was compressed using the
' COMPRESS.EXE program that Microsoft distributes.
'
'
Private Sub LZFileUnCopy(sSourceFile As String, sDestinationPath As String)
Dim SourceFileInfo As OFSTRUCT
Dim SourceHandle As Long
Dim DestFileInfo As OFSTRUCT
Dim DestHandle As Long
Dim lRet As Long
Dim lBackPos As Long
Dim sFilename As String
Dim sCompressedFilename As String
On Error GoTo Handler
SourceHandle = LZOpenFile(sSourceFile, SourceFileInfo, OF_READ)
If SourceHandle = 0 Then 'HFILE_ERR Then
Err.Raise SourceHandle, "LZFileUnCopy", "Could not open file: " & sSourceFile
Exit Sub
End If
lRet = GetExpandedName(sSourceFile, SourceFileInfo.szPathName)
' Returns 1 on success or a negative number upon failure.
If lRet < 0 Then
LZClose SourceHandle
Err.Raise lRet, "LZFileUnCopy", "Could not retrieve expanded filename for " & sSourceFile
End If
sCompressedFilename = Left(SourceFileInfo.szPathName, InStr(SourceFileInfo.szPathName, Chr(0)) - 1)
' Pull out the filename from the original filename stored in the compressed
' file
lBackPos = ReverseInstr(sCompressedFilename, "\", vbBinaryCompare)
If lBackPos = 0 Then
Err.Raise 53, "LZFileUnCopy", "Could not locate filename in " & sCompressedFilename
End If
sFilename = Mid$(sCompressedFilename, lBackPos + 1)
' Open handle to the destination file for decompression
DestHandle = LZOpenFile(sDestinationPath & sFilename, DestFileInfo, OF_CREATE Or OF_WRITE)
If DestHandle = 0 Then ' HFILE_ERR Then
LZClose SourceHandle
Err.Raise DestHandle, "LZFileUnCopy", "Could not open the destination file: " & sDestinationPath & sFilename
End If
' Decompress the source file to the destination file.
lRet = LZCopy(SourceHandle, DestHandle)
LZClose SourceHandle
LZClose DestHandle
Exit Sub
Handler:
Err.Raise Err.Number, "LZFileUnCopy", Err.Description
End Sub