home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: DFÜ und Kommunikation / SOS-DFUE.ISO / programm / dos / terminal / ca_29 / pc-2-pc.src < prev    next >
Encoding:
Text File  |  1992-11-30  |  52.2 KB  |  2,114 lines
  1. S29 = "ATE0Q0V1X1S0=2 S7=30 S9=10^M"    ; Modem init for autoconnect
  2. S19 = "PC-2-PC ver 1.1     "            ; 20 chars long
  3. ;
  4. ; ----- COM-AND Scripted PC-2-PC link
  5. ;    Commenced: 09/20/88 R.McG
  6. ;
  7. ;    Modified:  09/27/91
  8. ;           1.  To correctly transfer filenames with special characters,
  9. ;           such as "!" for both remote and local directories.
  10. ;    ..     2.  Also modified to use ZMODEM for all file transfers.
  11. ;    ..     3.  Also added CONNECT and DISCONNECT CLOG entries in order
  12. ;           that CALOGS will be able to process direct connections too.
  13. ; -----------------------------------------------------------------------
  14. ;    Goals:
  15. ;    o    Must autodetect connection
  16. ;    o    Must dial number on request
  17. ;    o    Must work correctly for modems reporting true CD and
  18. ;        also for direct connects
  19. ;
  20. ;    Functions:
  21. ;    o    Directory list - our current directory
  22. ;    o    Directory list - linked PC directory
  23. ;    o    Change subdirectory - our PC
  24. ;    o    Change subdirectory - linked PC
  25. ;    o    Transfers either way
  26. ; -----------------------------------------------------------------------
  27. ;    Usages:
  28. ;      FLAG(0) -> ON if link established
  29. ;      FLAG(1) -> ON if caller or initiator of connect
  30. ;      FLAG(2) -> Off if we are on 'our' side of the display
  31. ;      FLAG(3) -> On if direct connect
  32. ;
  33. ;      S29 -----> Modem initialization, including autoconnect command
  34. ;      S19 -----> Legend line
  35. ;      S18 -----> Load-time drive:subdirectory (for exit)
  36. ;      S17 -----> Load-time download d:subdir (for exit)
  37. ;
  38. ;      N99 -----> # screen lines
  39. ;      N98 -----> Debugging flag (for one side, two side tests)
  40. ;
  41. ;      N90 -----> Current cursor (1 to N99-5)
  42. ;      N91 -----> # local files selected
  43. ;      N92 -----> # remote files selected
  44. ;
  45. ;      S16 -----> local files selected (13 chars/field)
  46. ;      S15 -----> Remote files selected (13 chars/field)
  47. ;
  48. ;      S12 -----> Used by Change sides for line read/write
  49. ;      S11 -----> Used by various routines for saved file name
  50. ;      S10 -----> Used by various routines for saved ON ESCAPE label
  51. ; -----------------------------------------------------------------------
  52. ;
  53. ;    Initialization
  54. ;
  55. LEGEND S19            ; Set initial legend
  56. SUBDIR S18            ; Read current subdir
  57. DLDIR S17            ; Read current download subdir
  58. SET DLDIR " "                   ; Set download subdir to default
  59. SET FLAG(0) OFF         ; No current link
  60. SET FLAG(1) ON            ; Default - we called/initiated
  61. SET FLAG(2) Off         ; Default - on 'our side' of the display
  62. SET FLAG(3) Off         ; Default - dialed connect
  63. SET CDISP ON            ; Display control chars
  64. SET RDISP OFF            ; Don't display received chars
  65. SET SOFTFLOW OFF        ; Turn off our own flowctl
  66. ;SET HARDFLOW ON        ; Turn on hdwe flowctl
  67. SET ATIME 0            ; Set no alarm time
  68. SET ALARM OFF            ; Set no alarm sound
  69. SET CHAT OFF            ; Set chat off (just in case)
  70. SET XSUI 10            ; Set transer screen update interval
  71. ON ESCAPE GOSUB Exit        ; Escape action
  72. N90 = N91 = N92 = 0        ; Clear # files selected, cursor
  73. S16 = ""
  74. S15 = ""
  75. ;
  76. ;    Make 8n1 for best KERMIT throughput
  77. ;
  78. SET PARITY NONE
  79. SET DATA 8
  80. SET STOP 1
  81. ;
  82. ;    Debugging flag
  83. ;
  84. N98 = 0             ; Debugging if <> zero
  85. ;
  86. ;    Draw the screen, and decide if we're linked
  87. ;
  88. GOSUB InitScreen
  89. GOSUB BuildLocDir        ; Build our directory list
  90. IF ZERO N98            ; Test for debugging
  91.    GOSUB LinkTest        ; Not - make the link
  92. ELSE
  93.    FOPENI "PC2PC.LOC" TEXT      ; Open the file
  94.    ENDIF
  95. ;
  96. ; ----- Update the legend, and accept a command
  97. ;
  98. Main:
  99.     LEGEND S19
  100.     LOCATE (N99-3),77    ; Set the cursor
  101.     SOUND 440,100        ; Indicate we're ready
  102.     SET TTHRU OFF
  103. ;
  104. ;    Loop, waiting for a keypress or received commands
  105. ;
  106. Main100:
  107.     IF HITKEY        ; If a keypress pending
  108.        GOTO MAIN200     ; .. go handle it
  109.        ENDIF
  110.     IF RECEIVE        ; If comm port chars pending
  111.        GOTO MAIN300     ; .. go handle it
  112.        ENDIF
  113.     IF ZERO N98 AND NOT CONNECTED
  114.        GOTO Exit
  115.        ENDIF
  116.     GOTO Main100        ; And loop
  117. ;
  118. ;    We have a keypress pending
  119. ;
  120. MAIN200:
  121.     KEYGET S1        ; Read a single key
  122.     SWITCH S1
  123.        CASE "C"             ; Change directory
  124.           GOSUB ChangeOurDir
  125.        ENDCASE
  126.        CASE "E"             ; Exit
  127.           GOTO Exit     ; And exit
  128.        ENDCASE
  129.        CASE "H"             ; Help
  130.           GOSUB Help
  131.        ENDCASE
  132.        CASE "S"             ; Select
  133.           GOSUB Select
  134.        ENDCASE
  135.        CASE "T"             ; Transfer
  136.           GOSUB Transfer
  137.        ENDCASE
  138.        CASE "W"             ; Wildcard
  139.           GOSUB Wildcard    ; Send using wildcards
  140.        ENDCASE
  141.        CASE "4D00"          ; Cursor_Right
  142.           GOSUB Change_Sides
  143.        ENDCASE
  144.        CASE "4B00"          ; Cursor left
  145.           GOSUB Change_Sides
  146.        ENDCASE
  147.        CASE "4900"          ; PgUp
  148.           GOSUB Prev_Page
  149.        ENDCASE
  150.        CASE "5100"          ; PgDn
  151.           GOSUB Next_Page
  152.        ENDCASE
  153.        CASE "4700"          ; Home
  154.           GOSUB Home_Page
  155.        ENDCASE
  156.        CASE "4F00"          ; End
  157.           GOSUB End_Page
  158.        ENDCASE
  159.        CASE "4800"          ; Cursor Up
  160.           GOSUB Cursor_Up
  161.        ENDCASE
  162.        CASE "5000"          ; Cursor down
  163.           GOSUB Cursor_Down
  164.        ENDCASE
  165.        CASE "7100"          ; Alt-F10
  166.           SHELL
  167.        ENDCASE
  168.        DEFAULT
  169.          SOUND 100,100    ; Signal displeasure
  170.        ENDCASE
  171.     ENDSWITCH
  172.     GOTO Main        ; And continue
  173. ;
  174. ;    We have characters pending on the communications line
  175. ;
  176. MAIN300:
  177.     RGET S1 1        ; Read a single character
  178.     SWITCH S1
  179.        CASE "R"             ; Change directory
  180.           RGET S1 80 10    ; Read remainder
  181.           TRANSMIT "+!"     ; Acknowlege
  182.           GOSUB Remote_Chdir
  183.        ENDCASE
  184.        CASE "E"             ; Sender's local changed
  185.           GOTO Exit
  186.        ENDCASE
  187.        CASE "L"             ; Sender's local changed
  188.           RGET S1 80 10    ; Read remainder
  189.           TRANSMIT "+!"     ; Acknowlege
  190.           GOSUB Local_Chdir
  191.        ENDCASE
  192.        CASE "T"             ; Sender wants to transfer
  193.           RGET S1 80 10    ; Read remainder - note no ACK
  194.           GOSUB Rcv_Transfer
  195.        ENDCASE
  196.        CASE "W"             ; Sender's wants to xfer batch
  197.           RGET S1 80 10    ; Read remainder - note no ACK
  198.           GOSUB Rcv_Wildcard
  199.        ENDCASE
  200. ;       CASE "^M"            ; Carriage rtn
  201. ;       ENDCASE        ; Ignore it
  202.        CASE "?"             ; Link request
  203.           TRANSMIT "PC-2-PC!"
  204.           SET FLAG(1) OFF    ; Indicate we're receiving
  205.           GOSUB Exchange    ; Exchange directories
  206.        ENDCASE        ; Ignore it
  207.        DEFAULT        ; Unrecognized
  208.           RFLUSH        ; Clear line
  209.           GOTO Main100    ; And continue w/o beep
  210.        ENDCASE
  211.     ENDSWITCH
  212.     GOTO Main        ; And continue
  213. ;
  214. ; ----- Exit procedure - ESC has been hit
  215. ;    .. Restore screen, close files and delete temps
  216. ;
  217. Exit:
  218.     IF FLAG (0)        ; If linked
  219.        TRANSMIT "E!"        ; Terminate remote too
  220.        SET FLAG(0) OFF
  221.        ENDIF
  222.     TSINCE (9) N9,N8,N7
  223.     S3 = "DISCONNECT: ("&N9&":"&N8&":"&N7&")"
  224.     CLOG S3
  225.     IF CONNECTED and NOT FLAG(3)
  226.        HANGUP        ; Hangup if not direct
  227.        ENDIF
  228.     DO            ; There may be multiple saves outstanding
  229.        RESTORE        ; .. restore all
  230.        UNTIL FAILURE
  231.  
  232.     FCLOSEI         ; CLose files
  233.     FCLOSEO         ; ..
  234.     DELETE "PC2PC.LOC"      ; And delete them too
  235.     DELETE "PC2PC.REM"      ; ..
  236.  
  237.     CHDIR S18        ; Reset current subdir
  238. ; ***    SET HARDFLOW OFF    ; Disable
  239. ;
  240. ; ----- Terminate COM-AND and the script
  241. ;
  242.     SET CDRESPECT ON    ; Skip 'connected' query on exit
  243.     BYE            ; Terminate script AND COM-AND
  244. ;
  245. ; ----- Alternative to above... exit script
  246. ;    .. exchange this paragraph and the above if you want it this way
  247. ;    .. taking off the "***"s
  248. ;
  249. ***    RESET            ; Reset default parameters (bye doesn't care)
  250. ***    EXIT            ; And exit script
  251. ;
  252. ; ----- Subroutine: Clear the current cursor
  253. ;    .. according to the current stting of FLAG(2)
  254. ;
  255. Clear_Cursor:
  256.     IF NOT ZERO N90
  257.        GOSUB Read_Cursor
  258.        IF FLAG(2)        ; IF true we're on remote
  259.           ATSAY N90,41 (default) S12
  260.        ELSE
  261.           ATSAY N90, 2 (default) S12
  262.           ENDIF
  263.        ENDIF
  264.     RETURN
  265. ;
  266. ; ----- Subroutine: Display the current cursor
  267. ;    .. according to the current stting of FLAG(2)
  268. ;
  269. Set_Cursor:
  270.     GOSUB Read_Cursor
  271.     IF NOT ZERO N90
  272.        IF FLAG(2)        ; IF true we're on remote
  273.           IF NOT NULL S12
  274.          ATSAY N90,41 (contrast) S12
  275.           ELSE
  276.          N90 = N90-1
  277.          GOTO Set_Cursor
  278.          ENDIF
  279.        ELSE         ; On own side
  280.           IF NOT NULL S12
  281.          ATSAY N90, 2 (contrast) S12
  282.           ELSE
  283.          N90 = N90-1
  284.          GOTO Set_Cursor
  285.          ENDIF
  286.           ENDIF
  287.        ENDIF
  288.     RETURN
  289. ;
  290. ; ----- Subroutine: Read the line at the current cursor
  291. ;    .. according to the current stting of FLAG(2)
  292. ;    S12 returns the line at the current cursor
  293. ;
  294. Read_Cursor:
  295.     S12 = ""
  296.     IF NOT ZERO N90
  297.        IF FLAG(2)        ; IF true we're on Remote
  298.           ATSCR N90,41,37 S12
  299.        ELSE
  300.           ATSCR N90, 2,37 S12
  301.           ENDIF
  302.        ENDIF
  303.     RETURN
  304. ;
  305. ; ----- Subroutine: Move the cursor Up
  306. ;
  307. Cursor_Up:
  308.     GOSUB Clear_Cursor
  309.     IF NOT ZERO N90
  310.        N90 = N90-1
  311.     ELSE
  312.        N90 = N99-5
  313.        ENDIF
  314.     GOSUB Set_Cursor
  315.     RETURN
  316. ;
  317. ; ----- Subroutine: Move the cursor Down
  318. ;
  319. Cursor_Down:
  320.     GOSUB Clear_Cursor
  321.     IF LT N90 (N99-5)
  322.        N90 = N90+1
  323.     ELSE
  324.        N90 = 1
  325.        ENDIF
  326.     GOSUB Set_Cursor
  327.     RETURN
  328. ;
  329. ; ----- Subroutine: Change the display side
  330. ;
  331. Change_Sides:
  332.     GOSUB Clear_Cursor    ; Clear cursor if any
  333.     N90 = 0         ; Clear current cursor
  334.     IF FLAG(2)        ; IF true we're on remote
  335.        ATSAY N99-4,9  (default) " , , PgUp, PgDn "
  336.        ATSAY N99-4,48 (default) "  to this window "
  337.        SET FLAG(2) OFF
  338.        FOPENI "PC2PC.LOC" TEXT
  339.     ELSE
  340.        ATSAY N99-4,9  (default) "  to this window "
  341.        ATSAY N99-4,48 (default) " , , PgUp, PgDn "
  342.        SET FLAG(2) ON
  343.        FOPENI "PC2PC.REM" TEXT
  344.        ENDIF
  345.     RETURN
  346. ;
  347. ; ----- Subroutine: Clear a window - right or left
  348. ;    .. according to the current stting of FLAG(2)
  349. ;
  350. Clear_Window:
  351.     IF FLAG(2)        ; IF true we're on remote
  352.        SCROLL 0,1,40,(N99-5),77 (default)
  353.     ELSE
  354.        SCROLL 0,1,1,(N99-5),38 (default)
  355.        ENDIF
  356.     N90 = 0         ; Clear current cursor
  357.     RETURN
  358. ;
  359. ; ----- Subroutine: Display the previous page
  360. ;
  361. Prev_Page:
  362.     FRESTOREI        ; Restore pos of top of page
  363.     IF FAILURE        ; If first failed, exit
  364.        RETURN
  365.        ENDIF
  366.     FRESTOREI        ; Restore pos of top of previous page
  367.     IF FAILED        ; If at top of file
  368.        SOUND 100,100    ; Indicate no farther
  369.        ENDIF
  370.     FSAVEI            ; And save again
  371.     GOSUB Clear_Window    ; Clear right or left window
  372. ;
  373. ;    Read the current input file and display
  374. ;
  375. PRPA100:
  376.     N1 = 1            ; Set initial line #
  377. PRPA200:
  378.     READ S1 40 N0        ; Read a line
  379.     IF EOF
  380.        IF EQ N1 1        ; If nothing listed
  381.           GOTO Prev_Page    ; And try again
  382.           ENDIF
  383.        GOTO PRPAXIT     ; Exit on EOF
  384.        ENDIF
  385.     IF FLAG(2)        ; IF true we're on remote
  386.        ATSAY N1,41 (default) S1(0:35)
  387.     ELSE
  388.        ATSAY N1,2  (Default) S1(0:35)
  389.        ENDIF
  390.     INC N1
  391.     IF LE N1 (N99-5)
  392.        GOTO PRPA200
  393.        ENDIF
  394. PRPAXIT:
  395.     RETURN
  396. ;
  397. ; ----- Subroutine:  Display the next page
  398. ;
  399. Next_Page:
  400.     FSAVEI            ; And save again
  401.     GOSUB Clear_Window    ; Clear right or left window
  402.     GOTO PRPA100        ; And Display the page
  403. ;
  404. ; ----- Subroutine:  Set to the home page
  405. ;
  406. Home_Page:
  407.     REWIND            ; Rewind the input file
  408.     FSAVEI CLEAR        ; Clear the stack of positions
  409.     GOTO Next_Page        ; And display the next page
  410. ;
  411. ; ----- Subroutine:  Find the ending page
  412. ;
  413. End_Page:
  414.     FSAVEI            ; Save current position
  415.     GOSUB Clear_Window    ; Clear right or left window
  416. ;
  417. ;    Read the current input file for EOF
  418. ;
  419. ENPA100:
  420.     N1 = 1            ; Set initial line #
  421. ENPA200:
  422.     READ S1 40 N0        ; Read a line
  423.     IF EOF
  424.        IF EQ N1 1        ; Empty page
  425.           FRESTOREI     ; Set saved pos of EOF
  426.           IF FAILURE
  427.          RETURN
  428.          ENDIF
  429.           ENDIF
  430.        GOTO ENPAXIT     ; Exit on EOF
  431.        ENDIF
  432.     INC N1
  433.     IF LE N1 (N99-5)
  434.        GOTO ENPA200
  435.        ENDIF
  436.     FSAVEI            ; Save the current position
  437.     IF FAILED        ; Stack is full
  438.        FSAVEI SHIFT
  439.        FSAVEI
  440.        ENDIF
  441.     GOTO ENPA100        ; Read next page
  442. ;
  443. ;    End of loop
  444. ;
  445. ENPAXIT:
  446.     FSAVEI            ; Save EOF
  447.     IF FAILED        ; Stack is full
  448.        FSAVEI SHIFT
  449.        FSAVEI
  450.        ENDIF
  451.     GOTO PRev_Page        ; And display the previous page
  452. ;
  453. ; ----- Subroutine: Change subdirectory (on either side)
  454. ;
  455. ChangeOurDir:
  456.     IF FLAG(2)        ; We're on remote
  457.        IF NOT ZERO N92
  458.           GOTO CHDI200
  459.           ENDIF
  460.     ELSE
  461.        IF NOT ZERO N91
  462.           GOTO CHDI100
  463.           ENDIF
  464.        ENDIF
  465. ;
  466. ;    Save the current input file name, fully qualified
  467. ;
  468.     IF FLAG(2)        ; We're on remote
  469.        S11 = "PC2PC.REM"
  470.     ELSE
  471.        S11 = "PC2PC.LOC"
  472.        ENDIF
  473.     FFIRST S11
  474.     FNEXT S11 QUAL        ; Get qualified name of file
  475. ;
  476. ;    Ask for a new directory (and set it)
  477. ;
  478.     GOSUB Ask_Dir        ; Ask for subdir
  479.     IF FLAG(9)        ; If ESC out
  480.        RETURN        ; .. no-op
  481.        ENDIF
  482. ;
  483. ;    Close the input file and delete it
  484. ;
  485.     FCLOSEI         ; Close our directory file
  486.     DELETE S11        ; DELETE current PC2PC.LOC
  487. ;
  488. ;    And acquire a new directory
  489. ;
  490.     GOSUB Clear_Window    ; Clear whichever window
  491.     IF FLAG(2)        ; If we're on the remote
  492.        GOSUB BuildRemDir    ; Command remote, and receive new list
  493.     ELSE
  494.        GOSUB SendLocDir    ; Build a new, and send the update
  495.        ENDIF
  496. ;
  497. ;    Reset the input file, and we're done
  498. ;
  499.     IF FLAG(2)        ; We're on remote
  500.        S11 = "PC2PC.REM"
  501.     ELSE
  502.        S11 = "PC2PC.LOC"
  503.        ENDIF
  504.     FOPENI S11 TEXT     ; Open a new input file
  505.     RETURN
  506. ;
  507. ;    Files are selected on the local side
  508. ;    .. Ask if thry're to be deleted
  509. ;
  510. CHDI100:
  511.     S10 = "_ONESCAPE"               ; Save label previously set
  512.     ON ESCAPE GOSUB CHDIEsc     ; Escape out of pop-up
  513.  
  514.     SAVE 10,10,12,70
  515.     BOX  10,10,12,70 (contrast)
  516. CHDI110:
  517.     ATSAY 11,12 (contrast) "Files are selected on local side: Delete? Y/N: "
  518.     ATSAY 12,26 (contrast) " Press ESC to cancel "
  519.  
  520.     KEYGET S1        ; Wait for any key
  521.  
  522.     ON ESCAPE GOSUB S10    ; Reset original ON ESCAPE label
  523.     RESTORE         ; Restore screen under
  524.  
  525.     SWITCH S1
  526.        CASE "N"
  527.           RETURN
  528.        ENDCASE
  529.  
  530.        CASE "Y"
  531.           S16 = ""
  532.           N91 = 0
  533.           GOTO ChangeOurDir ; And continue
  534.        ENDCASE
  535.  
  536.        DEFAULT
  537.           SOUND 100,100
  538.           GOTO CHDI100
  539.        ENDCASE
  540.     ENDSWITCH
  541. ;
  542. ;    Files are selected on the remote side
  543. ;    .. Ask if thry're to be deleted
  544. ;
  545. CHDI200:
  546.     S10 = "_ONESCAPE"               ; Save label previously set
  547.     ON ESCAPE GOSUB CHDIEsc     ; Escape out of pop-up
  548.  
  549.     SAVE 10,10,12,70
  550.     BOX  10,10,12,70 (contrast)
  551.  
  552.     ATSAY 11,12 (contrast) "Files are selected on remote side: Delete? Y/N: "
  553.     ATSAY 12,26 (contrast) " Press ESC to cancel "
  554.  
  555.     KEYGET S1        ; Wait for any key
  556.  
  557.     ON ESCAPE GOSUB S10    ; Reset original ON ESCAPE label
  558.     RESTORE         ; Restore screen under
  559.  
  560.     SWITCH S1
  561.        CASE "N"
  562.           RETURN
  563.        ENDCASE
  564.  
  565.        CASE "Y"
  566.           S15 = ""
  567.           N92 = 0
  568.           GOTO ChangeOurDir ; And continue
  569.        ENDCASE
  570.  
  571.        DEFAULT
  572.           SOUND 100,100
  573.           GOTO CHDI200
  574.        ENDCASE
  575.     ENDSWITCH
  576. ;
  577. ;    Escape during "unimpl" window
  578. ;
  579. CHDIEsc:
  580.     S1 = ""
  581.     RETURN            ; And return to KEYGET above
  582. ;
  583. ; ----- Subroutine: Fatal disk error
  584. ;    .. Open a window, display, and exit
  585. ;
  586. Disc_Error:
  587.     BOX 10,10,12,70 (contrast)
  588.     ATSAY 11,12 (contrast) "Fatal disk error - PC2PC terminating"
  589.     ATSAY 12,26 (contrast) " Press any key to continue "
  590.  
  591.     KEYGET S0        ; Wait for any key
  592.     GOTO Exit        ; And we're done
  593. ;
  594. ; ----- Subroutine: Unimplemented function
  595. ;    .. Open a window, display, and and await keypress
  596. ;    S1,S10 modified
  597. ;
  598. Unimpl:
  599.     S10 = "_ONESCAPE"               ; Save label previously set
  600.     ON ESCAPE GOSUB UnimEsc     ; Escape out of pop-up
  601.  
  602.     SAVE 10,10,12,70
  603.     BOX  10,10,12,70 (contrast)
  604.  
  605.     ATSAY 11,12 (contrast) "Unimplemented function"
  606.     ATSAY 12,26 (contrast) " Press any key to continue "
  607.  
  608.     KEYGET S1        ; Wait for any key
  609.     ON ESCAPE GOSUB S10    ; Reset original ON ESCAPE label
  610.     RESTORE         ; Restore screen under
  611.     RETURN            ; And return to caller
  612. ;
  613. ;    Escape during "unimpl" window
  614. ;
  615. UnimEsc:
  616.     RETURN            ; And return to KEYGET above
  617. ;
  618. ; ----- Build our directory list (a file, PC2PC.LOC, and display)
  619. ;
  620. BuildLocDir:
  621.     FOPENO "PC2PC.LOC" TEXT ; Open, purge if need be
  622.     IF FAILURE
  623.        GOSUB Disc_Error
  624.        ENDIF
  625.  
  626.     FFIRST "*.*"            ; Initialize
  627.     IF Failure        ; If not found
  628.        FCLOSEO        ; Close (and flush) output file
  629.        RETURN        ; Quit here
  630.        ENDIF
  631.  
  632.     N1 = 1            ; Set loop counter
  633. ;
  634. ;    Read and display the file names
  635. ;
  636. BULD100:
  637.     FNEXT S1        ; Get next file name
  638.     IF Failure        ; If end of list
  639.        FCLOSEO        ; Close (and flush) output file
  640.        RETURN        ; Quit
  641.        ENDIF
  642. ;
  643. ;    Skip our own files
  644. ;
  645.     IF STRCMP S1 "PC2PC.LOC"
  646.        GOTO BULD100     ; SKip this file
  647.        ENDIF
  648.     IF STRCMP S1 "PC2PC.REM"
  649.        GOTO BULD100     ; SKip this file
  650.        ENDIF
  651.     IF STRCMP S1(1:1) "."   ; Skip parent subdir
  652.        GOTO BULD100     ; SKip this file
  653.        ENDIF
  654. ;
  655. ;    Handle subdirectories
  656. ;
  657.     FATTR S2 S1        ; Get attribute
  658.     IF STRCMP S2(3:3) "1"   ; If a subdirectory
  659.        GOTO BULD100     ; Goto endloop
  660.        ENDIF
  661. ;
  662. ;    Get remaining information and build the display line
  663. ;
  664.     FSIZE S2 S1        ; Get file size
  665.     FDATE S3 S1        ; Get file date
  666.     FTIME S4 S1        ; Get file time
  667.     S1(13:79) = S2        ; Set size
  668.     S1(21:79) = S3        ; Set date
  669.     S1(31:79) = S4        ; Set time
  670.     S1(36) = " "            ; Make last char blank
  671.     S1(37) = " "            ; Make last char blank
  672.     S1(38) = " "            ; Make last char blank
  673.     S1(39) = " "            ; Make last char blank
  674.     S1(40) = " "            ; Make last char blank
  675.     PRESERVE S1
  676. ;
  677. ;    Write the information to disc, and display the line
  678. ;
  679.     IF GE (N99-5),N1     ; If within window
  680.        ATSAY N1,2 (default) S1(0:36) ; And display
  681.        ENDIF
  682.     WRITE S1 40        ; Write the line to disk too
  683.     WRITE "^M" 2
  684.     INC N1            ; Count the line
  685.     GOTO BULD100        ; And continue
  686. ;
  687. ; ----- Subroutine: Test if we're linked
  688. ;
  689. LinkTest:
  690.     IF NOT CONNECTED    ; Test for carrier
  691.        GOTO NoLink        ; There can be no link
  692.        ENDIF
  693.     LEGEND " Testing for link"
  694. ;
  695. ;    Build an enquiry and wait for a response
  696. ;
  697.     RFLUSH            ; Clear pipe
  698.     TRANSMIT "!?!"          ; ? = enquiry
  699.     RGET S1 80 10        ; 10 second timeout - read the line
  700. ;
  701. ;    Interpret the response
  702. ;
  703.     IF FAILURE        ; If nothing received
  704.        GOTO NoLink        ; There is no link
  705.        ENDIF
  706.     IF NOT STRCMP S1 "PC-2-PC"
  707.        GOTO NoLink        ; Incorrect response
  708.        ENDIF
  709. ;
  710. ;    Exchange directory files
  711. ;
  712.     GOSUB Exchange        ; Exchange directories
  713.     IF NOT FLAG(0)        ; Exchange failed
  714.        GOTO NoLink
  715.        ENDIF
  716. ;
  717. ;    Flag that link has been established
  718. ;
  719. LinkXIT:
  720.     S19(20:79) = "Linked"
  721.     RETURN
  722. ;
  723. ;    Flag no link available
  724. ;    .. Note: Escape from here terminates the script
  725. ;
  726. NoLink:
  727.     RFLUSH            ; Clear pipe
  728.     LEGEND " Select link method"
  729.     SET FLAG(0) OFF
  730.     SAVE 8,10,21,70     ; Save for restore
  731.     BOX  8,10,21,70 (contrast)
  732.  
  733.     ATSAY  9,12 (contrast) "No link is detected: select one of the following:"
  734.     ATSAY 11,12 (contrast) "1) Direct connect "
  735.     ATSAY 12,12 (contrast) "2) Wait for direct connect"
  736.     ATSAY 14,12 (contrast) "3) Dial the remote PC"
  737.     ATSAY 15,12 (contrast) "4) Wait for call connect "
  738.     ATSAY 17,12 (contrast) "5) Change subdirectory "
  739.     ATSAY 18,12 (contrast) "6) Help"
  740.     ATSAY 20,12 (Contrast) "Select: "
  741.     ATSAY 21,28 (Contrast) " ESC terminates script "
  742. ;
  743. ;    Read the kbd for a response
  744. ;
  745. NOLI100:
  746.     LOCATE 20,21
  747.     KEYGET S1        ; Wait for any key
  748.     SWITCH S1        ; Act upone the entry
  749.        CASE "1"             ; Direct
  750.           GOSUB Direct    ; Set-up direct
  751.           IF not FLAG(9)    ; If escaped out
  752.          GOTO NOLI100    ; Ask again
  753.          ENDIF
  754.           COMPARM S3
  755.           S2 = "CONNECT: Direct Connect          " * S3 * " PC-TO-PC"
  756.           CLOG S2
  757.           SET TIMER (9)
  758.           SET FLAG(3) ON    ; Flag fact
  759.           RESTORE        ; Drop select window
  760.        ENDCASE
  761.  
  762.        CASE "2"             ; Await direct
  763.           GOSUB Await_Direct
  764.           IF not FLAG(9)    ; If escaped out
  765.          GOTO NOLI100    ; Ask again
  766.          ENDIF
  767.           GOSUB Respond    ; Wait for prompt
  768.           IF FLAG(1)    ; We didn't get the prompt
  769.          SOUND 880,500    ; Indicate problem
  770.          GOTO NOLI100
  771.          ENDIF
  772.           RESTORE        ; Drop select window
  773.           GOSUB Exchange    ; Exchange directories
  774.           IF FLAG(0)    ; We are connected
  775.          COMPARM S3
  776.          S2 = "CONNECT: Direct Connect          " * S3 * " PC-TO-PC"
  777.          CLOG S2
  778.          SET FLAG(3) ON ; Flag fact
  779.          GOTO LinkXIT    ; Exit LINKTEST
  780.          ENDIF
  781.        ENDCASE
  782.  
  783.        CASE "3"             ; Dial out
  784.           GOSUB Dial    ; Unimplemented
  785.           IF FLAG(9)    ; No connect indicated
  786.          GOTO NOLI100    ; .. or ESCAPE
  787.          ENDIF
  788.           CLOG "* PC-2-PC Dial done"
  789.           RESTORE        ; Drop select window
  790.        ENDCASE
  791.  
  792.        CASE "4"             ; Wait for call connect
  793.           GOSUB Await_Call    ; .. wait for connect
  794.           IF FLAG(9)    ; No connect indicated
  795.          GOTO NOLI100    ; .. or ESCAPE
  796.          ENDIF
  797.           GOSUB Respond    ; Wait for prompt
  798.           IF FLAG(1)    ; We didn't get the prompt
  799.          SOUND 880,500    ; Indicate problem
  800.          GOTO NOLI100
  801.          ENDIF
  802.           RESTORE        ; Clear window
  803.           GOSUB Exchange    ; Exchange directoroes
  804.           IF FLAG(0)    ; We are connected
  805.          CLOG "* PC-2-PC Dial auto-answer"
  806.          GOTO LinkXIT
  807.          ENDIF
  808.        ENDCASE
  809.  
  810.        CASE "5"             ; Set new subdirectory
  811.           FFIRST "PC2PC.LOC"
  812.           FNEXT S11 QUAL     ; Get qualified name of file
  813.           GOSUB Change_Dir    ; Ask for subdir
  814.           IF FLAG(9)    ; If ESC out
  815.          GOTO NOLI100    ; .. ask again
  816.          ENDIF
  817.           FCLOSEI        ; Close our directory file
  818.           DELETE S11    ; DELETE old PC2PC.LOC
  819.           RESTORE        ; Drop the current window
  820.           SCROLL 0,1,1,(N99-5),38 (default)
  821.           GOSUB BuildLocDir ; Redo the directory build
  822.           FOPENI "PC2PC.LOC" TEXT
  823.           GOTO NoLink    ; And redisplay window
  824.        ENDCASE
  825.  
  826.        CASE "6"             ; Help
  827.           GOSUB Help    ; Do a help screen
  828.           GOTO NOLI100    ; and read again
  829.        ENDCASE
  830.  
  831.        DEFAULT        ; None of the above
  832.          SOUND 100,100    ; Signal displeasure
  833.          GOTO NOLI100
  834.        ENDCASE
  835.     ENDSWITCH
  836. ;
  837. ;    We get here after one of the 'active' cases above
  838. ;
  839. ;***    PAUSE 3         ; Wait a bit
  840.     GOTO LinkTest        ; Go test again
  841. ;
  842. ; ----- Subroutine: Set-up and execute a direct connect
  843. ;    Flag(9) Is returned true if caller ESCapes
  844. ;    S1,S10 modified
  845. ;
  846. Direct:
  847.     SET CDRESPECT OFF    ; Turn off carrier respect
  848.     GOSUB Set_Parms     ; Set comm parms
  849.     RFLUSH            ; Clear line
  850.     RETURN
  851. ;
  852. ; ----- Subroutine: Await the a direct line
  853. ;    S1,S10 modified
  854. ;    Flag(9) Is returned true if caller ESCapes
  855. ;
  856. Await_Direct:
  857.     SET CDRESPECT OFF    ; Turn off carrier detect
  858.     GOSUB Set_Parms     ; Set comm parms
  859.     RFLUSH            ; Clear line
  860.     RETURN            ; And return
  861. ;
  862. ; ----- Subroutine: Set-up communications parms
  863. ;    FLAG (9) if rtnd true -> ESCAPE
  864. ;    S1,S10 modified
  865. ;
  866. Set_parms:
  867.     WOPEN 8,10,15,70 (Contrast) SEPAESC
  868.     SET FLAG(9) ON
  869.  
  870.     ATSAY  8,12 (contrast) " Direct connection - set parameters"
  871.     ATSAY  9,12 (contrast) "Select any of the following, CR to begin:"
  872.     ATSAY 10,12 (contrast) "A) COM1"
  873.     ATSAY 11,12 (contrast) "B) COM2"
  874.     ATSAY 12,12 (contrast) "C) COM3"
  875.     ATSAY 13,12 (contrast) "D) COM4"
  876.     ATSAY 10,22 (contrast) "1) 300"
  877.     ATSAY 11,22 (contrast) "2) 1200"
  878.     ATSAY 12,22 (contrast) "3) 2400"
  879.     ATSAY 13,22 (contrast) "4) 4800"
  880.     ATSAY 10,32 (contrast) "5) 9600"
  881.     ATSAY 11,32 (contrast) "6) 14.4k"
  882.     ATSAY 12,32 (contrast) "7) 19.2k"
  883.     ATSAY 13,32 (contrast) "8) 38.4k"
  884.     ATSAY 10,42 (contrast) "9) 57.6k"
  885.     ATSAY 11,42 (contrast) "0) 115k"
  886.     ATSAY 12,42 (contrast) "Note: 115k may yield"
  887.     ATSAY 13,42 (contrast) "a high error rate..."
  888.  
  889.     ATSAY 14,12 (contrast) "Current setting: "
  890.     ATSAY 15,29 (contrast) " Press ESC to cancel "
  891. SEPA100:
  892.     COMPARMS S1        ; Read current setting
  893.     ATSAY 14,29 (CONTRAST) S1(0:14)
  894.  
  895.     KEYGET S1        ; Wait for any key
  896.     SWITCH S1        ; Act upone the entry
  897.        CASE "0D"            ; Test for c/r entry
  898.           WCLOSE        ; Reset original ON ESCAPE label, and close window
  899.           RETURN        ; Return to caller if so
  900.        ENDCASE
  901.        CASE "A"
  902.           SET PORT COM1
  903.        ENDCASE
  904.        CASE "B"
  905.           SET PORT COM2
  906.        ENDCASE
  907.        CASE "C"
  908.           SET PORT COM3
  909.        ENDCASE
  910.        CASE "D"
  911.           SET PORT COM4
  912.        ENDCASE
  913.        CASE "1"
  914.           SET BAUD 300
  915.        ENDCASE
  916.        CASE "2"
  917.           SET BAUD 1200
  918.        ENDCASE
  919.        CASE "3"
  920.           SET BAUD 2400
  921.        ENDCASE
  922.        CASE "4"
  923.           SET BAUD 4800
  924.        ENDCASE
  925.        CASE "5"
  926.           SET BAUD 9600
  927.        ENDCASE
  928.        CASE "6"
  929.           SET BAUD 14k
  930.        ENDCASE
  931.        CASE "7"
  932.           SET BAUD 19K
  933.        ENDCASE
  934.        CASE "8"
  935.           SET BAUD 38K
  936.        ENDCASE
  937.        CASE "9"
  938.           SET BAUD 57K
  939.        ENDCASE
  940.        CASE "0"
  941.           SET BAUD 115K
  942.        ENDCASE
  943.        DEFAULT
  944.          SOUND 100,100    ; Signal displeasure
  945.        ENDCASE        ; End
  946.     ENDSWITCH
  947.     GOTO SEPA100
  948. ;
  949. ;    Escape during Set_Parms menu
  950. ;
  951. SEPAEsc:
  952.     S1 = "0D"               ; Fake a c/r entered
  953.     SET FLAG(9) OFF     ; Turn off rtn flag
  954.     RETURN            ; And return to KEYGET above
  955. ;
  956. ; ----- Subroutine: Dial another PC
  957. ;    S1,S10 modified
  958. ;    FLAG(9) Returned true -> error in dialing
  959. ;
  960. Dial:
  961.     S10 = "_ONESCAPE"       ; Save label previously set
  962.     ON ESCAPE GOSUB DialEsc ; Escape out of pop-up
  963.     LEGEND " Dialing remote PC"
  964.  
  965.     SAVE 10,10,12,70
  966.     BOX  10,10,12,70 (contrast)
  967.  
  968.     ATSAY 11,12 (contrast) "Enter number to be dialed: "
  969.     ATSAY 12,29 (contrast) " Press ESC to cancel "
  970. Dial100:
  971.     SET FLAG (9) ON     ; Indicate error
  972.     ATGET 11,39 (contrast) 4 S1 ;We expect no more than 4 chars
  973.     IF NULL S1
  974.        GOTO DialXIT     ; And exit
  975.        ENDIF
  976.     DIAL S1         ; Dial # given
  977.     IF FAILED        ; IF DIAL failed
  978.        SOUND 880,500    ; Indicate problem
  979.        GOTO Dial100     ; Ask again
  980.        ENDIF
  981.     CLOG "* PC-2-PC Dialed: "*"_call"
  982.     SET FLAG (9) OFF
  983. DialXIT:
  984.     ON ESCAPE GOSUB S10    ; Reset original ON ESCAPE label
  985.     RESTORE         ; Restore screen under
  986.     RETURN            ; And return to caller
  987. ;
  988. ;    Escape during "Dial" window
  989. ;
  990. DialEsc:
  991.     S1 = ""                 ; Make a null return
  992.     RETURN            ; And return to KEYGET above
  993. ;
  994. ; ----- Subroutine: Await a call from the remote PC
  995. ;    S1,S10 modified
  996. ;    FLAG(9) Returns true if ESC is taken
  997. ;
  998. Await_Call:
  999.     S10 = "_ONESCAPE"       ; Save label previously set
  1000.     ON ESCAPE GOSUB AWCAEsc ; Escape out of pop-up
  1001.     LEGEND " Waiting for call"
  1002.  
  1003.     SAVE 10,10,12,70
  1004.     BOX  10,10,12,70 (contrast)
  1005.  
  1006.     ATSAY 11,12 (contrast) "Waiting for call from remote"
  1007.     ATSAY 12,26 (contrast) " Press ESC to terminate "
  1008. ;
  1009. ;    Go into auto answer (echo off, answer on 2nd)
  1010. ;    Also: Return result codes, word form, with CONNECT 1200
  1011. ;
  1012.     SET PARITY NONE         ; Turn off parity
  1013.     SET DATA 8            ; Set 8 databits
  1014.     SET MASK ON            ; Mask received text to 7 bits
  1015.     SET FLAG(9) OFF         ; Assume OK
  1016. AWCA100:
  1017.     Pause 3             ; Wait 3 seconds
  1018.     HANGUP                ; HANGUP and leave modem in cmd mode
  1019.     PAUSE 3             ; Wait 3 secs
  1020.     TRANSMIT S29            ; Transmit init string, for autoconnect
  1021. ;
  1022. ;    Wait for a connect
  1023. ;
  1024. AWCA200:
  1025.     RGET S1 80 180            ; Wait for a line
  1026.     IF NOT SUCCESS            ; If nothing was read
  1027.        GOTO AWCAXIT         ; Exit on timeout or ESCape
  1028.        ENDIF
  1029.  
  1030.     FIND S1 "NO CARRIER"            ; Look for a disconn
  1031.     IF FOUND
  1032.        GOTO AWCA100
  1033.        ENDIF
  1034.  
  1035.     FIND S1 "CONNECT"               ; Anything else BUT CONNECT
  1036.     IF NOT FOUND            ; .. waits
  1037.        GOTO AWCA200
  1038.        ENDIF
  1039.  
  1040. ;***    IF NOT CONNECTED        ; Some modems don't seem fast enough
  1041. ;***       GOTO AWCA200
  1042. ;***       ENDIF
  1043. ;
  1044. ;    Change baud rate according to connect
  1045. ;
  1046.     IF FIND S1 "1200"               ; Test for 1200 baud
  1047.        SET BAUD 1200        ; Set to 1200 baud
  1048.        GOTO AWCAXIT         ; We're done.
  1049.        ENDIF
  1050.  
  1051.     IF FIND S1 "2400"               ; Test for 1400 baud
  1052.        SET BAUD 2400        ; Set to 1400 baud
  1053.        GOTO AWCAXIT         ; We're done.
  1054.        ENDIF
  1055.  
  1056.     IF FIND S1 "4800"
  1057.        SET BAUD 4800        ; Set to new rate
  1058.        GOTO AWCAXIT         ; Log the fact
  1059.        ENDIF
  1060.  
  1061.     IF FIND S1 "9600"
  1062.        SET BAUD 9600        ; Set to new rate
  1063.        GOTO AWCAXIT         ; Log the fact
  1064.        ENDIF
  1065.  
  1066.     IF FIND S1 "14400" or FIND S9 "14.4"
  1067.        SET BAUD 14k         ; Set to new rate
  1068.        GOTO AWCAXIT         ; Log the fact
  1069.        ENDIF
  1070.  
  1071.     IF FIND S1 "19200" or FIND S9 "19.2"
  1072.        SET BAUD 19k         ; Set to new rate
  1073.        GOTO AWCAXIT         ; Log the fact
  1074.        ENDIF
  1075.  
  1076.     IF FIND S1 "38400" or FIND S9 "38.4"
  1077.        SET BAUD 38k         ; Set to new rate
  1078.        GOTO AWCAXIT         ; Log the fact
  1079.        ENDIF
  1080.  
  1081.     IF FIND S1 "57600" or FIND S9 "57.6"
  1082.        SET BAUD 57k         ; Set to new rate
  1083.        GOTO AWCAXIT         ; Log the fact
  1084.        ENDIF
  1085. ;
  1086. ;    None of the above... set to 300
  1087. ;
  1088.     SET BAUD 300            ; Set to 1200 baud
  1089. ;
  1090. ;    We have connect (or ESCAPE)
  1091. ;
  1092. AWCAXIT:
  1093.     ON ESCAPE GOSUB S10    ; Reset original ON ESCAPE label
  1094.     RESTORE         ; Restore screen under
  1095.     RETURN            ; And return to caller
  1096. ;
  1097. ;    Escape during "Await" window
  1098. ;
  1099. AWCAEsc:
  1100.     SET FLAG(9) ON        ; Indicate escape
  1101.     RETURN            ; And return to KEYGET above
  1102. ;
  1103. ; ----- Subroutine: Change subdirectory
  1104. ;    FLAG(9) Returned true -> error or ESCAPE
  1105. ;
  1106. Change_Dir:
  1107.     GOSUB Ask_Dir
  1108.     IF NOT FLAG(9)
  1109.        CHDIR S1           ; Change subdirectory
  1110.        ENDIF
  1111.     RETURN
  1112. ;
  1113. ; ----- Subroutine: Query for a new subdirectory
  1114. ;    S1    Returns response
  1115. ;    FLAG(9) Returned true -> error or ESCAPE
  1116. ;
  1117. Ask_Dir:
  1118.     S10 = "_ONESCAPE"       ; Save label previously set
  1119.     ON ESCAPE GOSUB ASDIEsc ; Escape out of pop-up
  1120.  
  1121.     SAVE 10,1,12,77
  1122.     BOX  10,1,12,77 (contrast)
  1123.  
  1124.     ATSAY 11, 3 (contrast) "Enter new subdirectory: "
  1125.     ATSAY 12,28 (contrast) " Press ESC to cancel "
  1126. ASDI100:
  1127.     SET FLAG (9) ON     ; Indicate error
  1128.     ATGET 11,27 (contrast) 50 S1 ; Read response
  1129.     IF NOT NULL S1        ; Look for a null response
  1130.        SET FLAG (9) OFF
  1131.        ENDIF
  1132.  
  1133.     ON ESCAPE GOSUB S10    ; Reset original ON ESCAPE label
  1134.     RESTORE         ; Restore screen under
  1135.     RETURN            ; And return to caller
  1136. ;
  1137. ;    Escape during "Dial" window
  1138. ;
  1139. ASDIEsc:
  1140.     S1 = ""                 ; Make a null return
  1141.     RETURN            ; And return to KEYGET above
  1142. ;
  1143. ; ----- Subroutine: Wait for ENQ and respond
  1144. ;    .. FLAG (1) is set false upon successful completion
  1145. ;    S1,N1 modified
  1146. ;
  1147. Respond:
  1148.     LEGEND " Waiting for prompt"
  1149.     S10 = "_ONESCAPE"       ; Save label previously set
  1150.     ON ESCAPE GOSUB RESPEsc ; Escape out of pop-up
  1151.  
  1152.     SAVE 10,10,12,70
  1153.     BOX  10,10,12,70 (contrast)
  1154.  
  1155.     ATSAY 11,12 (contrast) "Waiting for prompt from remote"
  1156.     ATSAY 12,26 (contrast) " Press ESC to cancel "
  1157. RESP100:
  1158.     RGET S1 80,120        ; Wait 2 mins
  1159.     IF SUCCESS and NULL S1    ; If empty line rcv'd
  1160.        GOTO Resp100     ; Loop
  1161.        ENDIF
  1162.     IF SUCCESS and STRCMP S1(0:0) "?"   ; If enquiry received
  1163.        TRANSMIT "PC-2-PC!"  ; Transmit response
  1164.        SET FLAG(1) OFF    ; Indicate we're receiving
  1165.        ENDIF
  1166.  
  1167.     ON ESCAPE GOSUB S10    ; Reset original ON ESCAPE label
  1168.     RESTORE         ; Restore screen under
  1169.     LEGEND S19        ; Replace legend
  1170.     RETURN            ; And exit
  1171. ;
  1172. ;    Escape while waiting for prompt
  1173. ;
  1174. RESPEsc:
  1175.     S1 = "ESCAPE"           ; Make it non-null
  1176.     RETURN
  1177. ;
  1178. ; ----- Subroutine: Exchange subdirectory files
  1179. ;    .. FLAG (0) is set true upon successful completion
  1180. ;    S1,S2 N1,N2,N3,N4,N5 modified
  1181. ;
  1182. Exchange:
  1183.     FOPENO "PC2PC.REM" TEXT ; Open remote directory, purge if need be
  1184.     IF FAILURE
  1185.        GOSUB Disc_Error
  1186.        ENDIF
  1187.     FOPENI "PC2PC.LOC" TEXT ; Open our directory
  1188.     IF FAILURE
  1189.        GOSUB Disc_Error
  1190.        ENDIF
  1191.     LEGEND "Exchanging directory listings"
  1192. ;
  1193. ;    Initialize for a loop
  1194. ;
  1195.     N1 = 1            ; Screen line #
  1196.     N5 = 0            ; Error tracker
  1197.     IF FLAG(1)        ; If we're initiator
  1198.        GOTO EXCH200
  1199.        ENDIF
  1200. ;
  1201. ;    Wait for a response
  1202. ;    .. Comments removed from below to speed
  1203. ;
  1204. EXCH100:
  1205.     RGET S2 80 15
  1206.     PRESERVE S2
  1207.     IF Failure
  1208.        GOTO EXCHXIT
  1209.        ENDIF
  1210. ;
  1211. ;    Handle received NAK
  1212. ;
  1213.     IF NOT STRCMP S2(0:0) "+"
  1214.        INC N5
  1215.        IF GT N5,20
  1216.           GOTO EXCHXIT
  1217.           ENDIF
  1218.        GOTO EXCH210     ; Retransmit
  1219.        ENDIF
  1220. ;
  1221. ;    Perform a CRC check
  1222. ;
  1223.     LENGTH S2 N3
  1224.     IF GT N3 1
  1225.        CRC S2(1:40) N2
  1226.        ATOI S2(41:46) N4
  1227.        IF NE N2 N4
  1228.           GOTO EXCHERR
  1229.           ENDIF
  1230. ;
  1231. ;    1 character rcvd (ACK)
  1232. ;
  1233.     ELSE
  1234.        IF EOF
  1235.           TRANSMIT "+!"
  1236.           SET FLAG(0) ON
  1237.           GOTO EXCHXIT
  1238.           ENDIF
  1239.        LEGEND S19(0:19)&" Line "*N1&" exchanged"
  1240.        INC N1
  1241.        GOTO EXCH200
  1242.        ENDIF
  1243. ;
  1244. ;    Save the rcvd, and display
  1245. ;
  1246.     IF GE (N99-5),N1
  1247.        ATSAY N1,41 (default) S2(1:37)
  1248.     ELSE
  1249.        IF EQ (N99-4) N1
  1250.           FSAVEI
  1251.           ENDIF
  1252.        LEGEND S19(0:19)&" Line "*N1&" exchanged"
  1253.        ENDIF
  1254.     WRITE S2(1:40) 40
  1255.     WRITE "^M" 2
  1256.     INC N1
  1257. ;
  1258. ;    Send a line from our file
  1259. ;
  1260. EXCH200:
  1261.     N5 = 0
  1262.     READ S3 80 N2        ; Length read into N2
  1263.     PRESERVE S3
  1264.     S1 = S3
  1265.     IF EOF
  1266.        S1 = "!"             ; Make an cr line
  1267.        GOTO EXCH210     ; And and continue
  1268.        ENDIF
  1269.     CRC S1(0:39) N2     ; CRC what we read
  1270.     S1(40:50) = N2 &"!"     ; Place CRC and c/r into string
  1271. ;
  1272. ;    Transmit the line
  1273. ;
  1274. EXCH210:
  1275.     TRANSMIT "+"&S1
  1276.     GOTO EXCH100
  1277. ;
  1278. ;    Error on received line
  1279. ;
  1280. EXCHERR:
  1281.     INC N5
  1282.     IF GT N5,20
  1283.        GOTO EXCHXIT
  1284.        ENDIF
  1285.     TRANSMIT "-!"
  1286.     LEGEND "Exchange Error NAK"
  1287.     GOTO EXCH100
  1288. ;
  1289. ;    End of exchange procedure
  1290. ;
  1291. EXCHXIT:
  1292.     REWIND            ; REWIND input file (us)
  1293.     FCLOSEO         ; Close (and flush) output file
  1294.     LEGEND S19        ; Restore
  1295.     RETURN            ; And return to caller
  1296. ;
  1297. ; ----- Subroutine: Command (and receive) a remote directory build
  1298. ;    .. Send a 'C' command to the remote
  1299. ;    .. On entry, S1 contains the new directory
  1300. ;
  1301. BuildRemDir:
  1302.     TRANSMIT "R"& S1 &"!"   ; Send the command
  1303.     RGET S1 80 20        ; 10 second timeout - read the line
  1304.     PRESERVE S1
  1305.     IF FAILURE        ; Timeout on read
  1306.        SOUND 100,100    ; Indicate problem
  1307.        GOTO BURDXIT     ; And exit
  1308.        ENDIF
  1309.     IF NOT STRCMP S1(0) "+" ; Test for an ACK
  1310.        SOUND 200,100    ; Indicate problem
  1311.        GOTO BURDXIT     ; And exit
  1312.        ENDIF
  1313. ;
  1314. ;    Receive the new directory
  1315. ;
  1316.     FOPENO "PC2PC.REM" TEXT ; Open remote directory, purge if need be
  1317.     IF FAILURE
  1318.        GOSUB Disc_Error
  1319.        ENDIF
  1320.     LEGEND "Waiting to receive new directory"
  1321.     N1 = 1            ; Set loop/position ctr
  1322.     N5 = 0            ; Error counter
  1323. ;
  1324. ;    Wait for a response
  1325. ;
  1326. BURD100:
  1327.     RGET S2 80 120        ; Wait 2 mins max response
  1328.     PRESERVE S2
  1329.     IF Failure        ; If timeout on read
  1330.        GOTO BURDXIT     ; Exit proc
  1331.        ENDIF
  1332. ;
  1333. ;    Perform a CRC check on the text
  1334. ;
  1335.     LENGTH S2 N3        ; Look at the received line length
  1336.     IF GT N3 1        ; If not just an ACK alone
  1337.        CRC S2(1:40) N2    ; COmpute CRC of text
  1338.        ATOI S2(41:46) N4    ; Convert CRC embedded
  1339.        IF NE N2 N4        ; IF CRC's don't match
  1340.           TRANSMIT "-!"     ; Transmit a NAK
  1341.           INC N5        ; Increment error cnt
  1342.           IF GT N5,20
  1343.          GOTO BURDXIT
  1344.          ENDIF
  1345.           GOTO BURD100    ; And wait again for re-send
  1346.           ENDIF
  1347.        N5 = 0        ; Reset counter
  1348.     ELSE            ; Only one char sent
  1349.        TRANSMIT "+!"        ; And acknowlege
  1350.        GOTO BURDXIT     ; Exit - end of transmit
  1351.        ENDIF
  1352. ;
  1353. ;    Write the information to disc, and display the line
  1354. ;
  1355.     IF GE (N99-5),N1    ; If within window
  1356.        ATSAY N1,41 (default) S2(1:37) ; And display
  1357.     ELSE
  1358.        IF EQ (N99-4) N1
  1359.           FSAVEI
  1360.           ENDIF
  1361.        LEGEND S19(0:19)&" Line "*N1&" received"
  1362.        ENDIF
  1363.     WRITE S2(1:40) 40    ; Write the line to disk too
  1364.     WRITE "^M" 2
  1365.     INC N1            ; Count the line
  1366.     TRANSMIT "+!"           ; And acknowlege
  1367.     GOTO BURD100        ; And continue
  1368. ;
  1369. ;    End of receive procedure
  1370. ;
  1371. BURDXIT:
  1372.     FCLOSEO         ; Close (and flush) output file
  1373.     REWIND            ; Rewind the input file
  1374.     LEGEND S19        ; Restore
  1375.     RETURN            ; And return to caller
  1376. ;
  1377. ; ----- Subroutine: Remote commanded change of subdir
  1378. ;    .. We received a 'C' command
  1379. ;    .. S1 on entry is the new subdirectory
  1380. ;
  1381. Remote_Chdir:
  1382.     FCLOSEI         ; Close input just in case
  1383.     DELETE "PC2PC.LOC"      ; Delete our directory
  1384.  
  1385.     CHDIR S1        ; Set a new subdirectory
  1386.  
  1387.     IF FLAG(2)        ; If we're on remote
  1388.        GOSUB Change_sides    ; Switch our side
  1389.        ENDIF
  1390.     GOSUB Clear_Window    ; Clear our window
  1391.     LEGEND " Remote requested chdir"
  1392.  
  1393.     GOSUB BuildLocDir    ; Build a new directory
  1394.  
  1395.     FOPENI "PC2PC.LOC" TEXT ; Open our directory
  1396.     IF FAILURE
  1397.        GOSUB Disc_Error
  1398.        ENDIF
  1399.     N1 = 1
  1400.     N5 = 0
  1401. ;
  1402. ;    Send a line from our file
  1403. ;
  1404. RECH100:
  1405.     READ S3 80 N2        ; Length read into N2
  1406.     PRESERVE S3
  1407.     S1 = S3
  1408.     IF EOF
  1409.        S1 = "!"             ; Make an cr line
  1410.        GOTO RECH110     ; And continue
  1411.        ENDIF
  1412.  
  1413.     CRC S1(0:39) N2     ; CRC what we read
  1414.     S1(40:50) = N2 &"!"     ; Place CRC and c/r into string
  1415. RECH110:
  1416.     TRANSMIT "+"&S1         ; Transmit the line with an ACK
  1417.     LEGEND S19(0:19)&" Line "*N1&" sent"
  1418. ;
  1419. ;    Wait for a response
  1420. ;
  1421. RECH200:
  1422.     RGET S2 80 60        ; Wait 60 secs for a response
  1423.     PRESERVE S2
  1424.     IF Failure        ; If timeout on read
  1425.        GOTO RECHXIT     ; Exit proc
  1426.        ENDIF
  1427. ;
  1428. ;    Handle received NAK
  1429. ;
  1430.     IF NOT STRCMP S2(0:0) "+" ; IF NAK received
  1431.        INC N5        ; Increment error cnt
  1432.        IF GT N5,20
  1433.           GOTO RECHXIT
  1434.           ENDIF
  1435.        GOTO RECH110     ; .. resend last line
  1436.        ENDIF
  1437.     INC N1            ; Count the line sent
  1438.     N5 = 0            ; OKay
  1439.     IF NOT EOF
  1440.        GOTO RECH100     ; Go for more
  1441.        ENDIF
  1442. ;
  1443. ;    End of remote exchange procedure
  1444. ;
  1445. RECHXIT:
  1446.     REWIND            ; REWIND input file (us)
  1447.     LEGEND S19        ; Restore
  1448.     RETURN            ; And return to caller
  1449. ;
  1450. ; ----- Subroutine: Create a new directory, and send it to the remote
  1451. ;    .. Send an 'L' command
  1452. ;    .. On entry, S1 contains the new subdir
  1453. ;
  1454. SendLocDir:
  1455.     CHDIR S1        ; Change directory
  1456.     GOSUB BuildLocDir    ; Redo the directory build
  1457. ;
  1458. ;    Send the command, and wait for an acknowlegement
  1459. ;
  1460.     TRANSMIT "L!"           ; Send the command
  1461.     RGET S1 80 10        ; 10 second timeout - read the line
  1462.     PRESERVE S1
  1463.     IF FAILURE        ; Timeout on read
  1464.        SOUND 100,100    ; Indicate problem
  1465.        GOTO SELDXIT     ; And exit
  1466.        ENDIF
  1467.     IF NOT STRCMP S1(0) "+" ; Test for an ACK
  1468.        SOUND 200,100    ; Indicate problem
  1469.        GOTO SELDXIT     ; And exit
  1470.        ENDIF
  1471.  
  1472.     FOPENI "PC2PC.LOC" TEXT ; Open our directory
  1473.     IF FAILURE
  1474.        GOSUB Disc_Error
  1475.        ENDIF
  1476.     N1 = 1
  1477. ;
  1478. ;    Send a line from our file
  1479. ;
  1480. SELD100:
  1481.     READ S3 80 N2        ; Length read into N2
  1482.     PRESERVE S3
  1483.     S1 = S3
  1484.     IF EOF
  1485.        S1 = "!"             ; Make an cr line
  1486.        GOTO SELD110     ; And continue
  1487.        ENDIF
  1488.  
  1489.     CRC S1(0:39) N2     ; CRC what we read
  1490.     S1(40:50) = N2 &"!"     ; Place CRC and c/r into string
  1491. SELD110:
  1492.     TRANSMIT "+"&S1         ; Transmit the line with an ACK
  1493.     LEGEND S19(0:19)&" Line "*N1&" sent"
  1494. ;
  1495. ;    Wait for a response
  1496. ;
  1497. SELD200:
  1498.     RGET S2 80 60        ; Wait 60 secs for a response
  1499.     PRESERVE S2
  1500.     IF Failure        ; If timeout on read
  1501.        GOTO SELDXIT     ; Exit proc
  1502.        ENDIF
  1503. ;
  1504. ;    Handle received NAK
  1505. ;
  1506.     IF NOT STRCMP S2(0:0) "+" ; IF NAK received
  1507.        GOTO SELD110     ; .. resend last line
  1508.        ENDIF
  1509.     INC N1            ; Count the line sent
  1510.     IF NOT EOF
  1511.        GOTO SELD100     ; Go for more
  1512.        ENDIF
  1513. ;
  1514. ;    End of remote exchange procedure
  1515. ;
  1516. SELDXIT:
  1517.     REWIND            ; REWIND input file (us)
  1518.     LEGEND S19        ; Restore
  1519.     RETURN            ; And return to caller
  1520. ;
  1521. ; ----- Subroutine: Receive a new 'remote' directory
  1522. ;    .. We received an 'L' command
  1523. ;
  1524. Local_Chdir:
  1525.     FCLOSEI         ; Close input just in case
  1526.     DELETE "PC2PC.REM"      ; Delete remote directory
  1527.  
  1528.     IF NOT FLAG(2)        ; If we're on 'our' side
  1529.        GOSUB Change_sides    ; Switch our side
  1530.        ENDIF
  1531.  
  1532.     FOPENO "PC2PC.REM" TEXT ; Open our directory
  1533.     IF FAILURE
  1534.        GOSUB Disc_Error
  1535.        ENDIF
  1536.  
  1537.     N1 = 1
  1538.     LEGEND "Remote is sending new listing"
  1539.     GOSUB Clear_Window    ; Clear our window
  1540. ;
  1541. ;    Wait for a response
  1542. ;
  1543. LOCH100:
  1544.     RGET S2 80 120        ; Wait 2 mins max response
  1545.     PRESERVE S2
  1546.     IF Failure        ; If timeout on read
  1547.        GOTO LOCHXIT     ; Exit proc
  1548.        ENDIF
  1549. ;
  1550. ;    Perform a CRC check on the text
  1551. ;
  1552.     LENGTH S2 N3        ; Look at the received line length
  1553.     IF GT N3 1        ; If not just an ACK alone
  1554.        CRC S2(1:40) N2    ; COmpute CRC of text
  1555.        ATOI S2(41:46) N4    ; Convert CRC embedded
  1556.        IF NE N2 N4        ; IF CRC's don't match
  1557.           TRANSMIT "-!"     ; Transmit a NAK
  1558.           GOTO LOCH100    ; And wait again for response
  1559.           ENDIF
  1560.     ELSE            ; Only one char sent
  1561.        TRANSMIT "+!"        ; And acknowlege
  1562.        GOTO LOCHXIT     ; Exit - end of transmit
  1563.        ENDIF
  1564. ;
  1565. ;    Write the information to disc, and display the line
  1566. ;
  1567.     IF GE (N99-5),N1    ; If within window
  1568.        ATSAY N1,41 (default) S2(1:37) ; And display
  1569.     ELSE
  1570.        IF EQ (N99-4) N1
  1571.           FSAVEI
  1572.           ENDIF
  1573.        LEGEND S19(0:19)&" Line "*N1&" received"
  1574.        ENDIF
  1575.     WRITE S2(1:40) 40    ; Write the line to disk too
  1576.     WRITE "^M" 2
  1577.     INC N1            ; Count the line
  1578.     TRANSMIT "+!"           ; And acknowlege
  1579.     GOTO LOCH100        ; And continue
  1580. ;
  1581. ;    End of receive procedure
  1582. ;
  1583. LOCHXIT:
  1584.     FCLOSEO         ; Close (and flush) output file
  1585.     FOPENI "PC2PC.REM"      ; Open remote again
  1586.     LEGEND S19        ; Restore
  1587.     RETURN            ; And return to caller
  1588. ;
  1589. ; ----- Subroutine: Wildcard send
  1590. ;
  1591. Wildcard:
  1592.     LEGEND " Enter a wildcard spec for file(s) "
  1593.     WOPEN 10, 1,12,77 (contrast) WILDEsc
  1594. ;
  1595. ;    First: Ask for send/receive
  1596. ;
  1597.     ATSAY 11, 3 (contrast) "You may send or receive files: Enter S/R:  "
  1598.     ATSAY 12,27 (contrast) " Press ESC to cancel "
  1599. WILD100:
  1600.     ATGET 11,45 (contrast) 1 S1
  1601.     IF NULL S1
  1602.        GOTO WILDXIT     ; And exit
  1603.        ENDIF
  1604.     SWITCH S1
  1605.        CASE "S"
  1606.           SET FLAG(9) ON
  1607.        ENDCASE
  1608.        CASE "R"
  1609.           SET FLAG(9) OFF
  1610.        ENDCASE
  1611.        DEFAULT
  1612.           SOUND 100,100
  1613.           GOTO WILD100
  1614.        ENDCASE
  1615.     ENDSWITCH
  1616. ;
  1617. ;    Now, ask for a wildcard spec
  1618. ;
  1619. WILD200:
  1620.     BOX  10, 1,12,77 (contrast) ; Clear the window
  1621.     ATSAY 11, 3 (contrast) "Wildcard file spec: "
  1622.     ATSAY 12,27 (contrast) " Press ESC to cancel "
  1623.  
  1624.     ATGET 11,24 (contrast) 50 S1
  1625.     IF NULL S1
  1626.        GOTO WILDXIT     ; And exit
  1627.        ENDIF
  1628.     IF FLAG (9)        ; If sending
  1629.        FFIRST S1        ; Test for files available
  1630.        IF FAILED
  1631.           S1 = "No files match the given spec"
  1632.           GOSUB TranErr
  1633.           GOTO WILD200
  1634.           ENDIF
  1635.        TRANSMIT "WR!"       ; Send the command
  1636.     ELSE
  1637.        TRANSMIT "WS"& S1 &"!"
  1638.        ENDIF
  1639. ;
  1640. ;    Send the a command to remote, and wait for an acknowlegement
  1641. ;
  1642. WILD300:
  1643.     RGET S2 80 10        ; 10 second timeout - read the line
  1644.     IF FAILURE        ; Timeout on read
  1645.        S1 = "Remote has failed to acknowlege"
  1646.        GOSUB TranErr
  1647.        GOTO WILDXIT     ; And exit
  1648.        ENDIF
  1649.     IF NOT STRCMP S2(0) "+" ; Test for an ACK
  1650.        IF FLAG(9)
  1651.           GOTO WILD300    ; Try again
  1652.        ELSE
  1653.           S1 = "Sender reports no files matching your spec"
  1654.           GOSUB TranErr
  1655.           ENDIF
  1656.        GOTO WILDXIT     ; And exit
  1657.        ENDIF
  1658. ;
  1659. ;    Set-up our send/receive
  1660. ;
  1661.     IF FLAG(9)
  1662. ;       SENDFILE BYMODEM S1
  1663.        SENDFILE ZMODEM  S1
  1664.     ELSE
  1665. ;       GETFILE BYMODEM
  1666.        GETFILE ZMODEM
  1667.        ENDIF
  1668.     IF FAILED
  1669.        S1 = "Transfer has failed"
  1670.        GOSUB TranErr
  1671.        ENDIF
  1672. ;
  1673. ;    Exit the wildcard send
  1674. ;
  1675. WILDXIT:
  1676.     WCLOSE            ; Close open window
  1677.     LEGEND S19        ; Restore
  1678.     RETURN            ; And return to caller
  1679. ;
  1680. ;    Escape during "WILDCARD" window
  1681. ;
  1682. WILDEsc:
  1683.     S1 = ""                 ; Make a null return
  1684.     RETURN            ; And return to KEYGET above
  1685. ;
  1686. ; ----- Subroutine: Transfer error
  1687. ;    .. Open a window, display, and and await keypress
  1688. ;    S1 passes the message to display
  1689. ;    S11 is used to save ON ESCAPE, as this window is opened on another
  1690. ;
  1691. TranErr:
  1692.     S11 = "_ONESCAPE"               ; Save label previously set
  1693.     ON ESCAPE GOSUB TranEsc     ; Escape out of pop-up
  1694.  
  1695.     SAVE 10, 1,12,77
  1696.     BOX  10, 1,12,77 (contrast)
  1697.  
  1698.     ATSAY 11, 3 (contrast) S1
  1699.     ATSAY 12,26 (contrast) " Press any key to continue "
  1700.     SOUND 880,100
  1701.  
  1702.     KEYGET S0        ; Wait for any key
  1703.     ON ESCAPE GOSUB S11    ; Reset original ON ESCAPE label
  1704.     RESTORE         ; Restore screen under
  1705.     RETURN            ; And return to caller
  1706. ;
  1707. ;    Escape during "TranErr" window
  1708. ;
  1709. TranEsc:
  1710.     RETURN            ; And return to KEYGET above
  1711. ;
  1712. ; ----- Subroutine: Remote wildcard receive/send
  1713. ;    S1 contains the command ("WR" or "WS<spec>")
  1714. ;
  1715. Rcv_Wildcard:
  1716.     IF STRCMP S1(0) "S"
  1717.        FFIRST S1(1:79)    ; Test for files available
  1718.        IF FAILED
  1719.           TRANSMIT "-!"     ; Send a NAK
  1720.           RETURN
  1721.           ENDIF
  1722.        ENDIF
  1723. ;
  1724. ;    Acknowlege, and set-up the transfer
  1725. ;
  1726.     TRANSMIT "+!"
  1727.     IF STRCMP S1(0) "R"
  1728. ;       GETFILE BYMODEM
  1729.        GETFILE ZMODEM
  1730.     ELSE
  1731. ;       SENDFILE BYMODEM S1(1:79)
  1732.        SENDFILE ZMODEM  S1(1:79)
  1733.        ENDIF
  1734.     IF FAILED
  1735.        SOUND 880,500
  1736.        ENDIF
  1737.     RETURN
  1738. ;
  1739. ; ----- Subroutine: Select a file for transfer
  1740. ;
  1741. Select:
  1742.     IF FLAG(2)        ; We're on remote side
  1743.        N10 = N92
  1744.     ELSE
  1745.        N10 = N91
  1746.        ENDIF
  1747.  
  1748.     S10 = "_ONESCAPE"
  1749.     ON ESCAPE GOSUB SELEEsc
  1750. ;
  1751. ;    Open a window, and show current selections
  1752. ;
  1753.     LEGEND " Transfer selections"
  1754.     SAVE 8,10,20,70     ; Save for restore
  1755.     GOSUB Read_Cursor
  1756. ;
  1757. ;    Clear and redisplay
  1758. ;
  1759. SELE100:
  1760.     BOX  8,10,20,70 (contrast)
  1761.  
  1762.     ATSAY  9,12 (contrast) "   Local files selected     Remote files selected"
  1763.     ATSAY 11,12 (contrast) "1) "*S16(0:12)
  1764.     ATSAY 12,12 (contrast) "2) "*S16(13:25)
  1765.     ATSAY 13,12 (contrast) "3) "*S16(26:38)
  1766.     ATSAY 14,12 (contrast) "4) "*S16(39:51)
  1767.     ATSAY 15,12 (contrast) "5) "*S16(52:64)
  1768.  
  1769.     ATSAY 11,40 (contrast) "a) "*S15(0:12)
  1770.     ATSAY 12,40 (contrast) "b) "*S15(13:25)
  1771.     ATSAY 13,40 (contrast) "c) "*S15(26:38)
  1772.     ATSAY 14,40 (contrast) "d) "*S15(39:51)
  1773.     ATSAY 15,40 (contrast) "e) "*S15(52:64)
  1774.  
  1775.     IF LT N10 5 OR NULL S12
  1776.        ATSAY 17,12 (contrast) "Current cursor points to: "*S12(0:12)
  1777.        ATSAY 18,12 (contrast) "Do you wish to add this file (Y/N)?"
  1778.     ELSE
  1779.        ATSAY 17,12 (contrast) "No more files may be selected from this side"
  1780.        ATSAY 18,12 (contrast) "Enter a letter or number from above to clear an entry"
  1781.        ENDIF
  1782.     ATSAY 19,12 (Contrast) "Select: "
  1783.     ATSAY 20,28 (Contrast) " Press ESC to exit "
  1784. ;
  1785. ;    Read the kbd for a response
  1786. ;
  1787. SELE200:
  1788.     LOCATE    19,20
  1789.     KEYGET S1        ; Wait for any key
  1790.     SWITCH S1
  1791.        CASE "_NULL"
  1792.           GOTO SELEXIT
  1793.        ENDCASE
  1794.        CASE "Y"
  1795.           GOTO SELE500
  1796.        ENDCASE
  1797.        CASE "N"
  1798.           GOTO SELEXIT
  1799.        ENDCASE
  1800.  
  1801.        CASE "1"
  1802.           S16(0:79) = S16(13:79)
  1803.           GOTO SELE300
  1804.        ENDCASE
  1805.        CASE "2"
  1806.           S16(13:79) = S16(26:79)
  1807.           GOTO SELE300
  1808.        ENDCASE
  1809.        CASE "3"
  1810.           S16(26:79) = S16(39:79)
  1811.           GOTO SELE300
  1812.        ENDCASE
  1813.        CASE "4"
  1814.           S16(39:79) = S16(52:79)
  1815.           GOTO SELE300
  1816.        ENDCASE
  1817.        CASE "5"
  1818.           S16(52:79) = S16(65:79)
  1819.           GOTO SELE300
  1820.        ENDCASE
  1821.  
  1822.        CASE "A"
  1823.           S15(0:79) = S15(13:79)
  1824.           GOTO SELE400
  1825.        ENDCASE
  1826.        CASE "B"
  1827.           S15(13:79) = S15(26:79)
  1828.           GOTO SELE400
  1829.        ENDCASE
  1830.        CASE "C"
  1831.           S15(26:79) = S15(39:79)
  1832.           GOTO SELE400
  1833.        ENDCASE
  1834.        CASE "D"
  1835.           S15(39:79) = S15(52:79)
  1836.           GOTO SELE400
  1837.        ENDCASE
  1838.        CASE "E"
  1839.           S15(52:79) = S15(65:79)
  1840.           GOTO SELE400
  1841.        ENDCASE
  1842.  
  1843.        DEFAULT        ; Direct
  1844.          SOUND 100,100    ; Signal displeasure
  1845.          GOTO SELE200
  1846.        ENDCASE
  1847.     ENDSWITCH
  1848. ;
  1849. ;    Deleted a file from the local side
  1850. ;
  1851. SELE300:
  1852.     IF NOT ZERO N10
  1853.        DEC N91
  1854.        DEC N10
  1855.        ENDIF
  1856.     GOTO SELE100
  1857. ;
  1858. ;    Deleted a file from the remote side
  1859. ;
  1860. SELE400:
  1861.     IF NOT ZERO N10
  1862.        DEC N92
  1863.        DEC N10
  1864.        ENDIF
  1865.     GOTO SELE100
  1866. ;
  1867. ;    "Y" was entered
  1868. ;
  1869. SELE500:
  1870.     IF LT N10 5
  1871.        IF FLAG(2)        ; On remote side
  1872.           S15(N10*13:79) = S12(0:12)
  1873.           INC N10
  1874.           INC N92
  1875.        ELSE
  1876.           S16(N10*13:79) = S12(0:12)
  1877.           INC N10
  1878.           INC N91
  1879.           ENDIF
  1880.     ELSE
  1881.        SOUND 100,100
  1882.        GOTO SELE200
  1883.        ENDIF
  1884. ;
  1885. ;    The above case never falls through
  1886. ;
  1887. SELEXIT:
  1888.     ON ESCAPE GOSUB S10
  1889.     RESTORE
  1890.     RETURN
  1891. ;
  1892. ;    ESCAPE entered during select
  1893. ;
  1894. SELEESC:
  1895.     S1 = ""
  1896.     RETURN
  1897. ;
  1898. ; ----- Subroutine: Transfer selected files
  1899. ;
  1900. Transfer:
  1901.     IF ZERO N91 and ZERO N92
  1902.        S1 = "You have not selected a file to transfer"
  1903.        GOSUB TranErr
  1904.        RETURN
  1905.        ENDIF
  1906.  
  1907.     WOPEN 10,1 12,77 (contrast)
  1908.     ATSAY 11,3 (contrast) "Transfer in progress"
  1909. ;
  1910. ;    Send any files from the local side
  1911. ;
  1912. TRAN100:
  1913.     IF ZERO N91
  1914.        GOTO TRAN200
  1915.        ENDIF
  1916.  
  1917.     TRANSMIT "TR"& S16(0:12) &"!"   ; Command remote to receive
  1918. ;
  1919. ;    Send the a command to remote, and wait for an acknowlegement
  1920. ;
  1921. TRAN110:
  1922.     RGET S2 80 10        ; 10 second timeout - read the line
  1923.     IF FAILURE        ; Timeout on read
  1924.        S1 = "Remote has failed to acknowlege"
  1925.        GOSUB TranErr
  1926.        GOTO TRAN300     ; And exit
  1927.        ENDIF
  1928.     IF NOT STRCMP S2(0) "+" ; Test for an ACK
  1929.        GOTO TRAN110     ; Try again
  1930.        ENDIF
  1931. ;    SENDFILE XMODEM S16(0:12)
  1932.     SENDFILE ZMODEM S16(0:12)
  1933.     IF FAILED
  1934.        S1 = "Transfer has failed"
  1935.        GOSUB TranErr
  1936.        GOTO TRAN300
  1937.        ENDIF
  1938.     S16(0:79) = S16(13:79)
  1939.     DEC N91
  1940.     GOTO TRAN100
  1941. ;
  1942. ;    Receive any files from the remote side
  1943. ;
  1944. TRAN200:
  1945.     IF ZERO N92
  1946.        GOTO TRAN300
  1947.        ENDIF
  1948.  
  1949.     TRANSMIT "TS"& S15(0:12) &"!"   ; Command remote to send
  1950. ;
  1951. ;    Send the a command to remote, and wait for an acknowlegement
  1952. ;
  1953. TRAN210:
  1954.     RGET S2 80 10        ; 10 second timeout - read the line
  1955.     IF FAILURE        ; Timeout on read
  1956.        S1 = "Remote has failed to acknowlege"
  1957.        GOSUB TranErr
  1958.        GOTO TRAN300     ; And exit
  1959.        ENDIF
  1960.     IF NOT STRCMP S2(0) "+" ; Test for an ACK
  1961.        GOTO TRAN210     ; Try again
  1962.        ENDIF
  1963.     DELETE S15(0:12)
  1964. ;    GETFILE XMODEM S15(0:12)
  1965.     GETFILE ZMODEM
  1966.     IF FAILED
  1967.        S1 = "Transfer has failed"
  1968.        GOSUB TranErr
  1969.        GOTO TRAN300
  1970.        ENDIF
  1971.     S15(0:79) = S15(13:79)
  1972.     DEC N92
  1973.     GOTO TRAN200
  1974. ;
  1975. ;    Close the window opened above
  1976. ;
  1977. TRAN300:
  1978.     WCLOSE
  1979. ;
  1980. ;    And we're done
  1981. ;
  1982. TRANXIT:
  1983.     RETURN
  1984. ;
  1985. ; ----- Subroutine: Remote transfer receive/send
  1986. ;    S1 contains the command ("TR<file>" or "TS<file>")
  1987. ;
  1988. Rcv_Transfer:
  1989.     TRANSMIT "+!"
  1990.     IF STRCMP S1(0) "R"
  1991.        DELETE S1(1:13)
  1992. ;       GETFILE XMODEM S1(1:13)
  1993.        GETFILE ZMODEM
  1994.     ELSE
  1995. ;       SENDFILE XMODEM S1(1:13)
  1996.        SENDFILE ZMODEM S1(1:13)
  1997.        ENDIF
  1998.     IF FAILED
  1999.        SOUND 880,500
  2000.        ENDIF
  2001.     RETURN
  2002. ;
  2003. ; ----- Subroutine: Draw the basic screen box
  2004. ;
  2005. InitScreen:
  2006.     SSIZE N99
  2007.     SAVE 0,0,N99-2,79
  2008.  
  2009.     BOX   0, 0, (N99-2) ,78 (default)
  2010.  
  2011.     ATSAY 0, 18 (default) " Local "
  2012.     ATSAY 0, 35 (default) " PC-2-PC "
  2013.     ATSAY 0, 56 (default) " Remote "
  2014.  
  2015.     FOR N19 = 1 (N99-5) 1
  2016.         ATSAY N19 39 (default) "│"
  2017.         ENDFOR
  2018.  
  2019.     ATSAY N99-4,0  (default) "├─────────────────────────────────────────────────────────────────────────────┤"
  2020.     ATSAY N99-4,39 (default) "┴"
  2021.  
  2022.     ATSAY N99-4,9  (default) " , , PgUp, PgDn "
  2023.     ATSAY N99-4,48 (default) "  to this window "
  2024.     ATSAY N99-3,2  (Default) "H)elp, E)xit, C)hdir, W)ildcard, S)elect, T)ransfer and Alt-F10:"
  2025.     ATSAY N99-2,28 (Default) " Press ESC to terminate "
  2026.     RETURN
  2027. ;
  2028. ; ----- Subroutine: Help
  2029. ;
  2030. Help:
  2031.     SAVE  0 , 0,24,78
  2032.     BOX   0 , 0,24,78 (default)
  2033.  
  2034.     ATSAY  0, 2 (Default) " PC-2-PC "
  2035.     ATSAY 24,28 (Default) " Press any key to continue "
  2036.  
  2037.     S10 = "_ONESCAPE"
  2038.     ON ESCAPE GOSUB HELPESC
  2039.  
  2040.     IF FLAG(0)
  2041.        GOTO HELP100
  2042.        ENDIF
  2043. ;
  2044. ;    Help message prior to establishing link
  2045. ;
  2046.     ATSAY  1,2 (default) "PC-2-PC is a COM-AND script for linking PCs and exchanging files.  When    "
  2047.     ATSAY  2,2 (default) "PC-2-PC executed, it reads and displays the current subdirectory, and then  "
  2048.     ATSAY  3,2 (default) "prompts for a method to establish a link."
  2049.  
  2050.     ATSAY  5,2 (default) "Two link methods are provided, either DIRECT connect, or CALLing through    "
  2051.     ATSAY  6,2 (default) "the dialing directory.  Each method has two sides: one that initiates the   "
  2052.     ATSAY  7,2 (default) "connection, and one that awaits a connection.  The first script loaded (or  "
  2053.     ATSAY  8,2 (default) "the first PC to be loaded) is best instructed to 'await'.  The second to    "
  2054.     ATSAY  9,2 (default) "be loaded may then initiate the connection."
  2055.  
  2056.     ATSAY 11,2 (default) "A direct connection is, for example, an RS232 cable between async ports     "
  2057.     ATSAY 12,2 (default) "of two PCs.  The RS232 cable must be configured as a 'null modem' - i.e.,   "
  2058.     ATSAY 13,2 (default) "the send side of one PC must connect to the receive side of the other and   "
  2059.     ATSAY 14,2 (default) "vice versa.  As PC-2-PC ignores carrier using this method, even 3-wire      "
  2060.     ATSAY 15,2 (default) "null modem will work."
  2061.  
  2062.     ATSAY 17,2 (default) "A called connection uses a modem on each PC, and the dialing directory      "
  2063.     ATSAY 18,2 (default) "on one of them.  The modems must be able to communicate ordinarily (not     "
  2064.     ATSAY 19,2 (default) "all do).  The initiator of the called connection selects the dialing        "
  2065.     ATSAY 20,2 (default) "directory entry number (with or without LD prefix), and COM-AND dials       "
  2066.     ATSAY 21,2 (default) "in the ordinary fashion.  The PC awaiting the connect answers the call.     "
  2067.  
  2068.     ATSAY 23,2 (default) "Once connection has been established, the PC's exchange directory lists.    "
  2069.     GOTO HELPXIT
  2070. ;
  2071. ;    Help message after link established
  2072. ;
  2073. HELP100:
  2074.     ATSAY  1,2 (default) "The two PC's are connected, and directory listings have been exchanged.     "
  2075.     ATSAY  2,2 (default) "The left window is the current subdirectory on this PC.  The right window   "
  2076.     ATSAY  3,2 (default) "is the current directory on the remote.  Cursor-keys (left/right) change    "
  2077.     ATSAY  4,2 (default) "the 'active' window - you are either in the left or right windows."
  2078.  
  2079.     ATSAY  5,2 (default) "The 'C'hdir command will select a new drive:subdirectory on this PC (if     "
  2080.     ATSAY  6,2 (default) "the left window is active), and on the remote PC (if right window).         "
  2081.     ATSAY  7,2 (default) "The active window on the remote PC is switched (if need be) and a new       "
  2082.     ATSAY  8,2 (default) "list is displayed on both PC's."
  2083.  
  2084.     ATSAY 10,2 (default) "PgUp, PgDn, Home and End allow paging through the active window for files.  "
  2085.     ATSAY 11,2 (default) "Only paging is performed - the window is not scrolled line by line."
  2086.  
  2087.     ATSAY 13,2 (default) "Cursor-Up and Cursor-Down highlight files on the current page.  A lighted   "
  2088.     ATSAY 14,2 (default) "line is selected for transfer with 'S'elect.  Up to 5 files on the local    "
  2089.     ATSAY 15,2 (default) "side, and 5 files on the remote side may be selected.  A 'T'ransfer may be  "
  2090.     ATSAY 16,2 (default) "done at any time to transfer files (either from or to the local PC). "
  2091.  
  2092.     ATSAY 17,2 (default) "A wildcard file transfer is also available, selecting files to/from other   "
  2093.     ATSAY 18,2 (default) "than the current subdirectory, or where a template might make life easier.  "
  2094.     ATSAY 19,2 (default) "Unlike the 'T'ransfer command, you transfer using a wildcard only one       "
  2095.     ATSAY 20,2 (default) "direction at a time, either sending or receiving. "
  2096.  
  2097.     ATSAY 22,2 (default) "If you have selected files, you must transfer them before changing sub-     "
  2098.     ATSAY 23,2 (default) "directories.  E)xit terminates both sides if a called connected was made."
  2099.     GOTO HELPXIT
  2100. ;
  2101. ;    Wait for a keypress, and exit
  2102. ;
  2103. HELPXIT:
  2104.     KEYGET S0
  2105.  
  2106.     ON ESCAPE GOSUB S10
  2107.     RESTORE
  2108.     RETURN
  2109. ;
  2110. ;    ESCAPE pressed during the HELP
  2111. ;
  2112. HELPESC:
  2113.     RETURN
  2114.