a Program to Search for cipher words and messages in Large text

[ron77]

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: You cannot view this attachment.

[johnno56]

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...

[mysoft]

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...

hehe it basically look for the words with same distance from the characters like

t..h..e or t.h.e or t...h...e

and so on