Big QB Programs: diskette?

'$DYNAMIC
ON ERROR GOTO handler ' Prepares the error handler
DIM text(50) AS STRING ' Used to contain the text file.
maxlines = 50 ' Contains the current size of the buffer.

DO
CLS 'clears the screen
INPUT "Would you like to create a (N)ew file, (L)oad an existing one, or (E)xit the program"; choice$

SELECT CASE UCASE$(choice$) 'UCASE$ converts strings to UPPER CASE
CASE "N" 'New file
CASE "L" 'Load a file
CASE "E" 'Exit
CLS
END
END SELECT
LOOP 'returns to the top of the program.

handler:
errorflag = ERR ' Keep track of the error that occurred.
RESUME NEXT ' Proceeds with the next statement.

the whole to find by

http://en.wikibooks.org/wiki/QBasic/Files.

would well if were has time to think about a bas for diskette called windows

????????????????????????????????????

DECLARE FUNCTION IsALine% (T AS STRING)
DECLARE SUB CVTAllURL (T AS STRING)
DECLARE SUB CVTURL (T AS STRING, Prot AS STRING)
DECLARE SUB HTMLChar (S AS STRING)
DECLARE SUB FixLF (T AS STRING)
DECLARE SUB GetTop (F AS STRING, T AS STRING)
DECLARE FUNCTION WrapString% (S AS STRING, T() AS STRING, Max AS INTEGER)
DECLARE SUB Replace (Temp$, Old$, NW$)
CLS
CLEAR , , 4000
PRINT "CVT2HTM 1.00 1/31/98 (wel)": PRINT
PRINT
PRINT "Converts a text file to a HTML file"
PRINT

Fin$ = "TXT2HTML.TXT" ' Text File to Convert
' Extension must be .TXT

ConvertURLS = 1 ' 1 = Convert URLS, 0 = Do not convert

TB$ = CHR$(9)
LF$ = CHR$(10)
CR$ = CHR$(13)
CRLF$ = CR$ + LF$

Title$ = ""

' Sanity check on file names
FIin$ = UCASE$(Fin$)
I% = INSTR(Fin$, "."): LN% = LEN(Fin$)
IF I% THEN ' Does it contain a period?
Ext$ = UCASE$(RIGHT$(Fin$, LN% - I%))
IF Ext$ = "TXT" THEN
FOut$ = LEFT$(Fin$, I% - 1) + ".HTM"
ELSE
PRINT Fin$; " is not a text file"
GOTO EndOfLoop
END IF
ELSE
Ext$ = ""
GOTO EndOfLoop
END IF

Title$ = "Converted from " + Fin$

ON ERROR GOTO OpenErr
OPEN Fin$ FOR INPUT AS #1 LEN = 10240: GOTO GoodOpen

OpenErr: PRINT : PRINT "Error opening "; Fin$
PRINT : PRINT "File not found. Does it exist?"
CLOSE
END

GoodOpen:
OPEN FOut$ FOR OUTPUT AS #2 LEN = 10240

PRINT "Converting "; Fin$; " to "; FOut$

ON ERROR GOTO SomeError

' Print opening stuff

' We will be doing a bunch of processing on the first
' two lines. Cover your eyes.

T$ = "": T2$ = "": Line1$ = "": Line2$ = ""
IF EOF(1) THEN GOTO EndOfText
LINE INPUT #1, T$
IF EOF(1) THEN GOTO SecLine
LINE INPUT #1, T2$
SecLine:
IF RTRIM$(T$) = "" THEN T$ = T2$: T2$ = ""
IF T$ <> "" AND IsALine%(T$) = 0 THEN Title$ = LEFT$(T$, 66)
CALL FixLF(T$): CALL HTMLChar(T$)
CALL FixLF(T2$): CALL HTMLChar(T2$)

IF (T2$ = "" OR LEFT$(T2$, 3) = "<hr") AND IsALine(T$) = 0 AND LEN(T$) <= 75 THEN
Line1$ = "<center><h2>" + T$ + "</h2></center>"
Line2$ = ""
ELSE
Line1$ = T$
Line2$ = T2$
END IF
First% = 1: OldT$ = ""
CALL HTMLChar(Title$)

