home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / pibsoft / terminal / source / pibhostb.mod < prev    next >
Encoding:
Text File  |  1988-02-26  |  31.3 KB  |  809 lines
  1. (*----------------------------------------------------------------------*)
  2. (*  Process_File_Transfer_Commands --- Process file transfer commands   *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Process_File_Transfer_Commands( VAR Done: BOOLEAN;
  6.                                           VAR Back: BOOLEAN );
  7.  
  8. (*----------------------------------------------------------------------*)
  9. (*                                                                      *)
  10. (*     Procedure:  Process_File_Transfer_Commands                       *)
  11. (*                                                                      *)
  12. (*     Purpose:    Controls processing of file transfer commands.       *)
  13. (*                                                                      *)
  14. (*     Calling Sequence:                                                *)
  15. (*                                                                      *)
  16. (*        Process_File_Transfer_Commands( VAR Done: BOOLEAN;            *)
  17. (*                                        VAR Back: BOOLEAN );          *)
  18. (*                                                                      *)
  19. (*           Done --- set TRUE if quit command entered or carrier       *)
  20. (*                    dropped.                                          *)
  21. (*           Back --- set TRUE if return to main menu requested.        *)
  22. (*                                                                      *)
  23. (*----------------------------------------------------------------------*)
  24.  
  25. VAR
  26.    Ch       : CHAR;
  27.    Found_Ch : BOOLEAN;
  28.    Dont_Echo: BOOLEAN;
  29.  
  30. LABEL
  31.    ReadChar;
  32.  
  33. (*----------------------------------------------------------------------*)
  34. (*      Display_Xfer_Commands --- Display file transfer commands        *)
  35. (*----------------------------------------------------------------------*)
  36.  
  37. PROCEDURE Display_Xfer_Commands;
  38.  
  39. (*----------------------------------------------------------------------*)
  40. (*                                                                      *)
  41. (*     Procedure: Display_Xfer_Commands                                 *)
  42. (*                                                                      *)
  43. (*     Purpose:   Displays menu of PibTerm file transfer commands and   *)
  44. (*                prompts for command entry.                            *)
  45. (*                                                                      *)
  46. (*     Calling sequence:                                                *)
  47. (*                                                                      *)
  48. (*        Display_Xfer_Commands;                                        *)
  49. (*                                                                      *)
  50. (*----------------------------------------------------------------------*)
  51.  
  52. BEGIN (* Display_Xfer_Commands *)
  53.  
  54.    IF ( NOT Expert_On ) THEN
  55.       BEGIN
  56.          Host_Send_String_With_CR(' ');
  57.          Host_Send_String_With_CR('======================================================');
  58.          Host_Send_String_With_CR('=        PibTerm Host Mode File Transfer Menu        =');
  59.          Host_Send_String_With_CR('======================================================');
  60.          Host_Send_String_With_CR(' ');
  61.          Host_Send_String_With_CR('     U=Upload file');
  62.          Host_Send_String_With_CR('     D=Download file');
  63.          Host_Send_String_With_CR('     L=List files for transfer');
  64.          IF ( Privilege = 'S' ) THEN
  65.             Host_Send_String_With_CR('     J=Jump to DOS');
  66.          Host_Send_String_With_CR('     M=Return to main menu');
  67.          Host_Send_String_With_CR('     Q=Quit and logoff');
  68.          Host_Send_String_With_CR('     X=Expert mode');
  69.          Host_Send_String_With_CR(' ');
  70.          Host_Send_String_With_CR('======================================================');
  71.          Host_Send_String_With_CR(' ');
  72.          Host_Send_String_And_Echo('Enter command ? ');
  73.       END
  74.    ELSE
  75.       BEGIN
  76.          Host_Send_String_With_CR(' ');
  77.          IF ( Privilege = 'S' ) THEN
  78.             Host_Send_String_And_Echo('Xfer (U,D,J,L,M,Q,X) ? ')
  79.          ELSE
  80.             Host_Send_String_And_Echo('Xfer (U,D,L,M,Q,X) ? ');
  81.       END;
  82.  
  83.    IF ( NOT Local_Host ) THEN
  84.       Async_Purge_Buffer;
  85.  
  86. END   (* Display_Xfer_Commands *);
  87.  
  88. (*----------------------------------------------------------------------*)
  89. (*    List_Files_For_Transfer --- List files available for transfer     *)
  90. (*----------------------------------------------------------------------*)
  91.  
  92. PROCEDURE List_Files_For_Transfer;
  93.  
  94. (*----------------------------------------------------------------------*)
  95. (*                                                                      *)
  96. (*     Procedure: List_Files_For_Transfer                               *)
  97. (*                                                                      *)
  98. (*     Purpose:   Displays files available for transfer.                *)
  99. (*                                                                      *)
  100. (*     Calling sequence:                                                *)
  101. (*                                                                      *)
  102. (*        List_Files_For_Transfer;                                      *)
  103. (*                                                                      *)
  104. (*                                                                      *)
  105. (*     Remarks:                                                         *)
  106. (*                                                                      *)
  107. (*        This procedure sends the contents of the PIBTERM.XFR file to  *)
  108. (*        the remote user.                                              *)
  109. (*                                                                      *)
  110. (*----------------------------------------------------------------------*)
  111.  
  112. VAR
  113.    LCount            : INTEGER;
  114.    LDone             : BOOLEAN;
  115.    XFer_Line         : AnyStr;
  116.    Xfer_List_File    : Text_File   (* File transfer list file    *);
  117.  
  118. BEGIN (* List_Files_For_Transfer *)
  119.  
  120.                                    (* Open xferlist file *)
  121.    Host_Status('List files');
  122.  
  123.    ASSIGN( Xfer_List_File , Home_Dir + 'PIBTERM.XFR' );
  124.       (*!I-*)
  125.    RESET( Xfer_List_File );
  126.       (*!I+*)
  127.                                    (* If not there, no transfer possible *)
  128.    IF Int24Result <> 0 THEN
  129.       BEGIN
  130.          Host_Send_String( CR_LF_Host );
  131.          Host_Send_String_With_CR('No files available for transfer.');
  132.       END
  133.    ELSE                            (* If there, list it *)
  134.       BEGIN
  135.  
  136.          LCount := 2;
  137.          LDone  := FALSE;
  138.  
  139.          Host_Send_String( CR_LF_Host );
  140.          Host_Send_String_With_CR('List of files available for transfer: ');
  141.          Host_Send_String_With_CR(' ');
  142.  
  143.          List_Prompt( LCount , LDone );
  144.  
  145.          REPEAT
  146.  
  147.             READLN( Xfer_List_File , Xfer_Line );
  148.  
  149.             Host_Send_String_With_CR( Xfer_Line );
  150.  
  151.             List_Prompt( LCount , LDone );
  152.  
  153.          UNTIL ( EOF( Xfer_List_File ) OR LDone );
  154.  
  155.       END;
  156.  
  157.       (*!I-*)
  158.    CLOSE( Xfer_List_File );
  159.       (*!I+*)
  160.    Host_IO_Error := Int24Result;
  161.  
  162.    Host_Send_String_With_CR(' ');
  163.    Host_Prompt_And_Read_String('Finished listing files, hit <CR> to continue: ',
  164.                                Xfer_Line, TRUE );
  165.    Host_Send_String_With_CR(' ');
  166.  
  167.    Write_Log('List files for transfer.', FALSE, FALSE );
  168.  
  169.    Host_Status( Cur_Host_Status );
  170.  
  171. END   (* List_Files_For_Transfer *);
  172.  
  173. (*----------------------------------------------------------------------*)
  174. (*        Display_Xfer_Protocols --- Display file xfer protocols        *)
  175. (*----------------------------------------------------------------------*)
  176.  
  177. PROCEDURE Display_Xfer_Protocols;
  178.  
  179. (*----------------------------------------------------------------------*)
  180. (*                                                                      *)
  181. (*     Procedure: Display_Xfer_Protocols;                               *)
  182. (*                                                                      *)
  183. (*     Purpose:   Displays available file transfer protocols.           *)
  184. (*                                                                      *)
  185. (*     Calling sequence:                                                *)
  186. (*                                                                      *)
  187. (*        Display_Xfer_Protocols;                                       *)
  188. (*                                                                      *)
  189. (*----------------------------------------------------------------------*)
  190.  
  191. VAR
  192.    T : Transfer_Type;
  193.    I : INTEGER;
  194.    S : AnyStr;
  195.  
  196. BEGIN (* Display_Xfer_Protocols *)
  197.  
  198.    Host_Send_String( CR_LF_Host );
  199.    Host_Send_String_With_CR('Available transfer protocols are: ');
  200.    Host_Send_String_With_CR(' ');
  201. {
  202.    Host_Send_String_With_CR('   A         Ascii');
  203.    Host_Send_String_With_CR('   X         Xmodem CheckSum');
  204.    Host_Send_String_With_CR('   XC        Xmodem CRC');
  205.    Host_Send_String_With_CR('   XK        Xmodem 1K');
  206.    Host_Send_String_With_CR('   XG        Xmodem 1K G');
  207.    Host_Send_String_With_CR('   YB        Ymodem Batch');
  208.    Host_Send_String_With_CR('   YG        Ymodem G Batch');
  209.    Host_Send_String_With_CR('   T         Telink');
  210.    Host_Send_String_With_CR('   M         Modem7 Batch Checksum');
  211.    Host_Send_String_With_CR('   MC        Modem7 Batch CRC');
  212.    Host_Send_String_With_CR('   K         Kermit (Text file)');
  213.    Host_Send_String_With_CR('   KB        Kermit (Binary file)');
  214.    Host_Send_String_With_CR('   SL        SEALink');
  215.    Host_Send_String_With_CR('   RL        RLink');
  216.    Host_Send_String_With_CR('   WX        Windowed Xmodem');
  217. }
  218.    FOR I := 1 TO Max_Transfer_Types DO
  219.       BEGIN
  220.          T := Transfers[I];
  221.          IF ( ( Trans_Type_Name[T]  <> '  ' ) AND
  222.               ( Trans_OK_In_Host[T] OR ( Privilege = 'S' ) ) ) THEN
  223.             BEGIN
  224.                S := '   ' + COPY( Trans_Type_Name[T], 1, 2 ) + '        ' +
  225.                     Transfer_Name_List[I];
  226.                Host_Send_String_With_CR( S );
  227.             END;
  228.       END;
  229.  
  230.    Host_Send_String_With_CR('   Q or ^X  Quit transfer');
  231.  
  232. END   (* Display_Xfer_Protocols *);
  233.  
  234. (*----------------------------------------------------------------------*)
  235. (*              Get_Xfer_Protocol --- Get file xfer protocol            *)
  236. (*----------------------------------------------------------------------*)
  237.  
  238. FUNCTION Get_Xfer_Protocol : Transfer_Type;
  239.  
  240. (*----------------------------------------------------------------------*)
  241. (*                                                                      *)
  242. (*     Function:  Get_Xfer_Protocol;                                    *)
  243. (*                                                                      *)
  244. (*     Purpose:   Prompts remote user for, and reads, selected file     *)
  245. (*                transfer protocol.                                    *)
  246. (*                                                                      *)
  247. (*     Calling sequence:                                                *)
  248. (*                                                                      *)
  249. (*        Trans_Type := Get_Xfer_Protocol : Transfer_Type;              *)
  250. (*                                                                      *)
  251. (*           Trans_Type --- Protocol chosen by remote user.             *)
  252. (*                                                                      *)
  253. (*----------------------------------------------------------------------*)
  254.  
  255. VAR
  256.    Trans_Mode        : ShortStr;
  257.    Transfer_Protocol : Transfer_Type;
  258.    I                 : INTEGER;
  259.    Trans_Mode_Char2  : Char_2;
  260.    T                 : Transfer_Type;
  261.  
  262. BEGIN (* Get_Xfer_Protocol *)
  263.  
  264.    REPEAT
  265.  
  266.       Host_Send_String( CR_LF_Host );
  267.       Host_Prompt_And_Read_String('Enter transfer protocol (? for list, ^X to quit): ',
  268.                                    Trans_Mode, TRUE );
  269.  
  270.       Trans_Mode_Char2[1] := ' ';
  271.       Trans_Mode_Char2[2] := ' ';
  272.  
  273.       Trans_Mode := Uppercase( TRIM( Trans_Mode ) );
  274.  
  275.       FOR I := 1 TO MIN( LENGTH( Trans_Mode ) , 2 ) DO
  276.          Trans_Mode_Char2[I] := Trans_Mode[I];
  277.  
  278.       Transfer_Protocol := None;
  279.  
  280.       IF ( Trans_Mode = '?' ) THEN
  281.          Display_Xfer_Protocols
  282.       ELSE IF ( ( Trans_Mode <> ^X ) AND ( Trans_Mode <> 'Q' ) ) THEN
  283.          FOR I := 1 TO Max_Transfer_Types DO
  284.             BEGIN
  285.                T := Transfers[I];
  286.                IF ( ( Trans_Mode_Char2 = Trans_Type_Name[T] ) AND
  287.                     ( Trans_OK_In_Host[T] OR ( Privilege = 'S' ) ) ) THEN
  288.                   Transfer_Protocol := T;
  289.             END;
  290. {
  291.       ELSE IF Trans_Mode = 'A'  THEN
  292.          Transfer_Protocol := Ascii
  293.       ELSE IF Trans_Mode = 'X'  THEN
  294.          Transfer_Protocol := Xmodem_Chk
  295.       ELSE IF Trans_Mode = 'XC' THEN
  296.          Transfer_Protocol := Xmodem_CRC
  297.       ELSE IF Trans_Mode = 'XG'  THEN
  298.          Transfer_Protocol := Xmodem_1KG
  299.       ELSE IF Trans_Mode = 'XK'  THEN
  300.          Transfer_Protocol := Xmodem_1K
  301.       ELSE IF Trans_Mode = 'YB' THEN
  302.          Transfer_Protocol := Ymodem_Batch
  303.       ELSE IF Trans_Mode = 'YG' THEN
  304.          Transfer_Protocol := Ymodem_G
  305.       ELSE IF Trans_Mode = 'T'  THEN
  306.          Transfer_Protocol := Telink
  307.       ELSE IF Trans_Mode = 'TC' THEN
  308.          Transfer_Protocol := Telink
  309.       ELSE IF Trans_Mode = 'M'  THEN
  310.          Transfer_Protocol := Modem7_Chk
  311.       ELSE IF Trans_Mode = 'MC'  THEN
  312.          Transfer_Protocol := Modem7_CRC
  313.       ELSE IF Trans_Mode = 'M7' THEN
  314.          Transfer_Protocol := Modem7_CRC
  315.       ELSE IF Trans_Mode = 'K' THEN
  316.          BEGIN
  317.             Transfer_Protocol    := Kermit;
  318.             Kermit_File_Type_Var := Kermit_Ascii;
  319.          END
  320.       ELSE IF Trans_Mode = 'KB' THEN
  321.          BEGIN
  322.             Transfer_Protocol    := Kermit;
  323.             Kermit_File_Type_Var := Kermit_Binary;
  324.          END
  325.       ELSE IF Trans_Mode = 'RL'  THEN
  326.          Transfer_Protocol := RLink
  327.       ELSE IF Trans_Mode = 'SL'  THEN
  328.          Transfer_Protocol := SEALink
  329.       ELSE IF Trans_Mode = 'WX' THEN
  330.          Transfer_Protocol := WXModem;
  331. }
  332.    UNTIL ( Transfer_Protocol <> None ) OR ( Trans_Mode = 'Q' ) OR
  333.          ( Trans_Mode = ^X );
  334.  
  335.    Get_Xfer_Protocol := Transfer_Protocol;
  336.  
  337.    IF ( Transfer_Protocol = Kermit ) THEN
  338.       Kermit_File_Type_Var := Kermit_Binary;
  339.  
  340. END   (* Get_Xfer_Protocol *);
  341.  
  342. (*----------------------------------------------------------------------*)
  343. (*               Upload_A_File  --- Receive file from remote user       *)
  344. (*----------------------------------------------------------------------*)
  345.  
  346. PROCEDURE Upload_A_File;
  347.  
  348. (*----------------------------------------------------------------------*)
  349. (*                                                                      *)
  350. (*     Procedure:  Upload_A_File;                                       *)
  351. (*                                                                      *)
  352. (*     Purpose:   Prompts remote user for, and receives, selected file. *)
  353. (*                                                                      *)
  354. (*     Calling sequence:                                                *)
  355. (*                                                                      *)
  356. (*        Upload_A_File;                                                *)
  357. (*                                                                      *)
  358. (*----------------------------------------------------------------------*)
  359.  
  360. VAR
  361.    File_Name         : AnyStr;
  362.    Trans_Mode        : AnyStr;
  363.    Transfer_Protocol : Transfer_Type;
  364.    OK_To_Upload      : BOOLEAN;
  365.    Save_Attended     : BOOLEAN;
  366.    SDone             : BOOLEAN;
  367.    Single_FP         : BOOLEAN;
  368.    
  369. BEGIN (* Upload_A_File *)
  370.                                    (* Get transfer protocol *)
  371.  
  372.    Transfer_Protocol := Get_Xfer_Protocol;
  373.  
  374.    IF Transfer_Protocol = None THEN EXIT;
  375.  
  376.                                    (* Get file name to transfer if not *)
  377.                                    (* batch protocol.                  *)
  378.    File_Name    := '';
  379.    
  380.    Single_FP    := Single_File_Protocol[Transfer_Protocol];
  381.    OK_To_Upload := TRUE;
  382.    
  383.    IF Single_FP THEN
  384.       BEGIN
  385.  
  386.          Host_Send_String( CR_LF_Host );
  387.          Host_Prompt_And_Read_String('Enter file name to upload: ',
  388.                                       File_Name, TRUE );
  389.  
  390.          IF ( File_Name = '' ) THEN EXIT;
  391.  
  392.          IF ( POS( ^X , File_Name ) > 0 ) THEN EXIT;
  393.  
  394.          IF ( ( POS( '*', File_Name ) = 0 ) AND
  395.             ( ( POS( '?', File_Name ) = 0 ) ) ) THEN
  396.             OK_To_Upload := NOT Check_If_File_Exists( File_Name, Host_Mode_Upload )
  397.          ELSE 
  398.             BEGIN
  399.                OK_To_Upload := FALSE;
  400.                Host_Send_String( CR_LF_Host );
  401.                Host_Send_String('Wildcards are not allowed for this protocol.');
  402.                EXIT;
  403.             END;
  404.  
  405.       END;
  406.                                    (* Any file is OK for superuser *)
  407.    IF ( Privilege = 'S' ) THEN
  408.       OK_To_Upload := TRUE;
  409.  
  410.    IF Ok_To_Upload THEN
  411.       BEGIN                        (* FileName is global for transfers *)
  412.  
  413.          FileName := File_Name;
  414.  
  415.          Host_Send_String( CR_LF_Host );
  416.          Host_Send_String_With_CR('Ready to receive, begin your send procedure.');
  417.  
  418.          Async_Drain_Output_Buffer( Five_Seconds );
  419.  
  420.          Save_Attended := Attended_Mode;
  421.  
  422.          Attended_Mode := FALSE;
  423.  
  424.          Host_Status('Receiving file');
  425.  
  426.                                    (* Start transfer *)
  427.  
  428.          PibDownLoad( Transfer_Protocol );
  429.  
  430.                                    (* Make sure script if any is executed *)
  431.  
  432.          WHILE Script_File_Mode DO
  433.             BEGIN
  434.                Get_Script_Command( PibTerm_Command );
  435.                Execute_Command   ( PibTerm_Command , SDone , TRUE );
  436.             END;
  437.  
  438.          Host_Status(Cur_Host_Status);
  439.  
  440.          Attended_Mode := Save_Attended;
  441.  
  442.                                    (* Reset window *)
  443.  
  444.          PibTerm_Window( 1, 1, Max_Screen_Col, Max_Screen_Line - 2 );
  445.  
  446.       END
  447.    ELSE
  448.       BEGIN
  449.          Host_Send_String( CR_LF_Host );
  450.          Host_Send_String_With_CR('File already exists, upload cancelled.');
  451.          OK_To_Upload := FALSE;
  452.       END;
  453.  
  454. END   (* Upload_A_File *);
  455.  
  456. (*----------------------------------------------------------------------*)
  457. (*             Get_Transfer_Time --- Get transfer time for files        *)
  458. (*----------------------------------------------------------------------*)
  459.  
  460. PROCEDURE Get_Transfer_Time( VAR File_Spec             : AnyStr;
  461.                              VAR N_Files               : INTEGER;
  462.                              VAR Transfer_Time_Message : AnyStr );
  463.  
  464. (*----------------------------------------------------------------------*)
  465. (*                                                                      *)
  466. (*     Procedure:  Get_Transfer_Time                                    *)
  467. (*                                                                      *)
  468. (*     Purpose:    Gets transfer time for download                      *)
  469. (*                                                                      *)
  470. (*     Calling sequence:                                                *)
  471. (*                                                                      *)
  472. (*        Get_Transfer_Time(     File_Spec             : AnyStr;        *)
  473. (*                           VAR N_Files               : INTEGER;       *)
  474. (*                           VAR Transfer_Time_Message : AnyStr );      *)
  475. (*                                                                      *)
  476. (*           File_Spec             --- File spec for files to get       *)
  477. (*           N_Files               --- # of files to be transferred     *)
  478. (*           Transfer_Time_Message --- Message about transfer time      *)
  479. (*                                                                      *)
  480. (*----------------------------------------------------------------------*)
  481.  
  482. VAR
  483.    Total_File_Size: LONGINT;
  484.    File_Size      : LONGINT;
  485.    File_Entry     : SearchRec;
  486.    Last_Found     : BOOLEAN;
  487.    SN_Files       : STRING[8];
  488.    S_File_Size    : STRING[8];
  489.    OK_File        : BOOLEAN;
  490.    Info_Line      : AnyStr;
  491.    Transfer_Time  : LONGINT;
  492.  
  493. BEGIN (* Get_Transfer_Time *)
  494.  
  495.    Host_Send_String( CR_LF_Host );
  496.  
  497.    Host_Send_String_With_CR('Scanning file list ... ');
  498.  
  499.                                    (* No files = 0 total file size at start *)
  500.    Total_File_Size := 0;
  501.    N_Files         := 0;
  502.                                    (* Append download directory name *)
  503.                                    (* if necessary.                  *)
  504.  
  505.    Add_Path( File_Spec, Host_Mode_Download, File_Spec );
  506.  
  507.                                    (* See if any files at all *)
  508.  
  509.    FindFirst( File_Spec, AnyFile, File_Entry );
  510.    Last_Found := ( DosError <> 0 );
  511.  
  512.    WHILE ( NOT Last_Found ) DO
  513.       WITH File_Entry DO
  514.          BEGIN (* WHILE *)
  515.                                    (* Pick up file name, check if it *)
  516.                                    (* is on Xferlist.                *)
  517.  
  518.             OK_File          := FALSE;
  519.  
  520.             IF ( Privilege = 'S' ) THEN
  521.                OK_File := TRUE
  522.             ELSE
  523.                OK_File := ( Scan_Xfer_List( Name ) > 0 );
  524.  
  525.                                    (* If OK to download, add its length *)
  526.                                    (* into current running total.       *)
  527.             IF OK_File THEN
  528.                BEGIN (* OK_File *)
  529.                                    (* Increment file count *)
  530.  
  531.                   INC( N_Files );
  532.  
  533.                                    (* Display message if first file *)
  534.  
  535.                   IF ( N_Files = 1 ) THEN
  536.                      BEGIN
  537.                         Host_Send_String_With_CR(' File name      Size     Trans. time');
  538.                         Host_Send_String_With_CR('============  ========   ===========');
  539.                      END;
  540.                                    (* Pick up file size    *)
  541.  
  542.                   Total_File_Size := Total_File_Size + Size;
  543.  
  544.                                    (* Display information           *)
  545.  
  546.                   STR( Size:8 , S_File_Size );
  547.  
  548.                   Transfer_Time := ROUND( ROUND( ( Size / 128.0 ) + 0.49 ) *
  549.                                                  ( Trans_Time_Val * 1.0 ) /
  550.                                                  ( Baud_Rate      * 1.0 ) );
  551.  
  552.                   Info_Line := Name +
  553.                                DUPL( ' ' , 14 - LENGTH( Name ) ) +
  554.                                S_File_Size + '     ' +
  555.                                TimeString( Transfer_Time , Military_Time );
  556.  
  557.                   Host_Send_String_With_CR( Info_Line );
  558.  
  559.                END   (* OK_File *);
  560.                                          (* See if more files to transfer *)
  561.  
  562.             FindNext( File_Entry );
  563.             Last_Found := Last_Found OR ( DosError <> 0 );
  564.  
  565.          END  (* WHILE *);
  566.                                    (* Pick up transfer time *)
  567.  
  568.       Transfer_Time_Message := 'Approximate transfer time for ';
  569.  
  570.       IF ( N_Files <= 1 ) THEN
  571.          Transfer_Time_Message := Transfer_Time_Message + '1 file is '
  572.       ELSE
  573.          BEGIN
  574.             STR( N_Files , SN_Files );
  575.             Transfer_Time_Message := Transfer_Time_Message + SN_Files
  576.                                      + ' files is ';
  577.          END;
  578.  
  579.       Transfer_Time_Message := Transfer_Time_Message +
  580.                                TimeString( ROUND( ( Total_File_Size / 128.0 ) + 0.49 ) *
  581.                                            ROUND( ( Trans_Time_Val * 1.0 ) / Baud_Rate ),
  582.                                            Military_Time );
  583.  
  584. END   (* Get_Transfer_Time *);
  585.  
  586. (*----------------------------------------------------------------------*)
  587. (*             Download_A_File  --- Send file to remote user            *)
  588. (*----------------------------------------------------------------------*)
  589.  
  590. PROCEDURE Download_A_File;
  591.  
  592. (*----------------------------------------------------------------------*)
  593. (*                                                                      *)
  594. (*     Procedure:  Download_A_File;                                     *)
  595. (*                                                                      *)
  596. (*     Purpose:   Prompts remote user for, and sends, selected file.    *)
  597. (*                                                                      *)
  598. (*     Calling sequence:                                                *)
  599. (*                                                                      *)
  600. (*        Download_A_File;                                              *)
  601. (*                                                                      *)
  602. (*----------------------------------------------------------------------*)
  603.  
  604. VAR
  605.    File_Name         : AnyStr;
  606.    Trans_Mode        : AnyStr;
  607.    Transfer_Protocol : Transfer_Type;
  608.    N_Files           : INTEGER;
  609.    Save_Attended     : BOOLEAN;
  610.    SDone             : BOOLEAN;
  611.  
  612. BEGIN (* Download_A_File *)
  613.                                    (* Get transfer protocol *)
  614.  
  615.    Transfer_Protocol := Get_Xfer_Protocol;
  616.    IF Transfer_Protocol = NONE THEN EXIT;
  617.  
  618.                                    (* Get file spec for files to get *)
  619.  
  620.    Host_Send_String( CR_LF_Host );
  621.    Host_Prompt_And_Read_String('Enter file name to download: ',
  622.                                 File_Name, TRUE );
  623.  
  624.    IF ( File_Name = '' ) THEN EXIT;
  625.  
  626.    IF ( POS( ^X , File_Name ) > 0 ) THEN EXIT;
  627.  
  628.                                    (* Check that file name is proper form *)
  629.    IF ( Privilege <> 'S' ) THEN
  630.       IF ( POS( '\' , File_Name ) <> 0 ) OR
  631.          ( POS( ':' , File_Name ) <> 0 ) THEN
  632.          BEGIN
  633.             Host_Send_String( CR_LF_Host );
  634.             Host_Send_String('That is not a valid file specification.');
  635.             EXIT;
  636.          END;
  637.                                    (* Check wildcards on wrong protocols *)
  638.  
  639.    IF ( ( POS( '*', File_Name ) <> 0 ) OR
  640.         ( POS( '?', File_Name ) <> 0 ) ) THEN
  641.       IF ( Single_File_Protocol[Transfer_Protocol] ) THEN
  642.          BEGIN
  643.             Host_Send_String( CR_LF_Host );
  644.             Host_Send_String('Wildcards are not allowed for this protocol.');
  645.             EXIT;
  646.          END;
  647.                                    (* Get file names and sizes *)
  648.  
  649.    Get_Transfer_Time( File_Name , N_Files , Trans_Mode );
  650.  
  651.    IF ( N_Files <= 0 ) THEN
  652.       BEGIN
  653.          Host_Send_String( CR_LF_Host );
  654.          Host_Send_String_With_CR('No files found to send, transfer cancelled.');
  655.          EXIT;
  656.       END;
  657.                                    (* FileName is global for transfers *)
  658.    FileName := File_Name;
  659.  
  660.    Host_Send_String( CR_LF_Host );
  661.    Host_Send_String_With_CR( Trans_Mode );
  662.    Host_Send_String_With_CR('Ready to send, begin your receive procedure.');
  663.  
  664.                                    (* Get the file(s) ! *)
  665.  
  666.    Async_Drain_Output_Buffer( Five_Seconds );
  667.  
  668.    Save_Attended := Attended_Mode;
  669.  
  670.    Attended_Mode := FALSE;
  671.  
  672.    Host_Status('Sending file');
  673.                                    (* Start transfer *)
  674.    PibUpLoad( Transfer_Protocol );
  675.                                    (* Make sure script if any is executed *)
  676.  
  677.    WHILE Script_File_Mode DO
  678.       BEGIN
  679.          Get_Script_Command( PibTerm_Command );
  680.          Execute_Command   ( PibTerm_Command , SDone , TRUE );
  681.       END;
  682.  
  683.    Host_Status(Cur_Host_Status);
  684.  
  685.    Attended_Mode := Save_Attended;
  686.  
  687.                                    (* Reset window *)
  688.  
  689.    PibTerm_Window( 1, 1, Max_Screen_Col, Max_Screen_Line - 2 );
  690.  
  691. END   (* Download_A_File *);
  692.  
  693. (*----------------------------------------------------------------------*)
  694.  
  695. BEGIN (* Process_File_Transfer_Commands *)
  696.  
  697.                                    (* Indicate we're in file transfer *)
  698.  
  699.    Cur_Host_Status := 'File section';
  700.  
  701.    Host_Status(Cur_Host_Status);
  702.                                    (* Stay in files section for a while *)
  703.    Back := FALSE;
  704.                                    (* Prompt for commands *)
  705.    Display_Xfer_Commands;
  706.                                    (* Wait for command to be entered *)
  707. ReadChar:
  708.                                    (* No keyboard input yet *)
  709.    Kbd_Input := FALSE;
  710.  
  711.    REPEAT
  712.       Found_Ch := Async_Receive( Ch ) OR PibTerm_KeyPressed;
  713.       Done     := Done OR ( NOT Host_Carrier_Detect );
  714.       IF ( NOT Found_Ch ) THEN
  715.          GiveAwayTime( 2 );
  716.    UNTIL Done OR Found_Ch;
  717.                                    (* Process input from keyboard *)
  718.    Dont_Echo := FALSE;
  719.  
  720.    IF PibTerm_KeyPressed THEN
  721.       BEGIN
  722.          Read_Kbd( Ch );
  723.          Kbd_Input := TRUE;
  724.          IF ( ORD( Ch ) = ESC ) AND PibTerm_KeyPressed THEN
  725.             BEGIN
  726.                Dont_Echo := TRUE;
  727.                Read_Kbd( Ch );
  728.                CASE ORD( Ch ) OF
  729.                   F1 : Ch := 'G';
  730.                   F2 : Ch := 'Q';
  731.                   F3 : BEGIN
  732.                           DosJump('');
  733.                           Ch := ' ';
  734.                        END;
  735.                   F5 : BEGIN
  736.                           WRITELN;
  737.                           WRITELN('Current caller is ',Cur_User_Name);
  738.                           Ch := ' ';
  739.                        END;
  740.                END (* CASE *);
  741.             END;
  742.       END;
  743.  
  744.    IF ( Ch = ' ' ) THEN GOTO ReadChar;
  745.  
  746.    IF ( Not DONE ) THEN
  747.                                    (* Echo command character *)
  748.       IF( NOT Dont_Echo ) THEN
  749.          BEGIN
  750.             IF Printer_On THEN
  751.                Write_Prt_Str( Ch + CRLF_String );
  752.             IF Capture_On THEN
  753.                WRITELN( Capture_File, Ch );
  754.             Host_Send_String( Ch + CR_LF_Host );
  755.          END;
  756.                                    (* Process command request *)
  757.       CASE UpCase( Ch ) OF
  758.  
  759.          'U':  Upload_A_File;
  760.          'D':  Download_A_File;
  761.          'Q':  BEGIN
  762.                   IF Kbd_Input THEN
  763.                      BEGIN
  764.                         Host_Send_String_With_CR('System operator shutting ' +
  765.                                                   'down system.');
  766.                         Host_Send_String_With_CR('Thanks for calling.');
  767.                         Done := TRUE;
  768.                      END
  769.                   ELSE
  770.                      BEGIN
  771.                         Host_Send_String_With_CR('Quit and logoff');
  772.                         Done := TRUE;
  773.                      END;
  774.                END;
  775.          'L':  List_Files_For_Transfer;
  776.          'X':  Expert_On := NOT Expert_On;
  777.          'M':  BEGIN
  778.                   Back         := TRUE;
  779.                   Host_Section := 'M';
  780.                END;
  781.          'G':  IF Kbd_Input THEN
  782.                   BEGIN
  783.                      Host_Send_String_With_CR(' ... System operator wishes' +
  784.                                                ' to chat, please wait ...');
  785.                      Host_Send_String_With_CR(' ');
  786.                      Back           := TRUE;
  787.                      Last_Host_Sect := 'F';
  788.                      Host_Section   := 'G';
  789.                   END;
  790.  
  791.          'J':  IF ( Privilege = 'S' ) THEN
  792.                   BEGIN
  793.                      Host_Section   := 'D';
  794.                      Last_Host_Sect := 'F';
  795.                      Back           := TRUE;
  796.                   END
  797.                ELSE
  798.                   Host_Send_String( ^G );
  799.  
  800.          'Z':  IF Kbd_Input THEN
  801.                   DosJump('');
  802.  
  803.          ELSE  Host_Send_String( ^G );
  804.  
  805.       END (* CASE *)
  806.  
  807. END   (* Process_File_Transfer_Commands *);
  808.  
  809.