Hello, here is a program mysoft has worked on today it's a program to find cipher words and messages in large text files - as you may record or remember, once in the 90s, there was a big interest in hidden ciphers and messages in holy scriptures like "the bible code" however it doesn't have to be a holy scripture as it can be any large long text file... so I'm giving the code to the program in freebasic (it runs in terminal or cmd) and two text files for you to test it - 1 king James verse of the Bible and 2 - the novel "moby dick" both in text files -
the code: "fb_main.bas" :
#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
here are the database files in 7z compressed file: textfiles-databases.7z
I am not sure that I completely understand the purpose of the program, but having said that, I ran it anyway.
I was amazed by the speed of 'the search'... I asked it to find "The" in The Bible and it found 937,540 instances in 0.540313 seconds!! Cool...
Quote from: johnno56 on Oct 11, 2022, 07:18 PMI am not sure that I completely understand the purpose of the program, but having said that, I ran it anyway.
I was amazed by the speed of 'the search'... I asked it to find "The" in The Bible and it found 937,540 instances in 0.540313 seconds!! Cool...
hehe it basically look for the words with same distance from the characters like
t..h..e or t.h.e or t...h...eand so on