' OK done with that. Now actually write the first part
' of the HTML file.

PRINT #2, "<HTML>"
PRINT #2, ""
PRINT #2, ""

PRINT #2, ""
PRINT #2, "<HEAD><TITLE>"; Title$;

PRINT #2, "</TITLE></HEAD>"
Q$ = CHR$(34)
PRINT #2, "<BODY bgcolor="; Q$; "ffffff"; Q$;
PRINT #2, " Link="; Q$; "0000CC"; Q$;
PRINT #2, " ALink="; Q$; "00FF00"; Q$;
PRINT #2, " VLink="; Q$; "CC0000"; Q$;
PRINT #2, ">"
PRINT #2, ""
' PRINT #2, "<PRE>"

IF Line1$ <> "" THEN PRINT #2, Line1$
IF Line2$ <> "" THEN PRINT #2, Line2$

' We are FINALLY into processsing the file.
StartOfText:
IF EOF(1) THEN GOTO EndOfText

LINE INPUT #1, T$ ' Read a line from input file

CALL FixLF(T$) ' Fix any carriage return stuff
CALL HTMLChar(T$) ' Convert stuff like "<>
IF ConvertURLS THEN CALL CVTAllURL(T$)

IF T$ = "" THEN ' A Blank line?
IF OldT$ <> "<p>" THEN
T$ = "<p>"
PRINT #2, ""
PRINT #2, T$;
OldT$ = T$
GOTO StartOfText
ELSE
GOTO StartOfText
END IF
END IF
PRINT #2, T$
OldT$ = T$
GOTO StartOfText

EndOfText:
' Print closing stuff
' PRINT #2, "</PRE>"
PRINT #2, "</BODY>"
PRINT #2, "</HTML>"
EndOfLoop:
ON ERROR GOTO 0
CLOSE

PRINT
PRINT FRE(A$); "Bytes free"
END

' All done. Whew!

' Error processing. Should never happen.
SomeError:
BEEP: PRINT "Error processing "; Fin$
CLOSE
KILL FOut$
RESUME EndOfLoop

SUB CVTAllURL (T AS STRING)
CALL CVTURL(T, "http://")
CALL CVTURL(T, "ftp://")

END SUB

SUB CVTURL (T AS STRING, Prot AS STRING)
STATIC F AS INTEGER, LN AS INTEGER
STATIC P1 AS INTEGER, P2 AS INTEGER
STATIC URL AS STRING, C AS STRING, Q AS STRING

Q = CHR$(34)
F = INSTR(T, Prot)
URL = UCASE$(T)
IF INSTR(T, "HREF") THEN F = 0
C = ""
WHILE (F)
LN = LEN(T$)
FOR I = F TO LN
C = MID$(T, I, 1)
IF C = " " OR C = Q OR C = "&" THEN
EXIT FOR
END IF
NEXT I
IF I > LN THEN
I = LN
IF I > 1 THEN
IF MID$(T, I, 1) = "." THEN
I = I - 1
'BEEP: PRINT T: PRINT LEFT$(T, I): 'INPUT X$
END IF
END IF
END IF
'F = F - 1: IF F < 1 THEN F = 1
IF C = "&" OR C = Q THEN I = I - 1

IF I > LN THEN I = LN
P1 = F - 1 ' Left part without Prot
P2 = LEN(T) - I + 0 ' Right part without Prot
URL = MID$(T, F, I - F + 1)
URL = "<A HREF=" + Q + URL + Q + ">" + URL + "</A>"
'PRINT T$: PRINT LEFT$(T, P1): PRINT URL: PRINT RIGHT$(T, P2): INPUT X$
I = P1 + LEN(URL) + 1
T = LEFT$(T, P1) + URL + RIGHT$(T, P2)
IF I < LEN(T) THEN
F = INSTR(I, T, Prot)
ELSE
F = 0
END IF
'PRINT T; F: 'INPUT X$
WEND

END SUB

SUB FixLF (T AS STRING)
STATIC I AS INTEGER, FP AS INTEGER, LN AS INTEGER
STATIC TB AS STRING, LF AS STRING, CR AS STRING, CRLF AS STRING

TB = CHR$(9)
LF = CHR$(10)
CR = CHR$(13)
CRLF = CR + LF

