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) = "" 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, "" PRINT #2, "" PRINT #2, "" PRINT #2, "" PRINT #2, ""; Title$; PRINT #2, "" Q$ = CHR$(34) PRINT #2, "" PRINT #2, "" ' PRINT #2, "
"
			  
		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$ <> "
" THEN
				T$ = "
"
				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, "
" PRINT #2, "" PRINT #2, "" 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 = "" + URL + "" '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$ = "
" 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