|
|
Title | Download files to keep files on a Web server synchronized with files in a directory in Visual Basic 6 |
Description | This example shows how to upload files to keep files on a Web server synchronized with files in a directory in Visual Basic 6. It uses the Internet Transfer Control to move the files. It uses a file list file on the server to keep track of the server files' last modification dates. |
Keywords | upload, synchronize, Web server |
Categories | Internet, Utilities, Controls |
|
|
You could use this program to ensure that a local directory contained the latest vesions of files available on a Web server. For example, a customer could use this program to keep data files up to date.
This is a fairly complicated example so not all of the code is covered here. Download the project and read the code for details.
When you click the List Files button, the program calls subroutine GetLocalFileData to get the names and modification dates of the files in a local directory. It then downloads a file named filelist from the target Web server directory. This file begins with a line identifying it as a file list. It then contains lines giving a file name and the last modification date on the server.
The program loops through the entries in the file and adds their dates to the local file data in the m_FileData collection. The code then loops through the file data collection adding the name of each file and its last local and remote modification dates to a ListView control. It checks the checkbox next to entries for files where the local modification date is earlier than the remote modification date, indicating that a newer vesion of the file is available on the Web server.
|
|
' Get the remote list of files and update times.
' Compare this to the modification times of the files
' in the local directory.
Private Sub cmdListFiles_Click()
Dim remote_file_list As String
Dim local_file_list As String
Dim file_list_text As String
Dim lines() As String
Dim fields() As String
Dim i As Integer
Dim file_data As FileData
Dim new_item As ListItem
Screen.MousePointer = vbHourglass
lvwFiles.ListItems.Clear
DoEvents
' Get the parameters.
m_HostUrl = txtHostUrl.Text
If Right$(m_HostUrl, 1) <> "/" Then m_HostUrl = _
m_HostUrl & "/"
If Left$(LCase$(m_HostUrl), 7) <> "http://" Then _
m_HostUrl = "http://" & m_HostUrl
m_ToDir = txtToDirectory.Text
If Right$(m_ToDir, 1) <> "\" Then m_ToDir = m_ToDir & _
"\"
' Get information about the local files.
Set m_FileData = GetLocalFileData(m_ToDir)
' Get the remote list of files.
remote_file_list = m_HostUrl & "filelist"
local_file_list = m_ToDir & "filelist"
Select Case DownloadFile(remote_file_list, _
local_file_list)
Case dl_Error, dl_NotFound
' We didn't get the file list.
MsgBox "Error getting file list '" & _
remote_file_list & "'", _
vbExclamation Or vbOKOnly, _
"Error"
On Error Resume Next
Kill local_file_list
On Error GoTo 0
Screen.MousePointer = vbDefault
Exit Sub
Case dl_Ok
' Read the file.
file_list_text = _
GetFileContents(local_file_list)
' Verify that it looks like a file list.
If Left$(file_list_text, Len(FILELIST_HEADER)) _
<> FILELIST_HEADER Then
' We didn't get the file list.
MsgBox "Error getting file list '" & _
remote_file_list & "'", _
vbExclamation Or vbOKOnly, _
"Error"
On Error Resume Next
Kill local_file_list
On Error GoTo 0
Exit Sub
End If
End Select
' Set the remote dates for the files.
lines = Split(file_list_text, vbCrLf)
For i = LBound(lines) + 1 To UBound(lines)
' Skip blank lines.
If Len(lines(i)) > 0 Then
fields = Split(lines(i), ",")
' Get the file's FileData.
On Error Resume Next
Set file_data = m_FileData(fields(0))
If Err.Number = 0 Then
' We have the file locally.
file_data.RemoteDate = CDate(fields(1))
Else
' We don't have the file locally.
' Add an entry for it.
Err.Clear
Set file_data = New FileData
file_data.FileName = fields(0)
file_data.LocalDate = #1/1/1980 12:00:01 AM#
file_data.RemoteDate = CDate(fields(1))
m_FileData.Add file_data
End If
On Error GoTo 0
End If
Next i
' Delete the file list.
On Error Resume Next
Kill local_file_list
On Error GoTo 0
' Display the list of files.
For Each file_data In m_FileData
If file_data.FileName <> "filelist" Then
Set new_item = _
lvwFiles.ListItems.Add(Text:=file_data.FileName)
new_item.ListSubItems.Add _
Text:=Format$(file_data.LocalDate)
new_item.ListSubItems.Add _
Text:=Format$(file_data.RemoteDate)
new_item.Checked = file_data.RemoteDate > _
file_data.LocalDate
End If
Next file_data
Screen.MousePointer = vbDefault
End Sub
|
|
Subroutine GetLocalFileData uses the Dir statement to find the normal files in the selected local directory. It makes a FileData object for each file and sets the object's FileName and LocalDate properties. It initializes the object's RemoteDate property to 1/1/1980 12:00:01AM so, if a file isn't present in the remote file list, the local date will be newer than this default date so the program will upload the file.
|
|
' Get information about the local files.
Private Function GetLocalFileData(ByVal from_dir As String) _
As Collection
Dim results As Collection
Dim file_name As String
Dim file_data As FileData
Set results = New Collection
file_name = Dir$(from_dir & "*.*", vbNormal)
Do While Len(file_name) > 0
Set file_data = New FileData
file_data.FileName = file_name
file_data.LocalDate = FileDateTime(from_dir & _
file_name)
file_data.RemoteDate = #1/1/1980 12:00:01 AM#
results.Add file_data, file_name
file_name = Dir$(, vbNormal)
Loop
Set GetLocalFileData = results
End Function
|
|
When you click the Download button, the program loops through the items in the ListView control and downloads those that are checked. If a download is successful, the program unchecks the item's check box and sets its local modification date equal to the remote modification date.
|
|
' Download checked files.
Private Sub cmdDownload_Click()
Dim i As Integer
Dim from_file As String
Dim to_file As String
Screen.MousePointer = vbHourglass
DoEvents
For i = 1 To lvwFiles.ListItems.Count
If lvwFiles.ListItems(i).Checked Then
from_file = m_HostUrl & _
lvwFiles.ListItems(i).Text
to_file = m_ToDir & lvwFiles.ListItems(i).Text
Select Case DownloadFile(from_file, to_file)
Case dl_Error, dl_NotFound
If MsgBox("Error downloading file '" & _
from_file & "' to '" & _
to_file & "'" & vbCrLf & _
"Continue?", _
vbYesNo Or vbQuestion, _
"Continue?") = vbNo _
Then
Exit For
End If
Case dl_Ok
lvwFiles.ListItems(i).Checked = False
lvwFiles.ListItems(i).SubItems(1) = _
Format$(Now)
End Select
End If
Next i
Screen.MousePointer = vbDefault
MsgBox "Download complete", vbInformation Or vbOKOnly, _
"Done"
End Sub
|
|
|
|
|
|