home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 April / ChipCD_498.iso / software / ftp / quickftp / quickftp.frm < prev    next >
Text File  |  1996-01-30  |  35KB  |  1,239 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. End
  261.  
  262.  
  263. Sub AboutMenu_Click ()
  264.   '
  265.   Dim Msg, endofl
  266.   endofl = Chr$(13) & Chr$(10)
  267.   '
  268.   Msg = "Quick FTP scheduled file transfer utility" & endofl
  269.   Msg = Msg & "was developed using Visual Basic 3.0 and" & endofl
  270.   Msg = Msg & "SocketWrench/VB (TM) Custom Control 1.0" & endofl
  271.   Msg = Msg & "from Catalyst Software (www.earthlink.net)" & endofl
  272.   Msg = Msg & endofl
  273.   Msg = Msg & "Command line may have 0, 7, 8, or 9 arguments in exactly this order:" & endofl
  274.   Msg = Msg & endofl
  275.   Msg = Msg & "QUICKFTP HostName LoginName Password Directory [GET|PUT] SourceFileName DestFileName [ASCII|BINARY] [NOTIFY|SILENT]" & endofl
  276.   Msg = Msg & endofl
  277.   Msg = Msg & "(These last two are optional defaulting to ASCII NOTIFY. Use '?' instead of a parameter to prompt on startup" & endofl
  278.   Msg = Msg & endofl
  279.   Msg = Msg & "For example: QUICKFTP ftp.stolaf.edu anonymous ? pub/origami/WIN GET qckftp21.zip c:/temp/q.zip B N" & endofl
  280.   Msg = Msg & endofl
  281.   Msg = Msg & "Comments: Bob Hanson (hansonr@stolaf.edu)" & endofl
  282.   
  283.   '
  284.   MsgBox Msg, 64, "About QuickFTP"
  285.   '
  286. End Sub
  287.  
  288. Sub Cycle_sec_GotFocus ()
  289. '__
  290. '__ FTP_form Cycle_sec_GotFocus
  291. '__   calls     GLOBAL switch_to
  292. '__
  293.  initialcycle = Val(cycle_sec)
  294.  switch_to cycle_sec
  295. End Sub
  296.  
  297. Sub Cycle_sec_LostFocus ()
  298. '__
  299. '__ FTP_form Cycle_sec_LostFocus
  300. '__   calls     FTP_form ResetTimer
  301. '__
  302.   If initialcycle = Val(cycle_sec) Then Exit Sub
  303.   Call ResetTimer(Val(cycle_sec))
  304. End Sub
  305.  
  306. Sub Dir_list_Click ()
  307.  clickindex = Dir_list.ListIndex
  308. End Sub
  309.  
  310. Sub Dir_list_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
  311. '__
  312. '__ FTP_form Dir_list_MouseUp
  313. '__
  314. '__   parameter Button As Integer
  315. '__   parameter Shift As Integer
  316. '__   parameter X As Single
  317. '__   parameter Y As Single
  318. '__
  319.  On Error Resume Next
  320.  If clickindex = -1 Then Exit Sub
  321.  Dir_list.Selected(clickindex) = (olddirclick <> clickindex)
  322.  Menu_directory_item(0).Caption = "&Change Directory"
  323.  olddirclick = clickindex
  324.  If clickindex = -1 Then Exit Sub
  325.  If Dir_list.Selected(clickindex) Then
  326.    Menu_directory_item(0).Caption = "&Change to " & Dir_list.List(Dir_list.ListIndex)
  327.  End If
  328. End Sub
  329.  
  330. Sub Disable_menus ()
  331. '__
  332. '__ FTP_form Disable_menus
  333. '__   called by FTP_form Do_display_options
  334. '__
  335.   '
  336. '  Menu_connection.Enabled = False
  337.   Menu_file.Enabled = False
  338.   Menu_directory.Enabled = False
  339.   Menu_settings.Enabled = False
  340.   Quote_menu.Enabled = False
  341.   '
  342. End Sub
  343.  
  344. Sub Do_display_options ()
  345. '__
  346. '__ FTP_form Do_display_options
  347. '__   called by FTP_form DoConnFTPDisc
  348. '__   called by FTP_form DoDisconnect
  349. '__   called by FTP_form getfilenow
  350. '__   called by FTP_form GoToDir
  351. '__   called by FTP_form menu_connection_item_click
  352. '__   called by FTP_form Menu_directory_item_Click
  353. '__   called by FTP_form Menu_setting_items_Click
  354. '__   called by FTP_form putfilenow
  355. '__   called by FTP_form SendFTPCOMMAND
  356. '__   calls     FTP_form Disable_menus
  357. '__
  358.   '
  359.   Disable_menus
  360.   FTP_form!Message.Caption = ""
  361.   FTP_form.MousePointer = 11
  362.   
  363.   '
  364. End Sub
  365.  
  366. Sub Do_the_dirlist ()
  367. '__
  368. '__ FTP_form Do_the_dirlist
  369. '__   called by FTP_form Menu_directory_item_Click
  370. '__   called by FTP_form Menu_setting_items_Click
  371. '__   calls     GLOBAL FTPGetDirList
  372. '__   calls     GLOBAL Show_the_dir_list
  373. '__
  374.   'list directory info in a file identified with Dir_file
  375.   'read the contents of that file and put results in
  376.   'listbox Dir_list
  377.   '
  378.   Dim d_File
  379.   Filt$ = MaskType
  380.   d_File = Dir_file
  381.   If Connected Then
  382.     Dir_list.Clear
  383.     clickindex = -1
  384.     success = FTPGetDirList(Socket1, socket2, Message)
  385.     If success Then
  386.       Show_the_dir_list
  387.     Else
  388.       M$ = ctldata
  389.       Message.Caption = M$
  390.     End If
  391.   End If
  392.   '
  393. End Sub
  394.  
  395. Function DoConnectOnly ()
  396. '__
  397. '__ FTP_form DoConnectOnly
  398. '__   called by FTP_form DoConnFTPDisc
  399. '__   called by FTP_form menu_connection_item_click
  400. '__   calls     GLOBAL FTPConnect
  401. '__   calls     GLOBAL FTPLogin
  402. '__   calls     FTP_form Undo_Display_Options
  403. '__
  404.     Connected = False
  405.     DoConnectOnly = False
  406.     menu_connection.Enabled = False'disallow connect
  407.     
  408.     FTP_form!Message.Caption = "Logging in " & userid & " to " & hostname
  409.     If Not FTPConnect(hostname, Socket1, Message) Then
  410.             MsgBox "Unable to connect to remote host"
  411.       Ms$ = ctldata
  412.       FTP_form!Message.Caption = Ms$
  413.       FTP_form.Host_name.Caption = "< Not connected >"
  414.             Exit Function
  415.     End If
  416.     If Not FTPLogin(Trim$(userid), Trim$(password), Socket1, socket2, Message) Then
  417.             Undo_Display_Options
  418.             DoConnectOnly = False
  419.             FTP_form.MousePointer = 0
  420.             FTP_form.Socket1.Action = SOCKET_CLOSE
  421.             timer2.Enabled = False
  422.             Ms$ = ctldata
  423.             FTP_form!Message.Caption = Ms$
  424.             FTP_form.Host_name.Caption = "< Not connected >"
  425.             Exit Function
  426.     End If
  427.     Undo_Display_Options
  428.     Connected = True
  429.     DoConnectOnly = True
  430.     FTP_form.Host_name.Caption = hostname
  431. End Function
  432.  
  433. Sub DoConnFTPDisc ()
  434. '__
  435. '__ FTP_form DoConnFTPDisc
  436. '__   called by FTP_form Form_Load
  437. '__   called by FTP_form menu_connection_item_click
  438. '__   called by FTP_form Timer2_Timer
  439. '__   calls     GLOBAL FTPGetDirectory
  440. '__   calls     GLOBAL FTPSetDirectory
  441. '__   calls     GLOBAL getword
  442. '__   calls     FTP_form Do_display_options
  443. '__   calls     FTP_form DoConnectOnly
  444. '__   calls     FTP_form DoDisconnect
  445. '__   calls     FTP_form getfilenow
  446. '__   calls     FTP_form putfilenow
  447. '__   calls     FTP_form ResetTimer
  448. '__   calls     FTP_form Undo_Display_Options
  449. '__
  450.     t0 = Timer
  451.     timer2.Enabled = False
  452.     timeleft.Visible = False
  453.     Do_display_options
  454.     If DoConnectOnly() Then
  455.       If serverdirect <> "" Then
  456.         C_dir$ = serverdirect
  457.         Call FTPSetDirectory(C_dir$, Socket1, Message)
  458.       Else
  459.         Call FTPGetDirectory(Socket1, Message)
  460.       End If
  461.       While list_data <> ""
  462.        If list_data = "ENDLIST" Then
  463.          list_data = ""
  464.        Else
  465.          src_name = getword(list_data, "Source file name", "")
  466.          dest_name = getword(list_data, "Destination file name", "")
  467.        End If
  468.        If src_name <> "" And dest_name <> "" Then
  469.         If putmode Then
  470.           Call putfilenow
  471.         Else
  472.           Call getfilenow
  473.         End If
  474.        End If
  475.       Wend
  476.       
  477.       DoDisconnect
  478.     Else
  479.       Ms$ = ctldata
  480.       FTP_form!Message.Caption = Ms$
  481.       FTP_form.Host_name.Caption = "< Not connected >"
  482.     End If
  483.     Undo_Display_Options
  484.     Call ResetTimer(Val(cycle_sec) - (Timer - t0))
  485.     If timer2.Enabled Then FTP_form!Message.Caption = "counting..."
  486. End Sub
  487.  
  488. Sub DoDisconnect ()
  489. '__
  490. '__ FTP_form DoDisconnect
  491. '__   called by FTP_form DoConnFTPDisc
  492. '__   called by FTP_form menu_connection_item_click
  493. '__   calls     GLOBAL FTPDisconnect
  494. '__   calls     FTP_form Do_display_options
  495. '__   calls     FTP_form Undo_Display_Options
  496. '__
  497.     timer2.Enabled = False
  498.     timeleft.Visible = False
  499.     If Connected Then
  500.       Do_display_options
  501.       Call FTPDisconnect(Socket1)
  502.       Undo_Display_Options
  503.       Connected = False
  504.       FTP_form.Host_name.Caption = "< Not connected >"
  505.       FTP_form.Message.Caption = hostname & " disconnected"
  506.       Dir_list.Clear
  507.       olddirclick = -1
  508.     End If
  509.  
  510. End Sub
  511.  
  512. Sub Enable_menus ()
  513. '__
  514. '__ FTP_form Enable_menus
  515. '__   called by FTP_form Menu_directory_item_Click
  516. '__   called by FTP_form Menu_setting_items_Click
  517. '__   called by FTP_form Undo_Display_Options
  518. '__
  519.   '
  520.   menu_connection.Enabled = True
  521.   Menu_file.Enabled = True
  522.   Menu_directory.Enabled = True
  523.   Menu_settings.Enabled = True
  524.   Quote_menu.Enabled = True
  525.   '
  526. End Sub
  527.  
  528. Function Exit_program () As Integer
  529. '__
  530. '__ FTP_form Exit_program
  531. '__   called by FTP_form Form_QueryUnload
  532. '__
  533.   'give a message box to enable the operator to terminate
  534.   'the program or not
  535.   '
  536.   Dim DgDef, Msg, Response, Title
  537.   '
  538.   Title = "Exit QuickFTP"
  539.   Msg = hostname & " is still connected. Do you want to close the connection and exit?"
  540.   DgDef = MB_YESNO + MB_ICONQUESTION
  541.   Response = MsgBox(Msg, DgDef, Title)
  542.   '
  543.   Exit_program = Response
  544.   '
  545. End Function
  546.  
  547. Sub Form_Load ()
  548. '__
  549. '__ FTP_form Form_Load
  550. '__   calls     GLOBAL GetTempFileName
  551. '__   calls     GLOBAL getword
  552. '__   calls     FTP_form DoConnFTPDisc
  553. '__   calls     FTP_form menu_connection_item_click
  554. '__
  555.   On Error Resume Next
  556.   Kill logfile
  557.   '
  558.   click_index = -1
  559.   Connected = False
  560.   DirType = False
  561.   transtype = Asc("A")
  562.   MaskType = "" ' if "*.*" then you don't get directories
  563.   '
  564.   hostname = connectform!NodeEdit.Text
  565.   userid = connectform!UserEdit.Text
  566.   password = ""
  567.   serverdirect = connectform!txtDirect
  568.  
  569.   namebuff$ = String$(100, 0)
  570.   wI = GetTempFileName(0, "QFTP", 0, namebuff$)
  571.   Dir_file = Left$(namebuff$, InStr(namebuff$, Chr(0)) - 1)
  572.   wI = GetTempFileName(0, "QFTP", 0, namebuff$)
  573.   Temp_File = Left$(namebuff$, InStr(namebuff$, Chr(0)) - 1)
  574.   
  575.   '
  576.   FTP_form.Socket1.HostFile = ""
  577.   
  578.   FTP_form.Show
  579.   cline = Command$
  580.   'MsgBox CurDir
  581.  
  582.   CRLF = Chr$(13) & Chr$(10)
  583.   list_data = "ENDLIST"
  584.   If cline <> "" Then 'have automatic process
  585.    hostname = getword(cline, "Host Name", "")
  586.    mess = mess & "Host Name: " & hostname & CRLF
  587.    userid = getword(cline, "Login Name", "")
  588.    mess = mess & "Login Name: " & userid & CRLF
  589.    password = getword(cline, "Password", "HIDDENVALUE")
  590.    serverdirect = getword(cline, "Initial Directory", ".")
  591.    mess = mess & "Initial Directory: " & serverdirect & CRLF & CRLF
  592.  
  593.    putmode = (UCase(Left(getword(cline, "PUT or GET", "GET") & " ", 1)) = "P")
  594.    If putmode Then
  595.      mess = mess & "PUT "
  596.    Else
  597.      mess = mess & "GET "
  598.    End If
  599.    src_name = getword(cline, "Source File Name", "")
  600.    If Left(src_name, 1) = "<" Then
  601.      listfile = Mid(src_name, 2)
  602.      Open listfile For Binary As #1
  603.      list_data = Space(LOF(1))
  604.      Get 1, 1, list_data
  605.      Close 1
  606.      mess = mess & "From " & src_name & ":" & CRLF & list_data & CRLF
  607.      For i = 1 To Len(list_data)
  608.       If Mid(list_data, i, 1) = Chr(10) Or Mid(list_data, i, 1) = Chr(13) Then
  609.         Mid(list_data, i, 1) = " "
  610.       End If
  611.      Next
  612.    Else
  613.      mess = mess & src_name & CRLF
  614.      dest_name = getword(cline, "Destination File Name", "")
  615.      mess = mess & "--> " & dest_name & CRLF
  616.    End If
  617.    If putmode Then
  618.     Local_File_Name = src_name
  619.     Host_File_Name = dest_name
  620.    Else
  621.     Host_File_Name = src_name
  622.     Local_File_Name = dest_name
  623.    End If
  624.    transtype = Asc(UCase(getword(cline, "ASCII or BINARY", "ASCII")) & " ")
  625.    If transtype = 32 Then transtype = Asc("A")
  626.    If transtype <> Asc("A") Then transtype = Asc("I")
  627.    If transtype = Asc("A") Then
  628.      mess = mess & "mode ASCII"
  629.    Else
  630.      mess = mess & "mode BINARY"
  631.    End If
  632.    silent = UCase(Left(getword(cline, "NOTIFY or SILENT", "NOTIFY") & " ", 1))
  633.    notify = (silent <> "S")
  634.    doitmode = True
  635.    commandmode = True
  636.    ok = ID_OK
  637.    If notify Then ok = MsgBox(mess, MB_OKCANCEL Or MB_QUESTION)
  638.    If ok = ID_OK Then
  639.      DoConnFTPDisc
  640.      If notify Then MsgBox (src_name & " Operation complete")
  641.    End If
  642.    Unload FTP_form
  643.   End If
  644.  
  645.   menu_connection_item_click (0)
  646. End Sub
  647.  
  648. Sub Form_QueryUnload (Cancel As Integer, UnloadMode As Integer)
  649. '__
  650. '__ FTP_form Form_QueryUnload
  651. '__
  652. '__   parameter Cancel As Integer
  653. '__   parameter UnloadMode As Integer
  654. '__   calls     FTP_form Exit_program
  655. '__
  656.   '
  657.   'when finishing via - control program checks for connected
  658.   'and gives a message to the operator, he then can decide
  659.   'to finish or not
  660.   'Also a warning will be given when the release was not
  661.   'successful
  662.   '
  663.   If Connected Then
  664.     If Exit_program() = ID_YES Then
  665.       Cancel = False
  666.     Else
  667.       Cancel = True
  668.     End If
  669.   Else
  670.     Cancel = False
  671.   End If
  672.   '
  673. End Sub
  674.  
  675. Sub Form_Unload (Cancel As Integer)
  676. '__
  677. '__ FTP_form Form_Unload
  678. '__
  679. '__   parameter Cancel As Integer
  680. '__
  681.       On Error Resume Next
  682.       Kill Dir_file
  683.       Kill Temp_File
  684.       If Socket1.Connected Then Socket1.Action = SOCKET_CLOSE
  685.       If socket2.Listening Or socket2.Connected Then socket2.Action = SOCKET_CLOSE
  686.       ti = Timer: While Timer - 1 < ti: DoEvents: Wend
  687.       End                        'exit program
  688. End Sub
  689.  
  690. Sub getfilenow ()
  691. '__
  692. '__ FTP_form getfilenow
  693. '__   called by FTP_form DoConnFTPDisc
  694. '__   called by FTP_form menu_connection_item_click
  695. '__   called by FTP_form Menu_file_item_Click
  696. '__   called by FTP_form Timer1_Timer
  697. '__   called by FTP_form Timer2_Timer
  698. '__   calls     GLOBAL FTPGetFile
  699. '__   calls     FTP_form Do_display_options
  700. '__   calls     FTP_form ResetTimer
  701. '__   calls     FTP_form Undo_Display_Options
  702. '__
  703. Static going
  704.     If going Then Exit Sub
  705.     going = True
  706.     t0 = Timer
  707.     timer2.Enabled = False
  708.     transferaborted = False
  709.     Do_display_options
  710.     FTP_form!Message.Caption = ""
  711.     FTP_form!lblStatus.Caption = "Getting " & src_name
  712.     success = FTPGetFile(src_name, Temp_File, Socket1, socket2, Message)
  713.     If transferaborted Or Not success Then
  714.       Ms$ = ctldata
  715.       FTP_form!Message.Caption = Ms$
  716.       If notify Or commandmode Then MsgBox Ms$
  717.       lblStatus.Caption = "Ready"
  718.       If transferaborted Then Message.Caption = "File transfer aborted"
  719.     Else
  720.       FTP_form!lblStatus.Caption = "Copying temporary file..."
  721.       On Error Resume Next
  722.       Kill dest_name
  723.       On Error GoTo getfileerror
  724.       FileCopy Temp_File, dest_name
  725.       Kill Temp_File
  726.       If Val(cycle_sec) = 0 Then also = "" Else also = " and counting"
  727.       FTP_form!lblStatus.Caption = "Transfer OK; received " & FileLen(dest_name) & " bytes" & also
  728.     End If
  729.     If Not transferaborted Then Call ResetTimer(Val(cycle_sec) - (Timer - t0))
  730.     Undo_Display_Options
  731.     going = False
  732.     Exit Sub
  733.  
  734. getfileerror:
  735.     Undo_Display_Options
  736.     If transferaborted Then
  737.       FTP_form!lblStatus.Caption = "Transfer aborted"
  738.       going = False
  739.       Exit Sub
  740.     End If
  741.     If Err = 53 Then Resume Next 'File not found
  742.     mess = Error(Err) & "--"
  743.     If Err = 75 Then   'Access error
  744.       mess = mess & "Retrying..."
  745.       FTP_form!Message.Caption = mess
  746.       DoEvents
  747.       Resume
  748.     End If
  749.     FTP_form!Message.Caption = mess
  750.     Exit Sub
  751. End Sub
  752.  
  753. Sub GoToDir (C_dir$)
  754. '__
  755. '__ FTP_form GoToDir
  756. '__
  757. '__   parameter C_dir$
  758. '__   called by FTP_form menu_connection_item_click
  759. '__   called by FTP_form Menu_directory_item_Click
  760. '__   calls     GLOBAL FTPSetDirectory
  761. '__   calls     FTP_form Do_display_options
  762. '__   calls     FTP_form Menu_directory_item_Click
  763. '__   calls     FTP_form Undo_Display_Options
  764. '__
  765.     Do_display_options
  766.       FTP_form!lblStatus.Caption = "Changing directory to " & C_dir$
  767.       Call FTPSetDirectory(C_dir$, Socket1, Message)
  768.       Undo_Display_Options
  769.       Ms$ = ctldata
  770.       FTP_form!Message.Caption = Ms$
  771.       Call Menu_directory_item_Click(2)
  772. End Sub
  773.  
  774. Sub lblStatus_Change ()
  775. ' logmessage lblStatus
  776. End Sub
  777.  
  778. Sub logmessage (Message)
  779. '__
  780. '__ FTP_form logmessage
  781. '__
  782. '__   parameter Message
  783. '__   called by FTP_form Message_Change
  784. '__
  785.  If Val(Message) > 0 Then Exit Sub
  786.  messagelist.AddItem Message
  787.  messagelist.TopIndex = messagelist.ListCount - 1
  788.  messagelist.Refresh
  789. On Error Resume Next
  790. unit = FreeFile
  791. Open LogFileName For Append As #unit
  792. Print #unit, Time$ & " " & Message
  793. Close unit
  794. End Sub
  795.  
  796. Sub Menu_connection_Click ()
  797.   'set menu active depending on connection
  798.   'connect
  799.   menu_connection_item(0).Enabled = (Connected = False)
  800.   'disconnect
  801.   menu_connection_item(1).Enabled = (Connected = True)
  802.   'abort
  803.   menu_connection_item(2).Enabled = (Connected = True) Or (timer2.Enabled)
  804.   '
  805. End Sub
  806.  
  807. Sub menu_connection_item_click (Index As Integer)
  808. '__
  809. '__ FTP_form menu_connection_item_click
  810. '__
  811. '__   parameter Index As Integer
  812. '__   called by FTP_form Form_Load
  813. '__   calls     FTP_form Do_display_options
  814. '__   calls     FTP_form DoConnectOnly
  815. '__   calls     FTP_form DoConnFTPDisc
  816. '__   calls     FTP_form DoDisconnect
  817. '__   calls     FTP_form getfilenow
  818. '__   calls     FTP_form GoToDir
  819. '__   calls     FTP_form Menu_directory_item_Click
  820. '__   calls     FTP_form putfilenow
  821. '__   calls     FTP_form Undo_Display_Options
  822. '__
  823.   
  824.   
  825.   'do action depending on item
  826.   '
  827.   Select Case Index
  828.   Case 0                    'Connect
  829.     timer2.Enabled = False
  830.     timeleft.Visible = False
  831.     doitmode = False
  832.     src_name = ""
  833.     dest_name = ""
  834.     connectform.Show 1
  835.     If Not OKDialog Then Exit Sub
  836.     messagelist.Clear
  837.     Do_display_options
  838.     If doitmode Then
  839.       DoConnFTPDisc
  840.     Else
  841.       If DoConnectOnly() Then
  842.        If serverdirect <> "" Then
  843.          C_dir$ = serverdirect
  844.          Call GoToDir(C_dir$)
  845.        Else
  846.          Call Menu_directory_item_Click(2)
  847.        End If
  848.        If cyclemode And src_name <> "" And dest_name <> "" Then
  849.          If putmode Then
  850.           Call putfilenow
  851.          Else
  852.           Call getfilenow
  853.          End If
  854.        End If
  855.       End If
  856.     End If
  857.     Undo_Display_Options
  858.   Case 1                    'Disconnect
  859.     DoDisconnect
  860.   Case 2                    'Abort
  861.     timeleft.Visible = False
  862.     If timer2.Enabled Then
  863.       FTP_form!lblStatus.Caption = "Timer stopped"
  864.       FTP_form!Message.Caption = ""
  865.     End If
  866.     timer2.Enabled = False
  867.     transferaborted = True
  868.   Case 3                    'Exit
  869.     Unload FTP_form
  870.   Case 4                          'do full cycle-connect,ftp,disconnect
  871.     Call DoConnFTPDisc
  872.   End Select
  873.   '
  874. End Sub
  875.  
  876. Sub Menu_directory_Click ()
  877.   'set menu active depending on connection
  878.   'change
  879.   Menu_directory_item(0).Enabled = (Connected = True)
  880.   'parent
  881.   Menu_directory_item(1).Enabled = (Connected = True)
  882.   'dir list
  883.   Menu_directory_item(2).Enabled = (Connected = True)
  884.   '
  885. End Sub
  886.  
  887. Sub Menu_directory_item_Click (Index As Integer)
  888. '__
  889. '__ FTP_form Menu_directory_item_Click
  890. '__
  891. '__   parameter Index As Integer
  892. '__   called by FTP_form GoToDir
  893. '__   called by FTP_form menu_connection_item_click
  894. '__   calls     GLOBAL getinput
  895. '__   calls     FTP_form Do_display_options
  896. '__   calls     FTP_form Do_the_dirlist
  897. '__   calls     FTP_form Enable_menus
  898. '__   calls     FTP_form GoToDir
  899. '__   calls     FTP_form SendFTPCOMMAND
  900. '__
  901.   '
  902.   
  903.   Dim C_dir$
  904.   '
  905.   Select Case Index
  906.   Case 0          'change
  907.     If Dir_list.ListIndex > 0 Then
  908.        C_dir$ = Dir_list.List(Dir_list.ListIndex)
  909.     Else
  910.        C_dir$ = Getinput("Directory Name", serverdirect)
  911.     End If
  912.     Call GoToDir(C_dir$)
  913.   Case 1          'parent
  914.     C_dir$ = ".."
  915.     Call GoToDir(C_dir$)
  916.   Case 2
  917.     DirType = False
  918.     Do_display_options
  919.     FTP_form!lblStatus.Caption = "Getting directory info"
  920.     Do_the_dirlist
  921.     Call SendFTPCOMMAND("pwd", result$)
  922.     iq = InStr(result$, Chr(34))
  923.     If iq > 0 Then
  924.       result$ = Mid$(result$, iq + 1)
  925.       iq = InStr(result$, Chr(34))
  926.       If iq > 0 Then
  927.         result$ = Left$(result$, iq - 1)
  928.         Menu_directory_item(2).Caption = "&List of " & result$
  929.         serverdirect = result$
  930.         Host_name = hostname & "   " & result$
  931.       End If
  932.     End If
  933.     FTP_form.MousePointer = 0
  934.     Enable_menus
  935.     lblStatus = "Ready"
  936.   End Select
  937.   '
  938. End Sub
  939.  
  940. Sub Menu_file_Click ()
  941.   'set menu active depending on connection
  942.   'get
  943.   Menu_File_item(0).Enabled = (Connected = True)
  944.   Menu_File_item(0).Checked = Not putmode
  945.   'put
  946.   Menu_File_item(1).Enabled = (Connected = True)
  947.   Menu_File_item(1).Checked = putmode
  948.   '
  949.   MnuStopTimer.Enabled = timer2.Enabled
  950. End Sub
  951.  
  952. Sub Menu_file_item_Click (Index As Integer)
  953. '__
  954. '__ FTP_form Menu_file_item_Click
  955. '__
  956. '__   parameter Index As Integer
  957. '__   calls     FTP_form getfilenow
  958. '__   calls     FTP_form putfilenow
  959. '__
  960.   '
  961.   Select Case Index
  962.   Case 0      'get
  963.     putmode = False
  964.     Get_file.Show 1
  965.     If Not OKDialog Then Exit Sub
  966.     '
  967.     Call getfilenow
  968.    Case 1      'put
  969.     putmode = True
  970.     Get_file.Show 1
  971.     If Not OKDialog Then Exit Sub
  972.     Call putfilenow
  973.   End Select
  974.   '
  975. End Sub
  976.  
  977. Sub Menu_setting_items_Click (Index As Integer)
  978. '__
  979. '__ FTP_form Menu_setting_items_Click
  980. '__
  981. '__   parameter Index As Integer
  982. '__   calls     GLOBAL Get_mask_type
  983. '__   calls     FTP_form Do_display_options
  984. '__   calls     FTP_form Do_the_dirlist
  985. '__   calls     FTP_form Enable_menus
  986. '__
  987.   '
  988.   Select Case Index
  989.   Case 0                     'Ascii
  990.     transtype = Asc("A")
  991.   Case 1                     'binary
  992.     transtype = Asc("I")
  993.   Case 2                     'mask
  994.     MaskType = Get_mask_type()
  995.     Do_display_options
  996.     Do_the_dirlist
  997.     FTP_form.MousePointer = 0
  998.     Enable_menus
  999.   End Select
  1000.   '
  1001. End Sub
  1002.  
  1003. Sub Menu_settings_Click ()
  1004.   '
  1005.   Menu_setting_items(0).Checked = (transtype = Asc("A"))
  1006.   Menu_setting_items(1).Checked = (transtype = Asc("I"))
  1007.   '
  1008.   Menu_setting_items(0).Enabled = (Connected = True)
  1009.   Menu_setting_items(1).Enabled = (Connected = True)
  1010.   Menu_setting_items(2).Enabled = (Connected = True)
  1011.   '
  1012. End Sub
  1013.  
  1014. Sub Message_Change ()
  1015. '__
  1016. '__ FTP_form Message_Change
  1017. '__   calls     FTP_form logmessage
  1018. '__
  1019.  logmessage Message
  1020. End Sub
  1021.  
  1022. Sub mnuStopTimer_Click ()
  1023.     timeleft.Visible = False
  1024.     FTP_form!lblStatus.Caption = "Timer stopped"
  1025.     timer2.Enabled = False
  1026. End Sub
  1027.  
  1028. Sub putfilenow ()
  1029. '__
  1030. '__ FTP_form putfilenow
  1031. '__   called by FTP_form DoConnFTPDisc
  1032. '__   called by FTP_form menu_connection_item_click
  1033. '__   called by FTP_form Menu_file_item_Click
  1034. '__   called by FTP_form Timer2_Timer
  1035. '__   calls     GLOBAL FTPPutFile
  1036. '__   calls     FTP_form Do_display_options
  1037. '__   calls     FTP_form ResetTimer
  1038. '__   calls     FTP_form Undo_Display_Options
  1039. '__
  1040. Static going
  1041.     If going Then Exit Sub
  1042.     going = True
  1043.     t0 = Timer
  1044.     timer2.Enabled = False
  1045.     transferaborted = False
  1046.     Do_display_options
  1047.     FTP_form!Message.Caption = ""
  1048.     FTP_form!lblStatus.Caption = "Putting " & src_name & " (" & FileLen(src_name) & " bytes)"
  1049.     success = FTPPutFile(src_name, dest_name, Socket1, socket2, Message)
  1050.     If transferaborted Then
  1051.         Message.Caption = "File transfer aborted. Host data is probably corrupt."
  1052.         If notify Or commandmode Then MsgBox Message.Caption
  1053.     ElseIf Not success Then
  1054.         Ms$ = "Error in transmission: " & ctldata
  1055.         FTP_form!Message.Caption = Ms$
  1056.         If notify Or commandmode Then MsgBox Ms$
  1057.     Else
  1058.         FTP_form!lblStatus.Caption = "Transfer OK"
  1059.     End If
  1060.     If Not transferaborted Then Call ResetTimer(Val(cycle_sec) - (Timer - t0))
  1061.     Undo_Display_Options
  1062.     going = False
  1063.     Exit Sub
  1064.  
  1065. putfileerror:
  1066.     Undo_Display_Options
  1067.     If Err = 53 Then Resume Next 'File not found
  1068.     mess = Error(Err) & "--"
  1069.     If Err = 75 Then   'Access error
  1070.       mess = mess & "Retrying..."
  1071.       FTP_form!Message.Caption = mess
  1072.       DoEvents
  1073.       Resume
  1074.     End If
  1075.     FTP_form!Message.Caption = mess
  1076.     Exit Sub
  1077.  
  1078. End Sub
  1079.  
  1080. Sub Quote_command_Click ()
  1081. '__
  1082. '__ FTP_form Quote_command_Click
  1083. '__   calls     FTP_form SendFTPCOMMAND
  1084. '__
  1085.   'execute a command not implemented as standard command
  1086.   'in FTP4W.BAS
  1087.   '
  1088.   Dim answ$, DefVal, Msg, Title
  1089.   '
  1090.   DefVal = ""
  1091.   Msg = "Enter FTP command : "
  1092.   Title = "Quote option for FTP"
  1093.   '
  1094.   answ$ = InputBox$(Msg, Title, DefVal)
  1095.   If Len(Trim$(answ$)) = 0 Then
  1096.     Exit Sub
  1097.   Else
  1098.     Call SendFTPCOMMAND(answ$, result$)
  1099.   End If
  1100.   '
  1101. End Sub
  1102.  
  1103. Sub Quote_menu_Click ()
  1104.   '
  1105.   Quote_command.Enabled = (Connected = True)
  1106.   '
  1107. End Sub
  1108.  
  1109. Sub ResetTimer (tim)
  1110. '__
  1111. '__ FTP_form ResetTimer
  1112. '__
  1113. '__   parameter tim
  1114. '__   called by FTP_form Cycle_sec_LostFocus
  1115. '__   called by FTP_form DoConnFTPDisc
  1116. '__   called by FTP_form getfilenow
  1117. '__   called by FTP_form putfilenow
  1118. '__
  1119.     ttime = tim
  1120.     If ttime < 10 Then ttime = 10
  1121.     If Val(cycle_sec) > 0 Then
  1122.       timer2.Enabled = True
  1123.       timeleft = Int(ttime)
  1124.       timeleft.Visible = True
  1125.     Else
  1126.       timer2.Enabled = False
  1127.       timeleft.Visible = False
  1128.       cycle_sec = 0
  1129.     End If
  1130. End Sub
  1131.  
  1132. Sub SendFTPCOMMAND (commnd$, result As String)
  1133. '__
  1134. '__ FTP_form SendFTPCOMMAND
  1135. '__
  1136. '__   parameter commnd$
  1137. '__   parameter result As String
  1138. '__   called by FTP_form Menu_directory_item_Click
  1139. '__   called by FTP_form Quote_command_Click
  1140. '__   calls     GLOBAL FTPcommand
  1141. '__   calls     GLOBAL FTPResult
  1142. '__   calls     FTP_form Do_display_options
  1143. '__   calls     FTP_form Undo_Display_Options
  1144. '__
  1145.   '
  1146.     Do_display_options
  1147.     success = FTPcommand(commnd$, Socket1, Message)
  1148.     If Not success Then
  1149.         If notify Or commandmode Then MsgBox ctldata
  1150.     End If
  1151.     r = FTPResult(Socket1, Message)'don't take this out!
  1152.     Undo_Display_Options
  1153.     M$ = ctldata
  1154.     FTP_form!Message.Caption = M$
  1155.     result = ctldata
  1156.  
  1157. End Sub
  1158.  
  1159. Sub Socket1_Close ()
  1160. '__
  1161. '__ FTP_form Socket1_Close
  1162. '__   calls     FTP_form Undo_Display_Options
  1163. '__
  1164.     Socket1.Action = SOCKET_CLOSE
  1165.     FTP_form.Host_name.Caption = "< Not connected >"
  1166.     FTP_form.lblStatus.Caption = "Not connected"
  1167.     FTP_form.Message.Caption = hostname & " disconnected"
  1168.     Connected = False
  1169.     Undo_Display_Options
  1170.  
  1171. End Sub
  1172.  
  1173. Sub Socket2_Close ()
  1174. '__
  1175. '__ FTP_form Socket2_Close
  1176. '__   calls     FTP_form Undo_Display_Options
  1177. '__
  1178.     FTP_form.Host_name.Caption = "< Not connected >"
  1179.     FTP_form!lblStatus.Caption = "Not connected"
  1180.     FTP_form.Message.Caption = hostname & " disconnected"
  1181.     Connected = False
  1182.     Undo_Display_Options
  1183.  
  1184. End Sub
  1185.  
  1186. Sub Timer1_Timer ()
  1187. '__
  1188. '__ FTP_form Timer1_Timer
  1189. '__   calls     FTP_form getfilenow
  1190. '__
  1191.    timer2.Enabled = False
  1192.    timeleft.Visible = False
  1193.    Call getfilenow
  1194. End Sub
  1195.  
  1196. Sub Timer2_Timer ()
  1197. '__
  1198. '__ FTP_form Timer2_Timer
  1199. '__   calls     FTP_form DoConnFTPDisc
  1200. '__   calls     FTP_form getfilenow
  1201. '__   calls     FTP_form putfilenow
  1202. '__
  1203.  If Not timer2.Enabled Then Exit Sub
  1204.  timeleft = timeleft - 1
  1205.  If timeleft > 0 Then Exit Sub
  1206.    timeleft = 0
  1207.    timer2.Enabled = False
  1208.    timeleft.Visible = False
  1209.    If doitmode Then
  1210.      Call DoConnFTPDisc
  1211.    ElseIf putmode Then
  1212.      Call putfilenow
  1213.    Else
  1214.      Call getfilenow
  1215.    End If
  1216. End Sub
  1217.  
  1218. Sub Undo_Display_Options ()
  1219. '__
  1220. '__ FTP_form Undo_Display_Options
  1221. '__   called by FTP_form DoConnectOnly
  1222. '__   called by FTP_form DoConnFTPDisc
  1223. '__   called by FTP_form DoDisconnect
  1224. '__   called by FTP_form getfilenow
  1225. '__   called by FTP_form GoToDir
  1226. '__   called by FTP_form menu_connection_item_click
  1227. '__   called by FTP_form putfilenow
  1228. '__   called by FTP_form SendFTPCOMMAND
  1229. '__   called by FTP_form Socket1_Close
  1230. '__   called by FTP_form Socket2_Close
  1231. '__   calls     FTP_form Enable_menus
  1232. '__
  1233.   '
  1234.   FTP_form.MousePointer = 0
  1235.   Enable_menus
  1236.   '
  1237. End Sub
  1238.  
  1239.