• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 201
  • Last Modified:

VB Script - help with a search algorithm

Hi,

If this seems difficult, I will quickly up the points!

I have written a VB script (full script below) to search a text file for words that meet a criteria.  The input is three letters, and the script searches the word list for words that contain thos three letters in the order presented.  After getting 5 hits is stops and presents the results.  It works, mostly.  For some reason it skips words that are in the list.  Any ideas?  My algorithm is to read a line (word) at a time from the word list and then check for the existence of the first letter, if it's there, then search from the next place in the workd for the next letter, if it's there, then search fr the third.  Therefore if the letters are "xay" then unless there is at lease one x in the word, then the word is ignored and a new line read.

The code retruns valid results, but it misses some valid hits.  Am I missing something?



Full code....
'*******************
Option Explicit
Dim sLetters, sLetter1, sLetter2, sLetter3, nI, nI1, nI2, nI3
Dim sResult1, sResult2, sTemp, oFSO, oDataFile, nContinue
Dim sAns(9)

sLetters = ""               'Initialise variables
sLetter1 = ""     '
sLetter2 = ""     '
sLetter3 = ""     '
sTemp = ""     '
nI1 = 1          '
nI2 = 1          '
nI3 = 1          '
sResult1 = "False"
sResult2 = "False"
nContinue = 1
For nI = 0 to 4
     sAns(nI) = " "
Next

While nContinue = 1 'Program loops unless you hit cancel when given the result

For nI = 0 to 4
     sAns(nI) = " "
Next

sLetters = InputBox ("Enter the numberplate letters to check","", "abd") 'Get the letters to search for

'Divide the input into three letters
sLetter1 = Left (sLetters, 1)
sLetter2 = Mid (sLetters, 2, 1)
sLetter3 = Right (sLetters, 1)

Set oFSO = CreateObject ("Scripting.FileSystemObject") 'Create a file system object
Set oDataFile = oFSO.OpenTextFile("c:\npg\npg.data.big",1)'Open the data file for reading
Do Until oDataFile.AtEndOfStream     'Read file until you get to the end of it
     sTemp = oDataFile.ReadLine          'Read a line
     sResult1 = "False"
     sResult2 = "False"
     nI = 0

     For nI1 = 1 to Len (sTemp)
          If sLetter1 = Mid (sTemp, nI1, 1) Then sResult1 = "True" : nI3 = nI1 + 1: Exit For
     Next          

     If sResult1 = "True" Then
          For nI1 = nI3 to Len (sTemp)
               If sLetter2 = Mid (sTemp, nI1, 1) Then sResult2 = "True" : nI3 = nI1 + 1 : Exit For
          Next
     End If

     If sResult2 = "True" Then
          For nI1 = nI3 to Len (sTemp)
               If sLetter3 = Mid (sTemp, nI1, 1) Then
               sAns(nI) = sTemp
               nI = nI + 1
               End If

               If nI = 5 Then Exit Do
          Next
     End If

     
Loop          

     nContinue = MsgBox ("Letters: " & sLetter1 & sLetter2 & sLetter3 & vbCR & _
          "Possible Words:" & vbCR & vbCR & _
          sAns(0) & vbCR & sAns(1) & vbCR & sAns(2) & vbCR & sAns(3) & vbCR & _
          sAns(4),1 ,"Found the following words")

     Set oDataFile = Nothing
     Set oFSO = Nothing
Wend


0
tvanlint
Asked:
tvanlint
  • 4
  • 2
1 Solution
 
inthedarkCommented:
Have you considered using Instr.  Would also suggest that you read the whole file unless it is over say 50MB, depending on the available memory in your system.

A$ = Ucase$(InputBox("Enter search text"))

sFile = Ucase$(ReadFile("C:\.....Yourfile.txt"))

If Instr(sFile, A$) > 0 Then
    MsgBox a$ =" Was found in the file"
End If


Hope this helps:~)


Create a Function to pickup the whole file like:

Function ReadFile(FileName)
Dim oFSO
Dim oDataFile
Set oFSO = CreateObject ("Scripting.FileSystemObject") 'Create a file system object
Set oDataFile = oFSO.OpenTextFile("c:\npg\npg.data.big",1)'Open the data file for reading
FileName = oDataFile.ReadAll
oDataFile.Close
Set  oDataFile = Nothing
Set oFSO = Nothing
End Fucntion
0
 
inthedarkCommented:
Sorry in a script you can't use the $ symbol, just leave them out.
0
 
rdrunnerCommented:
Have you tried to use a regexp object for your search?
It is great for this stuff...

here is some example code :


dim ofso,oDataFile,oreg,oInput,cText,sletters,i,pat,cMatches,match




Set oFSO = CreateObject ("Scripting.FileSystemObject") 'Create a file system object
Set oDataFile = oFSO.OpenTextFile("c:\work\test.txt",1)'Open the data file for reading
set oreg = createobject("VBScript.regexp")
Set oInput = ofso.OpenTextFile("c:\work\test.txt")
ctext = oinput.readall

sLetters = InputBox ("Enter the numberplate letters to check","", "abd") 'Get the letters to search for
for i = 1 to len(sletters)
   pat = pat & mid(sletters,i,1) & "[a-zA-Z]+"
next
msgbox ctext


oreg.global = true
oreg.multiline = true  
oreg.ignorecase = true

oreg.pattern = pat
set cmatches = oreg.execute(ctext)
PAT = "Matches found (" & cmatches.count & ") : " & vbcrlf
for each match in cmatches
  pat = pat & match & vbcrlf          
next


msgbox pat
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
rdrunnerCommented:
OOOPS there is also a bug in my code ;)


pat = pat & mid(sletters,i,1) & "[a-zA-Z]+"

Has to be changed to (+ = one ore more , * = 0 or more)

pat = pat & mid(sletters,i,1) & "[a-zA-Z]*"


P.s: My example code assumes that the words to be searched has to START with the 1st letter ....

so if you enter "dor" you will find

Dover
denvor
detour
dor
0
 
tvanlintAuthor Commented:
doesn't actually answer my question, but answers my problem, so I have given you extra points, but only a B rating.
Now I'd like to be able to get words that don't start with the first letter...
0
 
rdrunnerCommented:
try this

....

pat = "[a-zA-Z]+"
for i = 1 to len(sletters)
  pat = pat & mid(sletters,i,1) & "[a-zA-Z]+"
next
....

Now it will also match words that start with anything


P.s: Wasnt your (one of) question(s) "Any ideas?" ;)
0
 
rdrunnerCommented:
GRRRRR

Sorry you need a * and not a + after the 1st []

pat = "[a-zA-Z]*"
for i = 1 to len(sletters)
 pat = pat & mid(sletters,i,1) & "[a-zA-Z]+"
next
....
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 4
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now