clstransfer.cls

simple vb ftp file tranfer project code

        strData = Trim(Mid(line, pos + 1))
        
        strFiles = Split(strData, ";")
        strLocal = Trim(strFiles(0))
        strRemote = Trim(strFiles(1))
        Call PutFiles(strLocal, strRemote)
        logfile.AddToLogFile ("Put files " & vbCrLf)
        Exit Sub
    End If
    
    '------------------------------------------
    'Command format :       [GET] = <remote file name> ; <local file name>
    'Example :              [GET] = Disclaimer.txt ; C:\Temp\Disclaimer.txt
    'FTP the file from the server to the local drive
    If InStr(1, LCase(line), "[get]") > 0 Then
        pos = InStr(1, line, "=")
        strData = Trim(Mid(line, pos + 1))
        
        strFiles = Split(strData, ";")
        strRemote = Trim(strFiles(0))
        strLocal = Trim(strFiles(1))
        DeleteLocalFile (strLocal)
        frmMain.ftp.Execute , "GET """ & strRemote & """ " & strLocal
            Do While frmMain.ftp.StillExecuting
                DoEvents
            Loop
          logfile.AddToLogFile ("ftp.Execute 'get' " & strData & vbCrLf)
        Exit Sub
    End If
    
    '------------------------------------------
    'Command format :       [GETDIRDIFFS] = <remote file name> ; <local file name>
    'Example :              [GETDIRDIFFS] = /iislogs/w3svc1/ ; d:\analog5\logfiles\
    'Gets the files from the server which are different to the files on the
    'local drive so that the remote and local files are same.
    'It does not delete the local files, it only deletes them when the
    'file size is different.
    'The GET function does not overright if the file already exits.
    If InStr(1, LCase(line), "[getdirdiffs]") > 0 Then
        pos = InStr(1, line, "=")
        strData = Trim(Mid(line, pos + 1))
        
        strFiles = Split(strData, ";")
        strRemote = Trim(strFiles(0))
        strLocal = Trim(strFiles(1))
        Call GetDirDiffs(strLocal, strRemote)
        logfile.AddToLogFile ("Get directory differences " & vbCrLf)
        Exit Sub
    End If
    
    '------------------------------------------
    'Delete local files
    'Command format :         [DELETELOCALFILES] = <local file spec>
    'Example :                [DELETELOCALFILES] = c:\temp\files\*.*
    If InStr(1, LCase(line), "[deletelocalfiles]") > 0 Then
        strFiles = Split(line, "=")
        strData = Trim(strFiles(1))
        DeleteLocalFile (strData)
        logfile.AddToLogFile ("Delete local files " & vbCrLf)
        Exit Sub
    End If

    '------------------------------------------
    'Close the ftp connection.
    'Command format :         [CLOSE]
    'Example :                [CLOSE]
    'ftp.Execute , "CLOSE"
    'Inet command : ftp.Execute, "CLOSE"
    If InStr(1, LCase(line), "[close]") > 0 Then
        frmMain.ftp.Execute , "CLOSE"
        logfile.AddToLogFile ("ftp.Execute, 'CLOSE' " & vbCrLf)
        logfile.AddToLogFile ("********************" & vbCrLf)
        Screen.MousePointer = vbDefault
        Exit Sub
    End If

    '------------------------------------------
    'Command format :         [LOGFILE]
    'Example :                [LOGFILE] = /islogs/w3svc1/ ; d:\analog5\logfiles\
    'Get latest logfile
    'this calculates the name of the last 7 days worth of log file and then
    'gets them from the server and places them into a local directory
    If InStr(1, LCase(line), "[logfile]") > 0 Then
        pos = InStr(1, line, "=")
        strData = Trim(Mid(line, pos + 1))
        
        For i = 1 To 7
          strDate = CalcDate(-i) 'calculate the date with reference to today's date
          strFiles = Split(strData, ";")
          strRemote = Trim(strFiles(0)) & strDate
          strLocal = Trim(strFiles(1)) & strDate
          DeleteLocalFile (strLocal)
          frmMain.ftp.Execute , "GET """ & strRemote & """ " & strLocal
              Do While frmMain.ftp.StillExecuting
                  DoEvents
              Loop
          Next
          logfile.AddToLogFile ("ftp.Execute 'get' " & strData & vbCrLf)
        Exit Sub
    End If

    '------------------------------------------
    'This exits the VB program
    'Command format :       [END]
    'Example :              [END]
    If InStr(1, LCase(line), "[end]") > 0 Then
        If Command$ <> "" Then
          logfile.AddToLogFile ("End program" & vbCrLf)
          logfile.AddToLogFile ("********************" & vbCrLf)
          End
        End If
        Exit Sub
    End If

End Sub
'*********************************
Private Sub DeleteLocalFile(filename)

  Dim fs, f

  On Error Resume Next        'in case of errors

  Set fs = CreateObject("Scripting.FileSystemObject")
  Set f = fs.GetFile(filename)
  f.Delete  'Delete the file
  
End Sub
'*********************************
'This calculates the logfile name for a given date
'the date is identified by 'back' which if -1 is
'yesterday, -2 is the day before, and so on
'format of log file is ex020515.log
'representing year - month - day
Private Function CalcDate(ByVal back As Integer) As String

Dim strYear As String
Dim strMonth As String
Dim strDay As String
Dim dteDate As Date

dteDate = DateAdd("d", back, Now())

strYear = Mid(CStr(DatePart("yyyy", dteDate)), 3)
strMonth = CStr(DatePart("m", dteDate))
If Len(strMonth) = 1 Then
  strMonth = "0" & strMonth
End If
strDay = CStr(DatePart("d", dteDate))
If Len(strDay) = 1 Then
  strDay = "0" & strDay
End If

CalcDate = "ex" & strYear & strMonth & strDay & ".log"

End Function
'*********************************
'Puts files from the local drive onto the remote drive
'strLocal is the local file spec
'strRemote is the remote directory
Private Sub PutFiles(ByVal strLocalDir As String, ByVal strRemoteDir As String)

Dim fs As Object
Dim LocalFileArray() As String  'A list of all the files in the local directory
Dim i As Integer
Dim strLocalFile As String

'first fill the local file array
Set fs = Application.FileSearch
With fs
    DoEvents
    .LookIn = strLocalDir       'start from here
    .SearchSubFolders = False   'search sub folders
    .filename = "*.*"         'which files to look for
    If .Execute() > 0 Then
        ReDim LocalFileArray(.FoundFiles.Count)
        For i = 1 To .FoundFiles.Count
            LocalFileArray(i) = .FoundFiles(i)
        Next i
    Else
        logfile.AddToLogFile ("There were no files found matching the criteria." & Chr(13) & Chr(10))
        If Command$ = "" Then
          MsgBox ("There were no files found matching the criteria.")
        End If
    End If
End With

For i = 0 To UBound(LocalFileArray)
  strLocalFile = Mid(LocalFileArray(i), Len(strLocalDir) + 1)
  If strLocalFile <> "" Then
  frmMain.ftp.Execute , "PUT """ & LocalFileArray(i) & """ " & strRemoteDir & strLocalFile
    Do While frmMain.ftp.StillExecuting
      DoEvents
    Loop
  End If
Next

End Sub
'*********************************
'Retrieves a remote directory by comparing
'the local directory contents and the remote
'directory contents then downloads the differences
Private Sub GetDirDiffs(ByVal strLocalDir As String, ByVal strRemoteDir As String)

Dim fs As Object
Dim i As Integer
Dim j As Integer
Dim temp As String
Dim LocalFileArray() As String  'A list of all the files in the local directory
Dim RemoteFileArray() As String 'A list of all the files in the remote directory
Dim DiffFileArray() As String   'A list of those file which are in the Remote Directory
                                'but not in the Local Directory
Dim bolFound As Boolean
Dim strRemote As String
Dim strLocal As String

'first fill the local file array
Set fs = Application.FileSearch
With fs
    DoEvents
    .LookIn = strLocalDir       'start from here
    .SearchSubFolders = False   'search sub folders
    .filename = "*.log"         'which files to look for
    If .Execute() > 0 Then
        ReDim LocalFileArray(.FoundFiles.Count)
        For i = 1 To .FoundFiles.Count
            LocalFileArray(i) = .FoundFiles(i)
        Next i
    Else
        logfile.AddToLogFile ("There were no files found matching the criteria." & Chr(13) & Chr(10))
        If Command$ = "" Then
          MsgBox ("There were no files found matching the criteria.")
        End If
    End If
End With

'Now fill the remote file array
frmMain.ftp.Execute , "DIR """ & strRemoteDir & Chr(34)
Do While frmMain.ftp.StillExecuting
  DoEvents
