home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 April / ChipCD_498.iso / software / ftp / quickftp / quickftp.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-01-30  |  33.9 KB  |  1,058 lines
  1. VERSION 2.00
  2. Begin Form FTP_form 
  3.    BorderStyle     =   3  'Fixed Double
  4.    Caption         =   "Quick FTP  Version 2.2"
  5.    ClientHeight    =   4170
  6.    ClientLeft      =   690
  7.    ClientTop       =   1785
  8.    ClientWidth     =   8010
  9.    Height          =   4860
  10.    Icon            =   QUICKFTP.FRX:0000
  11.    Left            =   630
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    ScaleHeight     =   4170
  15.    ScaleWidth      =   8010
  16.    Top             =   1155
  17.    Width           =   8130
  18.    Begin ListBox messagelist 
  19.       Height          =   810
  20.       Left            =   0
  21.       TabIndex        =   12
  22.       Top             =   2880
  23.       Width           =   8055
  24.    End
  25.    Begin Socket Socket1 
  26.       Backlog         =   1
  27.       Binary          =   -1  'True
  28.       Blocking        =   -1  'True
  29.       Broadcast       =   0   'False
  30.       BufferSize      =   0
  31.       HostAddress     =   ""
  32.       HostFile        =   ""
  33.       HostName        =   ""
  34.       InLine          =   0   'False
  35.       Interval        =   0
  36.       KeepAlive       =   0   'False
  37.       Left            =   4440
  38.       Linger          =   0
  39.       LocalPort       =   0
  40.       LocalService    =   ""
  41.       Peek            =   0   'False
  42.       Protocol        =   0
  43.       RecvLen         =   0
  44.       RemotePort      =   0
  45.       RemoteService   =   ""
  46.       ReuseAddress    =   0   'False
  47.       Route           =   -1  'True
  48.       SendLen         =   0
  49.       TabIndex        =   9
  50.       Timeout         =   0
  51.       Top             =   0
  52.       Type            =   1
  53.       Urgent          =   0   'False
  54.    End
  55.    Begin Socket Socket2 
  56.       Backlog         =   1
  57.       Binary          =   -1  'True
  58.       Blocking        =   -1  'True
  59.       Broadcast       =   0   'False
  60.       BufferSize      =   0
  61.       HostAddress     =   ""
  62.       HostFile        =   ""
  63.       HostName        =   ""
  64.       InLine          =   0   'False
  65.       Interval        =   0
  66.       KeepAlive       =   0   'False
  67.       Left            =   5040
  68.       Linger          =   0
  69.       LocalPort       =   0
  70.       LocalService    =   ""
  71.       Peek            =   0   'False
  72.       Protocol        =   0
  73.       RecvLen         =   0
  74.       RemotePort      =   0
  75.       RemoteService   =   ""
  76.       ReuseAddress    =   0   'False
  77.       Route           =   -1  'True
  78.       SendLen         =   0
  79.       TabIndex        =   8
  80.       Timeout         =   0
  81.       Top             =   0
  82.       Type            =   1
  83.       Urgent          =   0   'False
  84.    End
  85.    Begin Timer Timer2 
  86.       Enabled         =   0   'False
  87.       Interval        =   1000
  88.       Left            =   3960
  89.       Top             =   0
  90.    End
  91.    Begin TextBox Cycle_sec 
  92.       Height          =   285
  93.       Left            =   7320
  94.       TabIndex        =   6
  95.       Text            =   "0"
  96.       Top             =   80
  97.       Width           =   615
  98.    End
  99.    Begin ListBox Dir_list 
  100.       Height          =   2175
  101.       Left            =   0
  102.       Sorted          =   -1  'True
  103.       TabIndex        =   4
  104.       Top             =   720
  105.       Width           =   8055
  106.    End
  107.    Begin Label lblStatus 
  108.       Caption         =   "Not connected"
  109.       Height          =   255
  110.       Left            =   1320
  111.       TabIndex        =   11
  112.       Top             =   3840
  113.       Width           =   5295
  114.    End
  115.    Begin Label Label4 
  116.       Caption         =   "Status:"
  117.       Height          =   255
  118.       Left            =   240
  119.       TabIndex        =   10
  120.       Top             =   3840
  121.       Width           =   1095
  122.    End
  123.    Begin Label TimeLeft 
  124.       Caption         =   "TimeLeft"
  125.       Height          =   255
  126.       Left            =   6960
  127.       TabIndex        =   7
  128.       Top             =   3840
  129.       Visible         =   0   'False
  130.       Width           =   855
  131.    End
  132.    Begin Label Label2 
  133.       Caption         =   "cycle time (sec):"
  134.       Height          =   255
  135.       Left            =   5760
  136.       TabIndex        =   5
  137.       Top             =   120
  138.       Width           =   1455
  139.    End
  140.    Begin Line Line1 
  141.       X1              =   0
  142.       X2              =   8040
  143.       Y1              =   3720
  144.       Y2              =   3720
  145.    End
  146.    Begin Label Message 
  147.       Height          =   495
  148.       Left            =   1320
  149.       TabIndex        =   1
  150.       Top             =   4200
  151.       Visible         =   0   'False
  152.       Width           =   4935
  153.    End
  154.    Begin Label Label3 
  155.       BackColor       =   &H00C0C0C0&
  156.       Caption         =   "Messages :"
  157.       Height          =   255
  158.       Left            =   240
  159.       TabIndex        =   3
  160.       Top             =   4200
  161.       Visible         =   0   'False
  162.       Width           =   1095
  163.    End
  164.    Begin Label Host_name 
  165.       BackColor       =   &H00C0C0C0&
  166.       Caption         =   "< Not connected >"
  167.       Height          =   495
  168.       Left            =   840
  169.       TabIndex        =   2
  170.       Top             =   120
  171.       Width           =   4815
  172.    End
  173.    Begin Label Label1 
  174.       BackColor       =   &H00C0C0C0&
  175.       Caption         =   "Host :"
  176.       Height          =   255
  177.       Left            =   240
  178.       TabIndex        =   0
  179.       Top             =   120
  180.       Width           =   615
  181.    End
  182.    Begin Menu Menu_connection 
  183.       Caption         =   "&Host"
  184.       Begin Menu menu_Connection_item 
  185.          Caption         =   "&Connect.."
  186.          Index           =   0
  187.       End
  188.       Begin Menu menu_Connection_item 
  189.          Caption         =   "&Disconnect.."
  190.          Index           =   1
  191.       End
  192.       Begin Menu menu_Connection_item 
  193.          Caption         =   "&Abort"
  194.          Index           =   2
  195.       End
  196.       Begin Menu menu_Connection_item 
  197.          Caption         =   "E&xit"
  198.          Index           =   3
  199.       End
  200.       Begin Menu menu_Connection_item 
  201.          Caption         =   "D&o It All!!"
  202.          Index           =   4
  203.          Visible         =   0   'False
  204.       End
  205.    End
  206.    Begin Menu Menu_file 
  207.       Caption         =   "&Transfer"
  208.       Begin Menu Menu_file_item 
  209.          Caption         =   "&Get.."
  210.          Index           =   0
  211.       End
  212.       Begin Menu Menu_file_item 
  213.          Caption         =   "&Put.."
  214.          Index           =   1
  215.       End
  216.       Begin Menu mnuStopTimer 
  217.          Caption         =   "&Stop Timer"
  218.       End
  219.    End
  220.    Begin Menu Menu_directory 
  221.       Caption         =   "&Directory"
  222.       Begin Menu Menu_directory_item 
  223.          Caption         =   "&Change"
  224.          Index           =   0
  225.       End
  226.       Begin Menu Menu_directory_item 
  227.          Caption         =   "&Parent"
  228.          Index           =   1
  229.       End
  230.       Begin Menu Menu_directory_item 
  231.          Caption         =   "&Dir list"
  232.          Index           =   2
  233.       End
  234.    End
  235.    Begin Menu Menu_settings 
  236.       Caption         =   "&Settings"
  237.       Begin Menu Menu_setting_items 
  238.          Caption         =   "&Ascii type"
  239.          Index           =   0
  240.       End
  241.       Begin Menu Menu_setting_items 
  242.          Caption         =   "&Binary type"
  243.          Index           =   1
  244.       End
  245.       Begin Menu Menu_setting_items 
  246.          Caption         =   "&Mask"
  247.          Index           =   2
  248.          Visible         =   0   'False
  249.       End
  250.    End
  251.    Begin Menu Quote_menu 
  252.       Caption         =   "&Command"
  253.       Begin Menu Quote_command 
  254.          Caption         =   "&Send"
  255.       End
  256.    End
  257.    Begin Menu AboutMenu 
  258.       Caption         =   "&About"
  259.    End
  260. Sub AboutMenu_Click ()
  261.   Dim Msg, endofl
  262.   endofl = Chr$(13) & Chr$(10)
  263.   Msg = "Quick FTP scheduled file transfer utility" & endofl
  264.   Msg = Msg & "was developed using Visual Basic 3.0 and" & endofl
  265.   Msg = Msg & "SocketWrench/VB (TM) Custom Control 1.0" & endofl
  266.   Msg = Msg & "from Catalyst Software (www.earthlink.net)" & endofl
  267.   Msg = Msg & endofl
  268.   Msg = Msg & "Command line may have 0, 7, 8, or 9 arguments in exactly this order:" & endofl
  269.   Msg = Msg & endofl
  270.   Msg = Msg & "QUICKFTP HostName LoginName Password Directory [GET|PUT] SourceFileName DestFileName [ASCII|BINARY] [NOTIFY|SILENT]" & endofl
  271.   Msg = Msg & endofl
  272.   Msg = Msg & "(These last two are optional defaulting to ASCII NOTIFY. Use '?' instead of a parameter to prompt on startup" & endofl
  273.   Msg = Msg & endofl
  274.   Msg = Msg & "For example: QUICKFTP ftp.stolaf.edu anonymous ? pub/origami/WIN GET qckftp21.zip c:/temp/q.zip B N" & endofl
  275.   Msg = Msg & endofl
  276.   Msg = Msg & "Comments: Bob Hanson (hansonr@stolaf.edu)" & endofl
  277.   MsgBox Msg, 64, "About QuickFTP"
  278. End Sub
  279. Sub Cycle_sec_GotFocus ()
  280. '__ FTP_form Cycle_sec_GotFocus
  281. '__   calls     GLOBAL switch_to
  282.  initialcycle = Val(cycle_sec)
  283.  switch_to cycle_sec
  284. End Sub
  285. Sub Cycle_sec_LostFocus ()
  286. '__ FTP_form Cycle_sec_LostFocus
  287. '__   calls     FTP_form ResetTimer
  288.   If initialcycle = Val(cycle_sec) Then Exit Sub
  289.   Call ResetTimer(Val(cycle_sec))
  290. End Sub
  291. Sub Dir_list_Click ()
  292.  clickindex = Dir_list.ListIndex
  293. End Sub
  294. Sub Dir_list_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
  295. '__ FTP_form Dir_list_MouseUp
  296. '__   parameter Button As Integer
  297. '__   parameter Shift As Integer
  298. '__   parameter X As Single
  299. '__   parameter Y As Single
  300.  On Error Resume Next
  301.  If clickindex = -1 Then Exit Sub
  302.  Dir_list.Selected(clickindex) = (olddirclick <> clickindex)
  303.  Menu_directory_item(0).Caption = "&Change Directory"
  304.  olddirclick = clickindex
  305.  If clickindex = -1 Then Exit Sub
  306.  If Dir_list.Selected(clickindex) Then
  307.    Menu_directory_item(0).Caption = "&Change to " & Dir_list.List(Dir_list.ListIndex)
  308.  End If
  309. End Sub
  310. Sub Disable_menus ()
  311. '__ FTP_form Disable_menus
  312. '__   called by FTP_form Do_display_options
  313. '  Menu_connection.Enabled = False
  314.   Menu_file.Enabled = False
  315.   Menu_directory.Enabled = False
  316.   Menu_settings.Enabled = False
  317.   Quote_menu.Enabled = False
  318. End Sub
  319. Sub Do_display_options ()
  320. '__ FTP_form Do_display_options
  321. '__   called by FTP_form DoConnFTPDisc
  322. '__   called by FTP_form DoDisconnect
  323. '__   called by FTP_form getfilenow
  324. '__   called by FTP_form GoToDir
  325. '__   called by FTP_form menu_connection_item_click
  326. '__   called by FTP_form Menu_directory_item_Click
  327. '__   called by FTP_form Menu_setting_items_Click
  328. '__   called by FTP_form putfilenow
  329. '__   called by FTP_form SendFTPCOMMAND
  330. '__   calls     FTP_form Disable_menus
  331.   Disable_menus
  332.   FTP_form!Message.Caption = ""
  333.   FTP_form.MousePointer = 11
  334. End Sub
  335. Sub Do_the_dirlist ()
  336. '__ FTP_form Do_the_dirlist
  337. '__   called by FTP_form Menu_directory_item_Click
  338. '__   called by FTP_form Menu_setting_items_Click
  339. '__   calls     GLOBAL FTPGetDirList
  340. '__   calls     GLOBAL Show_the_dir_list
  341.   'list directory info in a file identified with Dir_file
  342.   'read the contents of that file and put results in
  343.   'listbox Dir_list
  344.   Dim d_File
  345.   Filt$ = MaskType
  346.   d_File = Dir_file
  347.   If Connected Then
  348.     Dir_list.Clear
  349.     clickindex = -1
  350.     success = FTPGetDirList(Socket1, socket2, Message)
  351.     If success Then
  352.       Show_the_dir_list
  353.     Else
  354.       M$ = ctldata
  355.       Message.Caption = M$
  356.     End If
  357.   End If
  358. End Sub
  359. Function DoConnectOnly ()
  360. '__ FTP_form DoConnectOnly
  361. '__   called by FTP_form DoConnFTPDisc
  362. '__   called by FTP_form menu_connection_item_click
  363. '__   calls     GLOBAL FTPConnect
  364. '__   calls     GLOBAL FTPLogin
  365. '__   calls     FTP_form Undo_Display_Options
  366.     Connected = False
  367.     DoConnectOnly = False
  368.     menu_connection.Enabled = False'disallow connect
  369.     FTP_form!Message.Caption = "Logging in " & userid & " to " & hostname
  370.     If Not FTPConnect(hostname, Socket1, Message) Then
  371.             MsgBox "Unable to connect to remote host"
  372.       Ms$ = ctldata
  373.       FTP_form!Message.Caption = Ms$
  374.       FTP_form.Host_name.Caption = "< Not connected >"
  375.             Exit Function
  376.     End If
  377.     If Not FTPLogin(Trim$(userid), Trim$(password), Socket1, socket2, Message) Then
  378.             Undo_Display_Options
  379.             DoConnectOnly = False
  380.             FTP_form.MousePointer = 0
  381.             FTP_form.Socket1.Action = SOCKET_CLOSE
  382.             timer2.Enabled = False
  383.             Ms$ = ctldata
  384.             FTP_form!Message.Caption = Ms$
  385.             FTP_form.Host_name.Caption = "< Not connected >"
  386.             Exit Function
  387.     End If
  388.     Undo_Display_Options
  389.     Connected = True
  390.     DoConnectOnly = True
  391.     FTP_form.Host_name.Caption = hostname
  392. End Function
  393. Sub DoConnFTPDisc ()
  394. '__ FTP_form DoConnFTPDisc
  395. '__   called by FTP_form Form_Load
  396. '__   called by FTP_form menu_connection_item_click
  397. '__   called by FTP_form Timer2_Timer
  398. '__   calls     GLOBAL FTPGetDirectory
  399. '__   calls     GLOBAL FTPSetDirectory
  400. '__   calls     GLOBAL getword
  401. '__   calls     FTP_form Do_display_options
  402. '__   calls     FTP_form DoConnectOnly
  403. '__   calls     FTP_form DoDisconnect
  404. '__   calls     FTP_form getfilenow
  405. '__   calls     FTP_form putfilenow
  406. '__   calls     FTP_form ResetTimer
  407. '__   calls     FTP_form Undo_Display_Options
  408.     t0 = Timer
  409.     timer2.Enabled = False
  410.     timeleft.Visible = False
  411.     Do_display_options
  412.     If DoConnectOnly() Then
  413.       If serverdirect <> "" Then
  414.         C_dir$ = serverdirect
  415.         Call FTPSetDirectory(C_dir$, Socket1, Message)
  416.       Else
  417.         Call FTPGetDirectory(Socket1, Message)
  418.       End If
  419.       While list_data <> ""
  420.        If list_data = "ENDLIST" Then
  421.          list_data = ""
  422.        Else
  423.          src_name = getword(list_data, "Source file name", "")
  424.          dest_name = getword(list_data, "Destination file name", "")
  425.        End If
  426.        If src_name <> "" And dest_name <> "" Then
  427.         If putmode Then
  428.           Call putfilenow
  429.         Else
  430.           Call getfilenow
  431.         End If
  432.        End If
  433.       Wend
  434.       
  435.       DoDisconnect
  436.     Else
  437.       Ms$ = ctldata
  438.       FTP_form!Message.Caption = Ms$
  439.       FTP_form.Host_name.Caption = "< Not connected >"
  440.     End If
  441.     Undo_Display_Options
  442.     Call ResetTimer(Val(cycle_sec) - (Timer - t0))
  443.     If timer2.Enabled Then FTP_form!Message.Caption = "counting..."
  444. End Sub
  445. Sub DoDisconnect ()
  446. '__ FTP_form DoDisconnect
  447. '__   called by FTP_form DoConnFTPDisc
  448. '__   called by FTP_form menu_connection_item_click
  449. '__   calls     GLOBAL FTPDisconnect
  450. '__   calls     FTP_form Do_display_options
  451. '__   calls     FTP_form Undo_Display_Options
  452.     timer2.Enabled = False
  453.     timeleft.Visible = False
  454.     If Connected Then
  455.       Do_display_options
  456.       Call FTPDisconnect(Socket1)
  457.       Undo_Display_Options
  458.       Connected = False
  459.       FTP_form.Host_name.Caption = "< Not connected >"
  460.       FTP_form.Message.Caption = hostname & " disconnected"
  461.       Dir_list.Clear
  462.       olddirclick = -1
  463.     End If
  464. End Sub
  465. Sub Enable_menus ()
  466. '__ FTP_form Enable_menus
  467. '__   called by FTP_form Menu_directory_item_Click
  468. '__   called by FTP_form Menu_setting_items_Click
  469. '__   called by FTP_form Undo_Display_Options
  470.   menu_connection.Enabled = True
  471.   Menu_file.Enabled = True
  472.   Menu_directory.Enabled = True
  473.   Menu_settings.Enabled = True
  474.   Quote_menu.Enabled = True
  475. End Sub
  476. Function Exit_program () As Integer
  477. '__ FTP_form Exit_program
  478. '__   called by FTP_form Form_QueryUnload
  479.   'give a message box to enable the operator to terminate
  480.   'the program or not
  481.   Dim DgDef, Msg, Response, Title
  482.   Title = "Exit QuickFTP"
  483.   Msg = hostname & " is still connected. Do you want to close the connection and exit?"
  484.   DgDef = MB_YESNO + MB_ICONQUESTION
  485.   Response = MsgBox(Msg, DgDef, Title)
  486.   Exit_program = Response
  487. End Function
  488. Sub Form_Load ()
  489. '__ FTP_form Form_Load
  490. '__   calls     GLOBAL GetTempFileName
  491. '__   calls     GLOBAL getword
  492. '__   calls     FTP_form DoConnFTPDisc
  493. '__   calls     FTP_form menu_connection_item_click
  494.   On Error Resume Next
  495.   Kill logfile
  496.   click_index = -1
  497.   Connected = False
  498.   DirType = False
  499.   transtype = Asc("A")
  500.   MaskType = "" ' if "*.*" then you don't get directories
  501.   hostname = connectform!NodeEdit.Text
  502.   userid = connectform!UserEdit.Text
  503.   password = ""
  504.   serverdirect = connectform!txtDirect
  505.   namebuff$ = String$(100, 0)
  506.   wI = GetTempFileName(0, "QFTP", 0, namebuff$)
  507.   Dir_file = Left$(namebuff$, InStr(namebuff$, Chr(0)) - 1)
  508.   wI = GetTempFileName(0, "QFTP", 0, namebuff$)
  509.   Temp_File = Left$(namebuff$, InStr(namebuff$, Chr(0)) - 1)
  510.   FTP_form.Socket1.HostFile = ""
  511.   FTP_form.Show
  512.   cline = Command$
  513.   'MsgBox CurDir
  514.   CRLF = Chr$(13) & Chr$(10)
  515.   list_data = "ENDLIST"
  516.   If cline <> "" Then 'have automatic process
  517.    hostname = getword(cline, "Host Name", "")
  518.    mess = mess & "Host Name: " & hostname & CRLF
  519.    userid = getword(cline, "Login Name", "")
  520.    mess = mess & "Login Name: " & userid & CRLF
  521.    password = getword(cline, "Password", "HIDDENVALUE")
  522.    serverdirect = getword(cline, "Initial Directory", ".")
  523.    mess = mess & "Initial Directory: " & serverdirect & CRLF & CRLF
  524.    putmode = (UCase(Left(getword(cline, "PUT or GET", "GET") & " ", 1)) = "P")
  525.    If putmode Then
  526.      mess = mess & "PUT "
  527.    Else
  528.      mess = mess & "GET "
  529.    End If
  530.    src_name = getword(cline, "Source File Name", "")
  531.    If Left(src_name, 1) = "<" Then
  532.      listfile = Mid(src_name, 2)
  533.      Open listfile For Binary As #1
  534.      list_data = Space(LOF(1))
  535.      Get 1, 1, list_data
  536.      Close 1
  537.      mess = mess & "From " & src_name & ":" & CRLF & list_data & CRLF
  538.      For i = 1 To Len(list_data)
  539.       If Mid(list_data, i, 1) = Chr(10) Or Mid(list_data, i, 1) = Chr(13) Then
  540.         Mid(list_data, i, 1) = " "
  541.       End If
  542.      Next
  543.    Else
  544.      mess = mess & src_name & CRLF
  545.      dest_name = getword(cline, "Destination File Name", "")
  546.      mess = mess & "--> " & dest_name & CRLF
  547.    End If
  548.    If putmode Then
  549.     Local_File_Name = src_name
  550.     Host_File_Name = dest_name
  551.    Else
  552.     Host_File_Name = src_name
  553.     Local_File_Name = dest_name
  554.    End If
  555.    transtype = Asc(UCase(getword(cline, "ASCII or BINARY", "ASCII")) & " ")
  556.    If transtype = 32 Then transtype = Asc("A")
  557.    If transtype <> Asc("A") Then transtype = Asc("I")
  558.    If transtype = Asc("A") Then
  559.      mess = mess & "mode ASCII"
  560.    Else
  561.      mess = mess & "mode BINARY"
  562.    End If
  563.    silent = UCase(Left(getword(cline, "NOTIFY or SILENT", "NOTIFY") & " ", 1))
  564.    notify = (silent <> "S")
  565.    doitmode = True
  566.    commandmode = True
  567.    ok = ID_OK
  568.    If notify Then ok = MsgBox(mess, MB_OKCANCEL Or MB_QUESTION)
  569.    If ok = ID_OK Then
  570.      DoConnFTPDisc
  571.      If notify Then MsgBox (src_name & " Operation complete")
  572.    End If
  573.    Unload FTP_form
  574.   End If
  575.   menu_connection_item_click (0)
  576. End Sub
  577. Sub Form_QueryUnload (Cancel As Integer, UnloadMode As Integer)
  578. '__ FTP_form Form_QueryUnload
  579. '__   parameter Cancel As Integer
  580. '__   parameter UnloadMode As Integer
  581. '__   calls     FTP_form Exit_program
  582.   'when finishing via - control program checks for connected
  583.   'and gives a message to the operator, he then can decide
  584.   'to finish or not
  585.   'Also a warning will be given when the release was not
  586.   'successful
  587.   If Connected Then
  588.     If Exit_program() = ID_YES Then
  589.       Cancel = False
  590.     Else
  591.       Cancel = True
  592.     End If
  593.   Else
  594.     Cancel = False
  595.   End If
  596. End Sub
  597. Sub Form_Unload (Cancel As Integer)
  598. '__ FTP_form Form_Unload
  599. '__   parameter Cancel As Integer
  600.       On Error Resume Next
  601.       Kill Dir_file
  602.       Kill Temp_File
  603.       If Socket1.Connected Then Socket1.Action = SOCKET_CLOSE
  604.       If socket2.Listening Or socket2.Connected Then socket2.Action = SOCKET_CLOSE
  605.       ti = Timer: While Timer - 1 < ti: DoEvents: Wend
  606.       End                        'exit program
  607. End Sub
  608. Sub getfilenow ()
  609. '__ FTP_form getfilenow
  610. '__   called by FTP_form DoConnFTPDisc
  611. '__   called by FTP_form menu_connection_item_click
  612. '__   called by FTP_form Menu_file_item_Click
  613. '__   called by FTP_form Timer1_Timer
  614. '__   called by FTP_form Timer2_Timer
  615. '__   calls     GLOBAL FTPGetFile
  616. '__   calls     FTP_form Do_display_options
  617. '__   calls     FTP_form ResetTimer
  618. '__   calls     FTP_form Undo_Display_Options
  619. Static going
  620.     If going Then Exit Sub
  621.     going = True
  622.     t0 = Timer
  623.     timer2.Enabled = False
  624.     transferaborted = False
  625.     Do_display_options
  626.     FTP_form!Message.Caption = ""
  627.     FTP_form!lblStatus.Caption = "Getting " & src_name
  628.     success = FTPGetFile(src_name, Temp_File, Socket1, socket2, Message)
  629.     If transferaborted Or Not success Then
  630.       Ms$ = ctldata
  631.       FTP_form!Message.Caption = Ms$
  632.       If notify Or commandmode Then MsgBox Ms$
  633.       lblStatus.Caption = "Ready"
  634.       If transferaborted Then Message.Caption = "File transfer aborted"
  635.     Else
  636.       FTP_form!lblStatus.Caption = "Copying temporary file..."
  637.       On Error Resume Next
  638.       Kill dest_name
  639.       On Error GoTo getfileerror
  640.       FileCopy Temp_File, dest_name
  641.       Kill Temp_File
  642.       If Val(cycle_sec) = 0 Then also = "" Else also = " and counting"
  643.       FTP_form!lblStatus.Caption = "Transfer OK; received " & FileLen(dest_name) & " bytes" & also
  644.     End If
  645.     If Not transferaborted Then Call ResetTimer(Val(cycle_sec) - (Timer - t0))
  646.     Undo_Display_Options
  647.     going = False
  648.     Exit Sub
  649. getfileerror:
  650.     Undo_Display_Options
  651.     If transferaborted Then
  652.       FTP_form!lblStatus.Caption = "Transfer aborted"
  653.       going = False
  654.       Exit Sub
  655.     End If
  656.     If Err = 53 Then Resume Next 'File not found
  657.     mess = Error(Err) & "--"
  658.     If Err = 75 Then   'Access error
  659.       mess = mess & "Retrying..."
  660.       FTP_form!Message.Caption = mess
  661.       DoEvents
  662.       Resume
  663.     End If
  664.     FTP_form!Message.Caption = mess
  665.     Exit Sub
  666. End Sub
  667. Sub GoToDir (C_dir$)
  668. '__ FTP_form GoToDir
  669. '__   parameter C_dir$
  670. '__   called by FTP_form menu_connection_item_click
  671. '__   called by FTP_form Menu_directory_item_Click
  672. '__   calls     GLOBAL FTPSetDirectory
  673. '__   calls     FTP_form Do_display_options
  674. '__   calls     FTP_form Menu_directory_item_Click
  675. '__   calls     FTP_form Undo_Display_Options
  676.     Do_display_options
  677.       FTP_form!lblStatus.Caption = "Changing directory to " & C_dir$
  678.       Call FTPSetDirectory(C_dir$, Socket1, Message)
  679.       Undo_Display_Options
  680.       Ms$ = ctldata
  681.       FTP_form!Message.Caption = Ms$
  682.       Call Menu_directory_item_Click(2)
  683. End Sub
  684. Sub lblStatus_Change ()
  685. ' logmessage lblStatus
  686. End Sub
  687. Sub logmessage (Message)
  688. '__ FTP_form logmessage
  689. '__   parameter Message
  690. '__   called by FTP_form Message_Change
  691.  If Val(Message) > 0 Then Exit Sub
  692.  messagelist.AddItem Message
  693.  messagelist.TopIndex = messagelist.ListCount - 1
  694.  messagelist.Refresh
  695. On Error Resume Next
  696. unit = FreeFile
  697. Open LogFileName For Append As #unit
  698. Print #unit, Time$ & " " & Message
  699. Close unit
  700. End Sub
  701. Sub Menu_connection_Click ()
  702.   'set menu active depending on connection
  703.   'connect
  704.   menu_connection_item(0).Enabled = (Connected = False)
  705.   'disconnect
  706.   menu_connection_item(1).Enabled = (Connected = True)
  707.   'abort
  708.   menu_connection_item(2).Enabled = (Connected = True) Or (timer2.Enabled)
  709. End Sub
  710. Sub menu_connection_item_click (Index As Integer)
  711. '__ FTP_form menu_connection_item_click
  712. '__   parameter Index As Integer
  713. '__   called by FTP_form Form_Load
  714. '__   calls     FTP_form Do_display_options
  715. '__   calls     FTP_form DoConnectOnly
  716. '__   calls     FTP_form DoConnFTPDisc
  717. '__   calls     FTP_form DoDisconnect
  718. '__   calls     FTP_form getfilenow
  719. '__   calls     FTP_form GoToDir
  720. '__   calls     FTP_form Menu_directory_item_Click
  721. '__   calls     FTP_form putfilenow
  722. '__   calls     FTP_form Undo_Display_Options
  723.   'do action depending on item
  724.   Select Case Index
  725.   Case 0                    'Connect
  726.     timer2.Enabled = False
  727.     timeleft.Visible = False
  728.     doitmode = False
  729.     src_name = ""
  730.     dest_name = ""
  731.     connectform.Show 1
  732.     If Not OKDialog Then Exit Sub
  733.     messagelist.Clear
  734.     Do_display_options
  735.     If doitmode Then
  736.       DoConnFTPDisc
  737.     Else
  738.       If DoConnectOnly() Then
  739.        If serverdirect <> "" Then
  740.          C_dir$ = serverdirect
  741.          Call GoToDir(C_dir$)
  742.        Else
  743.          Call Menu_directory_item_Click(2)
  744.        End If
  745.        If cyclemode And src_name <> "" And dest_name <> "" Then
  746.          If putmode Then
  747.           Call putfilenow
  748.          Else
  749.           Call getfilenow
  750.          End If
  751.        End If
  752.       End If
  753.     End If
  754.     Undo_Display_Options
  755.   Case 1                    'Disconnect
  756.     DoDisconnect
  757.   Case 2                    'Abort
  758.     timeleft.Visible = False
  759.     If timer2.Enabled Then
  760.       FTP_form!lblStatus.Caption = "Timer stopped"
  761.       FTP_form!Message.Caption = ""
  762.     End If
  763.     timer2.Enabled = False
  764.     transferaborted = True
  765.   Case 3                    'Exit
  766.     Unload FTP_form
  767.   Case 4                          'do full cycle-connect,ftp,disconnect
  768.     Call DoConnFTPDisc
  769.   End Select
  770. End Sub
  771. Sub Menu_directory_Click ()
  772.   'set menu active depending on connection
  773.   'change
  774.   Menu_directory_item(0).Enabled = (Connected = True)
  775.   'parent
  776.   Menu_directory_item(1).Enabled = (Connected = True)
  777.   'dir list
  778.   Menu_directory_item(2).Enabled = (Connected = True)
  779. End Sub
  780. Sub Menu_directory_item_Click (Index As Integer)
  781. '__ FTP_form Menu_directory_item_Click
  782. '__   parameter Index As Integer
  783. '__   called by FTP_form GoToDir
  784. '__   called by FTP_form menu_connection_item_click
  785. '__   calls     GLOBAL getinput
  786. '__   calls     FTP_form Do_display_options
  787. '__   calls     FTP_form Do_the_dirlist
  788. '__   calls     FTP_form Enable_menus
  789. '__   calls     FTP_form GoToDir
  790. '__   calls     FTP_form SendFTPCOMMAND
  791.   Dim C_dir$
  792.   Select Case Index
  793.   Case 0          'change
  794.     If Dir_list.ListIndex > 0 Then
  795.        C_dir$ = Dir_list.List(Dir_list.ListIndex)
  796.     Else
  797.        C_dir$ = Getinput("Directory Name", serverdirect)
  798.     End If
  799.     Call GoToDir(C_dir$)
  800.   Case 1          'parent
  801.     C_dir$ = ".."
  802.     Call GoToDir(C_dir$)
  803.   Case 2
  804.     DirType = False
  805.     Do_display_options
  806.     FTP_form!lblStatus.Caption = "Getting directory info"
  807.     Do_the_dirlist
  808.     Call SendFTPCOMMAND("pwd", result$)
  809.     iq = InStr(result$, Chr(34))
  810.     If iq > 0 Then
  811.       result$ = Mid$(result$, iq + 1)
  812.       iq = InStr(result$, Chr(34))
  813.       If iq > 0 Then
  814.         result$ = Left$(result$, iq - 1)
  815.         Menu_directory_item(2).Caption = "&List of " & result$
  816.         serverdirect = result$
  817.         Host_name = hostname & "   " & result$
  818.       End If
  819.     End If
  820.     FTP_form.MousePointer = 0
  821.     Enable_menus
  822.     lblStatus = "Ready"
  823.   End Select
  824. End Sub
  825. Sub Menu_file_Click ()
  826.   'set menu active depending on connection
  827.   'get
  828.   Menu_File_item(0).Enabled = (Connected = True)
  829.   Menu_File_item(0).Checked = Not putmode
  830.   'put
  831.   Menu_File_item(1).Enabled = (Connected = True)
  832.   Menu_File_item(1).Checked = putmode
  833.   MnuStopTimer.Enabled = timer2.Enabled
  834. End Sub
  835. Sub Menu_file_item_Click (Index As Integer)
  836. '__ FTP_form Menu_file_item_Click
  837. '__   parameter Index As Integer
  838. '__   calls     FTP_form getfilenow
  839. '__   calls     FTP_form putfilenow
  840.   Select Case Index
  841.   Case 0      'get
  842.     putmode = False
  843.     Get_file.Show 1
  844.     If Not OKDialog Then Exit Sub
  845.     '
  846.     Call getfilenow
  847.    Case 1      'put
  848.     putmode = True
  849.     Get_file.Show 1
  850.     If Not OKDialog Then Exit Sub
  851.     Call putfilenow
  852.   End Select
  853. End Sub
  854. Sub Menu_setting_items_Click (Index As Integer)
  855. '__ FTP_form Menu_setting_items_Click
  856. '__   parameter Index As Integer
  857. '__   calls     GLOBAL Get_mask_type
  858. '__   calls     FTP_form Do_display_options
  859. '__   calls     FTP_form Do_the_dirlist
  860. '__   calls     FTP_form Enable_menus
  861.   Select Case Index
  862.   Case 0                     'Ascii
  863.     transtype = Asc("A")
  864.   Case 1                     'binary
  865.     transtype = Asc("I")
  866.   Case 2                     'mask
  867.     MaskType = Get_mask_type()
  868.     Do_display_options
  869.     Do_the_dirlist
  870.     FTP_form.MousePointer = 0
  871.     Enable_menus
  872.   End Select
  873. End Sub
  874. Sub Menu_settings_Click ()
  875.   Menu_setting_items(0).Checked = (transtype = Asc("A"))
  876.   Menu_setting_items(1).Checked = (transtype = Asc("I"))
  877.   Menu_setting_items(0).Enabled = (Connected = True)
  878.   Menu_setting_items(1).Enabled = (Connected = True)
  879.   Menu_setting_items(2).Enabled = (Connected = True)
  880. End Sub
  881. Sub Message_Change ()
  882. '__ FTP_form Message_Change
  883. '__   calls     FTP_form logmessage
  884.  logmessage Message
  885. End Sub
  886. Sub mnuStopTimer_Click ()
  887.     timeleft.Visible = False
  888.     FTP_form!lblStatus.Caption = "Timer stopped"
  889.     timer2.Enabled = False
  890. End Sub
  891. Sub putfilenow ()
  892. '__ FTP_form putfilenow
  893. '__   called by FTP_form DoConnFTPDisc
  894. '__   called by FTP_form menu_connection_item_click
  895. '__   called by FTP_form Menu_file_item_Click
  896. '__   called by FTP_form Timer2_Timer
  897. '__   calls     GLOBAL FTPPutFile
  898. '__   calls     FTP_form Do_display_options
  899. '__   calls     FTP_form ResetTimer
  900. '__   calls     FTP_form Undo_Display_Options
  901. Static going
  902.     If going Then Exit Sub
  903.     going = True
  904.     t0 = Timer
  905.     timer2.Enabled = False
  906.     transferaborted = False
  907.     Do_display_options
  908.     FTP_form!Message.Caption = ""
  909.     FTP_form!lblStatus.Caption = "Putting " & src_name & " (" & FileLen(src_name) & " bytes)"
  910.     success = FTPPutFile(src_name, dest_name, Socket1, socket2, Message)
  911.     If transferaborted Then
  912.         Message.Caption = "File transfer aborted. Host data is probably corrupt."
  913.         If notify Or commandmode Then MsgBox Message.Caption
  914.     ElseIf Not success Then
  915.         Ms$ = "Error in transmission: " & ctldata
  916.         FTP_form!Message.Caption = Ms$
  917.         If notify Or commandmode Then MsgBox Ms$
  918.     Else
  919.         FTP_form!lblStatus.Caption = "Transfer OK"
  920.     End If
  921.     If Not transferaborted Then Call ResetTimer(Val(cycle_sec) - (Timer - t0))
  922.     Undo_Display_Options
  923.     going = False
  924.     Exit Sub
  925. putfileerror:
  926.     Undo_Display_Options
  927.     If Err = 53 Then Resume Next 'File not found
  928.     mess = Error(Err) & "--"
  929.     If Err = 75 Then   'Access error
  930.       mess = mess & "Retrying..."
  931.       FTP_form!Message.Caption = mess
  932.       DoEvents
  933.       Resume
  934.     End If
  935.     FTP_form!Message.Caption = mess
  936.     Exit Sub
  937. End Sub
  938. Sub Quote_command_Click ()
  939. '__ FTP_form Quote_command_Click
  940. '__   calls     FTP_form SendFTPCOMMAND
  941.   'execute a command not implemented as standard command
  942.   'in FTP4W.BAS
  943.   Dim answ$, DefVal, Msg, Title
  944.   DefVal = ""
  945.   Msg = "Enter FTP command : "
  946.   Title = "Quote option for FTP"
  947.   answ$ = InputBox$(Msg, Title, DefVal)
  948.   If Len(Trim$(answ$)) = 0 Then
  949.     Exit Sub
  950.   Else
  951.     Call SendFTPCOMMAND(answ$, result$)
  952.   End If
  953. End Sub
  954. Sub Quote_menu_Click ()
  955.   Quote_command.Enabled = (Connected = True)
  956. End Sub
  957. Sub ResetTimer (tim)
  958. '__ FTP_form ResetTimer
  959. '__   parameter tim
  960. '__   called by FTP_form Cycle_sec_LostFocus
  961. '__   called by FTP_form DoConnFTPDisc
  962. '__   called by FTP_form getfilenow
  963. '__   called by FTP_form putfilenow
  964.     ttime = tim
  965.     If ttime < 10 Then ttime = 10
  966.     If Val(cycle_sec) > 0 Then
  967.       timer2.Enabled = True
  968.       timeleft = Int(ttime)
  969.       timeleft.Visible = True
  970.     Else
  971.       timer2.Enabled = False
  972.       timeleft.Visible = False
  973.       cycle_sec = 0
  974.     End If
  975. End Sub
  976. Sub SendFTPCOMMAND (commnd$, result As String)
  977. '__ FTP_form SendFTPCOMMAND
  978. '__   parameter commnd$
  979. '__   parameter result As String
  980. '__   called by FTP_form Menu_directory_item_Click
  981. '__   called by FTP_form Quote_command_Click
  982. '__   calls     GLOBAL FTPcommand
  983. '__   calls     GLOBAL FTPResult
  984. '__   calls     FTP_form Do_display_options
  985. '__   calls     FTP_form Undo_Display_Options
  986.     Do_display_options
  987.     success = FTPcommand(commnd$, Socket1, Message)
  988.     If Not success Then
  989.         If notify Or commandmode Then MsgBox ctldata
  990.     End If
  991.     r = FTPResult(Socket1, Message)'don't take this out!
  992.     Undo_Display_Options
  993.     M$ = ctldata
  994.     FTP_form!Message.Caption = M$
  995.     result = ctldata
  996. End Sub
  997. Sub Socket1_Close ()
  998. '__ FTP_form Socket1_Close
  999. '__   calls     FTP_form Undo_Display_Options
  1000.     Socket1.Action = SOCKET_CLOSE
  1001.     FTP_form.Host_name.Caption = "< Not connected >"
  1002.     FTP_form.lblStatus.Caption = "Not connected"
  1003.     FTP_form.Message.Caption = hostname & " disconnected"
  1004.     Connected = False
  1005.     Undo_Display_Options
  1006. End Sub
  1007. Sub Socket2_Close ()
  1008. '__ FTP_form Socket2_Close
  1009. '__   calls     FTP_form Undo_Display_Options
  1010.     FTP_form.Host_name.Caption = "< Not connected >"
  1011.     FTP_form!lblStatus.Caption = "Not connected"
  1012.     FTP_form.Message.Caption = hostname & " disconnected"
  1013.     Connected = False
  1014.     Undo_Display_Options
  1015. End Sub
  1016. Sub Timer1_Timer ()
  1017. '__ FTP_form Timer1_Timer
  1018. '__   calls     FTP_form getfilenow
  1019.    timer2.Enabled = False
  1020.    timeleft.Visible = False
  1021.    Call getfilenow
  1022. End Sub
  1023. Sub Timer2_Timer ()
  1024. '__ FTP_form Timer2_Timer
  1025. '__   calls     FTP_form DoConnFTPDisc
  1026. '__   calls     FTP_form getfilenow
  1027. '__   calls     FTP_form putfilenow
  1028.  If Not timer2.Enabled Then Exit Sub
  1029.  timeleft = timeleft - 1
  1030.  If timeleft > 0 Then Exit Sub
  1031.    timeleft = 0
  1032.    timer2.Enabled = False
  1033.    timeleft.Visible = False
  1034.    If doitmode Then
  1035.      Call DoConnFTPDisc
  1036.    ElseIf putmode Then
  1037.      Call putfilenow
  1038.    Else
  1039.      Call getfilenow
  1040.    End If
  1041. End Sub
  1042. Sub Undo_Display_Options ()
  1043. '__ FTP_form Undo_Display_Options
  1044. '__   called by FTP_form DoConnectOnly
  1045. '__   called by FTP_form DoConnFTPDisc
  1046. '__   called by FTP_form DoDisconnect
  1047. '__   called by FTP_form getfilenow
  1048. '__   called by FTP_form GoToDir
  1049. '__   called by FTP_form menu_connection_item_click
  1050. '__   called by FTP_form putfilenow
  1051. '__   called by FTP_form SendFTPCOMMAND
  1052. '__   called by FTP_form Socket1_Close
  1053. '__   called by FTP_form Socket2_Close
  1054. '__   calls     FTP_form Enable_menus
  1055.   FTP_form.MousePointer = 0
  1056.   Enable_menus
  1057. End Sub
  1058.