clstransfer.cls

simple vb ftp file tranfer project code

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsTransfer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'*********************************
'P.Gibbs 23-07-02
'
'Provides facilities for ftp to and from
'a remote webserver using information
'contained in a text file

'Becareful with some commands in that they may
'not overwrite.  May have to delete files first
'to make sure.

'Basic commands needed are delete local files,
'delete remote files, get remote files from server,
'and put put local files to server.  Also need the
'commands to set up the connection to the ftp server

'Inet ftp
'--------
'
'CD file1
'Change Directory.
'Changes to the directory specified in file1. Execute , "CD docs\mydocs"
'
'CDUP
'Change to Parent.
'Same as "CD .."
'Execute , "CDUP"
'
'Delete file1
'Deletes the file specified in file1.
'Execute , "DELETE discard.txt"
'
'Dir [ file1 ]
'Searches the directory specified in file1. If file1 isn't supplied,
'the current working directory is searched. Use the GetChunk method to
'return the data.
'Execute , "DIR /mydocs"
'
'GET file1 file2
'Retrieves the remote file specified in file1, and creates a new local
'file specified in file2.
'Execute , "GET getme.txt C:\gotme.txt"
'
'MkDir file1
'Creates a directory as specified in file1. Success is dependent on user
'privileges on the remote host.
'Execute , "MKDIR /myDir"
'
'PUT file1 file2
'Copies a local file specified in file1 to the remote host specified in file2.
'Execute , "PUT C:\putme.txt /putme.txt"
'
'PWD
'Print Working Directory.
'Returns the current directory name. Use the GetChunk method to return the data.
'Execute , "PWD"
'
'Quit
'Terminate current connection
'Execute , "QUIT"
'
'RECV file1 file2
'Same as GET.
'Execute , "RECV getme.txt C:\gotme.txt"
'
'RENAME file1 file2
'Renames a file. Success is dependent on user privileges on the remote host.
'Execute , "RENAME old.txt new.txt"
'
'RmDir file1
'Remove directory. Success is dependent on user privileges on the remote host.
'Execute , "RMDIR oldDir"
'
'SEND file1
'Copies a file to the FTP site. (same as PUT.)
'Execute , "SEND C:\putme.txt /putme.txt"
'
'Size file1
'Returns the size of the file specified in file1.
'Execute "SIZE /largefile.txt"
'
'Important   If your proxy server is a CERN proxy server, direct FTP
'connections (using the Execute method) are disallowed. In that case,
'to get a file, use the OpenURL method with the Open, Put, and Close
'statements, as shown earlier in "Saving to a File Using the OpenURL
'Method." You can also use the OpenURL method to get a directory listing
'by invoking the method and specifying the target directory as the URL.



Dim logfile As New clsLogFile
Dim m_ftpfile As String
'*********************************
Public Sub DoTransfer(ByVal in_strFTPFile As String)
  
  Call ReadFile(in_strFTPFile)

End Sub
'*********************************
Private Sub ReadFile(ByVal strFileName As String)

On Error GoTo Err_OpenFile
    
    Dim strLine As String
    
    If strFileName = "" Then
      strFileName = App.Path & "\vbftp.txt"
    End If

    Const forReading = 1, ForWriting = 2, ForAppending = 8
    Dim fs, f
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.OpenTextFile(strFileName, forReading, True)
   
    'm_ftpfile = f.ReadAll
    'frmMain.txtDisplay.Text = m_ftpfile
    
    Do While f.AtEndOfStream <> True
        DoEvents
        strLine = f.ReadLine
        If strLine <> "" And Mid(strLine, 1, 1) <> "#" Then
            Parse (strLine)
        End If
    Loop
    
    f.Close

Exit_OpenFile:
    Exit Sub

Err_OpenFile:
    If Command$ = "" Then
        MsgBox Err.Number & " " & Err.Description
    Else
        logfile.AddToLogFile ("Error reading file " & Err.Number & " " & Err.Description & vbCrLf)
        End
    End If
    Screen.MousePointer = vbDefault
    Resume Exit_OpenFile

