Category : Communication (modem) tools and utilities
Archive   : CA29-3.ZIP
Filename : PC-2-PC.SRC

 
Output of file : PC-2-PC.SRC contained in archive : CA29-3.ZIP
S29 = "ATE0Q0V1X1S0=2 S7=30 S9=10^M" ; Modem init for autoconnect
S19 = "PC-2-PC ver 1.1 " ; 20 chars long
;
; ----- COM-AND Scripted PC-2-PC link
; Commenced: 09/20/88 R.McG
;
; Modified: 09/27/91
; 1. To correctly transfer filenames with special characters,
; such as "!" for both remote and local directories.
; .. 2. Also modified to use ZMODEM for all file transfers.
; .. 3. Also added CONNECT and DISCONNECT CLOG entries in order
; that CALOGS will be able to process direct connections too.
; -----------------------------------------------------------------------
; Goals:
; o Must autodetect connection
; o Must dial number on request
; o Must work correctly for modems reporting true CD and
; also for direct connects
;
; Functions:
; o Directory list - our current directory
; o Directory list - linked PC directory
; o Change subdirectory - our PC
; o Change subdirectory - linked PC
; o Transfers either way
; -----------------------------------------------------------------------
; Usages:
; FLAG(0) -> ON if link established
; FLAG(1) -> ON if caller or initiator of connect
; FLAG(2) -> Off if we are on 'our' side of the display
; FLAG(3) -> On if direct connect
;
; S29 -----> Modem initialization, including autoconnect command
; S19 -----> Legend line
; S18 -----> Load-time drive:subdirectory (for exit)
; S17 -----> Load-time download d:subdir (for exit)
;
; N99 -----> # screen lines
; N98 -----> Debugging flag (for one side, two side tests)
;
; N90 -----> Current cursor (1 to N99-5)
; N91 -----> # local files selected
; N92 -----> # remote files selected
;
; S16 -----> local files selected (13 chars/field)
; S15 -----> Remote files selected (13 chars/field)
;
; S12 -----> Used by Change sides for line read/write
; S11 -----> Used by various routines for saved file name
; S10 -----> Used by various routines for saved ON ESCAPE label
; -----------------------------------------------------------------------
;
; Initialization
;
LEGEND S19 ; Set initial legend
SUBDIR S18 ; Read current subdir
DLDIR S17 ; Read current download subdir
SET DLDIR " " ; Set download subdir to default
SET FLAG(0) OFF ; No current link
SET FLAG(1) ON ; Default - we called/initiated
SET FLAG(2) Off ; Default - on 'our side' of the display
SET FLAG(3) Off ; Default - dialed connect
SET CDISP ON ; Display control chars
SET RDISP OFF ; Don't display received chars
SET SOFTFLOW OFF ; Turn off our own flowctl
;SET HARDFLOW ON ; Turn on hdwe flowctl
SET ATIME 0 ; Set no alarm time
SET ALARM OFF ; Set no alarm sound
SET CHAT OFF ; Set chat off (just in case)
SET XSUI 10 ; Set transer screen update interval
ON ESCAPE GOSUB Exit ; Escape action
N90 = N91 = N92 = 0 ; Clear # files selected, cursor
S16 = ""
S15 = ""
;
; Make 8n1 for best KERMIT throughput
;
SET PARITY NONE
SET DATA 8
SET STOP 1
;
; Debugging flag
;
N98 = 0 ; Debugging if <> zero
;
; Draw the screen, and decide if we're linked
;
GOSUB InitScreen
GOSUB BuildLocDir ; Build our directory list
IF ZERO N98 ; Test for debugging
GOSUB LinkTest ; Not - make the link
ELSE
FOPENI "PC2PC.LOC" TEXT ; Open the file
ENDIF
;
; ----- Update the legend, and accept a command
;
Main:
LEGEND S19
LOCATE (N99-3),77 ; Set the cursor
SOUND 440,100 ; Indicate we're ready
SET TTHRU OFF
;
; Loop, waiting for a keypress or received commands
;
Main100:
IF HITKEY ; If a keypress pending
GOTO MAIN200 ; .. go handle it
ENDIF
IF RECEIVE ; If comm port chars pending
GOTO MAIN300 ; .. go handle it
ENDIF
IF ZERO N98 AND NOT CONNECTED
GOTO Exit
ENDIF
GOTO Main100 ; And loop
;
; We have a keypress pending
;
MAIN200:
KEYGET S1 ; Read a single key
SWITCH S1
CASE "C" ; Change directory
GOSUB ChangeOurDir
ENDCASE
CASE "E" ; Exit
GOTO Exit ; And exit
ENDCASE
CASE "H" ; Help
GOSUB Help
ENDCASE
CASE "S" ; Select
GOSUB Select
ENDCASE
CASE "T" ; Transfer
GOSUB Transfer
ENDCASE
CASE "W" ; Wildcard
GOSUB Wildcard ; Send using wildcards
ENDCASE
CASE "4D00" ; Cursor_Right
GOSUB Change_Sides
ENDCASE
CASE "4B00" ; Cursor left
GOSUB Change_Sides
ENDCASE
CASE "4900" ; PgUp
GOSUB Prev_Page
ENDCASE
CASE "5100" ; PgDn
GOSUB Next_Page
ENDCASE
CASE "4700" ; Home
GOSUB Home_Page
ENDCASE
CASE "4F00" ; End
GOSUB End_Page
ENDCASE
CASE "4800" ; Cursor Up
GOSUB Cursor_Up
ENDCASE
CASE "5000" ; Cursor down
GOSUB Cursor_Down
ENDCASE
CASE "7100" ; Alt-F10
SHELL
ENDCASE
DEFAULT
SOUND 100,100 ; Signal displeasure
ENDCASE
ENDSWITCH
GOTO Main ; And continue
;
; We have characters pending on the communications line
;
MAIN300:
RGET S1 1 ; Read a single character
SWITCH S1
CASE "R" ; Change directory
RGET S1 80 10 ; Read remainder
TRANSMIT "+!" ; Acknowlege
GOSUB Remote_Chdir
ENDCASE
CASE "E" ; Sender's local changed
GOTO Exit
ENDCASE
CASE "L" ; Sender's local changed
RGET S1 80 10 ; Read remainder
TRANSMIT "+!" ; Acknowlege
GOSUB Local_Chdir
ENDCASE
CASE "T" ; Sender wants to transfer
RGET S1 80 10 ; Read remainder - note no ACK
GOSUB Rcv_Transfer
ENDCASE
CASE "W" ; Sender's wants to xfer batch
RGET S1 80 10 ; Read remainder - note no ACK
GOSUB Rcv_Wildcard
ENDCASE
; CASE "^M" ; Carriage rtn
; ENDCASE ; Ignore it
CASE "?" ; Link request
TRANSMIT "PC-2-PC!"
SET FLAG(1) OFF ; Indicate we're receiving
GOSUB Exchange ; Exchange directories
ENDCASE ; Ignore it
DEFAULT ; Unrecognized
RFLUSH ; Clear line
GOTO Main100 ; And continue w/o beep
ENDCASE
ENDSWITCH
GOTO Main ; And continue
;
; ----- Exit procedure - ESC has been hit
; .. Restore screen, close files and delete temps
;
Exit:
IF FLAG (0) ; If linked
TRANSMIT "E!" ; Terminate remote too
SET FLAG(0) OFF
ENDIF
TSINCE (9) N9,N8,N7
S3 = "DISCONNECT: ("&N9&":"&N8&":"&N7&")"
CLOG S3
IF CONNECTED and NOT FLAG(3)
HANGUP ; Hangup if not direct
ENDIF
DO ; There may be multiple saves outstanding
RESTORE ; .. restore all
UNTIL FAILURE

FCLOSEI ; CLose files
FCLOSEO ; ..
DELETE "PC2PC.LOC" ; And delete them too
DELETE "PC2PC.REM" ; ..

