Home
Search
 
What's New
Index
Books
Links
Q & A
Newsletter
Banners
 
Feedback
Tip Jar
 
C# Helper...
 
XML RSS Feed
Follow VBHelper on Twitter
 
 
 
MSDN Visual Basic Community
 
 
 
 
 
TitleUpload files to keep files on a Web server synchronized with files in a directory in Visual Basic 6
DescriptionThis 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.
Keywordsupload, synchronize, Web server
CategoriesInternet, Utilities, Controls
 
For example, you could use this program to keep a Web site or customer download area 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 later than the remote modification date, indicating that a newer vesion of the file is available locally.

 
' 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 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_FromDir = txtFromDirectory.Text
    If Right$(m_FromDir, 1) <> "\" Then m_FromDir = _
        m_FromDir & "\"

    m_HostName = txtHostName.Text
    If LCase$(Left$(m_HostName, 6)) = "ftp://" Then _
        m_HostName = Mid$(m_HostName, 7)
    If LCase$(Left$(m_HostName, 7)) = "http://" Then _
        m_HostName = Mid$(m_HostName, 8)

    m_FtpRoot = txtFtpRoot.Text
    If Left$(m_FtpRoot, 1) <> "/" Then m_FtpRoot = "/" & _
        m_FtpRoot

    m_ToDir = txtToDirectory.Text
    If Left$(m_ToDir, 1) <> "/" Then m_ToDir = "/" & m_ToDir

    m_UserName = txtUserName.Text
    m_Password = txtPassword.Text

    ' Get information about the local files.
    Set m_FileData = GetLocalFileData(m_FromDir)

    ' Get the remote list of files.
    m_RemoteListFile = m_HostName & m_ToDir & "/filelist"
    m_LocalListFile = m_FromDir & "filelist"
    Select Case DownloadFile("http://" & m_RemoteListFile, _
        m_LocalListFile)
        Case dl_Error
            Screen.MousePointer = vbDefault
            Exit Sub
        Case dl_Ok
            ' Read the file.
            file_list_text = _
                GetFileContents(m_LocalListFile)

            ' Verify that it looks like a file list.
            If Left$(file_list_text, Len(FILELIST_HEADER)) _
                <> FILELIST_HEADER Then
                ' Assume all files are out of date.
                file_list_text = ""

                On Error Resume Next
                Kill m_LocalListFile
                On Error GoTo 0
            End If
        Case dl_NotFound
            ' All files are out of date.
            file_list_text = ""
    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
                Err.Clear
            Else
                file_data.RemoteDate = CDate(fields(1))
            End If
            On Error GoTo 0
        End If
    Next i

    ' 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 Upload button, the program loops through the items in the ListView control and uploads those that are checked. If an upload is successful, the program unchecks the item's check box and sets its remote modification date equal to the local modification date.

Next the program builds a new file list file containing the names and remote modification dates for the files, and it uploads the new file.

 
' Upload checked files.
Private Sub cmdUpload_Click()
Dim i As Integer
Dim file_list_text As String

    Screen.MousePointer = vbHourglass
    DoEvents

    For i = 1 To lvwFiles.ListItems.Count
        If lvwFiles.ListItems(i).Checked Then
            If Not UploadFile( _
                m_FromDir & lvwFiles.ListItems(i).Text, _
                m_FtpRoot & m_ToDir & "/" & _
                    lvwFiles.ListItems(i).Text, _
                "ftp://" & m_HostName, _
                m_UserName, _
                m_Password) _
            Then
                If MsgBox("Continue?", _
                    vbYesNo Or vbQuestion, _
                    "Continue?") = vbNo _
                Then
                    Exit For
                End If
            End If
            lvwFiles.ListItems(i).Checked = False
            lvwFiles.ListItems(i).SubItems(2) = _
                lvwFiles.ListItems(i).SubItems(1)
        End If
    Next i

    ' Upload a new file list.
    ' Build the list.
    file_list_text = FILELIST_HEADER
    For i = 1 To lvwFiles.ListItems.Count
        file_list_text = file_list_text & vbCrLf & _
            lvwFiles.ListItems(i).Text & "," & _
            lvwFiles.ListItems(i).SubItems(2)
    Next i

    ' Save the list.
    SetFileContents m_LocalListFile, file_list_text

    ' Upload the new list.
    UploadFile m_LocalListFile, _
        m_FtpRoot & m_ToDir & "/filelist", _
        "ftp://" & m_HostName, m_UserName, m_Password

    Screen.MousePointer = vbDefault
    MsgBox "Upload complete", vbInformation Or vbOKOnly, _
        "Done"
End Sub
 
 
Copyright © 1997-2010 Rocky Mountain Computer Consulting, Inc.   All rights reserved.
  Updated