Does anyone know of a way I can call Hyper Terminal function through VB? What I want to be able to do is automatically through VB beable to send a file using xModem protocol using Hyper Terminal that comes with windows.
Printable View
Does anyone know of a way I can call Hyper Terminal function through VB? What I want to be able to do is automatically through VB beable to send a file using xModem protocol using Hyper Terminal that comes with windows.
Wouldn't it just be easier to use Winsock?
If you do want to use Xmodem I have an old QBASIC program for it which you might be able to adapt. Here it comes. Sorry in advance to anyone who wants to get to the bottom of this page quickly ;)
DECLARE FUNCTION CalcCheckSum% (Blk$)
DECLARE FUNCTION CalcCRC& (X$, CRCHigh%, CRCLow%)
DECLARE FUNCTION FileExists% (T$, Attrib%)
DECLARE FUNCTION NoCarrier% ()
DECLARE FUNCTION TimedGet$ (Limit&, Cancelled%)
DECLARE FUNCTION Warn$ (Message$)
DECLARE SUB ClrLn (Ln%, Spaces%)
DECLARE SUB OpenCom (ComChan%, Param$)
DECLARE SUB PurgeBuffer ()
DECLARE SUB ReceiveXModem (BlkSize%, F$)
DECLARE SUB SendXModem (BlkSize%, F$)
DECLARE SUB SimpleTerminal ()
DECLARE SUB Txt (Side$, T$)
DECLARE SUB Transfer (WhichWay$)
DECLARE SUB VidBar (BarOn%, Col%, Length%)
TYPE RegTypeX 'Register Type for
ax AS INTEGER ' Interrupt Calls
bx AS INTEGER
cx AS INTEGER 'AX = AH AL
dx AS INTEGER 'BX = BH BL, etc.
bp AS INTEGER
si AS INTEGER
di AS INTEGER
Flags AS INTEGER
ds AS INTEGER
es AS INTEGER
END TYPE
CONST TRUE = -1, FALSE = 0 'Boolean Constants
DEFINT A-Z
DIM SHARED CR$, LF$, BS$, Escape$ 'Global String Constants
DIM SHARED Lft$, Rght$, Up$, Down$
DIM SHARED PgUp$, PgDown$
DIM SHARED XOn$, XOff$
DIM SHARED Ack$, Nak$, Soh$, Stx$, Eot$, Can$ 'Protocol Pseudo-Constants
DIM SHARED ComBase, Baud&
DIM SHARED Txt1st, TxtMax 'Used by Txt Sub
DIM SHARED Kolor, BGKolor 'Screen Colors
DIM SHARED ErrCode, ErrCt 'Error Number & Count
'===========================================================================
' I N I T I A L I Z E V A R I A B L E S
'===========================================================================
CR$ = CHR$(13): LF$ = CHR$(10): BS$ = CHR$(8): Escape$ = CHR$(27)
Up$ = CHR$(0) + CHR$(72): Down$ = CHR$(0) + CHR$(80)
Lft$ = CHR$(0) + CHR$(75): Rght$ = CHR$(0) + CHR$(77)
PgUp$ = CHR$(0) + CHR$(73): PgDown$ = CHR$(0) + CHR$(81)
XOn$ = CHR$(17): XOff$ = CHR$(19): Ack$ = CHR$(6): Nak$ = CHR$(21)
Soh$ = CHR$(1): Stx$ = CHR$(2): Eot$ = CHR$(4): Can$ = CHR$(24)
Baud& = 2400 'Set the BaudRate
Param$ = STR$(Baud&) + ",N,8,1,RS,OP,CD0,DS0" ' and Com Parameters
'===========================================================================
' M A I N P R O G R A M
'===========================================================================
OpenCom 1, Param$ 'Open Port 1 with Parameters$
SimpleTerminal 'Terminal Mode
END
'***************************************************************************
' E R R O R H A N D L E R
'***************************************************************************
Handler:
ErrCode = ERR 'Copy Err # to Global Var
ErrCt = ErrCt + 1 'Try Statement Causing the Error
IF ErrCt MOD 3 = 0 THEN ' Twice Before Giving Up and
RESUME NEXT: ErrCt = 0 ' Going to the Next Statement
ELSE
RESUME
END IF
FUNCTION CalcCheckSum (Blk$) 'Returns CheckSum on Blk$
C& = 0 'Use Long Int to Avoid Overflow
FOR Q = 1 TO LEN(Blk$)
C& = C& + ASC(MID$(Blk$, Q, 1)) 'Add to Add Bits of Each Byte
NEXT Q
C& = (C& AND 255) 'AND Out Hi Byte Bits
CalcCheckSum = C&
END FUNCTION
FUNCTION CalcCRC& (B$, CRCHigh%, CRCLow%) 'Calculates CRC for Each Block
DIM Power(0 TO 7) 'For the 8 Powers of 2
DIM CRC AS LONG
FOR I = 0 TO 7 'Calculate Once Per Block to
Power(I) = 2 ^ I ' Increase Speed Within FOR J
NEXT I ' Loop
CRC = 0 'Reset for Each Text Block
FOR I = 1 TO LEN(B$) 'Calculate for Length of Block
ByteVal = ASC(MID$(B$, I, 1))
FOR J = 7 TO 0 STEP -1
TestBit = ((CRC AND 32768) = 32768) XOR ((ByteVal AND Power(J)) = Power(J))
CRC = ((CRC AND 32767&) * 2&)
IF TestBit THEN CRC = CRC XOR &H1021& ' <-- This for 16 Bit CRC
'*** IF TestBit THEN CRC = CRC XOR &H8005& ' <-- This for 32 Bit CRC
NEXT J
NEXT I
CRCHigh% = (CRC \ 256) 'Break Word Down into Bytes
CRCLow% = (CRC MOD 256) ' for Comparison Later
ComputeCRC& = CRC 'Return the Word Value
END FUNCTION
REM $DYNAMIC
SUB ClrLn (Ln, Spaces) 'Clears Line from Left Side
LOCATE Ln, 1, 0: PRINT SPACE$(Spaces); ' for Number of Designated
LOCATE Ln, 1 ' Spaces. Returns Cursor to
END SUB ' to First Column Afterwards
REM $STATIC
FUNCTION FileExists (T$, Attrib) 'True if File T$ Exists else False
DIM F AS STRING * 64
DIM Inx AS RegTypeX
DIM Outx AS RegTypeX
Inx.ax = &H2F00 'Function 2FH Gets the DTA Address in
'CALL INTERRUPTX(&H21, Inx, Outx) ' ES:BX
DTASeg = Outx.es
DTAAddr = Outx.bx
F$ = LTRIM$(RTRIM$(UCASE$(T$))) + CHR$(0)
Inx.ds = VARSEG(F$) 'Pass the File Specs by Giving Address
Inx.dx = VARPTR(F$) ' of String that Contains Specification
Inx.ax = &H4E00 'Function 4EH for Find 1st Matching Entry
Inx.cx = Attrib 'CX = Directory Attribute (0=Files Only)
'CALL INTERRUPTX(&H21, Inx, Outx) 'Use Interrupt 21H
IF Outx.Flags AND 1 THEN
FileExists = FALSE
ELSE
FileExists = TRUE
END IF
END FUNCTION
REM $DYNAMIC
FUNCTION NoCarrier
DEF SEG = &H40
IF (INP(ComBase + 6) AND 128) = 0 THEN NoCarrier = TRUE ELSE NoCarrier = FALSE
DEF SEG
END FUNCTION
REM $STATIC
SUB OpenCom (ComChan, Param$)
CLOSE 1
SELECT CASE ComChan 'Will Require Swapping at &H400, &H402
CASE 1 ' Order to Support Com 3 and 4
ComBase = &H3F8
OPEN "R", 1, "COM1:" + Param$
CASE 2
ComBase = &H2F8
OPEN "R", 1, "COM2:" + Param$
END SELECT
END SUB
SUB PurgeBuffer 'Clear Comm Line of Chars
Mark& = TIMER 'Mark Starting Time
DO
IF NOT EOF(1) THEN 'Get More Chars While Some
JunkIt$ = INPUT$(1, 1): Mark& = TIMER ' In the Buffer and it's
END IF ' Less Than 1/2 Second
LOOP UNTIL EOF(1) AND (ABS(TIMER - Mark&) > .5) ' Since Last Char Gotten
END SUB
SUB ReceiveXModem (BlkSize, F$) '(Block Size and Filename)
DIM B$(1 TO 4) 'Temp Storage of Block Bytes
CLOSE 9: OPEN "O", #9, F$ 'Save File to Channel #9
PRINT #1, XOff$; XOn$;
Cancels$ = STRING$(3, Can$)
Underway = FALSE 'True After 1st Pkt Confirmed
Blocks = 1 'Block/Pkt Counter (1-Max)
BlkNum = 1 'Packet Block Number (1-255)
Bad = 0 'Bad Packets/Error Count
BCt = 0 'RAM Block Ptr for B$()
PurgeBuffer 'Get Rid of Extra Chars
CrcMode = TRUE: PktSize = BlkSize + 5 'Try CRC Mode First
PRINT #1, "C"; 'Send "C" to Signal It
GetPacket: 'Get Packet of Bytes
IF NoCarrier THEN ErrType = 13: GOTO ShowErr 'Are We Still Online?
Pkt$ = ""
FOR Tries = 1 TO 10 'Allow 10 Tries
W$ = TimedGet$(8, Cancelled) 'Get Response/1st Char of Pkt
IF Cancelled THEN ErrType = 11: GOTO ShowErr 'Quit If User Cancelled
SELECT CASE W$ '1st Byte Is:
CASE Soh$: BlkSize = 128: EXIT FOR 'Soh = 128 Byte Block Coming
CASE Stx$: BlkSize = 1024: EXIT FOR 'Stx = 1K Block Coming
CASE Eot$: GOTO ReceptionDone 'End of Xmission. Close Out.
CASE Can$: EXIT FOR 'Cancelled by Sender
CASE "" 'No Char In Means Timed Out
Bad = Bad + 1: LOCATE 7, 40
PRINT "Tries:"; Tries; TAB(80);
CASE ELSE 'Else Didn't Get An Expected
PurgeBuffer ' Response So Purge Characters
END SELECT
IF NOT Underway THEN 'Handshaking Not Complete Yet
IF Tries < 4 THEN ' So Send Out Init Char Again
CrcMode = TRUE: PRINT #1, "C"; ' Send a "C" to Start CRC or
ELSE ' a <Nak> for Standard Mode
CrcMode = FALSE: PRINT #1, Nak$;
END IF
END IF
IF Bad >= 10 THEN 'Have Reached the Max of 10
ErrType = 14: PurgeBuffer: GOTO ShowErr ' Errors from TimeOuts or
END IF ' Bad Packets so Abort
NEXT Tries
IF CrcMode THEN 'Blk Size Determined by <Soh>
PktSize = BlkSize + 5 ' or <Stx>, PacketSize by
ELSE ' BlockSize and Type of Check
PktSize = BlkSize + 4 ' Used (1 Extra Byte for CRC)
END IF
Pkt$ = W$ 'We've Got the First Byte
WHILE LEN(Pkt$) <= PktSize - 1 'Now Get Rest of Packet
W$ = TimedGet$(4, Cancelled)
IF Cancelled THEN ErrType = 11: GOTO ShowErr
IF LEN(W$) THEN 'If There is a Byte then Add
Pkt$ = Pkt$ + W$ ' it to the Packet
IF LEFT$(Pkt$, 3) = Cancels$ THEN 'Packet Starting with Three
PRINT #1, Cancels$; Ack$; ' <Can>s Is a Cancellation So
ErrType = 12: GOTO ShowErr ' <Ack>nowledge And Abort
END IF
ELSE 'Else Null Means We Timed Out
Bad = Bad + 1
LOCATE 7, 40: PRINT TAB(80);
LOCATE 7, 40: PRINT "Character Timeout. Errors:"; Bad;
GOTO CheckPacket
END IF
WEND
CheckPacket: 'Check Packet Errors
IF LEN(Pkt$) = PktSize THEN 'If Packet Right Size
IF BlkNum = ASC(MID$(Pkt$, 2, 1)) + 1 AND (BlkNum XOR 255) = ASC(MID$(Pkt$, 3, 1)) THEN
ErrType = 7: GOTO ShowErr 'Repeated Block #
ELSEIF BlkNum <> ASC(MID$(Pkt$, 2, 1)) THEN 'Block Counts Don't
ErrType = 5: GOTO ShowErr ' Match. Try New Pkt
ELSEIF (BlkNum XOR 255) <> ASC(MID$(Pkt$, 3, 1)) THEN 'Block Ct Complement
ErrType = 6: GOTO ShowErr ' Mismatch. Try New
END IF ' Packet
Blk$ = MID$(Pkt$, 4, BlkSize) 'Else Copy the Block
IF CrcMode THEN 'Do CheckSum or CRC
J& = CalcCRC&(Blk$, Hi, Low)
IF Hi <> ASC(MID$(Pkt$, PktSize - 1, 1)) THEN ErrType = 4: GOTO ShowErr
IF Low <> ASC(MID$(Pkt$, PktSize, 1)) THEN ErrType = 4: GOTO ShowErr
ELSE
ChkSum = CalcCheckSum(Blk$)
IF ChkSum <> ASC(MID$(Pkt$, PktSize, 1)) THEN ErrType = 3: GOTO ShowErr
END IF
GOSUB ShowProgress 'Displays Xfer Status
BlkNum = 255 AND (BlkNum + 1) 'Success Thru All CheckPts
Blocks = Blocks + 1: Bad = 0 ' so Increment Block Cts
Underway = TRUE ' Mark Handshake Completed
IF BlkSize = 1024 THEN 'For Xmodem-1k Write to Disk
PRINT #9, Blk$; ' Immediately
ELSE
BCt = BCt + 1: B$(BCt) = Blk$ 'Else Save 4 Blocks In RAM
IF BCt = 4 THEN ' Write them to Disk Every
PRINT #9, B$(1); B$(2); B$(3); B$(4); ' 4th, i.e. After 512 Bytes
BCt = 0 ' Reset RAM Block Index
END IF
END IF 'Acknowledge Good Block Read
PRINT #1, Ack$; ' And Go to Get Next Packet
GOTO GetPacket
ELSEIF LEN(Pkt$) < PktSize THEN 'Packet Too Short so Show
ErrType = 1: GOTO ShowErr ' Err and Get New Packet
ELSEIF LEN(Pkt$) > PktSize THEN 'Packet Too Big so Show Err
ErrType = 2: GOTO ShowErr ' And Get New Packet
ELSE 'Else an Unexpected Error
ErrType = 8: GOTO ShowErr ' So Warn and Try for New
END IF ' Packet
' Last 2 Should NOT Occur
ReceptionDone:
IF BCt <> 0 THEN 'If Some Bytes Still In
FOR I = 1 TO BCt: PRINT #9, B$(I); : NEXT I ' Memory Then Write Them
END IF ' to Disk
CLOSE 9: PRINT #1, Ack$; 'Xmit Complete so Close
EXIT SUB ' File and Send Final Ack
'---------------------------------------------------------------------------
ShowErr:
Response$ = Nak$ 'Send Nak After Most Errors
SELECT CASE ErrType
CASE 1: ErM$ = "Short Block in #" + STR$(Blocks)
CASE 2: ErM$ = "Long Block in #" + STR$(Blocks)
CASE 3: ErM$ = "Checksum Error in #" + STR$(Blocks)
CASE 4: ErM$ = "CRC Error in #" + STR$(Blocks)
CASE 5: ErM$ = "Block # Error in #" + STR$(Blocks)
CASE 6: ErM$ = "Complement Error in #" + STR$(Blocks)
CASE 7: ErM$ = "Block # Repeated in #" + STR$(Blocks - 1): Response$ = Ack$
CASE 8: ErM$ = "Unexpected Error!"
CASE 9:
CASE 10: ErM$ = "Transfer Cancelled"
CASE 11: ErM$ = "Transfer Aborted by User"
CASE 12: ErM$ = "Transfer Aborted by Sender"
CASE 13: ErM$ = "No Carrier"
CASE 14: ErM$ = "Maximum Errors. Transfer Aborted."
END SELECT
LOCATE 7, 40: PRINT TAB(80); 'Show the ErrorMsg
LOCATE 7, 40: PRINT ErM$;
IF ErrType < 10 THEN 'ErrType < 10 is Recoverable
Bad = Bad + 1 ' Count One More Error
PRINT #1, Response$; ' Respond Nak (or Ack) and
Pkt$ = "": GOTO GetPacket ' Go to Get Packet Again
ELSE
J$ = Warn$(ErM$) 'Notify User of Cancel
SLEEP 2: PurgeBuffer 'Get Rid of Remaining Pkt
PRINT #1, STRING$(5, 24); STRING$(5, 8); 'Send 5 <Can>s & 5 <BS>s
CLOSE 9: KILL F$ 'ErrType >= 10 is Fatal so
EXIT SUB ' Kill Off File and Quit
END IF
'---------------------------------------------------------------------------
ShowProgress: 'Show Byte Counts & Bar
KBytes = INT(Blocks * (BlkSize / 1024))
LOCATE 5, 40: PRINT "Received #"; Blocks; TAB(60); KBytes; "K Bytes";
IF BarLength = 0 THEN
LOCATE 9: VidBar FALSE, 1, 80
FOR K = 1 TO 9
LOCATE 10, K * 8 - 1
PRINT LTRIM$(STR$(100 * (KBytes \ 100) + (K * 10))); "K ";
NEXT K
END IF
BarLength = INT(80 * ((KBytes MOD 100) / 100))
LOCATE 9: VidBar TRUE, 1, BarLength
RETURN
' Block refers to Block of Text from File (128 bytes, 1024 for Xmodem-1K)
' Packet Refers to Block + Extra "Control" Characters, i.e. :
' XModem: SOH + BlockCt + Complement BlockCt + Block + CheckSum
' XModemCRC: SOH + BlockCt + Complement BlockCt + Block + CRC (Hi & Low)
' XModem-1K: STX + BlockCt + Complement BlockCt + Block + CheckSum
' XModemCRC-1K: STX + BlockCt + Complement BlockCt + Block + CRC (Hi & Low)
END SUB
SUB SendXModem (BlkSize, F$) '(Bytes, FileName$)
CLOSE 9: OPEN F$ FOR RANDOM AS 9 LEN = 128
FIELD #9, 128 AS BlkOf128$
FiLen& = LOF(9): TtlBlocks = FiLen& \ BlkSize 'Get File Length
IF FiLen& MOD BlkSize > 0 THEN TtlBlocks = TtlBlocks + 1 ' in Bytes & Blocks
LOCATE 3, 40: PRINT "Blocks:"; TtlBlocks; TAB(60);
Seconds = ((TtlBlocks * 6) + FiLen&) \ (Baud& \ 16)
Est$ = STR$(Seconds \ 3600) + STR$(Seconds \ 60) + STR$(Seconds MOD 60)
FOR I = 2 TO LEN(Est$)
IF MID$(Est$, I, 1) = " " THEN MID$(Est$, I, 1) = ":"
NEXT I
PRINT "Est. Time:"; Est$;
ErM$ = "Transfer Aborted" 'Generic Msg In Case of Error
Blocks = 0: BlkNum = 0 'Blocks (1-?), BlkNum (1-255)
EoFile = FALSE: W$ = "" 'Initialize Block, Byte,
Ct& = 0 'To Count Bytes Used & Sent
Bad = 0 'Error Counter
PurgeBuffer 'Clear the Com Line
DO 'Shake Hands with Receiver
W$ = TimedGet$(20, Cancelled) 'Get Initial Character
IF Cancelled THEN GOTO AbortSend 'If User Pressed <Esc>
SELECT CASE W$
CASE Can$: GOTO AbortSend 'Receiver is Cancelling
CASE Nak$: CrcMode = FALSE: EXIT DO 'Nak for Standard XModem
CASE "C": CrcMode = TRUE: EXIT DO 'C Indicates XModem-CRC
END SELECT 'Begin After <Nak> or C
LOOP
MakePacket:
IF NoCarrier THEN 'Still Online?
ErM$ = "No Carrier!": GOTO AbortSend
END IF
W$ = "": Blocks = Blocks + 1: Bad = 0 'Advance Block Counter
IF (BlkSize = 1024) AND ((Ct& + 896) > FiLen&) THEN 'If Doing 1k and at End
BlkSize = 128 ' of File Then Shorten
END IF ' to Avoid Extra Nulls
IF BlkSize = 128 THEN MaxBCt = 1 ELSE MaxBCt = 8 '8 Groups of 128 = 1024
BCt = 0: Blk$ = "" 'Build the Block$
DO
Ct& = Ct& + 128: GET #9 'Advance File Ptr, Get From File
BCt = BCt + 1: Blk$ = Blk$ + BlkOf128$
IF Ct& >= FiLen& THEN 'If It's Last Block We're
EoFile = TRUE ' About Done Xmitting
Pad = Ct& - FiLen& ' Pad the End with Nulls
MID$(Blk$, BlkSize - Pad, Pad) = STRING$(Pad, CHR$(0))
EXIT DO
END IF
LOOP UNTIL BCt = MaxBCt 'Done After 1 (8 for 1k)
BlkNum = (255 AND Blocks) ' So Assemble the Packet
Pkt$ = Soh$ + CHR$(BlkNum) + CHR$(BlkNum XOR 255) + Blk$
IF BlkSize = 1024 THEN MID$(Pkt$, 1, 1) = Stx$ '1st Byte is Stx for 1K
IF CrcMode THEN 'End of Packet Varies
J& = CalcCRC&(Blk$, Hi%, Low%) ' with Check Method Used
Pkt$ = Pkt$ + CHR$(Hi%) + CHR$(Low%) ' 2 Bytes for CRC
ELSE
ChkSum = CalcCheckSum(Blk$) ' 1 Byte for CheckSum
Pkt$ = Pkt$ + CHR$(ChkSum)
END IF
SendPacket:
PRINT #1, Pkt$; 'Send the Packet and
LOCATE 5, 40: PRINT "Sending #"; Blocks; ' Show Progress on Screen
P = INT((Blocks / TtlBlocks) * 100) 'Calculate Percentage
IF P <= 100 THEN 'Percentage Can Be > 100
LOCATE 5, 60: PRINT P; "% Complete": LOCATE 9 ' On Last Blocks of 1k
VidBar TRUE, 1, INT((Blocks / TtlBlocks) * 80) ' Mode Since Last 1024 is
END IF ' Sent in 128 Byte Blocks
DO 'Packet Has Been Sent so
W$ = TimedGet$(10, Cancelled) 'Get Response/Confirm
IF Cancelled THEN GOTO AbortSend 'Quit If User <Esc>aped
SELECT CASE W$ 'Interpret Response
CASE Ack$ 'Block Acknowledged So
Bad = 0 ' Send Next Packet If
IF EoFile THEN EXIT DO ELSE GOTO MakePacket ' More Data
CASE ELSE 'Else
Bad = Bad + 1 ' Count 1 More Error
IF Bad > 9 THEN GOTO AbortSend ' Abort If Over Limit
IF W$ = Can$ THEN 'If a <Can> Then Look
FOR I = 1 TO 2 ' For at Least 2 More to
W$ = W$ + TimedGet$(2, Cancelled) ' Be Sure (Or User Esc)
IF Cancelled THEN GOTO AbortSend
IF W$ = STRING$(3, Can$) THEN GOTO AbortSend
NEXT I
GOTO SendPacket
ELSE
PurgeBuffer 'Any Other Char Is an
GOTO SendPacket ' Error So ReSend Packet
END IF ' & Look for <Ack> Again
END SELECT
LOOP
ConcludeSend:
ErM$ = "End of Transmission": GOSUB ShowStatus 'Proper End of Transmit
CLOSE 9: PRINT #1, Eot$; 'Close File, Send the EOT
I$ = TimedGet$(10, Cancelled) 'Get Final Char
IF I$ = Ack$ THEN 'Should Be an <Ack> but
ErM$ = "Acknowledged": GOSUB ShowStatus
ELSEIF Cancelled THEN 'Allow User to Cancel
EXIT SUB
ELSE 'If Not an <Ack> Resend
GOTO ConcludeSend ' <Eot> and Try Again
END IF
EXIT SUB
'---------------------------------------------------------------------------
AbortSend:
J$ = Warn$(ErM$) 'Show Error Status
CLOSE 9 'Close File
PRINT #1, STRING$(5, Can$); STRING$(5, BS$); 'Send Cancel to Receiver
EXIT SUB
'---------------------------------------------------------------------------
ShowStatus:
LOCATE 7, 40: PRINT ErM$; TAB(80); 'Show the Status or ErrorMsg
RETURN
END SUB
SUB SimpleTerminal
ON ERROR GOTO Handler
FF$ = CHR$(12): Hm$ = CHR$(11)
CLS : GOSUB InfoBar
PRINT #1, "AT S0=1" 'Send Modem Initialization String
DO
Out$ = INKEY$ 'Look for Key Press
IF LEN(Out$) THEN 'If There IS One then Select
SELECT CASE Out$
CASE PgUp$, PgDown$ ' to Upload or Download
Transfer Out$: GOSUB InfoBar
CASE Escape$ ' Escape to End Program
EXIT DO
CASE CHR$(0) + CHR$(59)
PRINT #1, "atdt 626-9456"
CASE ELSE
PRINT #1, Out$; ' Else Send the Character Verbatim
END SELECT
END IF
IF LOC(1) THEN 'Is there Incoming Data from Com?
DO ' If So then Get Chars Until No
ComChr$ = INPUT$(1, 1) ' More or End of a Line <LF>
SELECT CASE ComChr$
CASE BS$: ComChr$ = CHR$(29) 'Replace BackSpaces with CHR$(29)
CASE FF$, Hm$: ComChr$ = "" 'Filter these Out
CASE LF$: ComChr$ = "": EXIT DO 'Ignore Linefeeds But Exit Do Loop
END SELECT
PRINT ComChr$; 'Print the Char Received On Screen
LOOP UNTIL LOC(1) = 0 'No More Com Waiting
END IF
LOOP
EXIT SUB
'---------------------------------------------------------------------------
InfoBar:
LOCATE 25, 1: COLOR 0, 7
PRINT " <PgUp> to Upload, <PgDown> to Download, <Escape> to End Program"; TAB(80); " ";
COLOR 7, 0: LOCATE 24, 1
RETURN
END SUB
FUNCTION TimedGet$ (Limit&, Cancelled) 'Timed Routine to Get One
'Character from Comm Port
Mark& = TIMER 'Mark Starting Time
DO
IF NOT EOF(1) THEN 'If Chars Waiting Then
TimedGet$ = INPUT$(1, 1): EXIT FUNCTION ' Return 1 Character
END IF
IF INKEY$ = Escape$ THEN 'User Can Press <Esc> to
Cancelled = TRUE: EXIT FUNCTION ' Quit
END IF
LOOP WHILE ABS(TIMER - Mark&) < Limit& 'Wait Up Until Past Limit
TimedGet$ = "" 'Return "" If Timing Out
END FUNCTION
REM $DYNAMIC
SUB Transfer (WhichWay$) 'WhichWay = PgUp (U/L), PgDn (D/L)
ON ERROR GOTO Handler
NumProtos = 4 'Number of Protocols Here
SendDir$ = "" 'Define Directories Where Files Will
RecvDir$ = "" ' Be DownLoaded To or Uploaded From
SendExternal$ = "" 'DOS Command Line Used to Execute
RecvExternal$ = "" ' External Protocol (~ for Filename)
Kolor = 0: BGKolor = 7 'Transfer Area in Reverse Video for
COLOR Kolor, BGKolor ' Contrast
VIEW PRINT 1 TO 11: CLS 2: VIEW PRINT 'Clear Top 11 Lines
LOCATE 11, 1: PRINT STRING$(80, "±");
IF WhichWay$ = PgUp$ THEN 'Determine if Sending or Receiving
Way$ = "Sending": Sending = TRUE ' From Key Pressed
ELSE
Way$ = "Receiving": Sending = FALSE
END IF
DO
ClrLn 9, 80: PRINT "File You Are "; Way$; ": ";
F$ = "": LINE INPUT F$
IF F$ = "" THEN GOTO ExitTransfer
F$ = UCASE$(F$)
IF Sending THEN
IF LEN(SendDir$) THEN
IF INSTR(F$, ":") = 0 THEN F$ = SendDir$ + "\" + F$
END IF
IF FileExists(F$, 0) THEN Ok = TRUE ELSE J$ = Warn$("File Not Found")
ELSE
IF LEN(ReceiveDir$) THEN
IF INSTR(F$, ":") = 0 THEN F$ = ReceiveDir$ + "\" + F$
END IF
IF FileExists(F$, 0) THEN
ClrLn 9, 80
PRINT F$; " Already Exists! Overwrite it? (Y/N)? ";
DO: B$ = UCASE$(INKEY$)
LOOP UNTIL LEN(B$) AND INSTR("YN", B$)
IF B$ = "Y" THEN Ok = TRUE
ELSE
ErrCode = 0: F = FREEFILE
OPEN "O", F, F$
IF ErrCode THEN J$ = Warn$("Bad Path/Filename?") ELSE Ok = TRUE
CLOSE F
END IF
END IF
LOOP UNTIL Ok
Txt1st = 1: TxtMax = 30 'And Draw a Box Around
LOCATE 1, 1
PRINT TAB(40); "Choose a Protocol"; TAB(80);
Txt "T", ""
Txt "C", " XModem "
Txt "C", " XModem-1k (YModem) "
Txt "C", " External Protocol "
Txt "C", " Cancel "
Txt "B", ""
R = 1: C = 0
DO
LOCATE R + 1, 2, 0
VidBar TRUE, 2, 30
DO: C$ = INKEY$: LOOP UNTIL LEN(C$)
VidBar FALSE, 2, 30
SELECT CASE C$ 'Based on Terminator:
CASE Up$: R = R - 1: IF R < 1 THEN R = NumProtos ' Go to Line Above
CASE Down$: R = R + 1: IF R > NumProtos THEN R = 1 ' or Line Below
CASE CR$: EXIT DO
CASE Escape$: EXIT DO
END SELECT
LOOP
IF C$ = Escape$ THEN GOTO ExitTransfer 'Cancelled by User
VidBar TRUE, 2, 30
LOCATE 9, 1: PRINT "ÇÄÄ+ÄÄÄÅÄÄÄ+ÄÄÄÅÄÄÄ+ÄÄÄÅÄÄÄ+ÄÄÄÅÄÄÄ+ÄÄĺÄÄÄ+ÄÄÄÅÄÄÄ+Ä ÄÄÅÄÄÄ+ÄÄÄÅÄÄÄ+ÄÄÄÅÄÄÄ+ÄÄĶ"
LOCATE 1, 3: PRINT " Press <Escape> to Cancel "
LOCATE 1, 40: PRINT Way$; ": "; UCASE$(F$); TAB(80);
IF Sending THEN
LOCATE 10, 1: PRINT " 10% 20% 30% 40% 50% 60% 70% 80% 90%"
SELECT CASE R
CASE 1: SendXModem 128, F$
CASE 2: SendXModem 1024, F$
CASE 3: Ext$ = SendExternal$: GOSUB InsertFileName: SHELL Ext$
CASE 4: GOTO ExitTransfer
END SELECT
ELSE
SELECT CASE R
CASE 1: ReceiveXModem 128, F$
CASE 2: ReceiveXModem 1024, F$
CASE 3: Ext$ = RecvExternal$: GOSUB InsertFileName: SHELL Ext$
CASE 4: GOTO ExitTransfer
END SELECT
END IF
PLAY "T90 O3 L32 CBCBCBCBCBCBCBCBCBCBCBCBCBCBCBC" 'All Done Warning Sound
ExitTransfer:
COLOR 7, 0 'Back to White on Black
VIEW PRINT 1 TO 11: CLS 2: VIEW PRINT 'Clear Top 11 Lines
VIEW PRINT 1 TO 24: LOCATE 24, 1, 1
EXIT SUB
'----------------------------------------------------------------------------
InsertFileName: 'Substitute FileName for ~ in Strings Used
P = INSTR(Ext$, "~") ' to Call External Protocol (Send or Recv)
IF P > 1 THEN
Ext$ = LEFT$(Ext$, P - 1) + F$ + RIGHT$(Ext$, LEN(Ext$) - P)
END IF
RETURN
END SUB
REM $STATIC
SUB Txt (Side$, Text$) 'Put 1 Line of Text w/ Box Delimiters
IF LEN(Text$) > TxtMax THEN Text$ = LEFT$(Text$, TxtMax - 2)
SpaceLeft = (TxtMax - LEN(Text$)) \ 2
LOCATE , Txt1st
IF LEN(Text$) MOD 2 = 1 THEN Text$ = Text$ + " "
IF Side$ = LCASE$(Side$) THEN Shadow$ = ""
SELECT CASE UCASE$(Side$)
CASE "T"
Text$ = "É" + STRING$(TxtMax, "Í") + "»" 'Top Border
C = (TxtMax \ 2) - (LEN(T$) \ 2)
MID$(Text$, C) = T$
CASE "B"
Text$ = "È" + STRING$(TxtMax, "Í") + "¼" 'Bottom Border
C = (TxtMax \ 2) - (LEN(T$) \ 2)
MID$(Text$, C) = T$
CASE "C"
Text$ = "º" + STRING$(SpaceLeft, " ") + Text$ + STRING$(SpaceLeft, " ") + "º"
CASE "R"
Text$ = "º" + STRING$(2 * SpaceLeft, " ") + Text$ + "º" 'Right-Justify
CASE "L"
Text$ = "º" + Text$ + STRING$(2 * SpaceLeft, " ") + "º" 'Left-Justify
END SELECT
PRINT Text$; Shadow$; 'Print Text, DeLimits
IF CSRLIN < 24 THEN PRINT 'Go to Next Line
IF (Side$ = "B") AND LEN(Shadow$) THEN
IF CSRLIN = 24 THEN LOCATE 25
LOCATE , Txt1st
PRINT " "; STRING$(TxtMax + 1, Shadow$); Shadow$;
Shadow$ = ""
END IF
END SUB
SUB VidBar (BarOn, Col, Length)
113 LOCATE , Col 'Position at Paramter Column
IF BarOn THEN 'IF Hilighting (BarOn = True) then
COLOR BGKolor, Kolor ' Use the BGKolor in the FG
FOR J = Col TO Col + Length - 1 'Across the Screen for the "Length"
PRINT CHR$(SCREEN(CSRLIN, J)); ' Re-Print the Char That is Already
NEXT J ' There in It's New Colors
ELSE
COLOR Kolor, BGKolor 'ELSE De-HiLiting So Return Colors
FOR J = Col TO Col + Length - 1 ' to Normal and Re-Print each Char
PRINT CHR$(SCREEN(CSRLIN, J)); ' in the Row with the Regular Video
NEXT J
END IF
LOCATE , Col 'Return to 1st Column
COLOR Kolor, BGKolor ' and Normal Colors
END SUB
FUNCTION Warn$ (Warning$)
LOCATE 1, 40: COLOR 20
PRINT " "; Warning$; TAB(80);
COLOR Kolor, BGKolor
BEEP: BEEP
END FUNCTION
Whoa! That is one *mother* of a long program. I'ts not my program I so I ain't saying this is my code here. I originally downloaded it from and QB site called:
http://www.acidworks.com run by and 18 yr old called Andrew Nunally (or something like that).
HTH
How would you be able to do this using winsock control? I don't really think that could be done. If anything you probably have to use the MScomm control but I thought it would be easier if I could do this through HyperTerminal automatically.
Maybe there are some command line parameters you could use for Hyper Terminal... Try contacting Hilgraeve, or you could type at the DOS prompt
hypertrm /? Which might give you a list of command line parameters. Then again it might not.
HTH
Sorry. I tried the hypertrm /? thing. All it does is launch HyperTerminal (on HyperTerminal Private Edition anyway). Contact Hilgraeve.
BTW. If you are still using HyperTerminal normal version, I recommend you upgrade to PE immediately, the original version has a serious security flaw, and should be upgraded to PE.
Me again. That code I posted b4 should work without any extra controls. It opens the modem COM port like a file and works with it like that. (I think). So all you would need is change the names of a few of the in built functions and change the output format, eg. placing PRINT functions to a listbox or a label.