End Sub
'*********************************
Private Sub Parse(ByVal line As String)

    Dim strData As String
    Dim pos As Integer
    Dim strLocal As String
    Dim strRemote As String
    Dim strFiles() As String
    Dim strDate As String
    Dim i As Integer

    '------------------------------------------
    'Access type
    'Command format :   [ACCESSTYPE] = <data>
    'Example :          [ACCESSTYPE] = icDirect
    'Inet command :     ftp.AccessType = icDirect
    If InStr(1, LCase(line), "[accesstype]") > 0 Then
        pos = InStr(1, line, "=")
        strData = Trim(Mid(line, pos + 1))
        frmMain.ftp.AccessType = strData
        logfile.AddToLogFile ("ftp.AccessType = " & strData & vbCrLf)
        Exit Sub
    End If
    
    '------------------------------------------
    'Set up proxy server, if needed
    'Command format :   [PROXY] = <data>
    'Example :          [PROXY] = www.new.co.uk
    'Inet command :     ftp.Proxy = ""
    If InStr(1, LCase(line), "[proxy]") > 0 Then
        pos = InStr(1, line, "=")
        strData = Trim(Mid(line, pos + 1))
        frmMain.ftp.Proxy = strData
        logfile.AddToLogFile ("ftp.Proxy = " & strData & vbCrLf)
        Exit Sub
    End If
    
    '------------------------------------------
    'Request timeout
    'Command format :   [REQUESTTIMEOUT] = <data>
    'Example :          [REQUESTTIMEOUT] = 60
    'Inet command :     ftp.Requesttimout = 60
    If InStr(1, LCase(line), "[requesttimeout]") > 0 Then
        pos = InStr(1, line, "=")
        strData = Trim(Mid(line, pos + 1))
        frmMain.ftp.RequestTimeout = strData
        logfile.AddToLogFile ("ftp.RequestTimeout = " & strData & vbCrLf)
        Exit Sub
    End If
    
    '------------------------------------------
    'The URL of the ftp site
    'Command format :   [URL] = <data>
    'Example :          [URL] = www.thisurl.co.uk
    'Inet command :     ftp.URL = "www.thisurl.co.uk"
    If InStr(1, LCase(line), "[url]") > 0 Then
        pos = InStr(1, line, "=")
        strData = Trim(Mid(line, pos + 1))
        frmMain.ftp.URL = strData
        logfile.AddToLogFile ("ftp.url = " & strData & vbCrLf)
        Exit Sub
    End If
    
    '------------------------------------------
    'The protocol,in this case icFTP
    'Command format :   [PROTOCOL] = <data>
    'Example :          [PROTOCOL] = icFTP
    'Inet command :     ftp.Protocol = icFTP
    If InStr(1, LCase(line), "[protocol]") > 0 Then
        pos = InStr(1, line, "=")
        strData = Trim(Mid(line, pos + 1))
        'frmMain.ftp.Protocol = strData
        frmMain.ftp.Protocol = icFTP
        logfile.AddToLogFile ("ftp.Protocol = " & strData & vbCrLf)
        Exit Sub
    End If
    
    '------------------------------------------
    'Sets the directory on the remote host
    'Command format :   [REMOTEHOST] = <remote directory>
    'Example :          [REMOTEHOST] = /courinfo/general/
    'Inet command :     ftp.RemoteHost = "/courinfo/general/"
    If InStr(1, LCase(line), "[remotehost]") > 0 Then
        pos = InStr(1, line, "=")
        strData = Trim(Mid(line, pos + 1))
        frmMain.ftp.RemoteHost = strData
        logfile.AddToLogFile ("ftp.RemoteHost = " & strData & vbCrLf)
        Exit Sub
    End If
   
    '------------------------------------------
    'Sets the ftp port, usually 21
    'Command format :   [REMOTEPORT] = <data>
    'Example :          [REMOTEPORT] = 21
    'Inet command :     ftp.RemotePort = "21"
    If InStr(1, LCase(line), "[remoteport]") > 0 Then
        pos = InStr(1, line, "=")
        strData = Trim(Mid(line, pos + 1))
        frmMain.ftp.RemotePort = strData
        logfile.AddToLogFile ("ftp.RemotePort = " & strData & vbCrLf)
        Exit Sub
    End If
    
    '------------------------------------------
    'The ftp site user name
    'Command format :   [USERNAME] = <data>
    'Example :          [USERNAME] = fred
    'Inet command       ftp.UserName = "fred"
    If InStr(1, LCase(line), "[username]") > 0 Then
        pos = InStr(1, line, "=")
        strData = Trim(Mid(line, pos + 1))
        frmMain.ftp.UserName = strData
        logfile.AddToLogFile ("ftp.UserName = " & "xxxx" & vbCrLf)
        Exit Sub
    End If
    
    '------------------------------------------
    'The ftp site password
    'Command format :   [PASSWORD] = <data>
    'Example :          [PASSWORD] = blogs
    'Inet command :     ftp.Password = "blogs"
    If InStr(1, LCase(line), "[password]") > 0 Then
        pos = InStr(1, line, "=")
        strData = Trim(Mid(line, pos + 1))
        frmMain.ftp.Password = strData
        logfile.AddToLogFile ("ftp.Password = " & "xxxx" & vbCrLf)
        Exit Sub
    End If
    
    '------------------------------------------
    'Command format :   [DOCUMENT] = <data>
    'Example :          [DOCUMENT] = test
    'Inet Command :     ftp.Document = "test"
    If InStr(1, LCase(line), "[document]") > 0 Then
        pos = InStr(1, line, "=")
        strData = Trim(Mid(line, pos + 1))
        frmMain.ftp.Document = strData
        logfile.AddToLogFile ("ftp.Document = " & strData & vbCrLf)
        Exit Sub
    End If
    
    '------------------------------------------
    'Change local directory (not working)
    'Command format :   [LOCALDIRECTORY] = <directory name>
    'Example :          [LOCALDIRECTORY] = c:\temp\files\
    If InStr(1, LCase(line), "[localdirectory]") > 0 Then
        pos = InStr(1, line, "=")
        strData = Trim(Mid(line, pos + 1))
        'Call FTPCmd("L0CALDIRECTORY", strData)
        logfile.AddToLogFile ("ftp.localdirectory = " & strData & vbCrLf)
        Exit Sub
    End If
    
    '------------------------------------------
    'Chnage remote directory (not working)
    'Command format :     [REMOTEDIRECTORY] = <remote directory>
    'Example :            [REMOTEDIRECTORY] = /root/courinfo/
    If InStr(1, LCase(line), "[remotedirectory]") > 0 Then
        pos = InStr(1, line, "=")
        strData = Trim(Mid(line, pos + 1))
        'Call FTPCmd("REMOTEDIRECTORY", strData)
        logfile.AddToLogFile ("ftp.remotedirectory = " & strData & vbCrLf)
        Exit Sub
    End If
    
    '------------------------------------------
    'Delete a remote file
    'Command format :     [DELETEREMOTEFILE] = <file spec>
    'Example :            [DELETEREMOTEFILE] = /root/courinfo/display.htm
    'Deletes a specific file from the given remote directory
    'Only deletes one file
    If InStr(1, LCase(line), "[deleteremotefile]") > 0 Then
        pos = InStr(1, line, "=")
        strData = Trim(Mid(line, pos + 1))
        frmMain.ftp.Execute , "DELETE """ & strData & """"
            Do While frmMain.ftp.StillExecuting
                DoEvents
            Loop
        logfile.AddToLogFile ("ftp.delete = " & strData & vbCrLf)
        Exit Sub
    End If
    
    '------------------------------------------
    'Delete all files in a given directory
    'Command format :     [DELETEDIRFILES] = <remote directory>
    'Example :            [DELETEDIRFILES] = /root/courinfo/*.*
    'Deletes all files from the given remote directory
    'First need to find out what files are in the remote directory and
    'then delete one at a time.
    If InStr(1, LCase(line), "[deletedirfiles]") > 0 Then
      pos = InStr(1, line, "=")
      strData = Trim(Mid(line, pos + 1))
        DeleteRmtDirContents (strData)
        logfile.AddToLogFile ("ftp.delete = " & strData & vbCrLf)
        Exit Sub
    End If
    
    '------------------------------------------
    'Command format :     [CD] = <remote directory>
    'Example :            [CD] = /root/courinfo/
    'Change directory
    If InStr(1, LCase(line), "[cd]") > 0 Then
        pos = InStr(1, line, "=")
        strData = Trim(Mid(line, pos + 1))
        frmMain.ftp.Execute , "CD & strData & chr(34)"
            Do While frmMain.ftp.StillExecuting
                DoEvents
            Loop
        logfile.AddToLogFile ("ftp.Execute CD " & strData & vbCrLf)
        Exit Sub
    End If
    
    '------------------------------------------
    'Command format :     [PUT] = <local file name> ; <remote file name>
    'Example :            [PUT] = C:\Temp\tofilename.txt ; fromfilename.txt
    'FTP single file onto the server
    If InStr(1, LCase(line), "[put]") > 0 Then
        pos = InStr(1, line, "=")
        strData = Trim(Mid(line, pos + 1))
        
        strFiles = Split(strData, ";")
        strLocal = Trim(strFiles(0))
        strRemote = Trim(strFiles(1))
            
        frmMain.ftp.Execute , "PUT """ & strLocal & """ " & strRemote
            Do While frmMain.ftp.StillExecuting
                DoEvents
            Loop
          logfile.AddToLogFile ("ftp.Execute , 'put' " & strData & vbCrLf)
        Exit Sub
    End If
    
    '------------------------------------------
    'Command format :       [PUTFILES] = <local directory> ; <remote directory>
    'Example :              [PUTFILES] = C:\TEMP\ ; /test/
    'Puts files from the local drive on to the remote server
    'PUT over rights the remote files
    If InStr(1, LCase(line), "[putfiles]") > 0 Then
        pos = InStr(1, line, "=")