|
|
|
| Title | Use multiple file versions |
|---|
| Description | This example shows how to use multiple file versions in Visual Basic. |
|---|
| Keywords | file version |
|---|
| Categories | Files and Directories, Utilities |
|---|
|
|
|
Some operating systems automatically keep a certain number of versions of a file. If you edit a file and save your changes, the new file is given a new version number. If there are too many versions of the file, the oldest is discarded. This system lets you retrieve old versions for a while but eventually throws them away to recover disk space. This example does something similar.
Subroutine GetLatestName gets a file's latest version number. It uses the Dir function to look for files matching the file name. An asterisk in the name indicates where the version number should go. The program keeps track of the largest version number it finds and returns it together with the file's full name.
|
|
' Get the name and number of the latest version of the file.
Private Sub GetLatestName(ByVal file_name As String, ByRef _
latest_name As String, ByRef latest_number As Integer)
Dim pos As Integer
Dim file_title As String
Dim file_path As String
Dim len_before As Integer
Dim len_after As Integer
Dim fname As String
Dim num As Integer
' Get the file's title and path.
pos = InStrRev(file_name, "\")
file_title = Mid$(file_name, pos + 1)
file_path = Left$(file_name, pos)
' Get the part of the file title before and after the *.
pos = InStr(file_title, "*")
len_before = pos - 1
len_after = Len(file_title) - pos
' Look for matching files.
fname = Dir$(file_name)
latest_number = -1
latest_name = ""
Do While Len(fname) > 0
On Error Resume Next
num = CInt(Mid$(fname, len_before + 1, Len(fname) - _
len_before - len_after))
If Err.Number <> 0 Then
Err.Clear
Else
If latest_number < num Then
latest_number = num
latest_name = file_path & fname
End If
End If
On Error GoTo 0
fname = Dir$()
Loop
End Sub
|
|
|
Function GetLatestContents returns a file's most recent contents. It uses GetLatestName to get the file's most recent vesion and calls GetFileContents to read the file's contents.
GetFileContents opens the file, reads it, and closes the file.
|
|
' Get the latest version of the file.
Private Function GetLatestContents(ByVal file_name As _
String) As String
Dim latest_name As String
Dim latest_number As Integer
' Get the latest file's name.
GetLatestName file_name, latest_name, latest_number
' Read the file.
If Len(latest_name) = 0 Then
GetLatestContents = ""
Else
On Error Resume Next
GetLatestContents = GetFileContents(latest_name)
If Err.Number <> 0 Then GetLatestContents = ""
End If
End Function
' Get the file's contents.
Private Function GetFileContents(ByVal file_name As String) _
As String
Dim fnum As Integer
' Open the file.
fnum = FreeFile
Open file_name For Input As fnum
' Grab the file's contents.
GetFileContents = Input(LOF(fnum), fnum)
' Close the file.
Close fnum
End Function
|
|
|
Subroutine SetLatestContents saves a string into a new version of a file. It uses GetLatestName to get the latest version number, increments the version, and uses SetFileContents to write the new file. If keep_versions is greater than 0, then the routine calls subroutine PurgeVersionsBefore to remove any old versions.
Subroutine SetFileContents opens the file, writes into it, and closes the file.
|
|
' Get the latest version of the file.
Private Sub SetLatestContents(ByVal file_name As String, _
ByVal version_format As String, ByVal new_contents As _
String, Optional ByVal keep_versions = 0)
Dim latest_name As String
Dim latest_number As Integer
' Get the latest file's name.
GetLatestName file_name, latest_name, latest_number
' Add one to the version.
latest_number = latest_number + 1
' Wrap around after 999 (you could change this for your
' application).
If latest_number > 1000 Then latest_number = 1
latest_name = Replace$(file_name, "*", _
Format$(latest_number, version_format))
' Save the file.
SetFileContents latest_name, new_contents
' See if we should purge old versions.
If keep_versions > 0 Then
PurgeVersionsBefore file_name, latest_number - _
keep_versions + 1
End If
End Sub
' Set the file's contents.
Private Sub SetFileContents(ByVal file_name As String, _
ByVal contents As String)
Dim fnum As Integer
' Open the file.
fnum = FreeFile
Open file_name For Output As fnum
' Write the file's contents (without an
' extra trailing vbCrLf).
Print #fnum, contents;
' Close the file.
Close fnum
End Sub
|
|
|
Subroutine PurgeVersionsBefore uses the Dir function to find different versions of a file. It uses Visual Basic's Kill command to delete any files older than a specified version.
|
|
' Purge files with version numbers before this one.
Private Sub PurgeVersionsBefore(ByVal file_name As String, _
ByRef purge_before As Integer)
Dim pos As Integer
Dim file_title As String
Dim file_path As String
Dim len_before As Integer
Dim len_after As Integer
Dim fname As String
Dim num As Integer
' Get the file's title and path.
pos = InStrRev(file_name, "\")
file_title = Mid$(file_name, pos + 1)
file_path = Left$(file_name, pos)
' Get the part of the file title before and after the *.
pos = InStr(file_title, "*")
len_before = pos - 1
len_after = Len(file_title) - pos
' Look for matching files.
fname = Dir$(file_name)
Do While Len(fname) > 0
On Error Resume Next
num = CInt(Mid$(fname, len_before + 1, Len(fname) - _
len_before - len_after))
If Err.Number <> 0 Then
Err.Clear
Else
If num < purge_before Then
Kill file_path & fname
End If
End If
On Error GoTo 0
fname = Dir$()
Loop
End Sub
|
| |
|
| |
|
|
