you can try it on any large text file (just change the text file loaded in the code :
file "fb_main.bas: :
Code: Select all
#include "fbgfx.bi"
SUB txtfile(f AS STRING , sOutput as string)
CLS
'DIM AS STRING buffer
DIM h AS LONG = FREEFILE()
OPEN f FOR BINARY AS #h
sOutput = SPACE(LOF(h))
GET #h , , sOutput
CLOSE #h
'PRINT buffer
End SUB
dim b as string
dim as string sBook
input "press 1 for bible as database or press 2 for moby dick book as database", b
if b = "1" then
txtfile("BibleKJV.txt",sBook)
elseif b = "2" then
txtfile("moby-dick.txt",sBook)
else
print "invalid input! error" : sleep 1000 : end
end if
dim as double dTime=timer
dim as string sBookNoSpaces = space(len(sBook))
dim as long iOutPos = 0
redim as long aPosition(len(sBook)-1)
for I as long = 0 to len(sBook)-1
var bChar = sBook[I]
select case bChar
Case asc("A") to asc("Z"), asc("a") to asc("z")
sBookNoSpaces[iOutPos] = bChar or 32
aPosition( iOutPos ) = I
iOutPos += 1
case 13,10
sBook[I] = asc(" ")
End Select
Next I
sBookNoSpaces = left(sBookNoSpaces,iOutPos)
redim preserve aPosition( len(sBookNoSpaces)-1 )
'print cint((timer-dTime)*1000);"ms"
const MaxDistance = 256
dim as string sSearch
dim as long iFoundCount,iConWid=loword(width())
input "Word to search";sSearch
dim as long iWordLen = len(sSearch)
dim as long SearchLimit = iOutPos-iWordLen*MaxDistance
sSearch = lcase(sSearch)
type ResultStruct
iPosition as LONG
iDistance as long
End Type
redim as ResultStruct atResult(15)
dTime = timer
for I as long = 0 to iOutPos-1
if sBookNoSpaces[I] <> sSearch[0] then continue for
for D as long = 2 to MaxDistance
dim as long N = any , iPos = I+D
for N = 1 to iWordLen-1
if sBookNoSpaces[iPos] <> sSearch[N] then exit for
iPos += D
Next
if N >= iWordLen then
if (iFoundCount and 15)=0 then redim preserve atResult(iFoundCount+15)
with atResult(iFoundCount)
.iPosition = I
.iDistance = D
End With
iFoundCount += 1
EndIf
Next
Next
print "Found " & iFoundCount & " occurances in " & csng(timer-dTime) & " seconds."
print string(iConwid-1,"-") : sleep 2000
for ResuN as long = 0 to iFoundCount-1 step 0
with atResult(ResuN)
cls
print "Occurrance: (" & (ResuN+1) & " of " & iFoundCount & ") Position: " & aPosition(.iPosition) & " Distance:" & .iDistance
print string(iConwid-1,"-")
#if 0 'display using the book without spaces
scope
var iStart = .iPosition , iEnd = iStart+(iWordLen-1)*.iDistance
for N = iStart to iEnd step D
color 7,1 : print chr(sBookNoSpaces[N]);: color 7,0
print mid(sBookNoSpaces,N+2,D-1)
next N
End Scope
#else 'display using the original book
var iStart = .iPosition , iEnd = iStart+(iWordLen-1)*.iDistance
color 7
for N as long = iStart to iEnd Step .iDistance
var iPos = aPosition(N), iWord = iPos
while sBook[iWord-1] <> asc(" ") : iWord -= 1 : wend
var iPos2 = aPosition(N+.iDistance)-1
var iMaxLen = (iPos2-iWord)
while sBook[iWord+iMaxLen] <> asc(" ") : iMaxLen += 1 : wend
var iLen = iMaxLen
if iLen > (iConWid-5) then iLen = (iConWid-5)
print mid(sBook,iWord+1,iLen);
if iLen <> iMaxLen then print " ...";
color 7,1 : locate ,(iPos-iWord)+1
print chr(sBook[iPos]): color 7,0
Next
#endif
print string(iConwid-1,"-")
do
var sKey = inkey
if len(sKey)=0 then sleep 1,1:continue do
dim as long iKey = sKey[0]
if iKey=255 then iKey = -sKey[1]
select case iKey
case -fb.SC_PAGEUP
if ResuN > 0 then
ResuN -= 50 : if ResuN < 0 then ResuN = 0
exit do
end if
case -fb.SC_PAGEDOWN
if ResuN < (iFoundCount-1) then
ResuN += 50: if ResuN >= iFoundCount then ResuN = iFoundCount-1
exit do
end if
Case -fb.SC_UP
if ResuN > 0 then ResuN -= 1 : exit do
case -fb.SC_DOWN
if ResuN < (iFoundCount-1) then ResuN += 1 : exit do
case 27 'escape
exit for
End Select
Loop
end with
next
https://retrocoders.phatcode.net/index.php?topic=302.0
kind regards
Ron77