No I did not write this; someone asked a question about regular expressions either here or an QB64.net, but I can't find that post. Anyway, here's the code I found if anyone wants it.
DECLARE FUNCTION RegClass$ (aRegExp$, K%)
DECLARE FUNCTION RegExp% (aRegExp$, aText$)
DECLARE FUNCTION MatchThis% (aRegExp$, aREptr%, aText$, aTptr%, aTlen%)
RESTORE TestSet2
CLS
LET Q$ = ""
LET Text$ = ""
LET J = 1
DO WHILE J <= 30
LET M$ = "-1"
LET Q$ = Q$ + "a?"
LET Text$ = Text$ + "a"
LET RE$ = "^" + Q$ + Text$
READ M$, RE$, Text$
IF M$ = "" THEN EXIT DO
PRINT TIME$; J; ": "; RE$; TAB(31); Text$; TAB(61);
IF M$ = LTRIM$(STR$(RegExp(RE$, Text$))) THEN
PRINT "Okay"
ELSE
PRINT "Expected "; M$; " got "; RegExp(RE$, Text$)
END IF
LET J = J + 1
LOOP
SYSTEM
TestSet0:
DATA "-1", "^", ""
DATA "-1", "$", ""
DATA "0", "A", ""
DATA "-1", "A?", ""
DATA "-1", "^$", ""
DATA "-1", "^", "A"
DATA "-1", "$", "A"
DATA "-1", "A", "A"
DATA "-1", "^A", "A"
DATA "-1", "A$", "A"
DATA "-1", "^A$", "A"
DATA "-1", "^AA$", "AA"
DATA "", "", ""
TestSet1:
DATA "-1", "^Any", "Any"
DATA "-1", "^Any\.", "Any."
DATA "0", "^Any\.", "Any?"
DATA "-1", "^Any", "Anywhere"
DATA "0", "^Any", "Nowhere"
DATA "-1", "^Any$", "Any"
DATA "0", "^Any$", "Anywhere"
DATA "0", "^Any$", "Nowhere"
DATA "-1", "^Ann*y", "Any"
DATA "-1", "^Ann*y", "Anny"
DATA "-1", "^An+y", "Any"
DATA "0", "^An+y", "Ay"
DATA "-1", "^A.+y", "Any"
DATA "0", "^A.+y", "Ay"
DATA "-1", "^OPEN *.+ *FOR +INPUT +AS *# *.+$", "OPEN dFile FOR INPUT AS #F1"
DATA "-1", "^OPEN *.+ *FOR +INPUT +AS +#? *.+$", "OPEN dFile FOR INPUT AS 1"
DATA "-1","^LET .+ = .+$", "LET X = 3"
DATA "-1","^PRINT .+$", "PRINT X"
DATA "-1","^FOR .+ = .+ TO .+$", "FOR J = 1 TO 7"
DATA "-1","^FOR .+ = .+ TO .+ STEP .+$", "FOR J = 1 TO 7 STEP 3"
DATA "-1","^NEXT ?[A-Za-z]?$", "NEXT"
DATA "", "", ""
TestSet2:
DATA "-1","^[0123456789]$","3"
DATA "0","^[0123456789]$","A3"
DATA "-1","^[0123456789]+$","3141"
DATA "-1","^[0123456789]+E$","3141E"
DATA "0","^[0123456789]*\.?[0123456789]*E?[+-]?[0123456789]?[0123456789]?$","3.141E*07"
DATA "-1","^[A-Za-z][A-Za-z0-9]*$","hello"
DATA "0","^[A-Za-z][A-Za-z0-9]$","A"
DATA "-1","^[A-Za-z][A-Za-z0-9]?$","A"
DATA "-1","^[A-Za-z][A-Za-z0-9]$","A9"
DATA "-1","^[A-Za-z][A-Za-z0-9]*$","hello72"
DATA "-1","^[A-Za-z][A-Za-z0-9]*$","T3A2W8"
DATA "0","^[A-Za-z][A-Za-z0-9]*$","3A2W8T"
DATA "0","^[A-Za-z][A-Za-z0-9]*$","1958"
DATA "-1","^[A-Za-z][A-Za-z0-9]*\.fred$","Y1958.fred"
DATA "", "", ""
TestSet3:
DATA "-1","^a?a", "a"
DATA "-1","^a?a?aa", "aa"
DATA "-1","^a?a?a?aaa", "aaa"
DATA "-1","^a?a?a?a?aaaa", "aaaa"
DATA "-1","^a?a?a?a?a?aaaaa", "aaaaa"
DATA "-1","^a?a?a?a?a?a?aaaaaa", "aaaaaa"
DATA "-1","^a?a?a?a?a?a?a?aaaaaaa", "aaaaaaa"
DATA "-1","^a?a?a?a?a?a?a?a?aaaaaaaa", "aaaaaaaa"
DATA "-1","^a?a?a?a?a?a?a?a?a?aaaaaaaaa", "aaaaaaaaa"
DATA "-1","^a?a?a?a?a?a?a?a?a?a?aaaaaaaaaa", "aaaaaaaaaa"
DATA "-1","^a?a?a?a?a?a?a?a?a?a?a?aaaaaaaaaaa", "aaaaaaaaaaa"
DATA "-1","^a?a?a?a?a?a?a?a?a?a?a?a?aaaaaaaaaaaa", "aaaaaaaaaaaa"
DATA "", "", ""
FUNCTION MatchThis% (aRegExp$, aREptr%, aText$, aTptr%, aTlen%)
DIM dResult%
DIM dChar$
DIM J%
DO
LET dChar$ = MID$(aRegExp$, aREptr%, 1)
SELECT CASE dChar$
CASE ""
LET dResult% = (1 = 1)
EXIT DO
CASE "$"
LET dResult% = (aTptr% > aTlen%)
EXIT DO
CASE ELSE
SELECT CASE dChar$
CASE "["
LET dChar$ = RegClass$(MID$(aRegExp$, aREptr%), J%)
LET aREptr% = aREptr% + J%
CASE "\"
LET aREptr% = aREptr% + 1
LET dChar$ = MID$(aRegExp$, aREptr%, 1)
CASE "."
LET dChar$ = ""
END SELECT
LET aREptr% = aREptr% + 1
SELECT CASE MID$(aRegExp$, aREptr%, 1)
CASE "*"
LET aREptr% = aREptr% + 1
LET aTptr% = aTptr% - 1
DO
LET aTptr% = aTptr% + 1
LET dResult% = MatchThis(aRegExp$, (aREptr%), aText$,(aTptr%), aTlen%)
LOOP WHILE aTptr% <= aTlen% AND (INSTR(dChar$, MID$(aText$, aTptr%, 1)) > 0 OR dChar$ = "") AND NOT dResult%
EXIT DO
CASE "?"
LET aREptr% = aREptr% + 1
LET dResult% = MatchThis(aRegExp$, (aREptr%), aText$,(aTptr%), aTlen%)
IF NOT dResult% THEN
IF aTptr% <= aTlen% THEN
IF INSTR(dChar$, MID$(aText$, aTptr%, 1)) > 0 OR dChar$ = "" THEN
LET dResult% = MatchThis(aRegExp$, (aREptr%), aText$, (aTptr% + 1), aTlen%)
END IF
END IF
END IF
EXIT DO
CASE "+"
LET aREptr% = aREptr% + 1
LET dResult% = (1 = 0)
DO WHILE aTptr% <= aTlen% AND (INSTR(dChar$, MID$(aText$, aTptr%, 1)) > 0 OR dChar$ = "") AND NOT dResult%
LET aTptr% = aTptr% + 1
LET dResult% = MatchThis(aRegExp$, (aREptr%), aText$, (aTptr%), aTlen%)
LOOP
EXIT DO
CASE ELSE
IF aTptr% <= aTlen% AND (INSTR(dChar$, MID$(aText$, aTptr%, 1)) > 0 OR dChar$ = "") THEN
LET aTptr% = aTptr% + 1
ELSE
LET dResult% = (1 = 0)
EXIT DO
END IF
END SELECT
END SELECT
LOOP
LET MatchThis% = dResult%
END FUNCTION
FUNCTION RegClass$ (aRegExp$, K%)
DIM dClass$
DIM dChar$
DIM Exclam%
DIM dLastChar%
DIM dNextChar%
DIM J%
LET J% = 2
LET Exclam% = (MID$(aRegExp$, J%, 1) = "!")
LET J% = J% - Exclam%
LET dClass$ = STRING$(256, MID$("YN", 2 + Exclam%, 1))
LET dLastChar% = 1
DO
LET dChar$ = MID$(aRegExp$, J%, 1)
SELECT CASE dChar$
CASE "]", ""
EXIT DO
CASE "\"
LET J% = J% + 1
LET dLastChar% = ASC(MID$(aRegExp$, J%, 1)) + 1
CASE "-"
LET J% = J% + 1
SELECT CASE MID$(aRegExp$, J%, 1)
CASE "\"
LET J% = J% + 1
CASE "]", ""
LET J% = J% - 1
LET dLastChar% = ASC(MID$(aRegExp$, J%, 1)) + 1
END SELECT
LET dNextChar% = ASC(MID$(aRegExp$, J%, 1)) + 1
FOR K% = dLastChar% + 1 TO dNextChar% - 1
MID$(dClass$, K%, 1) = MID$("NY", 2 + Exclam%, 1)
NEXT
LET dLastChar% = dNextChar%
CASE ELSE
LET dLastChar% = ASC(MID$(aRegExp$, J%, 1)) + 1
END SELECT
MID$(dClass$, dLastChar%, 1) = MID$("NY", 2 + Exclam%, 1)
LET J% = J% + 1
LOOP
FOR K% = 0 TO 255
LET dClass$ = dClass$ + MID$(CHR$(K%), 1, -(MID$(dClass$, K% + 1,1) = "Y"))
NEXT
LET dClass$ = MID$(dClass$, 257)
LET K% = J% - 1
LET RegClass$ = dClass$
END FUNCTION
FUNCTION RegExp% (aRegExp$, aText$)
DIM dResult%
DIM dTptr%
DIM dTlen%
LET dTlen% = LEN(aText$)
IF LEFT$(aRegExp$, 1) = "^" THEN
LET dResult% = MatchThis(aRegExp$, 2, aText$, 1, dTlen%)
ELSE
LET dTptr% = 0
DO
LET dTptr% = dTptr% + 1
LET dResult% = MatchThis(aRegExp$, 1, aText$, (dTptr%), dTlen%)
LOOP WHILE dTptr% <= dTlen% AND NOT dResult%
END IF
LET RegExp% = dResult%
END FUNCTION
|