Loop

'bubble sort LocalFileArray
For i = 1 To UBound(LocalFileArray) - 1
  For j = 1 To UBound(LocalFileArray) - 1
    If LocalFileArray(j) > LocalFileArray(j + 1) Then
      temp = LocalFileArray(j)
      LocalFileArray(j) = LocalFileArray(j + 1)
      LocalFileArray(j + 1) = temp
    End If
  Next
Next

If STRCONTENT <> "" Then
    RemoteFileArray = Split(STRCONTENT, vbCrLf)
    'now compare localarray and remotearray contents and
    'ftp the ones that are in the remotearray but not in
    'the localarray
    
    'bubble sort RemoteFileArray
    For i = 1 To UBound(RemoteFileArray) - 1
      For j = 1 To UBound(RemoteFileArray) - 1
        If RemoteFileArray(j) > RemoteFileArray(j + 1) Then
          temp = RemoteFileArray(j)
          RemoteFileArray(j) = RemoteFileArray(j + 1)
          RemoteFileArray(j + 1) = temp
        End If
      Next
    Next
    
  'Local files are stored and sorted in LocalFileArray
  'Remote files are stored and sorted in RemotefileArray
  'Now compare one with the other
  ReDim DiffFileArray(UBound(RemoteFileArray))
  
  For i = 0 To UBound(RemoteFileArray)
    bolFound = False
    For j = 0 To UBound(LocalFileArray)
      If LocalFileArray(j) = RemoteFileArray(i) Then
        bolFound = True
      End If
    Next
    If bolFound = False Then
      DiffFileArray(i) = RemoteFileArray(i)
    End If
  Next

  'For i = 0 To UBound(DiffFileArray)
  '  MsgBox (DiffFileArray(i))
  'Next
    
  For i = 0 To UBound(DiffFileArray)
    'MsgBox (DiffFileArray(i)) 'list of differences
    'ftp GET the differences
    If DiffFileArray(i) <> "" Then
      strRemote = strRemoteDir & DiffFileArray(i)
      strLocal = strLocalDir & DiffFileArray(i)
      'MsgBox (DiffFileArray(i))
      frmMain.ftp.Execute , "GET """ & strRemote & """ " & strLocal
        Do While frmMain.ftp.StillExecuting
          DoEvents
      Loop
    End If
  Next
  
'  'Now check local and remote file sizes
'  'If there is a difference, download them
  For i = 0 To UBound(RemoteFileArray)
      If RemoteFileArray(i) <> "" Then
        strRemote = strRemoteDir & RemoteFileArray(i)
        strLocal = strLocalDir & RemoteFileArray(i)
        If GetRemoteFileSize(strRemote) <> GetLocalFileSize(strLocal) Then
          DeleteLocalFile (strLocal)  'delete local file first
          frmMain.ftp.Execute , "GET """ & strRemote & """ " & strLocal
              Do While frmMain.ftp.StillExecuting
                DoEvents
              Loop
        End If
      End If
  Next

End If

logfile.AddToLogFile ("Get directory differences " & vbCrLf)

End Sub
'*********************************
'Given a remote directory, delete all the files in that directory
'There seems to be a problem with deleting empty directories
'One solution is to put a temp file up so that the directory
'is not empty.
Sub DeleteRmtDirContents(ByVal strRemoteDir As String)

Dim RemoteFileArray() As String 'A array of all the files in the remote directory
Dim strFile As String
Dim i As Integer
Dim strLocal As String
Dim strRemote As String

strLocal = App.Path & "\vbftp.txt"

'First put a temporary file on the directory
frmMain.ftp.Execute , "PUT """ & strLocal & """ " & strRemote
  Do While frmMain.ftp.StillExecuting
    DoEvents
  Loop

'Now fill the remote file array
frmMain.ftp.Execute , "DIR """ & strRemoteDir & Chr(34)
Do While frmMain.ftp.StillExecuting
  DoEvents
Loop

If STRCONTENT <> "" Then
    RemoteFileArray = Split(STRCONTENT, vbCrLf)
    'now delete each file one at a time
    For i = 0 To UBound(RemoteFileArray)
      If RemoteFileArray(i) <> "" Then  'blank is a directory
        frmMain.ftp.Execute , "DELETE """ & strRemoteDir & RemoteFileArray(i) & """"
          Do While frmMain.ftp.StillExecuting
            DoEvents
          Loop
      End If
    Next
End If

End Sub
'*********************************
'Given a remote filename, returns the file size
Function GetRemoteFileSize(ByVal strFileName As String) As String

frmMain.ftp.Execute , "SIZE " & strFileName
Do While frmMain.ftp.StillExecuting
  DoEvents
Loop

GetRemoteFileSize = STRCONTENT

End Function
'*********************************
'Given a local filename, returns the file size
Function GetLocalFileSize(ByVal strFileName As String) As Long

Dim fs, f, s

On Error Resume Next

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(strFileName)
GetLocalFileSize = f.Size

End Function