T = RTRIM$(T)
CALL Replace(T, CRLF, LF)
' 'PRINT T: INPUT X
' Ln = LEN(T)
' FOR I = Ln TO 1 STEP -1
' IF MID$(T, I, 1) = LF THEN
' T = LEFT$(T, I - 1)
' EXIT FOR
' END IF
' NEXT I
CALL Replace(T, LF, " ")
CALL Replace(T, CR, " ")
CALL Replace(T, TB, " ")
CALL Replace(T, " ", " ")

END SUB

SUB GetArgs (S$, ArgV$(), ArgC%) STATIC
' 1.01 05/26/87
' Subroutine to emulate argv[] and argc (from C)
' Assumes that array argv() is already dimensioned
' "Parses" s$, fills argv$() with individual "tokens" that were
' separated by spaces. Sets argc% to the number of "tokens" parsed
' Example:
' s$="file1.ext file2.ext -i5"
' call GetArgs(s$,argv(),argc%)
' Then argc%=3,
' argv$(0)="", argv$(1)="file1.ext", argv$(2)="file2.ext", argv$(3)="-i5"
ArgC% = 0
Sep$ = " ": ' Token separator
StrLen% = LEN(S$)
IF StrLen% <= 0 THEN GOTO TheEnd
BgnTok% = 1:
LoopStart:
IF BgnTok% > StrLen% THEN GOTO TheEnd
IF MID$(S$, BgnTok%, 1) = " " THEN BgnTok% = BgnTok% + 1: GOTO LoopStart
MarkSep% = INSTR(BgnTok%, S$, Sep$)
IF MarkSep% = 0 THEN MarkSep% = StrLen% + 1
IF ArgC% >= UBOUND(ArgV$, 1) THEN GOTO TheEnd
ArgC% = ArgC% + 1
ArgV$(ArgC%) = MID$(S$, BgnTok%, MarkSep% - BgnTok%)
IF MarkSep% = StrLen% + 1 THEN GOTO TheEnd
BgnTok% = MarkSep% + 1
GOTO LoopStart
TheEnd:
END SUB

SUB GetTop (F AS STRING, T AS STRING)
STATIC I AS INTEGER, FP AS INTEGER, LN AS INTEGER, Max AS INTEGER
STATIC TB AS STRING, LF AS STRING, CR AS STRING, CRLF AS STRING, CtrZ AS STRING

TB = CHR$(9)
LF = CHR$(10)
CR = CHR$(13)
CRLF = CR + LF
CtrZ = CHR$(26)

Max = LEN(T)
FP = FREEFILE
OPEN F FOR BINARY AS FP LEN = Max
GET FP, , T
CLOSE FP

LN = INSTR(T, CtrZ)
IF LN THEN T = LEFT$(T, LN - 1)

T = RTRIM$(T)
END SUB

SUB HTMLChar (S AS STRING)
STATIC Q AS STRING

