02-17-2006, 08:17 PM
I have found something of interest, I think. Since I couldn't create a new post in the QB forums, I am posting the code here...
The complete source can be found here: ftp://ftp.eunet.bg/pub/simtelnet/msdos/c...kmodem.zip
I have found this site to be quite interesting.
>anarky
The complete source can be found here: ftp://ftp.eunet.bg/pub/simtelnet/msdos/c...kmodem.zip
I have found this site to be quite interesting.
Code:
'******************************************************************************
'
' File: CHKMODEM.BAS
'
' Date: 06/21/90
'
' By: Gary G. Hendershot
' Soft Sale Limited BBS
' (703) 569-6876
'
' Purpose: Utility program to find HAYES command compatible
' modems on COM1 thru COM4. Report maximum possible
' baud rate for all modems found. Test a selected
' modem for DTR and CD line settings.
'
' This utility is part of an installation program
' under development which when finished will
' automate the installation of a commercial
' vertical market micro to mainframe dialup
' communications program.
'
' The intent is to make the installation of the
' program as idiot proof as possible. In this program
' segment no configuration file is created. Responses
' are sent to the screen only.
'
' Note: Both the EXECUTABLE and SOURCE files are included.
' The program conpiles under MS-BASIC Ver. 7.0 and
' MS-QuickBASIC 4.5.
'
' The program makes CALLs to a Serial I/O Library called
' QBSERIAL Ver. 1.5. This Library was written by
' Jeff Sumberg and was obtained from the SailBoard BBS
' at (201) 831-8152
'
' I do not intend to provide any support or upgrades to
' this program. It is offered AS IS to anyone interested
' in communications programming as an example of what
' compiled BASIC can do with a little help.
'
' I would of course appreciate any comments or mods others
' might offer that would enhance the capabilities of this
' program to deliver the results described above. Please
' leave any comments or mods addressed to the SYSOP at
' (703) 569-6876 or in writting to
' Gary G. Hendershot
' 7218 Reservoir Road
' Springfield, VA 22150
'
'******************************************************************************
'
' These DECLAREs are required by QBSERIAL.LIB
'
DECLARE SUB OpenComm CDECL ALIAS "_open_comm" (BYVAL Port%, BYVAL Wlen%, BYVAL Parity%, BYVAL Baud&, BYVAL HS%)
DECLARE SUB CloseComm CDECL ALIAS "_close_comm" ()
DECLARE FUNCTION WriteChar% CDECL (BYVAL Ascii%)
DECLARE FUNCTION ReadChar% CDECL ()
DECLARE SUB Transmit CDECL ALIAS "_transmit_string" (addr$)
DECLARE FUNCTION DataWaiting% CDECL ALIAS "_data_waiting" ()
DECLARE SUB ClearInputBuffer CDECL ALIAS "_clear_input_buffer" ()
DECLARE SUB CarrierDetect CDECL ALIAS "_carrier_detect_flag" (BYVAL OnOff%)
DECLARE SUB CDtrap CDECL ALIAS "_trap_mode" (BYVAL OnOff%)
DECLARE FUNCTION CarrierLost% CDECL ALIAS "_carrier_state" ()
DECLARE SUB DTRcontrol CDECL ALIAS "_dtr" (BYVAL OnOff%)
'
'$STATIC
'
DIM Report%(4,4)
DIM FoundPort%(4)
DIM Init%(4,60)
DIM ModemPort%(4)
DIM Respond$(30)
'
DEFINT A-Z
'
CONST True = -1
CONST False = 0
'
Verbal:
Respond$(0) = "OK"
Respond$(1) = "CONNECT"
Respond$(2) = "RING"
Respond$(3) = "NO CARRIER"
Respond$(4) = "ERROR"
Respond$(5) = "CONNECT 1200"
Respond$(6) = "NO DIALTONE"
Respond$(7) = "BUSY"
Respond$(8) = "NO ANSWER"
Respond$(9) = "RESERVED"
Respond$(10) = "CONNECT 2400"
'
Numeric:
Respond$(20) = "0"
Respond$(21) = "1"
Respond$(22) = "2"
Respond$(23) = "3"
Respond$(24) = "4"
Respond$(25) = "5"
Respond$(26) = "6"
Respond$(27) = "7"
Respond$(28) = "8"
Respond$(29) = "9"
Respond$(30) = "10"
'
Main:
CLS
'
Length = 8
Parity = 0
HS = 0
Send$ = "AT" + CHR$(13)
NextPort% = 0
PrevPort% = 0
ModemAvail% = 0
'
GOSUB TestPort1
GOSUB TestPort2
GOSUB TestPort3
GOSUB TestPort4
GOSUB PortReport
GOSUB HowManyModems
GOSUB ChooseActivePort
GOSUB CheckCDLine
GOSUB CheckDTRLine
DTRControl 0
CloseComm
'
END
'
TestPort1:
Port = 1
Rate& = 0
GOSUB TickleIt
RETURN
'
TestPort2:
Port = 2
Rate& = 0
GOSUB TickleIt
RETURN
'
TestPort3:
Port = 3
Rate& = 0
GOSUB TickleIt
RETURN
'
TestPort4:
Port = 4
Rate& = 0
GOSUB TickleIt
RETURN
'
PortReport:
CLS
LOCATE 4, 15, 0
PRINT "An Ok marks a useable PORT/MODEM at a given BAUD"
LOCATE 8, 15
PRINT "300 BAUD"
LOCATE 8, 30
PRINT "1200 BAUD"
LOCATE 8, 45
PRINT "2400 BAUD"
LOCATE 8, 60
PRINT "9600 BAUD"
LOCATE 11, 5
PRINT "COM1:"
LOCATE 13, 5
PRINT "COM2:"
LOCATE 15, 5
PRINT "COM3:"
LOCATE 17, 5
PRINT "COM4:"
FOR X% = 1 TO 4
FOR Y% = 1 TO 4
LOCATE (X% * 2) + 9, (Y% * 15) + 3
IF Y% = 1 THEN
Speed% = 300
ELSEIF Y% = 2 THEN
Speed% = 1200
ELSEIF Y% = 3 THEN
Speed% = 2400
ELSEIF Y% = 4 THEN
Speed% =9600
END IF
IF Report%(X%,Y%) THEN
PRINT "Ok";
FoundPort%(X%) = Speed%
END IF
NEXT Y%
NEXT X%
LOCATE 20, 30
PRINT "Press Any Key to Continue"
A$=""
WHILE A$=""
A$=INKEY$
WEND
RETURN
'
HowManyModems:
ModemAvail%=0
FOR X% = 1 TO 4
IF FoundPort%(X%) THEN
ModemAvail% = ModemAvail% + 1
ModemPort%(ModemAvail%) = X%
END IF
NEXT X%
RETURN
'
ChooseActivePort:
CLS
PRINT
PRINT
PRINT
IF ModemAvail% = 0 THEN
PRINT
PRINT "No MODEM found that responds to HAYES AT commands"
PRINT
PRINT
PRINT "Press any key to exit program"
PRINT
A$ = ""
WHILE A$ = ""
A$ = INKEY$
WEND
RETURN
ELSEIF ModemAvail% > 0 THEN
FOR X% = 1 TO ModemAvail%
PRINT
PRINT "There is a MODEM on COM";
PRINT STR$(ModemPort%(X%));":";
PRINT " responding properly at ";
PRINT STR$(FoundPort%(ModemPort%(X%)));" Baud"
PRINT
NEXT X%
GOSUB ChooseModem
IF ChosenModem% = 0 THEN SYSTEM
END IF
OpenComm Port, Length, Parity, Rate&, HS
CarrierDetect 0
SOUND 32767,15:SOUND 32767,1
DTRcontrol 1
SOUND 32767,15:SOUND 32767,1
RETURN
'
CheckCDLine:
CLS
PRINT
PRINT
PRINT "Testing Carrier Detect"
PRINT
CarrierDetect 0
SOUND 32767,15:SOUND 32767,1
DTRControl 1
SOUND 32767,15:SOUND 32767,1
Send$ = "ATQ0E0V1X1" + CHR$(13)
SOUND 32767,15:SOUND 32767,1
Transmit Send$
SOUND 32767,15:SOUND 32767,1
GOSUB GetResponse
IF Response% = 5 THEN
CD% = 0
RETURN
END IF
SOUND 32767,15:SOUND 32767,1
Send$ = "ATA" + CHR$(13)
Transmit Send$
Response% = 0
CounterVal! = TIMER + 60
DO WHILE Response% <> 4 AND TIMER < CounterVal!
GOSUB GetResponse
LOOP
IF Response% <> 4 THEN
CD% = 0
PRINT
PRINT "Carrier Detect Test FAILED !!!!!"
ELSE
CD% = 1
PRINT
PRINT "Carrier Detect Test Successful !"
END IF
CarrierDetect 1
IF CarrierLost THEN
PRINT
PRINT "CARRIERLOST Routine shows NO CARRIER"
ELSE
PRINT
PRINT "CARRIERLOST Routine shows CARRIER PRESENT"
END IF
CarrierDetect 0
SOUND 32767,15:SOUND 32767,1
Send$ = "ATH0" + CHR$(13)
Transmit Send$
SOUND 32767,15:SOUND 32767,1
GOSUB GetResponse
SOUND 32767,15:SOUND 32767,1
Send$ = "AT &F" + CHR$(13)
Transmit Send$
SOUND 32767,15:SOUND 32767,1
GOSUB GetResponse
SOUND 32767,15:SOUND 32767,1
DTRControl 0
TriggerVal! = TIMER + 10
WHILE TIMER < TriggerVal!
WEND
RETURN
'
CheckDTRLine:
PRINT
PRINT
PRINT
PRINT
PRINT "Testing Data Terminal Ready"
PRINT
DTRControl 1
SOUND 32767,15:SOUND 32767,1
Send$ = "ATA" + CHR$(13)
Transmit Send$
SOUND 32767,15:SOUND 32767,1
DTRControl 0
SOUND 32767,15:SOUND 32767,1
GOSUB GetResponse
IF Response% = 1 THEN DTR = True ELSE DTR = False
DTRControl 1
SOUND 32767,15:SOUND 32767,1
Send$ = "ATH0" + CHR$(13)
Transmit Send$
SOUND 32767,15:SOUND 32767,1
GOSUB GetResponse
DTRControl 0
IF DTR THEN
PRINT
PRINT "Modem follows TRUE STATE of DTR"
PRINT
ELSE
PRINT
PRINT "Modem may not follow TRUE STATE of DTR"
PRINT
END IF
RETURN
'
TickleIt:
GOSUB CycleRate
ReportX% = Port
Notice$ = "Initialize MODEM on COM" + STR$(Port) + ": at "
Notice$ = Notice$ + STR$(Rate&) + " Baud"
PRINT Notice$
OpenComm Port, Length, Parity, Rate&, HS
CarrierDetect 0
SOUND 32767,15:SOUND 32767,1
DTRcontrol 1
SOUND 32767,15:SOUND 32767,1
C$=""
Response% = 0
Transmit Send$
GOSUB GetResponse
DTRcontrol 0
SOUND 32767,15:SOUND 32767,1
CloseComm
PRINT
IF Response% > 0 AND Response% <> 5 THEN
PRINT "Attempt to ";Notice$;" SUCCEEDED !!";CHR$(13)
Report%(ReportX%,ReportY%) = 1
ELSE
PRINT "Attempt to ";Notice$;" FAILED !!";CHR$(13)
Report%(ReportX%,ReportY%) = 0
END IF
PRINT
PRINT
IF Rate& < 9600 THEN GOTO TickleIt
RETURN
'
CycleRate:
IF Rate& = 0 THEN
Rate& = 300
ReportY% = 1
ELSEIF Rate& = 300 THEN
Rate& = 1200
ReportY% = 2
ELSEIF Rate& = 1200 THEN
Rate& = 2400
ReportY% = 3
ELSEIF Rate& = 2400 THEN
Rate& = 9600
ReportY% = 4
ELSEIF Rate& = 9600 THEN
ReportY% = 0
END IF
RETURN
'
ChooseModem:
PRINT
PRINT
PRINT "Choose the port number you wish to test from above list!"
A$ = ""
WHILE A$ = ""
A$ = INKEY$
WEND
ChosenModem% = VAL(A$)
Rate& = FoundPort%(ChosenModem%)
Port = ChosenModem%
RETURN
'
GetResponse:
C$ = ""
Response% = 0
Accept% = 0
TriggerVal! = TIMER + 1
DO
DO WHILE DataWaiting
A$=CHR$(ReadChar)
A% = ASC(A$)
GOSUB GoodChar
IF Accept% = True THEN
C$ = C$ + A$
ELSEIF Accept% = 99 THEN
C$ = C$ + CHR$(32)
END IF
LOOP
GOSUB ResponseCatagory
LOOP UNTIL TIMER > TriggerVal! OR Response% > 0 OR Accept% = 99
IF Response% THEN
PRINT
PRINT "Modem Response: ";C$;
PRINT
ELSEIF Accept% = 99 THEN
GOTO GetResponse
END IF
RETURN
'
ResponseCatagory:
IF INSTR(C$,Respond$(0)) OR INSTR(C$,Respond$(20)) THEN
Response% = 1
ELSEIF INSTR(C$,Respond$(1)) OR INSTR(C$,Respond$(21)) THEN
Response% = 2
ELSEIF INSTR(C$,Respond$(2)) OR INSTR(C$,Respond$(22)) THEN
Response% = 3
ELSEIF INSTR(C$,Respond$(3)) OR INSTR(C$,Respond$(23)) THEN
Response% = 4
ELSEIF INSTR(C$,Respond$(4)) OR INSTR(C$,Respond$(24)) THEN
Response% = 5
ELSEIF INSTR(C$,Respond$(5)) OR INSTR(C$,Respond$(25)) THEN
Response% = 6
ELSEIF INSTR(C$,Respond$(6)) OR INSTR(C$,Respond$(26)) THEN
Response% = 7
ELSEIF INSTR(C$,Respond$(7)) OR INSTR(C$,Respond$(27)) THEN
Response% = 8
ELSEIF INSTR(C$,Respond$(8)) OR INSTR(C$,Respond$(28)) THEN
Response% = 9
ELSEIF INSTR(C$,Respond$(8)) OR INSTR(C$,Respond$(29)) THEN
Response% = 10
ELSEIF INSTR(C$,Respond$(10)) OR INSTR(C$,Respond$(30)) THEN
Response% = 11
ELSEIF VAL(C$) > 0 THEN
Response% = CINT(VAL(LEFT$(C$,INSTR(C$,CHR$(13)))))
ELSE
Response% = 0
END IF
RETURN
'
GoodChar:
IF A% = 13 THEN
Accept% = 99
ELSEIF A% = 32 THEN
Accept% = True
ELSEIF (A% > 47) AND (A% < 58) THEN
Accept% = True
ELSEIF (A% > 64) AND (A% < 91) THEN
Accept% = True
ELSE
Accept% = False
END IF
RETURN
'>anarky
Screwing with your reality since 1998.