CHDIR S18 ; Reset current subdir
; *** SET HARDFLOW OFF ; Disable
;
; ----- Terminate COM-AND and the script
;
SET CDRESPECT ON ; Skip 'connected' query on exit
BYE ; Terminate script AND COM-AND
;
; ----- Alternative to above... exit script
; .. exchange this paragraph and the above if you want it this way
; .. taking off the "***"s
;
*** RESET ; Reset default parameters (bye doesn't care)
*** EXIT ; And exit script
;
; ----- Subroutine: Clear the current cursor
; .. according to the current stting of FLAG(2)
;
Clear_Cursor:
IF NOT ZERO N90
GOSUB Read_Cursor
IF FLAG(2) ; IF true we're on remote
ATSAY N90,41 (default) S12
ELSE
ATSAY N90, 2 (default) S12
ENDIF
ENDIF
RETURN
;
; ----- Subroutine: Display the current cursor
; .. according to the current stting of FLAG(2)
;
Set_Cursor:
GOSUB Read_Cursor
IF NOT ZERO N90
IF FLAG(2) ; IF true we're on remote
IF NOT NULL S12
ATSAY N90,41 (contrast) S12
ELSE
N90 = N90-1
GOTO Set_Cursor
ENDIF
ELSE ; On own side
IF NOT NULL S12
ATSAY N90, 2 (contrast) S12
ELSE
N90 = N90-1
GOTO Set_Cursor
ENDIF
ENDIF
ENDIF
RETURN
;
; ----- Subroutine: Read the line at the current cursor
; .. according to the current stting of FLAG(2)
; S12 returns the line at the current cursor
;
Read_Cursor:
S12 = ""
IF NOT ZERO N90
IF FLAG(2) ; IF true we're on Remote
ATSCR N90,41,37 S12
ELSE
ATSCR N90, 2,37 S12
ENDIF
ENDIF
RETURN
;
; ----- Subroutine: Move the cursor Up
;
Cursor_Up:
GOSUB Clear_Cursor
IF NOT ZERO N90
N90 = N90-1
ELSE
N90 = N99-5
ENDIF
GOSUB Set_Cursor
RETURN
;
; ----- Subroutine: Move the cursor Down
;
Cursor_Down:
GOSUB Clear_Cursor
IF LT N90 (N99-5)
N90 = N90+1
ELSE
N90 = 1
ENDIF
GOSUB Set_Cursor
RETURN
;
; ----- Subroutine: Change the display side
;
Change_Sides:
GOSUB Clear_Cursor ; Clear cursor if any
N90 = 0 ; Clear current cursor
IF FLAG(2) ; IF true we're on remote
ATSAY N99-4,9 (default) " , , PgUp, PgDn "
ATSAY N99-4,48 (default) "  to this window "
SET FLAG(2) OFF
FOPENI "PC2PC.LOC" TEXT
ELSE
ATSAY N99-4,9 (default) "  to this window "
ATSAY N99-4,48 (default) " , , PgUp, PgDn "
SET FLAG(2) ON
FOPENI "PC2PC.REM" TEXT
ENDIF
RETURN
;
; ----- Subroutine: Clear a window - right or left
; .. according to the current stting of FLAG(2)
;
Clear_Window:
IF FLAG(2) ; IF true we're on remote
SCROLL 0,1,40,(N99-5),77 (default)
ELSE
SCROLL 0,1,1,(N99-5),38 (default)
ENDIF
N90 = 0 ; Clear current cursor
RETURN
;
; ----- Subroutine: Display the previous page
;
Prev_Page:
FRESTOREI ; Restore pos of top of page
IF FAILURE ; If first failed, exit
RETURN
ENDIF
FRESTOREI ; Restore pos of top of previous page
IF FAILED ; If at top of file
SOUND 100,100 ; Indicate no farther
ENDIF
FSAVEI ; And save again
GOSUB Clear_Window ; Clear right or left window
;
; Read the current input file and display
;
PRPA100:
N1 = 1 ; Set initial line #
PRPA200:
READ S1 40 N0 ; Read a line
IF EOF
IF EQ N1 1 ; If nothing listed
GOTO Prev_Page ; And try again
ENDIF
GOTO PRPAXIT ; Exit on EOF
ENDIF
IF FLAG(2) ; IF true we're on remote
ATSAY N1,41 (default) S1(0:35)
ELSE
ATSAY N1,2 (Default) S1(0:35)
ENDIF
INC N1
IF LE N1 (N99-5)
GOTO PRPA200
ENDIF
PRPAXIT:
RETURN
;
; ----- Subroutine: Display the next page
;
Next_Page:
FSAVEI ; And save again
GOSUB Clear_Window ; Clear right or left window
GOTO PRPA100 ; And Display the page
;
; ----- Subroutine: Set to the home page
;
Home_Page:
REWIND ; Rewind the input file
FSAVEI CLEAR ; Clear the stack of positions
GOTO Next_Page ; And display the next page
;
; ----- Subroutine: Find the ending page
;
End_Page:
FSAVEI ; Save current position
GOSUB Clear_Window ; Clear right or left window
;
; Read the current input file for EOF
;
ENPA100:
N1 = 1 ; Set initial line #
ENPA200:
READ S1 40 N0 ; Read a line
IF EOF
IF EQ N1 1 ; Empty page
FRESTOREI ; Set saved pos of EOF
IF FAILURE
RETURN
ENDIF
ENDIF
GOTO ENPAXIT ; Exit on EOF
ENDIF
INC N1
IF LE N1 (N99-5)
GOTO ENPA200
ENDIF
FSAVEI ; Save the current position
IF FAILED ; Stack is full
FSAVEI SHIFT
FSAVEI
ENDIF
GOTO ENPA100 ; Read next page
;
; End of loop
;
ENPAXIT:
FSAVEI ; Save EOF
IF FAILED ; Stack is full
FSAVEI SHIFT
FSAVEI
ENDIF
GOTO PRev_Page ; And display the previous page
;
; ----- Subroutine: Change subdirectory (on either side)
;
ChangeOurDir:
IF FLAG(2) ; We're on remote
IF NOT ZERO N92
GOTO CHDI200
ENDIF
ELSE
IF NOT ZERO N91
GOTO CHDI100
ENDIF
ENDIF
;
; Save the current input file name, fully qualified
;
IF FLAG(2) ; We're on remote
S11 = "PC2PC.REM"
ELSE
S11 = "PC2PC.LOC"
ENDIF
FFIRST S11
FNEXT S11 QUAL ; Get qualified name of file
;
; Ask for a new directory (and set it)
;
GOSUB Ask_Dir ; Ask for subdir
IF FLAG(9) ; If ESC out
RETURN ; .. no-op
ENDIF
;
; Close the input file and delete it
;
FCLOSEI ; Close our directory file
DELETE S11 ; DELETE current PC2PC.LOC
;
; And acquire a new directory
;
GOSUB Clear_Window ; Clear whichever window
IF FLAG(2) ; If we're on the remote
GOSUB BuildRemDir ; Command remote, and receive new list
ELSE
GOSUB SendLocDir ; Build a new, and send the update
ENDIF
;
; Reset the input file, and we're done
;
IF FLAG(2) ; We're on remote
S11 = "PC2PC.REM"
ELSE
S11 = "PC2PC.LOC"
ENDIF
FOPENI S11 TEXT ; Open a new input file
RETURN
;
; Files are selected on the local side
; .. Ask if thry're to be deleted
;
CHDI100:
S10 = "_ONESCAPE" ; Save label previously set
ON ESCAPE GOSUB CHDIEsc ; Escape out of pop-up

SAVE 10,10,12,70
BOX 10,10,12,70 (contrast)
CHDI110:
ATSAY 11,12 (contrast) "Files are selected on local side: Delete? Y/N: "
ATSAY 12,26 (contrast) " Press ESC to cancel "

KEYGET S1 ; Wait for any key

ON ESCAPE GOSUB S10 ; Reset original ON ESCAPE label
RESTORE ; Restore screen under

SWITCH S1
CASE "N"
RETURN
ENDCASE

CASE "Y"
S16 = ""
N91 = 0
GOTO ChangeOurDir ; And continue
ENDCASE

DEFAULT
SOUND 100,100
GOTO CHDI100
ENDCASE
ENDSWITCH
;
; Files are selected on the remote side
; .. Ask if thry're to be deleted
;
CHDI200:
S10 = "_ONESCAPE" ; Save label previously set
ON ESCAPE GOSUB CHDIEsc ; Escape out of pop-up

SAVE 10,10,12,70
BOX 10,10,12,70 (contrast)

ATSAY 11,12 (contrast) "Files are selected on remote side: Delete? Y/N: "
ATSAY 12,26 (contrast) " Press ESC to cancel "

KEYGET S1 ; Wait for any key

ON ESCAPE GOSUB S10 ; Reset original ON ESCAPE label
RESTORE ; Restore screen under

SWITCH S1
CASE "N"
RETURN
ENDCASE

CASE "Y"
S15 = ""
N92 = 0
GOTO ChangeOurDir ; And continue
ENDCASE

DEFAULT
SOUND 100,100
GOTO CHDI200
ENDCASE
ENDSWITCH
;
; Escape during "unimpl" window
;
CHDIEsc:
S1 = ""
RETURN ; And return to KEYGET above
;
; ----- Subroutine: Fatal disk error
; .. Open a window, display, and exit
;
Disc_Error:
BOX 10,10,12,70 (contrast)
ATSAY 11,12 (contrast) "Fatal disk error - PC2PC terminating"
ATSAY 12,26 (contrast) " Press any key to continue "

KEYGET S0 ; Wait for any key
GOTO Exit ; And we're done
;
; ----- Subroutine: Unimplemented function
; .. Open a window, display, and and await keypress
; S1,S10 modified
;
Unimpl:
S10 = "_ONESCAPE" ; Save label previously set
ON ESCAPE GOSUB UnimEsc ; Escape out of pop-up

SAVE 10,10,12,70
BOX 10,10,12,70 (contrast)

ATSAY 11,12 (contrast) "Unimplemented function"
ATSAY 12,26 (contrast) " Press any key to continue "

KEYGET S1 ; Wait for any key
ON ESCAPE GOSUB S10 ; Reset original ON ESCAPE label
RESTORE ; Restore screen under
RETURN ; And return to caller
;
; Escape during "unimpl" window
;
UnimEsc:
RETURN ; And return to KEYGET above
;
; ----- Build our directory list (a file, PC2PC.LOC, and display)
;
BuildLocDir:
FOPENO "PC2PC.LOC" TEXT ; Open, purge if need be
IF FAILURE
GOSUB Disc_Error
ENDIF

FFIRST "*.*" ; Initialize
IF Failure ; If not found
FCLOSEO ; Close (and flush) output file
RETURN ; Quit here
ENDIF

N1 = 1 ; Set loop counter
;
; Read and display the file names
;
BULD100:
FNEXT S1 ; Get next file name
IF Failure ; If end of list
FCLOSEO ; Close (and flush) output file
RETURN ; Quit
ENDIF
;
; Skip our own files
;
IF STRCMP S1 "PC2PC.LOC"
GOTO BULD100 ; SKip this file
ENDIF
IF STRCMP S1 "PC2PC.REM"
GOTO BULD100 ; SKip this file
ENDIF
IF STRCMP S1(1:1) "." ; Skip parent subdir
GOTO BULD100 ; SKip this file
ENDIF
;
; Handle subdirectories
;
FATTR S2 S1 ; Get attribute
IF STRCMP S2(3:3) "1" ; If a subdirectory
GOTO BULD100 ; Goto endloop
ENDIF
;
; Get remaining information and build the display line
;
FSIZE S2 S1 ; Get file size
FDATE S3 S1 ; Get file date
FTIME S4 S1 ; Get file time
S1(13:79) = S2 ; Set size
S1(21:79) = S3 ; Set date
S1(31:79) = S4 ; Set time
S1(36) = " " ; Make last char blank
S1(37) = " " ; Make last char blank
S1(38) = " " ; Make last char blank
S1(39) = " " ; Make last char blank
S1(40) = " " ; Make last char blank
PRESERVE S1
;
; Write the information to disc, and display the line
;
IF GE (N99-5),N1 ; If within window
ATSAY N1,2 (default) S1(0:36) ; And display
ENDIF
WRITE S1 40 ; Write the line to disk too
WRITE "^M" 2
INC N1 ; Count the line
GOTO BULD100 ; And continue
;
; ----- Subroutine: Test if we're linked
;
LinkTest:
IF NOT CONNECTED ; Test for carrier
GOTO NoLink ; There can be no link
ENDIF
LEGEND " Testing for link"
;
; Build an enquiry and wait for a response
;
RFLUSH ; Clear pipe
TRANSMIT "!?!" ; ? = enquiry
RGET S1 80 10 ; 10 second timeout - read the line
;
; Interpret the response
;
IF FAILURE ; If nothing received
GOTO NoLink ; There is no link
ENDIF
IF NOT STRCMP S1 "PC-2-PC"
GOTO NoLink ; Incorrect response
ENDIF
;
; Exchange directory files
;
GOSUB Exchange ; Exchange directories
IF NOT FLAG(0) ; Exchange failed
GOTO NoLink
ENDIF
;
; Flag that link has been established
;
LinkXIT:
S19(20:79) = "Linked"
RETURN
;
; Flag no link available
; .. Note: Escape from here terminates the script
;
NoLink:
RFLUSH ; Clear pipe
LEGEND " Select link method"
SET FLAG(0) OFF
SAVE 8,10,21,70 ; Save for restore
BOX 8,10,21,70 (contrast)

ATSAY 9,12 (contrast) "No link is detected: select one of the following:"
ATSAY 11,12 (contrast) "1) Direct connect "
ATSAY 12,12 (contrast) "2) Wait for direct connect"
ATSAY 14,12 (contrast) "3) Dial the remote PC"
ATSAY 15,12 (contrast) "4) Wait for call connect "
ATSAY 17,12 (contrast) "5) Change subdirectory "
ATSAY 18,12 (contrast) "6) Help"
ATSAY 20,12 (Contrast) "Select: "
ATSAY 21,28 (Contrast) " ESC terminates script "
;
; Read the kbd for a response
;
NOLI100:
LOCATE 20,21
KEYGET S1 ; Wait for any key
SWITCH S1 ; Act upone the entry
CASE "1" ; Direct
GOSUB Direct ; Set-up direct
IF not FLAG(9) ; If escaped out
GOTO NOLI100 ; Ask again
ENDIF
COMPARM S3
S2 = "CONNECT: Direct Connect " * S3 * " PC-TO-PC"
CLOG S2
SET TIMER (9)
SET FLAG(3) ON ; Flag fact
RESTORE ; Drop select window
ENDCASE

CASE "2" ; Await direct
GOSUB Await_Direct
IF not FLAG(9) ; If escaped out
GOTO NOLI100 ; Ask again
ENDIF
GOSUB Respond ; Wait for prompt
IF FLAG(1) ; We didn't get the prompt
SOUND 880,500 ; Indicate problem
GOTO NOLI100
ENDIF
RESTORE ; Drop select window
GOSUB Exchange ; Exchange directories
IF FLAG(0) ; We are connected
COMPARM S3
S2 = "CONNECT: Direct Connect " * S3 * " PC-TO-PC"
CLOG S2
SET FLAG(3) ON ; Flag fact
GOTO LinkXIT ; Exit LINKTEST
ENDIF
ENDCASE

CASE "3" ; Dial out
GOSUB Dial ; Unimplemented
IF FLAG(9) ; No connect indicated
GOTO NOLI100 ; .. or ESCAPE
ENDIF
CLOG "* PC-2-PC Dial done"
RESTORE ; Drop select window
ENDCASE

CASE "4" ; Wait for call connect
GOSUB Await_Call ; .. wait for connect
IF FLAG(9) ; No connect indicated
GOTO NOLI100 ; .. or ESCAPE
ENDIF
GOSUB Respond ; Wait for prompt
IF FLAG(1) ; We didn't get the prompt
SOUND 880,500 ; Indicate problem
GOTO NOLI100
ENDIF
RESTORE ; Clear window
GOSUB Exchange ; Exchange directoroes
IF FLAG(0) ; We are connected
CLOG "* PC-2-PC Dial auto-answer"
GOTO LinkXIT
ENDIF
ENDCASE

CASE "5" ; Set new subdirectory
FFIRST "PC2PC.LOC"
FNEXT S11 QUAL ; Get qualified name of file
GOSUB Change_Dir ; Ask for subdir
IF FLAG(9) ; If ESC out
GOTO NOLI100 ; .. ask again
ENDIF
FCLOSEI ; Close our directory file
DELETE S11 ; DELETE old PC2PC.LOC
RESTORE ; Drop the current window
SCROLL 0,1,1,(N99-5),38 (default)
GOSUB BuildLocDir ; Redo the directory build
FOPENI "PC2PC.LOC" TEXT
GOTO NoLink ; And redisplay window
ENDCASE

CASE "6" ; Help
GOSUB Help ; Do a help screen
GOTO NOLI100 ; and read again
ENDCASE

DEFAULT ; None of the above
SOUND 100,100 ; Signal displeasure
GOTO NOLI100
ENDCASE
ENDSWITCH
;
; We get here after one of the 'active' cases above
;
;*** PAUSE 3 ; Wait a bit
GOTO LinkTest ; Go test again
;
; ----- Subroutine: Set-up and execute a direct connect
; Flag(9) Is returned true if caller ESCapes
; S1,S10 modified
;
Direct:
SET CDRESPECT OFF ; Turn off carrier respect
GOSUB Set_Parms ; Set comm parms
RFLUSH ; Clear line
RETURN
;
; ----- Subroutine: Await the a direct line
; S1,S10 modified
; Flag(9) Is returned true if caller ESCapes
;
Await_Direct:
SET CDRESPECT OFF ; Turn off carrier detect
GOSUB Set_Parms ; Set comm parms
RFLUSH ; Clear line
RETURN ; And return
;
; ----- Subroutine: Set-up communications parms
; FLAG (9) if rtnd true -> ESCAPE
; S1,S10 modified
;
Set_parms:
WOPEN 8,10,15,70 (Contrast) SEPAESC
SET FLAG(9) ON

ATSAY 8,12 (contrast) " Direct connection - set parameters"
ATSAY 9,12 (contrast) "Select any of the following, CR to begin:"
ATSAY 10,12 (contrast) "A) COM1"
ATSAY 11,12 (contrast) "B) COM2"
ATSAY 12,12 (contrast) "C) COM3"
ATSAY 13,12 (contrast) "D) COM4"
ATSAY 10,22 (contrast) "1) 300"
ATSAY 11,22 (contrast) "2) 1200"
ATSAY 12,22 (contrast) "3) 2400"
ATSAY 13,22 (contrast) "4) 4800"
ATSAY 10,32 (contrast) "5) 9600"
ATSAY 11,32 (contrast) "6) 14.4k"
ATSAY 12,32 (contrast) "7) 19.2k"
ATSAY 13,32 (contrast) "8) 38.4k"
ATSAY 10,42 (contrast) "9) 57.6k"
ATSAY 11,42 (contrast) "0) 115k"
ATSAY 12,42 (contrast) "Note: 115k may yield"
ATSAY 13,42 (contrast) "a high error rate..."

ATSAY 14,12 (contrast) "Current setting: "
ATSAY 15,29 (contrast) " Press ESC to cancel "
SEPA100:
COMPARMS S1 ; Read current setting
ATSAY 14,29 (CONTRAST) S1(0:14)

KEYGET S1 ; Wait for any key
SWITCH S1 ; Act upone the entry
CASE "0D" ; Test for c/r entry
WCLOSE ; Reset original ON ESCAPE label, and close window
RETURN ; Return to caller if so
ENDCASE
CASE "A"
SET PORT COM1
ENDCASE
CASE "B"
SET PORT COM2
ENDCASE
CASE "C"
SET PORT COM3
ENDCASE
CASE "D"
SET PORT COM4
ENDCASE
CASE "1"
SET BAUD 300
ENDCASE
CASE "2"
SET BAUD 1200
ENDCASE
CASE "3"
SET BAUD 2400
ENDCASE
CASE "4"
SET BAUD 4800
ENDCASE
CASE "5"
SET BAUD 9600
ENDCASE
CASE "6"
SET BAUD 14k
ENDCASE
CASE "7"
SET BAUD 19K
ENDCASE
CASE "8"
SET BAUD 38K
ENDCASE
CASE "9"
SET BAUD 57K
ENDCASE
CASE "0"
SET BAUD 115K
ENDCASE
DEFAULT
SOUND 100,100 ; Signal displeasure
ENDCASE ; End
ENDSWITCH
GOTO SEPA100
;
; Escape during Set_Parms menu
;
SEPAEsc:
S1 = "0D" ; Fake a c/r entered
SET FLAG(9) OFF ; Turn off rtn flag
RETURN ; And return to KEYGET above
;
; ----- Subroutine: Dial another PC
; S1,S10 modified
; FLAG(9) Returned true -> error in dialing
;
Dial:
S10 = "_ONESCAPE" ; Save label previously set
ON ESCAPE GOSUB DialEsc ; Escape out of pop-up
LEGEND " Dialing remote PC"

SAVE 10,10,12,70
BOX 10,10,12,70 (contrast)

ATSAY 11,12 (contrast) "Enter number to be dialed: "
ATSAY 12,29 (contrast) " Press ESC to cancel "
Dial100:
SET FLAG (9) ON ; Indicate error
ATGET 11,39 (contrast) 4 S1 ;We expect no more than 4 chars
IF NULL S1
GOTO DialXIT ; And exit
ENDIF
DIAL S1 ; Dial # given
IF FAILED ; IF DIAL failed
SOUND 880,500 ; Indicate problem
GOTO Dial100 ; Ask again
ENDIF
CLOG "* PC-2-PC Dialed: "*"_call"
SET FLAG (9) OFF
DialXIT:
ON ESCAPE GOSUB S10 ; Reset original ON ESCAPE label
RESTORE ; Restore screen under
RETURN ; And return to caller
;
; Escape during "Dial" window
;
DialEsc:
S1 = "" ; Make a null return
RETURN ; And return to KEYGET above
;
; ----- Subroutine: Await a call from the remote PC
; S1,S10 modified
; FLAG(9) Returns true if ESC is taken
;
Await_Call:
S10 = "_ONESCAPE" ; Save label previously set
ON ESCAPE GOSUB AWCAEsc ; Escape out of pop-up
LEGEND " Waiting for call"

SAVE 10,10,12,70
BOX 10,10,12,70 (contrast)

ATSAY 11,12 (contrast) "Waiting for call from remote"
ATSAY 12,26 (contrast) " Press ESC to terminate "
;
; Go into auto answer (echo off, answer on 2nd)
; Also: Return result codes, word form, with CONNECT 1200
;
SET PARITY NONE ; Turn off parity
SET DATA 8 ; Set 8 databits
SET MASK ON ; Mask received text to 7 bits
SET FLAG(9) OFF ; Assume OK
AWCA100:
Pause 3 ; Wait 3 seconds
HANGUP ; HANGUP and leave modem in cmd mode
PAUSE 3 ; Wait 3 secs
TRANSMIT S29 ; Transmit init string, for autoconnect
;
; Wait for a connect
;
AWCA200:
RGET S1 80 180 ; Wait for a line
IF NOT SUCCESS ; If nothing was read
GOTO AWCAXIT ; Exit on timeout or ESCape
ENDIF

FIND S1 "NO CARRIER" ; Look for a disconn
IF FOUND
GOTO AWCA100
ENDIF

FIND S1 "CONNECT" ; Anything else BUT CONNECT
IF NOT FOUND ; .. waits
GOTO AWCA200
ENDIF

;*** IF NOT CONNECTED ; Some modems don't seem fast enough
;*** GOTO AWCA200
;*** ENDIF
;
; Change baud rate according to connect
;
IF FIND S1 "1200" ; Test for 1200 baud
SET BAUD 1200 ; Set to 1200 baud
GOTO AWCAXIT ; We're done.
ENDIF

IF FIND S1 "2400" ; Test for 1400 baud
SET BAUD 2400 ; Set to 1400 baud
GOTO AWCAXIT ; We're done.
ENDIF

IF FIND S1 "4800"
SET BAUD 4800 ; Set to new rate
GOTO AWCAXIT ; Log the fact
ENDIF

IF FIND S1 "9600"
SET BAUD 9600 ; Set to new rate
GOTO AWCAXIT ; Log the fact
ENDIF

IF FIND S1 "14400" or FIND S9 "14.4"
SET BAUD 14k ; Set to new rate
GOTO AWCAXIT ; Log the fact
ENDIF

IF FIND S1 "19200" or FIND S9 "19.2"
SET BAUD 19k ; Set to new rate
GOTO AWCAXIT ; Log the fact
ENDIF

IF FIND S1 "38400" or FIND S9 "38.4"
SET BAUD 38k ; Set to new rate
GOTO AWCAXIT ; Log the fact
ENDIF

IF FIND S1 "57600" or FIND S9 "57.6"
SET BAUD 57k ; Set to new rate
GOTO AWCAXIT ; Log the fact
ENDIF
;
; None of the above... set to 300
;
SET BAUD 300 ; Set to 1200 baud
;
; We have connect (or ESCAPE)
;
AWCAXIT:
ON ESCAPE GOSUB S10 ; Reset original ON ESCAPE label
RESTORE ; Restore screen under
RETURN ; And return to caller
;
; Escape during "Await" window
;
AWCAEsc:
SET FLAG(9) ON ; Indicate escape
RETURN ; And return to KEYGET above
;
; ----- Subroutine: Change subdirectory
; FLAG(9) Returned true -> error or ESCAPE
;
Change_Dir:
GOSUB Ask_Dir
IF NOT FLAG(9)
CHDIR S1 ; Change subdirectory
ENDIF
RETURN
;
; ----- Subroutine: Query for a new subdirectory
; S1 Returns response
; FLAG(9) Returned true -> error or ESCAPE
;
Ask_Dir:
S10 = "_ONESCAPE" ; Save label previously set
ON ESCAPE GOSUB ASDIEsc ; Escape out of pop-up

SAVE 10,1,12,77
BOX 10,1,12,77 (contrast)

ATSAY 11, 3 (contrast) "Enter new subdirectory: "
ATSAY 12,28 (contrast) " Press ESC to cancel "
ASDI100:
SET FLAG (9) ON ; Indicate error
ATGET 11,27 (contrast) 50 S1 ; Read response
IF NOT NULL S1 ; Look for a null response
SET FLAG (9) OFF
ENDIF

ON ESCAPE GOSUB S10 ; Reset original ON ESCAPE label
RESTORE ; Restore screen under
RETURN ; And return to caller
;
; Escape during "Dial" window
;
ASDIEsc:
S1 = "" ; Make a null return
RETURN ; And return to KEYGET above
;
; ----- Subroutine: Wait for ENQ and respond
; .. FLAG (1) is set false upon successful completion
; S1,N1 modified
;
Respond:
LEGEND " Waiting for prompt"
S10 = "_ONESCAPE" ; Save label previously set
ON ESCAPE GOSUB RESPEsc ; Escape out of pop-up

SAVE 10,10,12,70
BOX 10,10,12,70 (contrast)

ATSAY 11,12 (contrast) "Waiting for prompt from remote"
ATSAY 12,26 (contrast) " Press ESC to cancel "
RESP100:
RGET S1 80,120 ; Wait 2 mins
IF SUCCESS and NULL S1 ; If empty line rcv'd
GOTO Resp100 ; Loop
ENDIF
IF SUCCESS and STRCMP S1(0:0) "?" ; If enquiry received
TRANSMIT "PC-2-PC!" ; Transmit response
SET FLAG(1) OFF ; Indicate we're receiving
ENDIF

ON ESCAPE GOSUB S10 ; Reset original ON ESCAPE label
RESTORE ; Restore screen under
LEGEND S19 ; Replace legend
RETURN ; And exit
;
; Escape while waiting for prompt
;
RESPEsc:
S1 = "ESCAPE" ; Make it non-null
RETURN
;
; ----- Subroutine: Exchange subdirectory files
; .. FLAG (0) is set true upon successful completion
; S1,S2 N1,N2,N3,N4,N5 modified
;
Exchange:
FOPENO "PC2PC.REM" TEXT ; Open remote directory, purge if need be
IF FAILURE
GOSUB Disc_Error
ENDIF
FOPENI "PC2PC.LOC" TEXT ; Open our directory
IF FAILURE
GOSUB Disc_Error
ENDIF
LEGEND "Exchanging directory listings"
;
; Initialize for a loop
;
N1 = 1 ; Screen line #
N5 = 0 ; Error tracker
IF FLAG(1) ; If we're initiator
GOTO EXCH200
ENDIF
;
; Wait for a response
; .. Comments removed from below to speed
;
EXCH100:
RGET S2 80 15
PRESERVE S2
IF Failure
GOTO EXCHXIT
ENDIF
;
; Handle received NAK
;
IF NOT STRCMP S2(0:0) "+"
INC N5
IF GT N5,20
GOTO EXCHXIT
ENDIF
GOTO EXCH210 ; Retransmit
ENDIF
;
; Perform a CRC check
;
LENGTH S2 N3
IF GT N3 1
CRC S2(1:40) N2
ATOI S2(41:46) N4
IF NE N2 N4
GOTO EXCHERR
ENDIF
;
; 1 character rcvd (ACK)
;
ELSE
IF EOF
TRANSMIT "+!"
SET FLAG(0) ON
GOTO EXCHXIT
ENDIF
LEGEND S19(0:19)&" Line "*N1&" exchanged"
INC N1
GOTO EXCH200
ENDIF
;
; Save the rcvd, and display
;
IF GE (N99-5),N1
ATSAY N1,41 (default) S2(1:37)
ELSE
IF EQ (N99-4) N1
FSAVEI
ENDIF
LEGEND S19(0:19)&" Line "*N1&" exchanged"
ENDIF
WRITE S2(1:40) 40
WRITE "^M" 2
INC N1
;
; Send a line from our file
;
EXCH200:
N5 = 0
READ S3 80 N2 ; Length read into N2
PRESERVE S3
S1 = S3
IF EOF
S1 = "!" ; Make an cr line
GOTO EXCH210 ; And and continue
ENDIF
CRC S1(0:39) N2 ; CRC what we read
S1(40:50) = N2 &"!" ; Place CRC and c/r into string
;
; Transmit the line
;
EXCH210:
TRANSMIT "+"&S1
GOTO EXCH100
;
; Error on received line
;
EXCHERR:
INC N5
IF GT N5,20
GOTO EXCHXIT
ENDIF
TRANSMIT "-!"
LEGEND "Exchange Error NAK"
GOTO EXCH100
;
; End of exchange procedure
;
EXCHXIT:
REWIND ; REWIND input file (us)
FCLOSEO ; Close (and flush) output file
LEGEND S19 ; Restore
RETURN ; And return to caller
;
; ----- Subroutine: Command (and receive) a remote directory build
; .. Send a 'C' command to the remote
; .. On entry, S1 contains the new directory
;
BuildRemDir:
TRANSMIT "R"& S1 &"!" ; Send the command
RGET S1 80 20 ; 10 second timeout - read the line
PRESERVE S1
IF FAILURE ; Timeout on read
SOUND 100,100 ; Indicate problem
GOTO BURDXIT ; And exit
ENDIF
IF NOT STRCMP S1(0) "+" ; Test for an ACK
SOUND 200,100 ; Indicate problem
GOTO BURDXIT ; And exit
ENDIF
;
; Receive the new directory
;
FOPENO "PC2PC.REM" TEXT ; Open remote directory, purge if need be
IF FAILURE
GOSUB Disc_Error
ENDIF
LEGEND "Waiting to receive new directory"
N1 = 1 ; Set loop/position ctr
N5 = 0 ; Error counter
;
; Wait for a response
;
BURD100:
RGET S2 80 120 ; Wait 2 mins max response
PRESERVE S2
IF Failure ; If timeout on read
GOTO BURDXIT ; Exit proc
ENDIF
;
; Perform a CRC check on the text
;
LENGTH S2 N3 ; Look at the received line length
IF GT N3 1 ; If not just an ACK alone
CRC S2(1:40) N2 ; COmpute CRC of text
ATOI S2(41:46) N4 ; Convert CRC embedded
IF NE N2 N4 ; IF CRC's don't match
TRANSMIT "-!" ; Transmit a NAK
INC N5 ; Increment error cnt
IF GT N5,20
GOTO BURDXIT
ENDIF
GOTO BURD100 ; And wait again for re-send
ENDIF
N5 = 0 ; Reset counter
ELSE ; Only one char sent
TRANSMIT "+!" ; And acknowlege
GOTO BURDXIT ; Exit - end of transmit
ENDIF
;
; Write the information to disc, and display the line
;
IF GE (N99-5),N1 ; If within window
ATSAY N1,41 (default) S2(1:37) ; And display
ELSE
IF EQ (N99-4) N1
FSAVEI
ENDIF
LEGEND S19(0:19)&" Line "*N1&" received"
ENDIF
WRITE S2(1:40) 40 ; Write the line to disk too
WRITE "^M" 2
INC N1 ; Count the line
TRANSMIT "+!" ; And acknowlege
GOTO BURD100 ; And continue
;
; End of receive procedure
;
BURDXIT:
FCLOSEO ; Close (and flush) output file
REWIND ; Rewind the input file
LEGEND S19 ; Restore
RETURN ; And return to caller
;
; ----- Subroutine: Remote commanded change of subdir
; .. We received a 'C' command
; .. S1 on entry is the new subdirectory
;
Remote_Chdir:
FCLOSEI ; Close input just in case
DELETE "PC2PC.LOC" ; Delete our directory

CHDIR S1 ; Set a new subdirectory

IF FLAG(2) ; If we're on remote
GOSUB Change_sides ; Switch our side
ENDIF
GOSUB Clear_Window ; Clear our window
LEGEND " Remote requested chdir"

GOSUB BuildLocDir ; Build a new directory

FOPENI "PC2PC.LOC" TEXT ; Open our directory
IF FAILURE
GOSUB Disc_Error
ENDIF
N1 = 1
N5 = 0
;
; Send a line from our file
;
RECH100:
READ S3 80 N2 ; Length read into N2
PRESERVE S3
S1 = S3
IF EOF
S1 = "!" ; Make an cr line
GOTO RECH110 ; And continue
ENDIF

CRC S1(0:39) N2 ; CRC what we read
S1(40:50) = N2 &"!" ; Place CRC and c/r into string
RECH110:
TRANSMIT "+"&S1 ; Transmit the line with an ACK
LEGEND S19(0:19)&" Line "*N1&" sent"
;
; Wait for a response
;
RECH200:
RGET S2 80 60 ; Wait 60 secs for a response
PRESERVE S2
IF Failure ; If timeout on read
GOTO RECHXIT ; Exit proc
ENDIF
;
; Handle received NAK
;
IF NOT STRCMP S2(0:0) "+" ; IF NAK received
INC N5 ; Increment error cnt
IF GT N5,20
GOTO RECHXIT

ENDIF
GOTO RECH110 ; .. resend last line
ENDIF
INC N1 ; Count the line sent
N5 = 0 ; OKay
IF NOT EOF
GOTO RECH100 ; Go for more
ENDIF
;
; End of remote exchange procedure
;
RECHXIT:
REWIND ; REWIND input file (us)
LEGEND S19 ; Restore
RETURN ; And return to caller
;
; ----- Subroutine: Create a new directory, and send it to the remote
; .. Send an 'L' command
; .. On entry, S1 contains the new subdir
;
SendLocDir:
CHDIR S1 ; Change directory
GOSUB BuildLocDir ; Redo the directory build
;
; Send the command, and wait for an acknowlegement
;
TRANSMIT "L!" ; Send the command
RGET S1 80 10 ; 10 second timeout - read the line
PRESERVE S1
IF FAILURE ; Timeout on read
SOUND 100,100 ; Indicate problem
GOTO SELDXIT ; And exit
ENDIF
IF NOT STRCMP S1(0) "+" ; Test for an ACK
SOUND 200,100 ; Indicate problem
GOTO SELDXIT ; And exit
ENDIF

FOPENI "PC2PC.LOC" TEXT ; Open our directory
IF FAILURE
GOSUB Disc_Error
ENDIF
N1 = 1
;
; Send a line from our file
;
SELD100:
READ S3 80 N2 ; Length read into N2
PRESERVE S3
S1 = S3
IF EOF
S1 = "!" ; Make an cr line
GOTO SELD110 ; And continue
ENDIF

CRC S1(0:39) N2 ; CRC what we read
S1(40:50) = N2 &"!" ; Place CRC and c/r into string
SELD110:
TRANSMIT "+"&S1 ; Transmit the line with an ACK
LEGEND S19(0:19)&" Line "*N1&" sent"
;
; Wait for a response
;
SELD200:
RGET S2 80 60 ; Wait 60 secs for a response
PRESERVE S2
IF Failure ; If timeout on read
GOTO SELDXIT ; Exit proc
ENDIF
;
; Handle received NAK
;
IF NOT STRCMP S2(0:0) "+" ; IF NAK received
GOTO SELD110 ; .. resend last line
ENDIF
INC N1 ; Count the line sent
IF NOT EOF
GOTO SELD100 ; Go for more
ENDIF
;
; End of remote exchange procedure
;
SELDXIT:
REWIND ; REWIND input file (us)
LEGEND S19 ; Restore
RETURN ; And return to caller
;
; ----- Subroutine: Receive a new 'remote' directory
; .. We received an 'L' command
;
Local_Chdir:
FCLOSEI ; Close input just in case
DELETE "PC2PC.REM" ; Delete remote directory

IF NOT FLAG(2) ; If we're on 'our' side
GOSUB Change_sides ; Switch our side
ENDIF

FOPENO "PC2PC.REM" TEXT ; Open our directory
IF FAILURE
GOSUB Disc_Error
ENDIF

N1 = 1
LEGEND "Remote is sending new listing"
GOSUB Clear_Window ; Clear our window
;
; Wait for a response
;
LOCH100:
RGET S2 80 120 ; Wait 2 mins max response
PRESERVE S2
IF Failure ; If timeout on read
GOTO LOCHXIT ; Exit proc
ENDIF
;
; Perform a CRC check on the text
;
LENGTH S2 N3 ; Look at the received line length
IF GT N3 1 ; If not just an ACK alone
CRC S2(1:40) N2 ; COmpute CRC of text
ATOI S2(41:46) N4 ; Convert CRC embedded
IF NE N2 N4 ; IF CRC's don't match
TRANSMIT "-!" ; Transmit a NAK
GOTO LOCH100 ; And wait again for response
ENDIF
ELSE ; Only one char sent
TRANSMIT "+!" ; And acknowlege
GOTO LOCHXIT ; Exit - end of transmit
ENDIF
;
; Write the information to disc, and display the line
;
IF GE (N99-5),N1 ; If within window
ATSAY N1,41 (default) S2(1:37) ; And display
ELSE
IF EQ (N99-4) N1
FSAVEI
ENDIF
LEGEND S19(0:19)&" Line "*N1&" received"
ENDIF
WRITE S2(1:40) 40 ; Write the line to disk too
WRITE "^M" 2
INC N1 ; Count the line
TRANSMIT "+!" ; And acknowlege
GOTO LOCH100 ; And continue
;
; End of receive procedure
;
LOCHXIT:
FCLOSEO ; Close (and flush) output file
FOPENI "PC2PC.REM" ; Open remote again
LEGEND S19 ; Restore
RETURN ; And return to caller
;
; ----- Subroutine: Wildcard send
;
Wildcard:
LEGEND " Enter a wildcard spec for file(s) "
WOPEN 10, 1,12,77 (contrast) WILDEsc
;
; First: Ask for send/receive
;
ATSAY 11, 3 (contrast) "You may send or receive files: Enter S/R: "
ATSAY 12,27 (contrast) " Press ESC to cancel "
WILD100:
ATGET 11,45 (contrast) 1 S1
IF NULL S1
GOTO WILDXIT ; And exit
ENDIF
SWITCH S1
CASE "S"
SET FLAG(9) ON
ENDCASE
CASE "R"
SET FLAG(9) OFF
ENDCASE
DEFAULT
SOUND 100,100
GOTO WILD100
ENDCASE
ENDSWITCH
;
; Now, ask for a wildcard spec
;
WILD200:
BOX 10, 1,12,77 (contrast) ; Clear the window
ATSAY 11, 3 (contrast) "Wildcard file spec: "
ATSAY 12,27 (contrast) " Press ESC to cancel "

ATGET 11,24 (contrast) 50 S1
IF NULL S1
GOTO WILDXIT ; And exit
ENDIF
IF FLAG (9) ; If sending
FFIRST S1 ; Test for files available
IF FAILED
S1 = "No files match the given spec"
GOSUB TranErr
GOTO WILD200
ENDIF
TRANSMIT "WR!" ; Send the command
ELSE
TRANSMIT "WS"& S1 &"!"
ENDIF
;
; Send the a command to remote, and wait for an acknowlegement
;
WILD300:
RGET S2 80 10 ; 10 second timeout - read the line
IF FAILURE ; Timeout on read
S1 = "Remote has failed to acknowlege"
GOSUB TranErr
GOTO WILDXIT ; And exit
ENDIF
IF NOT STRCMP S2(0) "+" ; Test for an ACK
IF FLAG(9)
GOTO WILD300 ; Try again
ELSE
S1 = "Sender reports no files matching your spec"
GOSUB TranErr
ENDIF
GOTO WILDXIT ; And exit
ENDIF
;
; Set-up our send/receive
;
IF FLAG(9)
; SENDFILE BYMODEM S1
SENDFILE ZMODEM S1
ELSE
; GETFILE BYMODEM
GETFILE ZMODEM
ENDIF
IF FAILED
S1 = "Transfer has failed"
GOSUB TranErr
ENDIF
;
; Exit the wildcard send
;
WILDXIT:
WCLOSE ; Close open window
LEGEND S19 ; Restore
RETURN ; And return to caller
;
; Escape during "WILDCARD" window
;
WILDEsc:
S1 = "" ; Make a null return
RETURN ; And return to KEYGET above
;
; ----- Subroutine: Transfer error
; .. Open a window, display, and and await keypress
; S1 passes the message to display
; S11 is used to save ON ESCAPE, as this window is opened on another
;
TranErr:
S11 = "_ONESCAPE" ; Save label previously set
ON ESCAPE GOSUB TranEsc ; Escape out of pop-up

SAVE 10, 1,12,77
BOX 10, 1,12,77 (contrast)

ATSAY 11, 3 (contrast) S1
ATSAY 12,26 (contrast) " Press any key to continue "
SOUND 880,100

KEYGET S0 ; Wait for any key
ON ESCAPE GOSUB S11 ; Reset original ON ESCAPE label
RESTORE ; Restore screen under
RETURN ; And return to caller
;
; Escape during "TranErr" window
;
TranEsc:
RETURN ; And return to KEYGET above
;
; ----- Subroutine: Remote wildcard receive/send
; S1 contains the command ("WR" or "WS")
;
Rcv_Wildcard:
IF STRCMP S1(0) "S"
FFIRST S1(1:79) ; Test for files available
IF FAILED
TRANSMIT "-!" ; Send a NAK
RETURN
ENDIF
ENDIF
;
; Acknowlege, and set-up the transfer
;
TRANSMIT "+!"
IF STRCMP S1(0) "R"
; GETFILE BYMODEM
GETFILE ZMODEM
ELSE
; SENDFILE BYMODEM S1(1:79)
SENDFILE ZMODEM S1(1:79)
ENDIF
IF FAILED
SOUND 880,500
ENDIF
RETURN
;
; ----- Subroutine: Select a file for transfer
;
Select:
IF FLAG(2) ; We're on remote side
N10 = N92
ELSE
N10 = N91
ENDIF

S10 = "_ONESCAPE"
ON ESCAPE GOSUB SELEEsc
;
; Open a window, and show current selections
;
LEGEND " Transfer selections"
SAVE 8,10,20,70 ; Save for restore
GOSUB Read_Cursor
;
; Clear and redisplay
;
SELE100:
BOX 8,10,20,70 (contrast)

ATSAY 9,12 (contrast) " Local files selected Remote files selected"
ATSAY 11,12 (contrast) "1) "*S16(0:12)
ATSAY 12,12 (contrast) "2) "*S16(13:25)
ATSAY 13,12 (contrast) "3) "*S16(26:38)
ATSAY 14,12 (contrast) "4) "*S16(39:51)
ATSAY 15,12 (contrast) "5) "*S16(52:64)

ATSAY 11,40 (contrast) "a) "*S15(0:12)
ATSAY 12,40 (contrast) "b) "*S15(13:25)
ATSAY 13,40 (contrast) "c) "*S15(26:38)
ATSAY 14,40 (contrast) "d) "*S15(39:51)
ATSAY 15,40 (contrast) "e) "*S15(52:64)

IF LT N10 5 OR NULL S12
ATSAY 17,12 (contrast) "Current cursor points to: "*S12(0:12)
ATSAY 18,12 (contrast) "Do you wish to add this file (Y/N)?"
ELSE
ATSAY 17,12 (contrast) "No more files may be selected from this side"
ATSAY 18,12 (contrast) "Enter a letter or number from above to clear an entry"
ENDIF
ATSAY 19,12 (Contrast) "Select: "
ATSAY 20,28 (Contrast) " Press ESC to exit "
;
; Read the kbd for a response
;
SELE200:
LOCATE 19,20
KEYGET S1 ; Wait for any key
SWITCH S1
CASE "_NULL"
GOTO SELEXIT
ENDCASE
CASE "Y"
GOTO SELE500
ENDCASE
CASE "N"
GOTO SELEXIT
ENDCASE

CASE "1"
S16(0:79) = S16(13:79)
GOTO SELE300
ENDCASE
CASE "2"
S16(13:79) = S16(26:79)
GOTO SELE300
ENDCASE
CASE "3"
S16(26:79) = S16(39:79)
GOTO SELE300
ENDCASE
CASE "4"
S16(39:79) = S16(52:79)
GOTO SELE300
ENDCASE
CASE "5"
S16(52:79) = S16(65:79)
GOTO SELE300
ENDCASE

CASE "A"
S15(0:79) = S15(13:79)
GOTO SELE400
ENDCASE
CASE "B"
S15(13:79) = S15(26:79)
GOTO SELE400
ENDCASE
CASE "C"
S15(26:79) = S15(39:79)
GOTO SELE400
ENDCASE
CASE "D"
S15(39:79) = S15(52:79)
GOTO SELE400
ENDCASE
CASE "E"
S15(52:79) = S15(65:79)
GOTO SELE400
ENDCASE

DEFAULT ; Direct
SOUND 100,100 ; Signal displeasure
GOTO SELE200
ENDCASE
ENDSWITCH
;
; Deleted a file from the local side
;
SELE300:
IF NOT ZERO N10
DEC N91
DEC N10
ENDIF
GOTO SELE100
;
; Deleted a file from the remote side
;
SELE400:
IF NOT ZERO N10
DEC N92
DEC N10
ENDIF
GOTO SELE100
;
; "Y" was entered
;
SELE500:
IF LT N10 5
IF FLAG(2) ; On remote side
S15(N10*13:79) = S12(0:12)
INC N10
INC N92
ELSE
S16(N10*13:79) = S12(0:12)
INC N10
INC N91
ENDIF
ELSE
SOUND 100,100
GOTO SELE200
ENDIF
;
; The above case never falls through
;
SELEXIT:
ON ESCAPE GOSUB S10
RESTORE
RETURN
;
; ESCAPE entered during select
;
SELEESC:
S1 = ""
RETURN
;
; ----- Subroutine: Transfer selected files
;
Transfer:
IF ZERO N91 and ZERO N92
S1 = "You have not selected a file to transfer"
GOSUB TranErr
RETURN
ENDIF

WOPEN 10,1 12,77 (contrast)
ATSAY 11,3 (contrast) "Transfer in progress"
;
; Send any files from the local side
;
TRAN100:
IF ZERO N91
GOTO TRAN200
ENDIF

TRANSMIT "TR"& S16(0:12) &"!" ; Command remote to receive
;
; Send the a command to remote, and wait for an acknowlegement
;
TRAN110:
RGET S2 80 10 ; 10 second timeout - read the line
IF FAILURE ; Timeout on read
S1 = "Remote has failed to acknowlege"
GOSUB TranErr
GOTO TRAN300 ; And exit
ENDIF
IF NOT STRCMP S2(0) "+" ; Test for an ACK
GOTO TRAN110 ; Try again
ENDIF
; SENDFILE XMODEM S16(0:12)
SENDFILE ZMODEM S16(0:12)
IF FAILED
S1 = "Transfer has failed"
GOSUB TranErr
GOTO TRAN300
ENDIF
S16(0:79) = S16(13:79)
DEC N91
GOTO TRAN100
;
; Receive any files from the remote side
;
TRAN200:
IF ZERO N92
GOTO TRAN300
ENDIF

TRANSMIT "TS"& S15(0:12) &"!" ; Command remote to send
;
; Send the a command to remote, and wait for an acknowlegement
;
TRAN210:
RGET S2 80 10 ; 10 second timeout - read the line
IF FAILURE ; Timeout on read
S1 = "Remote has failed to acknowlege"
GOSUB TranErr
GOTO TRAN300 ; And exit
ENDIF
IF NOT STRCMP S2(0) "+" ; Test for an ACK
GOTO TRAN210 ; Try again
ENDIF
DELETE S15(0:12)
; GETFILE XMODEM S15(0:12)
GETFILE ZMODEM
IF FAILED
S1 = "Transfer has failed"
GOSUB TranErr
GOTO TRAN300
ENDIF
S15(0:79) = S15(13:79)
DEC N92
GOTO TRAN200
;
; Close the window opened above
;
TRAN300:
WCLOSE
;
; And we're done
;
TRANXIT:
RETURN
;
; ----- Subroutine: Remote transfer receive/send
; S1 contains the command ("TR" or "TS")
;
Rcv_Transfer:
TRANSMIT "+!"
IF STRCMP S1(0) "R"
DELETE S1(1:13)
; GETFILE XMODEM S1(1:13)
GETFILE ZMODEM
ELSE
; SENDFILE XMODEM S1(1:13)
SENDFILE ZMODEM S1(1:13)
ENDIF
IF FAILED
SOUND 880,500
ENDIF
RETURN
;
; ----- Subroutine: Draw the basic screen box
;
InitScreen:
SSIZE N99
SAVE 0,0,N99-2,79

BOX 0, 0, (N99-2) ,78 (default)

ATSAY 0, 18 (default) " Local "
ATSAY 0, 35 (default) " PC-2-PC "
ATSAY 0, 56 (default) " Remote "

FOR N19 = 1 (N99-5) 1
ATSAY N19 39 (default) "³"
ENDFOR

ATSAY N99-4,0 (default) "ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´"
ATSAY N99-4,39 (default) "Á"

ATSAY N99-4,9 (default) " , , PgUp, PgDn "
ATSAY N99-4,48 (default) "  to this window "
ATSAY N99-3,2 (Default) "H)elp, E)xit, C)hdir, W)ildcard, S)elect, T)ransfer and Alt-F10:"
ATSAY N99-2,28 (Default) " Press ESC to terminate "
RETURN
;
; ----- Subroutine: Help
;
Help:
SAVE 0 , 0,24,78
BOX 0 , 0,24,78 (default)

ATSAY 0, 2 (Default) " PC-2-PC "
ATSAY 24,28 (Default) " Press any key to continue "

S10 = "_ONESCAPE"
ON ESCAPE GOSUB HELPESC

IF FLAG(0)
GOTO HELP100
ENDIF
;
; Help message prior to establishing link
;
ATSAY 1,2 (default) "PC-2-PC is a COM-AND script for linking PCs and exchanging files. When "
ATSAY 2,2 (default) "PC-2-PC executed, it reads and displays the current subdirectory, and then "
ATSAY 3,2 (default) "prompts for a method to establish a link."

ATSAY 5,2 (default) "Two link methods are provided, either DIRECT connect, or CALLing through "
ATSAY 6,2 (default) "the dialing directory. Each method has two sides: one that initiates the "
ATSAY 7,2 (default) "connection, and one that awaits a connection. The first script loaded (or "
ATSAY 8,2 (default) "the first PC to be loaded) is best instructed to 'await'. The second to "
ATSAY 9,2 (default) "be loaded may then initiate the connection."

ATSAY 11,2 (default) "A direct connection is, for example, an RS232 cable between async ports "
ATSAY 12,2 (default) "of two PCs. The RS232 cable must be configured as a 'null modem' - i.e., "
ATSAY 13,2 (default) "the send side of one PC must connect to the receive side of the other and "
ATSAY 14,2 (default) "vice versa. As PC-2-PC ignores carrier using this method, even 3-wire "
ATSAY 15,2 (default) "null modem will work."

ATSAY 17,2 (default) "A called connection uses a modem on each PC, and the dialing directory "
ATSAY 18,2 (default) "on one of them. The modems must be able to communicate ordinarily (not "
ATSAY 19,2 (default) "all do). The initiator of the called connection selects the dialing "
ATSAY 20,2 (default) "directory entry number (with or without LD prefix), and COM-AND dials "
ATSAY 21,2 (default) "in the ordinary fashion. The PC awaiting the connect answers the call. "

ATSAY 23,2 (default) "Once connection has been established, the PC's exchange directory lists. "
GOTO HELPXIT
;
; Help message after link established
;
HELP100:
ATSAY 1,2 (default) "The two PC's are connected, and directory listings have been exchanged. "
ATSAY 2,2 (default) "The left window is the current subdirectory on this PC. The right window "
ATSAY 3,2 (default) "is the current directory on the remote. Cursor-keys (left/right) change "
ATSAY 4,2 (default) "the 'active' window - you are either in the left or right windows."

ATSAY 5,2 (default) "The 'C'hdir command will select a new drive:subdirectory on this PC (if "
ATSAY 6,2 (default) "the left window is active), and on the remote PC (if right window). "
ATSAY 7,2 (default) "The active window on the remote PC is switched (if need be) and a new "
ATSAY 8,2 (default) "list is displayed on both PC's."

ATSAY 10,2 (default) "PgUp, PgDn, Home and End allow paging through the active window for files. "
ATSAY 11,2 (default) "Only paging is performed - the window is not scrolled line by line."

ATSAY 13,2 (default) "Cursor-Up and Cursor-Down highlight files on the current page. A lighted "
ATSAY 14,2 (default) "line is selected for transfer with 'S'elect. Up to 5 files on the local "
ATSAY 15,2 (default) "side, and 5 files on the remote side may be selected. A 'T'ransfer may be "
ATSAY 16,2 (default) "done at any time to transfer files (either from or to the local PC). "

ATSAY 17,2 (default) "A wildcard file transfer is also available, selecting files to/from other "
ATSAY 18,2 (default) "than the current subdirectory, or where a template might make life easier. "
ATSAY 19,2 (default) "Unlike the 'T'ransfer command, you transfer using a wildcard only one "
ATSAY 20,2 (default) "direction at a time, either sending or receiving. "

ATSAY 22,2 (default) "If you have selected files, you must transfer them before changing sub- "
ATSAY 23,2 (default) "directories. E)xit terminates both sides if a called connected was made."
GOTO HELPXIT
;
; Wait for a keypress, and exit
;
HELPXIT:
KEYGET S0

ON ESCAPE GOSUB S10
RESTORE
RETURN
;
; ESCAPE pressed during the HELP
;
HELPESC:
RETURN


  3 Responses to “Category : Communication (modem) tools and utilities
Archive   : CA29-3.ZIP
Filename : PC-2-PC.SRC

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/