SUBROUTINE DIAL_HAYES C C This routine dials the phone number for the HAYES SMARTMODEM C (Also works for U.S. Robotics Password/Courier.) C C This routine dials the phone number for the HAYES Smartmodem. This C configuration switches should be setup as follows for computer hookup. C C Configuration Switches: C C Switch Command Position Function C ------ ------- -------- ------------------ C 1 * NONE UP Allows computer to detect DTR. C 2 V1 UP Result codes sent as English words. C 3 Q0 DOWN Result codes are sent to the terminal. C 4 E1 UP Characters echoes in command mode. C 5 * S0=1 UP Automatically answer incoming calls. C 6 * NONE UP Allows computer to detect carrier signal. C 7 NONE UP Setting for single line RJ11 jack. C 8 NONE DOWN Enables Smartmodem command recognition. C C * = Switches changed from the factory default settings. C INCLUDE 'COM.INC/NOLIST' CHARACTER*(*) BAD_MSG, CONNECTION_BAD CHARACTER*(*) DIAL_MSG, CHECK_MSG, PLEASE_WAIT PARAMETER TMO = 120 ! Read timeout count. LOGICAL WAIT_FOR_READ INTEGER*4 DESC(2) INTEGER*4 AUTO_RETRY, STATUS PARAMETER DIALING_TERMINATOR = 58 PARAMETER (BAD_MSG = SS// 1 '*** Bad response from the modem, aborting... ***'//BELL//SS) PARAMETER (CONNECTION_BAD = SS// 1 '*** No Connection established ***'//BELL//SS) PARAMETER (CHECK_MSG = SS// 1 '### Modem is being checked out ###'//SS) PARAMETER (DIAL_MSG = SS// 1 '*** Modem has been instructed to DIAL ***'//SS) PARAMETER (PLEASE_WAIT = SS// 1 '*** DIALing may take some time. Please Wait ***'//SS) IF (PHONE_SIZE .EQ. 0) RETURN ! No phone number to dial. AUTO_RETRY = 1 ! Initialize retry counter. C C Send the following comes from the modem C ATE1PV1M0 C OK C ATD{number} C CALL WRITE_USER (CHECK_MSG) ! Tell user we're checking modem. CALL SET_TERMINATOR(TPTR,TTBL,LF)! Terminate read on linefeed. 100 IF (.NOT. POST_READ(RBUFFER,TMO,TPTR)) RETURN ! Get at least a XBUFFER(1) = 'A' XBUFFER(2) = 'T' XBUFFER(3) = 'E' XBUFFER(4) = '1' XBUFFER(5) = 'P' XBUFFER(6) = 'V' XBUFFER(7) = '1' XBUFFER(8) = 'M' XBUFFER(9) = '1' CALL WRITE_REMOTE(XBUFFER(1),9) ! Check to see if modem is working IF (.NOT. WAIT_FOR_READ (RBUFFER, RDESC, .FALSE.)) THEN IF (CONTROLC_TYPED) RETURN ! Return if aborted. AUTO_RETRY = AUTO_RETRY + 1 ! Bump the retry count. IF (AUTO_RETRY .EQ. AUTODIAL_LIMIT) THEN 310 CALL WRITE_USER(BAD_MSG) ! Tell user its no good. RETURN ELSE GO TO 100 ! Try it again ... ENDIF ENDIF CALL SET_TERMINATOR(TPTR,TTBL,LF)! Terminate read on linefeed. IF (.NOT. POST_READ(RBUFFER,TMO,TPTR)) RETURN ! GET "OK" CALL WAIT_FOR_READ (RBUFFER, RDESC, .FALSE.) C C Now send the phone number. C CALL WAITABIT('00.10') CALL SET_TERMINATOR(TPTR,TTBL,LF)! Terminate read on linefeed. XBUFFER(1) = 'A' XBUFFER(2) = 'T' XBUFFER(3) = 'D' XBUFFER(4) = 'P' DO 306 I = 1,PHONE_SIZE XBUFFER(4+I) = ICHAR(PHONE_NUMBER(I:I)) 306 CONTINUE IF (.NOT. POST_READ(RBUFFER,TMO,TPTR)) RETURN ! Get the dial response. CALL WRITE_USER(DIAL_MSG) CALL WRITE_USER(PLEASE_WAIT) CALL WRITE_REMOTE(XBUFFER(1),PHONE_SIZE+4) ! Send the number. CALL WAIT_FOR_READ (RBUFFER, RDESC, .FALSE.) AUTO_RETRY = 0 ! Reinitialize the retry counter. C C Now set the read terminator to LF. The modem will display C one of the following messages after dialing: C C CONNECT C NO CARRIER C CALL SET_TERMINATOR(TPTR,TTBL,LF) IF (.NOT. POST_READ(RBUFFER,200,TPTR)) RETURN ! Get the dial response. IF (.NOT. WAIT_FOR_READ (RBUFFER, RDESC, .FALSE.)) GO TO 310 C C C If the modem is really online, set the flags to say so. C IF (FIND_SUBSTRING('CONNECT',RDESC) .GT. 0) THEN MODEM_ONLINE = .TRUE. ! Show modem is online. REMOTE = .TRUE. ! Make VMS look online. ELSEIF (FIND_SUBSTRING('NO CARRIER',RDESC) .GT. 0) THEN CALL WRITE_USER(CONNECTION_BAD) MODEM_ONLINE = .FALSE. ! Show modem is not online. REMOTE = .FALSE. ENDIF RETURN END SUBROUTINE SIGNOFF_HAYES C C This routine is used to sginoff the HAYES SMARTMODEM. C INCLUDE 'COM.INC/NOLIST' C C Give a one-second pause followed by "+++" followed by another C one second pause to put modem back into local command state. C CALL SET_TERMINATOR(TPTR,TTBL,LF) XBUFFER(1) = '+' XBUFFER(2) = '+' XBUFFER(3) = '+' IF (.NOT. POST_READ(RBUFFER,TMO,TPTR)) RETURN CALL WAITABIT('02.00') CALL WRITE_REMOTE(XBUFFER(1),3) CALL WAITABIT('02.00') CALL WAIT_FOR_READ (RBUFFER, RDESC, .FALSE.) C C Give Hangup command "ATH" to hangup the phone C CALL SET_TERMINATOR(TPTR,TTBL,LF) XBUFFER(1) = 'A' XBUFFER(2) = 'T' XBUFFER(3) = 'H' IF (.NOT. POST_READ(RBUFFER,TMO,TPTR)) RETURN ! Read "ATH" CALL WRITE_REMOTE(XBUFFER(1),3) CALL WAIT_FOR_READ (RBUFFER, RDESC, .FALSE.) IF (.NOT. POST_READ(RBUFFER,TMO,TPTR)) RETURN ! Read "OK" CALL WAIT_FOR_READ (RBUFFER, RDESC, .FALSE.) RETURN END