The QBasic / QB64 Discussion Forum      Other Subforums, Links and Downloads
 
 

 Return to Index  

diskette?

August 18 2011 at 7:02 AM
Anonymous  (no login)


Response to floppy 3,5 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, "<!-- Created by CVT2HTM on "; DATE$; " "; TIME$; " -->"

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






 
 Respond to this message   
Response TitleAuthor and Date
programm??cd rom? note (View Thread)Anonymous on Aug 20
   MORT.BAS not tested?Anonymous on Aug 23
      http://www.rkeene.org/devel/archive/quickbasic/Anonymous on Aug 23
         HIDEFILE.BASAnonymous on Aug 23
            http://cd.textfiles.com/pcsig08/DOD/1_1000.UPPAnonymous on Aug 23
            http://cd.textfiles.com/pcsig08/DOD/1_1000.UPPAnonymous on Aug 23
               * I guess I shouldn't be surprised this hasn't been removed as SPAM either... on Aug 29
               ??htm.ico perhaps i try'd was not coming on other place yesAnonymous on Dec 5
                  maybee needs a monitor for itAnonymous on Dec 10
            *I guess I shouldn't be surprised at how many programs have been written over the decades. on Aug 27
         now testedAnonymous on Dec 10
 Copyright © 1999-2014 Network54. All rights reserved.   Terms of Use   Privacy Statement  

Newbies usually go to www.qbasic.com and click on The QBasic Forum
Forum regulars have their own ways, which include The QBasic Community Forums