frmmain.frm

simple vb ftp file tranfer project code

VERSION 5.00
Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "MSINET.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmMain 
   Caption         =   "FTP"
   ClientHeight    =   6225
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8595
   LinkTopic       =   "Form1"
   ScaleHeight     =   6225
   ScaleWidth      =   8595
   StartUpPosition =   2  'CenterScreen
   Begin VB.Frame Frame2 
      Height          =   4695
      Left            =   120
      TabIndex        =   4
      Top             =   1200
      Width           =   8295
      Begin VB.CommandButton cmdSave 
         Caption         =   "Save file"
         Height          =   375
         Left            =   360
         TabIndex        =   6
         Top             =   4080
         Width           =   975
      End
      Begin VB.TextBox txtVBFTP 
         Height          =   3375
         Left            =   240
         MultiLine       =   -1  'True
         ScrollBars      =   3  'Both
         TabIndex        =   5
         Top             =   480
         Width           =   7815
      End
      Begin VB.Label Label3 
         Caption         =   "vbftp.txt file"
         Height          =   375
         Left            =   240
         TabIndex        =   7
         Top             =   240
         Width           =   2895
      End
   End
   Begin VB.Frame Frame1 
      Height          =   975
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   8295
      Begin VB.CommandButton cmdExit 
         Caption         =   "Exit"
         Height          =   375
         Left            =   6720
         TabIndex        =   8
         Top             =   360
         Width           =   975
      End
      Begin VB.CommandButton cmdGo 
         Caption         =   "Do FTP actions"
         Height          =   375
         Left            =   3840
         TabIndex        =   3
         Top             =   360
         Width           =   1455
      End
      Begin VB.Label Label1 
         Caption         =   "Click on the 'Do FTP actions' button to action the details in the vbftp.txt text file"
         Height          =   375
         Left            =   240
         TabIndex        =   2
         Top             =   360
         Width           =   3015
      End
   End
   Begin InetCtlsObjects.Inet ftp 
      Left            =   240
      Top             =   480
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      Protocol        =   2
      RemotePort      =   21
      URL             =   "ftp://"
   End
   Begin MSComctlLib.StatusBar SBMain 
      Align           =   2  'Align Bottom
      Height          =   240
      Left            =   0
      TabIndex        =   0
      Top             =   5985
      Width           =   8595
      _ExtentX        =   15161
      _ExtentY        =   423
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   1
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            AutoSize        =   2
            Bevel           =   0
            Object.Width           =   3757
            Text            =   "Upload Progress Information"
            TextSave        =   "Upload Progress Information"
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'**********************************************
Private Sub cmdExit_Click()
    End
End Sub
'**********************************************
Private Sub cmdGo_Click()
  
Dim clsFTP As New clsTransfer
Dim logfile As New clsLogFile

  'Delete logfile when start up
  'logfile.DeleteLogFile

  SaveFile    'save the file first

  logfile.AddToLogFile ("********************" & vbCrLf)
  logfile.AddToLogFile ("FTP started at " & Now() & vbCrLf)

  Screen.MousePointer = vbHourglass
  
  clsFTP.DoTransfer ("")
  
  Screen.MousePointer = vbDefault

End Sub
'**********************************************
Private Sub SaveFile()

Dim logfile As New clsLogFile

On Error GoTo Err_Save

    Dim strFileName As String
    Dim strBackUp As String
    Dim strResult As String

    strFileName = App.Path & "\vbftp.txt"
    strBackUp = App.Path & "\vbftp.bak"

    Const forReading = 1, ForWriting = 2, ForAppending = 8
    Dim fs, f
    Set fs = CreateObject("Scripting.FileSystemObject")

    fs.CopyFile strFileName, strBackUp  'make a backup first
    Set f = fs.OpenTextFile(strFileName, ForWriting, True)
    strResult = frmMain.txtVBFTP.text

    f.Write (strResult)
    f.Close

Exit_Save:
    Exit Sub

Err_Save:

    If Command$ = "" Then
        MsgBox Err.Number & " " & Err.Description
    Else
      logfile.AddToLogFile ("Error saving file vbftp.txt " & vbCrLf)
    End If
    
    Screen.MousePointer = vbDefault
    
    End
    
    Resume Exit_Save

End Sub
'**********************************************
Private Sub cmdSave_Click()

SaveFile
MsgBox ("File save")
Call Form_Load

End Sub
'**********************************************
Private Sub Form_Load()

Dim logfile As New clsLogFile

On Error GoTo Err_Form_Load

    Dim strFileName As String
    Dim strLine As String
    Dim strResult As String

    strLine = ""

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

    Const forReading = 1, ForWriting = 2, ForAppending = 8
    Dim fs, f
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.OpenTextFile(strFileName, forReading, False)
    
    Do While f.AtEndOfStream <> True
    
      'frmMain.txtVBFTP = f.ReadAll
      strLine = f.ReadLine

      strResult = strResult & strLine & vbCrLf

    Loop
    
    frmMain.txtVBFTP = strResult
    
    f.Close

Exit_Form_Load:
    Exit Sub

Err_Form_Load:
    
    If Command$ = "" Then
        MsgBox Err.Number & " " & Err.Description
    Else
      logfile.AddToLogFile ("Error at start up " & vbCrLf)
    End If
    
    Screen.MousePointer = vbDefault
    
    End
    
    Resume Exit_Form_Load

End Sub
'**********************************************
Private Sub ftp_StateChanged(ByVal State As Integer)

    SBMain.Panels(1).text = GetState(State)

    If State = icResponseCompleted Then ' (12)
        STRCONTENT = GetChunk()
    End If

End Sub
'******************************************
Function GetChunk() As String

Dim strChunk As String
Dim strText As String

strText = ""
strChunk = ""

Do
    DoEvents
    strChunk = frmMain.ftp.GetChunk(1024, icString)
    If Len(strChunk) = 0 Then Exit Do
    strText = strText & strChunk
Loop

GetChunk = strText

End Function