home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / bbs / pibterm / pibt3sp4 / sendmdm7.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-10-04  |  18.1 KB  |  457 lines
  1. (*----------------------------------------------------------------------*)
  2. (*        Send_Modem7_File --- Upload file with Modem7/Telink           *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Send_Modem7_File( Use_CRC: BOOLEAN );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  Send_Modem7_File                                     *)
  10. (*                                                                      *)
  11. (*     Purpose:    Uploads file using Modem7/Telink batch               *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        Send_Modem7_File( Use_CRC: BOOLEAN);                          *)
  16. (*                                                                      *)
  17. (*           Use_CRC --- TRUE to use CRC checking;                      *)
  18. (*                       FALSE to use Checksum checking.                *)
  19. (*                                                                      *)
  20. (*     Calls:   KeyPressed                                              *)
  21. (*              Async_Send                                              *)
  22. (*              Async_Receive_With_TimeOut                              *)
  23. (*              Get_Modem7_File_Name                                    *)
  24. (*              Check_KeyBoard                                          *)
  25. (*              RvsVideoOn                                              *)
  26. (*              RvsVideoOff                                             *)
  27. (*              Wait_For_Nak                                            *)
  28. (*              Send_File_Name                                          *)
  29. (*              Perform_Upload                                          *)
  30. (*                                                                      *)
  31. (*      Remarks:                                                        *)
  32. (*                                                                      *)
  33. (*         This routine performs wildcard directory searches and        *)
  34. (*         implements the Modem7 and Telink batch file transfer         *)
  35. (*         protocols.                                                   *)
  36. (*                                                                      *)
  37. (*----------------------------------------------------------------------*)
  38.  
  39. VAR
  40.    File_Pattern : AnyStr;
  41.    SFileName    : PACKED ARRAY[1..11] OF CHAR;
  42.    Int_Ch       : INTEGER;
  43.    Ch           : CHAR;
  44.    CheckSum     : INTEGER;
  45.    EndFName     : BOOLEAN;
  46.    I            : INTEGER;
  47.    J            : INTEGER;
  48.    Local_Save   : Saved_Screen_Ptr;
  49.    Tname        : STRING[10];
  50.    File_Entry   : Directory_Record;
  51.    Ack_OK       : BOOLEAN;
  52.    OK_File      : BOOLEAN;
  53.    Batch_Title  : AnyStr;
  54.  
  55. (*----------------------------------------------------------------------*)
  56. (*              Check_KeyBoard --- Check for keyboard input             *)
  57. (*----------------------------------------------------------------------*)
  58.  
  59. PROCEDURE Check_KeyBoard;
  60.  
  61. BEGIN (* Check_KeyBoard *)
  62.                                    (* If Alt_R found, stop transfer *)
  63.    IF KeyPressed THEN
  64.       BEGIN
  65.  
  66.          READ( Kbd, Ch );
  67.  
  68.          IF ( Ch = CHR( ESC ) ) AND KeyPressed THEN
  69.             BEGIN
  70.                READ( Kbd, Ch );
  71.                IF ORD( Ch ) = Alt_S THEN
  72.                   BEGIN
  73.                      Stop_Send := TRUE;
  74.                      WRITELN('  Alt_S accepted, transfer cancelled.');
  75.                   END;
  76.             END;
  77.  
  78.       END;
  79.  
  80. END   (* Check_KeyBoard *);
  81.  
  82. (*----------------------------------------------------------------------*)
  83. (*          Make_Telink_Header --- Send special TELINK header block     *)
  84. (*----------------------------------------------------------------------*)
  85.  
  86. PROCEDURE Make_Telink_Header;
  87.  
  88. (*----------------------------------------------------------------------*)
  89. (*                                                                      *)
  90. (*       Procedure:  Make_Telink_Header                                 *)
  91. (*                                                                      *)
  92. (*       Purpose:    Makes special TELINK header block                  *)
  93. (*                                                                      *)
  94. (*       Calling sequence:                                              *)
  95. (*                                                                      *)
  96. (*          Make_Telink_Header;                                         *)
  97. (*                                                                      *)
  98. (*       Calls:  None                                                   *)
  99. (*                                                                      *)
  100. (*       Remarks:                                                       *)
  101. (*                                                                      *)
  102. (*          The Telink header block is ALWAYS sent in Checksum mode,    *)
  103. (*          regardless of whether or not the files are to be sent in    *)
  104. (*          CRC or checksum mode.                                       *)
  105. (*                                                                      *)
  106. (*          Format of Telink block:                                     *)
  107. (*                                                                      *)
  108. (*             Bytes         Contents                                   *)
  109. (*             -----       ---------------------------------------      *)
  110. (*                                                                      *)
  111. (*               1           SYN                                        *)
  112. (*               2             0                                        *)
  113. (*               3           255                                        *)
  114. (*              4-7          File size in MS DOS directory form         *)
  115. (*              8-9          Creation date in MS DOS form               *)
  116. (*             10-11         Creation time in MS DOS form               *)
  117. (*             12-27         Name of file in 'name.ext' form            *)
  118. (*              28           Version number (always zero here)          *)
  119. (*             29-44         PIBTERM  -- sending program's name         *)
  120. (*             45-131        All zeroes                                 *)
  121. (*              132          Checksum of block                          *)
  122. (*                                                                      *)
  123. (*          The first three bytes are added later by the Xmodem send    *)
  124. (*          routine.  The rest are constructed here.                    *)
  125. (*                                                                      *)
  126. (*----------------------------------------------------------------------*)
  127.  
  128. VAR
  129.    I            : INTEGER;
  130.    J            : INTEGER;
  131.    L            : INTEGER;
  132.    CheckSum     : INTEGER;
  133.    ACK_Ok       : BOOLEAN;
  134.    Int_Ch       : INTEGER;
  135.  
  136. BEGIN (* Make_Telink_Header *)
  137.                                    (* Zero out block *)
  138.    FOR I := 1 TO 130 DO
  139.       Sector_Data[I] := 0;
  140.                                    (* File size in 32-bit MS DOS form *)
  141.  
  142.    Sector_Data[1]  := LO( File_Entry.File_Size[1] );
  143.    Sector_Data[2]  := HI( File_Entry.File_Size[1] );
  144.    Sector_Data[3]  := LO( File_Entry.File_Size[2] );
  145.    Sector_Data[4]  := HI( File_Entry.File_Size[2] );
  146.  
  147.                                    (* Creation date in MS DOS form *)
  148.  
  149.    Sector_Data[5]  := LO( File_Entry.File_Time );
  150.    Sector_Data[6]  := HI( File_Entry.File_Time );
  151.  
  152.                                    (* Creation time in MS DOS form *)
  153.  
  154.    Sector_Data[7] := LO( File_Entry.File_Date );
  155.    Sector_Data[8] := HI( File_Entry.File_Date );
  156.  
  157.                                    (* File name *)
  158.    L := LENGTH( FileName );
  159.  
  160.    FOR I := 1 TO L DO
  161.       Sector_Data[I+8] := ORD( FileName[I] );
  162.  
  163.    FOR I := ( L + 1 ) TO 16 DO
  164.       Sector_Data[I+8] := ORD(' ');
  165.  
  166.                                    (* Sending program's name *)
  167.    FOR I := 1 TO 16 DO
  168.       Sector_Data[I+25] := ORD( COPY( 'PIBTERM         ', I, 1 ) );
  169.  
  170.                                    (* Compute checksum *)
  171.    CheckSum := 0;
  172.  
  173.    FOR I := 1 TO 128 DO
  174.       CheckSum := ( CheckSum + Sector_Data[I] ) AND 255;
  175.  
  176.    Sector_Data[129] := CheckSum;
  177.  
  178. END   (* Make_Telink_Header *);
  179.  
  180. (*----------------------------------------------------------------------*)
  181. (*       Get_Modem7_File_Name --- Construct file name to MODEM7 form    *)
  182. (*----------------------------------------------------------------------*)
  183.  
  184. PROCEDURE Get_Modem7_File_Name( VAR OK_File : BOOLEAN );
  185.  
  186. (*----------------------------------------------------------------------*)
  187. (*                                                                      *)
  188. (*     Remarks:                                                         *)
  189. (*                                                                      *)
  190. (*        The filename for Modem7 is 11 characters long.  The filename  *)
  191. (*        is left-justified and blank-filled in the first 8 characters. *)
  192. (*        The extension appears left-justified and blank-filled in      *)
  193. (*        positions 9 through 11.                                       *)
  194. (*                                                                      *)
  195. (*        Examples:                                                     *)
  196. (*                                 12345678901                          *)
  197. (*           'root.dat'  becomes:  root    dat                          *)
  198. (*           'root'      becomes:  root                                 *)
  199. (*                                                                      *)
  200. (*        Note that the checksum INCLUDES the terminating Ctrl-z (SUB)  *)
  201. (*        character of the file name.                                   *)
  202. (*                                                                      *)
  203. (*        In host mode, a check is made to ensure that the file to be   *)
  204. (*        sent is on the transfer list.  If not, it is not sent.        *)
  205. (*                                                                      *)
  206. (*----------------------------------------------------------------------*)
  207.  
  208. BEGIN (* Get_Modem7_File_Name *)
  209.  
  210.    I             := 1;
  211.    J             := 0;
  212.    SFileName     := '           ';
  213.    FileName      := '';
  214.  
  215.    WHILE( File_Entry.File_Name[I] <> CHR( 0 ) ) AND ( I <= 12 ) DO
  216.       BEGIN
  217.  
  218.          Ch := File_Entry.File_Name[I];
  219.  
  220.          IF Ch = '.' THEN
  221.             J := 8
  222.          ELSE
  223.             BEGIN
  224.                J            := J + 1;
  225.                SFileName[J] := Ch;
  226.             END;
  227.  
  228.          FileName := FileName + Ch;
  229.  
  230.          I  := I + 1;
  231.  
  232.       END;
  233.                                    (* Get checksum *)
  234.    CheckSum := 0;
  235.  
  236.    FOR I := 1 TO 11 DO
  237.       CheckSum := ( CheckSum + ORD( SFileName[I] ) ) AND 255;
  238.  
  239.    CheckSum := ( CheckSum + SUB ) AND 255;
  240.  
  241.    OK_File := ( File_Entry.File_Attr AND
  242.                 ( Dir_Attr_Volume_Label + Dir_Attr_Subdirectory ) = 0 );
  243.  
  244.                                    (* If host mode, make sure file *)
  245.                                    (* is on xferlist!              *)
  246.    IF Host_Mode THEN
  247.       OK_File := Scan_Xfer_List( FileName );
  248.  
  249. END   (* Get_Modem7_File_Name *);
  250.  
  251. (*----------------------------------------------------------------------*)
  252. (*             Wait_For_Nak --- Wait for NAK at start of file name      *)
  253. (*----------------------------------------------------------------------*)
  254.  
  255. PROCEDURE Wait_For_Nak;
  256.  
  257. BEGIN (* Wait_For_Nak *)
  258.  
  259.    I := 0;
  260.                                    (* Wait up to minute for NAK *)
  261.    REPEAT
  262.       Async_Receive_With_Timeout( One_Second , Int_Ch );
  263.       Check_KeyBoard;
  264.       I := I + 1;
  265.    UNTIL ( Int_Ch  = NAK ) OR
  266.          ( I      >= 60  ) OR
  267.          Stop_Send;
  268.  
  269.    IF ( Int_Ch <> NAK ) THEN
  270.       BEGIN
  271.          Stop_Send := TRUE;
  272.          WRITELN('   NAK for start of file name not received;');
  273.          WRITELN('   Received Ascii ',Int_Ch,' instead.');
  274.       END
  275.    ELSE                            (* If NAK found, ACK it *)
  276.       BEGIN
  277.          WRITELN('   NAK for start of file name received.');
  278.          Async_Send( CHR( ACK ) );
  279.       END;
  280.                                    (* Wait for com line to clear *)
  281.    Async_Purge_Buffer;
  282.  
  283. END   (* Wait_For_Nak *);
  284.  
  285. (*----------------------------------------------------------------------*)
  286. (*             Send_File_Name --- Send file name characters             *)
  287. (*----------------------------------------------------------------------*)
  288.  
  289. PROCEDURE Send_File_Name;
  290.  
  291. (*----------------------------------------------------------------------*)
  292. (*                                                                      *)
  293. (*     Remarks:                                                         *)
  294. (*                                                                      *)
  295. (*        The file name characters are sent one at a time.  After       *)
  296. (*        each is sent, we wait for an ACK.  To end the file name       *)
  297. (*        we send an SUB (ctrl-z) character.                            *)
  298. (*                                                                      *)
  299. (*----------------------------------------------------------------------*)
  300.  
  301. BEGIN (* Send_File_Name *)
  302.  
  303.    I := 0;
  304.  
  305.    WHILE( NOT Stop_Send ) AND ( I < 11 ) DO
  306.       BEGIN
  307.  
  308.          I := I + 1;
  309.  
  310.          Async_Send( SFileName[I] );
  311.  
  312.          Async_Receive_With_TimeOut( Ten_Seconds , Int_Ch );
  313.  
  314.          Ack_OK := ( Int_Ch = ACK );
  315.  
  316.          Check_KeyBoard;
  317.  
  318.          Stop_Send := Stop_Send OR ( NOT Ack_OK );
  319.  
  320.       END;
  321.                                    (* Send End of file name character *)
  322.                                    (* and await receiver to send      *)
  323.                                    (* checksum.                       *)
  324.    IF NOT Stop_Send THEN
  325.       BEGIN
  326.  
  327.          Async_Send( CHR( SUB ) );
  328.  
  329.          Async_Receive_With_TimeOut( Ten_Seconds , Int_Ch );
  330.  
  331.          IF ( Int_Ch <> CheckSum ) THEN
  332.             BEGIN
  333.                Stop_Send := TRUE;
  334.                WRITELN('   Received checksum for filename not correct;');
  335.                WRITELN('   Correct checksum = ',CheckSum,', received ',Int_Ch);
  336.             END
  337.          ELSE
  338.             Async_Send( CHR( ACK ) );
  339.  
  340.       END;
  341.  
  342. END   (* Send_File_Name *);
  343.  
  344. (*----------------------------------------------------------------------*)
  345. (*                Perform_Upload --- Do the upload                      *)
  346. (*----------------------------------------------------------------------*)
  347.  
  348. PROCEDURE Perform_Upload;
  349.  
  350. BEGIN (* Perform_Upload *)
  351.  
  352.    Writelne('  Uploading: ' + FileName , TRUE );
  353.  
  354.    IF Transfer_Protocol = Telink THEN
  355.       Make_Telink_Header;
  356.  
  357.    IF ( NOT Stop_Send ) THEN
  358.       Send_Xmodem_File( Use_CRC );
  359.  
  360.    TextColor( Menu_Text_Color );
  361.  
  362. END   (* Perform_Upload *);
  363.  
  364. (*----------------------------------------------------------------------*)
  365.  
  366. BEGIN (* Send_Modem7_File *)
  367.                                    (* Open display window for transfers  *)
  368.    Save_Screen( Local_Save );
  369.  
  370.    CASE Transfer_Protocol OF
  371.       Telink     : Tname := 'Telink';
  372.       Modem7_Chk : Tname := 'Modem7 (Checksum)';
  373.       Modem7_CRC : Tname := 'Modem7 (CRC)';
  374.    END (* CASE *);
  375.  
  376.                                    (* Always CRC for Telink *)
  377.  
  378.    Use_CRC     := Use_CRC OR ( Transfer_Protocol = Telink );
  379.  
  380.    Batch_Title := 'Batch file upload using ' + Tname;
  381.  
  382.    Draw_Menu_Frame( 2, 2, 79, 24, Menu_Frame_Color,
  383.                     Menu_Text_Color, Batch_Title );
  384.  
  385.    Writelne( Batch_Title , FALSE );
  386.  
  387.    Window( 3, 3, 78, 23 );
  388.                                    (* Get file name pattern to send *)
  389.    File_Pattern  := FileName;
  390.                                    (* See if we can find anything to *)
  391.                                    (* be sent.                       *)
  392.  
  393.    Stop_Send    := ( Dir_Find_First_File( File_Pattern, File_Entry ) <> 0 );
  394.  
  395.    IF Stop_Send THEN
  396.       WRITELN('  No files found to send.');
  397.  
  398.                                    (* Loop over file names         *)
  399.    WHILE( NOT Stop_Send ) DO
  400.       BEGIN
  401.                                    (* Get file name *)
  402.  
  403.          Get_Modem7_File_Name( OK_File );
  404.  
  405.                                    (* If file can be sent, do it   *)
  406.          IF OK_File THEN
  407.             BEGIN
  408.                                    (* Wait for NAK indicating host *)
  409.                                    (* is ready for the file name.  *)
  410.                IF NOT Stop_Send THEN
  411.                   Wait_For_Nak;
  412.                                    (* Send file name characters     *)
  413.                IF NOT Stop_Send THEN
  414.                   Send_File_Name;
  415.                                    (* Send the file itself          *)
  416.                IF NOT Stop_Send THEN
  417.                   Perform_Upload;
  418.  
  419.             END;
  420.                                    (* See if more files to transfer *)
  421.  
  422.          Stop_Send := Stop_Send OR ( Dir_Find_Next_File( File_Entry ) <> 0 );
  423.  
  424.       END (* While *);
  425.  
  426.                                    (* Purge reception *)
  427.    REPEAT
  428.       Async_Receive_With_Timeout( One_Second , Int_Ch );
  429.    UNTIL ( Int_Ch = TimeOut );
  430.                                    (* Send EOT to indicate no more files *)
  431.    Async_Send( CHR( EOT ) );
  432.                                    (* Wait for ACK                       *)
  433.  
  434.    Async_Receive_With_TimeOut( Ten_Seconds , Int_Ch );
  435.  
  436.    IF ( Int_Ch = ACK ) THEN
  437.       BEGIN
  438.          Writelne(' ', TRUE);
  439.          Writelne('  Host system ACKnowledged EOT.', TRUE);
  440.       END;
  441.                                    (* Indicate end of transfer    *)
  442.    Writelne(' ', TRUE);
  443.  
  444.    RvsVideoOn ( Menu_Text_Color, BackGround_Color );
  445.  
  446.    Writelne('  Batch transfer complete.' , TRUE);
  447.  
  448.    RvsVideoOff( Menu_Text_Color, BackGround_COlor );
  449.  
  450.    DELAY( Two_Second_Delay );
  451.                                    (* Remove batch transfer window *)
  452.    Restore_Screen( Local_Save );
  453.  
  454.    Reset_Global_Colors;
  455.  
  456. END   (* Send_Modem7_File *);
  457. ə