|
VERSION 2.00
Begin Form frmConnect
BackColor = &H00C0C0C0&
BorderStyle = 3 'Fixed Double
Caption = "Ftp Connect"
ClientHeight = 2460
ClientLeft = 3030
ClientTop = 2325
ClientWidth = 3885
ControlBox = 0 'False
Height = 2865
Left = 2970
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2460
ScaleWidth = 3885
Top = 1980
Width = 4005
Begin CommandButton cmdCancel
Cancel = -1 'True
Caption = "Cancel"
Height = 435
Left = 2100
TabIndex = 9
TabStop = 0 'False
Top = 1800
Width = 1035
End
Begin CommandButton cmdConnect
Caption = "Connect"
Default = -1 'True
Height = 435
Left = 660
TabIndex = 8
TabStop = 0 'False
Top = 1800
Width = 1035
End
Begin TextBox txtLogonID
Height = 345
Left = 1260
TabIndex = 5
Top = 900
Width = 2415
End
Begin TextBox txtPassword
Height = 345
Left = 1260
PasswordChar = "*"
TabIndex = 7
Top = 1320
Width = 2415
End
Begin TextBox txtIPAddress
Height = 345
Left = 1260
TabIndex = 3
Top = 480
Width = 2415
End
Begin ComboBox cboHostName
Height = 300
Left = 1260
Sorted = -1 'True
TabIndex = 1
Top = 120
Width = 2415
End
Begin Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Password:"
Height = 195
Left = 240
TabIndex = 6
Top = 1440
Width = 885
End
Begin Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Logon ID:"
Height = 195
Left = 300
TabIndex = 4
Top = 1020
Width = 855
End
Begin Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "IP Address:"
Height = 195
Left = 180
TabIndex = 2
Top = 600
Width = 990
End
Begin Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Host Name:"
Height = 195
Left = 180
TabIndex = 0
Top = 180
Width = 1005
End
End
Option Explicit
Sub cboHostName_Change ()
'enable button if a host is entered
If (Len(cboHostName.Text) > 0 Or Len(txtIPAddress.Text) > 0) Then
cmdConnect.Enabled = True
Else
cmdConnect.Enabled = False
End If
End Sub
Sub cboHostName_LostFocus ()
Dim intLpCnt As Integer
Dim intRC As Integer
Dim intFound As Integer
Dim strMachineName As String
On Error Resume Next
'set the socket to connect to the entry
'this does a DNS (Domain Name Search) to find the address
frmClient.Socket1.HostName = Trim(cboHostName.Text)
txtIPAddress.Text = frmClient.Socket1.HostAddress
If Err = WSANO_DATA Then
MsgBox "Invalid host - " & cboHostName.Text
cboHostName.Text = ""
txtIPAddress.Text = ""
Else
intFound = False
For intLpCnt = 0 To (cboHostName.ListCount - 1)
If cboHostName.List(intLpCnt) = cboHostName.Text Then intFound = True
Next intLpCnt
If Not intFound Then
cboHostName.AddItem cboHostName.Text
'update ini
intMachineCnt = intMachineCnt + 1
strMachineName = "Machine" & intMachineCnt
intRC = WritePrivateProfileString("Machine Count", "Counter", Str$(intMachineCnt), "vbftp.ini")
intRC = WritePrivateProfileString("VBFTP", strMachineName, cboHostName.Text, "vbftp.ini")
End If
End If
End Sub
Sub cmdCancel_Click ()
'we don't want to lose the entries in the combo box
Me.Hide
End Sub
Sub cmdConnect_Click ()
Dim intRC As Integer
Dim strCtlData As String
Me.MousePointer = 11
cmdConnect.Enabled = False
cmdCancel.Enabled = False
'if no userid, prompt for anonymous login
If Trim$(txtLogonID.Text) = "" Then
If txtPassword.Text = "" Then
'anon logon requires password of userid@machineid
txtPassword.Text = InputBox$("Please enter your E-mail address in the form UserName@MachineName.", "VBFTP")
End If
If txtPassword.Text <> "" Then txtLogonID = "anonymous"
End If
'call connect function with host name
If Not FTPConnect(Trim$(cboHostName.Text)) Then
'wipe the socket if the connect failed
frmClient.Socket1.Action = SOCKET_FLUSH
frmClient.Socket1.Action = SOCKET_ABORT
MsgBox "Could not connect with " & cboHostName.Text
cmdConnect.Enabled = True
cmdCancel.Enabled = True
Me.MousePointer = 0
Exit Sub
End If
'now log into the remote host
If Not FTPLogin(Trim$(txtLogonID.Text), Trim$(txtPassword.Text)) Then
Me.MousePointer = 0
'close socket if login failed
If ftpcommand("QUIT") Then intRC = FTPResult(strCtlData)
frmClient.Socket1.Action = SOCKET_CLOSE
MsgBox "Invalid logon - Please check and try again."
cmdConnect.Enabled = True
cmdCancel.Enabled = True
Exit Sub
End If
'set the screen titles
frmClient.lblHostName.Caption = frmClient.Socket1.HostName
frmClient.lblIPAddress.Caption = frmClient.Socket1.HostAddress
'get the present directory and file list on the remote host
FTPGetDirectory
frmClient.mnuSessionConnect.Enabled = False
frmClient.mnuSessionDisconnect.Enabled = True
frmClient.mnuSessionChange.Enabled = True
frmClient.cmdRemRef.Enabled = True
cmdConnect.Enabled = True
cmdCancel.Enabled = True
Me.MousePointer = 0
Me.Hide
End Sub
Sub Form_Load ()
Dim strHost As String
'read the host file
On Error Resume Next
'get list of hosts and their related IP addresses
frmClient.Socket1.HostFile = "HOSTS"
If Err = 0 Then
'set the host to the first host in the list
strHost = frmClient.Socket1.GetFirstHost
While strHost <> ""
'add the host to the host listbox
cboHostName.AddItem strHost
'get the next host
strHost = frmClient.Socket1.GetNextHost
Wend
End If
'clear the socket hostfile
frmClient.Socket1.HostFile = ""
End Sub
Sub txtIPAddress_Change ()
'enable the button if an address has been entered
If Len(cboHostName.Text) > 0 Or Len(txtIPAddress.Text) > 0 Then
cmdConnect.Enabled = True
Else
cmdConnect.Enabled = False
End If
End Sub
Sub txtIPAddress_KeyPress (KeyAscii As Integer)
cboHostName.Text = ""
End Sub
Sub txtIPAddress_LostFocus ()
On Error Resume Next
'set the socket to connect to the entry and find its name
frmClient.Socket1.HostAddress = Trim(txtIPAddress.Text)
'cboHostName.Text = frmClient.Socket1.HostName
If Err = WSANO_DATA Then
MsgBox "That IP address is invalid"
frmClient.Socket1.HostAddress = ""
Else
If cboHostName.Text = "" Then
cboHostName.Text = frmClient.Socket1.HostName
End If
End If
End Sub
|