Q = CHR$(34)
CALL Replace(S, "&", "&")
CALL Replace(S, "<", "<")
CALL Replace(S, ">", ">")
'CALL Replace(S, Q, """)
CALL Replace(S, Q, """) ' " isn't supported anymore!
IF IsALine(S$) THEN S$ = "<hr noshade>"

END SUB

FUNCTION IsALine% (S AS STRING)
IsALine% = 0
IF INSTR(S, "~~~~~~~~~~") OR INSTR(S$, "***********") OR INSTR(S$, "-----------") OR INSTR(S$, "===========") OR INSTR(S$, "___________") THEN IsALine% = -1

END FUNCTION

SUB Replace (Temp$, Old$, NW$)
STATIC Mark%, OMark%, M%, O%
STATIC P1 AS INTEGER, P2 AS INTEGER, NOff AS INTEGER
O% = LEN(Old$)
M% = LEN(NW$)
IF O% = 2 THEN
IF LEFT$(Old$, 1) = RIGHT$(Old$, 1) THEN
NOff = 0
ELSE
NOff = 1
END IF
END IF
Mark% = INSTR(Temp$, Old$)
IF Old$ = NW$ THEN Mark% = 0
WHILE Mark%
P1 = Mark% - 1 ' Left part without Old$
P2 = LEN(Temp$) - Mark% - O% + 1 ' Right part without Old$

'Part1$ = LEFT$(Temp$, P1)
'Part2$ = RIGHT$(Temp$, P2)
'Temp$ = Part1$ + Nw$ + Part2$
Temp$ = LEFT$(Temp$, P1) + NW$ + RIGHT$(Temp$, P2)
'OMark% = LEN(Part1$) + M% + 1
OMark% = P1 + M% + NOff ' + 1???
IF OMark% < 1 THEN OMark% = 1 ' e.g., NW$ = ""
IF OMark% > LEN(Temp$) THEN
Mark% = 0
ELSE
Mark% = INSTR(OMark%, Temp$, Old$) ' ???
IF Old$ = " " AND 1 = 0 THEN
PRINT Temp$:
PRINT "|"; LEFT$(Temp$, P1); "|"; NW$; "|"
PRINT STRING$(P1 + M% + NOff + 3, "*")
PRINT P1; OMark%: INPUT X
END IF
END IF
WEND
IF INSTR(Temp$, Old$) AND 1 = 0 THEN
PRINT "Error in REPLACE() function."
PRINT Temp$: PRINT "Old |"; Old$; "| New |"; NW$; "|"
PRINT "Should have no "; Old$
BEEP
INPUT "Press ENTER to go on "; XX$
END IF
END SUB

SUB SplitArg (S$, Tok$, TokV) STATIC
' 1.00 7/22/87
' Subroutine to "split" apart an argument
'
' Returns Tok$ = Upper-cased "Token"
' TokV = Optional "value" following token
'
' eats leading -, /, or \'s
STATIC LN%, C$ ' Make variables local
SS$ = S$: Tok$ = "": TokV = 0
SLoop1:
LN% = LEN(SS$): IF LN% <= 0 THEN GOTO SEnd
C$ = LEFT$(SS$, 1)
IF C$ = "-" OR C$ = "/" OR C$ = "\" THEN
SS$ = RIGHT$(SS$, LN% - 1)
GOTO SLoop1
END IF
IF LN% <= 0 THEN GOTO SEnd
Tok$ = LEFT$(SS$, 1): LN% = LN% - 1
IF Tok$ > "_" THEN Tok$ = CHR$(ASC(Tok$) - 32)
IF Tok$ >= "0" AND Tok$ <= "9" THEN Tok$ = "": LN% = LN% + 1
IF LN% <= 0 THEN GOTO SEnd
TokV = VAL(RIGHT$(SS$, LN%))
SEnd:
END SUB

FUNCTION WrapString% (S AS STRING, T() AS STRING, Max AS INTEGER)

STATIC I%, J%, K%, WrapLen%, Lin%, ThisLin%

S$ = RTRIM$(S$)
WrapLen% = LEN(S)

IF WrapLen% = 0 THEN
T(1) = ""
Lin% = 1:
GOTO WrapStringX
END IF

Lin% = 1: ThisLin% = 1: J% = 0
T(Lin%) = ""

WrapString% = 0
FOR I% = 1 TO WrapLen%
J% = J% + 1
T(Lin%) = T(Lin%) + MID$(S$, I%, 1)
IF J% > Max THEN
FOR K% = J% TO 1 STEP -1
IF MID$(T(Lin%), K%, 1) = " " THEN
'We are stripping leading spaces.
'T(Lin%) = LTRIM$(RTRIM$(LEFT$(T(Lin%), K%)))
' NOT stripping leading spaces
T(Lin%) = RTRIM$(LEFT$(T(Lin%), K%))
I% = I% - (J% - K%)
IF Lin% < UBOUND(T) THEN
Lin% = Lin% + 1
T(Lin%) = ""
ELSE
I% = WrapLen% + 1
END IF

J% = 0: K% = 1
END IF
NEXT K%
END IF
NEXT I%
FOR I% = 1 TO Lin%
IF LEN(T(I%)) > Max THEN
T(I%) = LEFT$(T(I%), Max)
'PRINT T(I%)
END IF
NEXT I%

WrapStringX:
WrapString% = Lin%

END FUNCTION

from www.scrounge.org/cvt2htm.bas