Intensive search/replace problem

My application allows a user to insert as ascii.txt file into a RichTextBox

Once the text file is loaded the application then tests the inputted characters for certain characters and changes the color of these to red if found. This is an attempt to alert the user to the fact that these characters are illegal and should be deleted before taking any other action with the data.

The code I use is

rtfTmp.LoadFile strFile,1

For i = 1 to Len(rtfTmp)
  If Not IsValidString(Mid$(rtfTmp,i),"@#$%^") Then
     rtfTmp.SelStart = i - 1
     rtfTmp.SelLength = 1
     rtfTmp.SelColor = vbRed
  endif
Next i

Function IsValidString(strToTest As String, Invalid As String) as Boolean

Dim i as Long

For i = 1 To Len(Invalid)
   If Instr(1,strToTest, Mid$(Invalid, i, 1),0) Then
      IsValidString = False
      Exit Function
   End If
Next i

IsValidString = True

End Function
-------------------

This routine works OK as long as the imported file is not lengthy. For example a file containing 100 characters means that there is up to 500 iterations. Some of the files I've trialled contain a lot more characters than 100 and the problem I'm faced with is that it either takes forever to iterate through the sequence or the PC has a hernia and does the old 'Not responding" trick.

My question: Is there a faster, simpler method of achieving this without any GPFs or hang ups



mutrusAsked:
Who is Participating?
 
deightonConnect With a Mentor progCommented:
Dim sInvalid As String
Dim i As Long
Dim lPos As Long
Dim sTest As String
Dim bInvalid As Boolean

With rtfTemp

    sInvalid = "@#$%^"

    For i = 1 To Len(sInvalid)
        sTest = Mid(sInvalid, i, 1)
        lPos = InStr(.Text, sTest)
        While lPos > 0
           
            .SelStart = lPos - 1
            .SelLength = 1
            .SelColor = vbRed
           
            lPos = InStr(lPos + 1, .Text, sTest)
            bInvalid = True
                   
        Wend
       
    Next
       
   
End With
0
 
Guy Hengel [angelIII / a3]Billing EngineerCommented:
This should be faster:

dim strInvalid as string
dim lngPos as Long

strinvalid = "@#$%^"

rtfTmp.LoadFile strFile,1

For i = 1 to Len(strinvalid)
  lngPos = InStr(1,rtfTmp,mid(strInvalid,i,1))
  while lngPos>0
    with rtfTmp
      .SelStart = lngPos
      .SelLength = 1
      .SelColor = vbRed
    end with
    lngPos = InStr(lngPos+1,rtfTmp,mid(strInvalid,i,1))
  wend
Next i


Cheers
0
 
Guy Hengel [angelIII / a3]Billing EngineerCommented:
... i need to be faster!!! ...
:-)
0
Cloud Class® Course: Ruby Fundamentals

This course will introduce you to Ruby, as well as teach you about classes, methods, variables, data structures, loops, enumerable methods, and finishing touches.

 
inthedarkCommented:
Suggest the following:

Change:

For i = 1 to Len(rtfTmp)
 If Not IsValidString(Mid$(rtfTmp,i),"@#$%^") Then
    rtfTmp.SelStart = i - 1
    rtfTmp.SelLength = 1
    rtfTmp.SelColor = vbRed
 endif
Next i

To:

' only loop if invlaid chars are found
If Not IsValidString(rtfTmp,"@#$%^") Then

    For i = 1 to Len(rtfTmp)
        ' you had a bug in the mid which would pass the whole string time and time again.
        If Not IsValidString(Mid$(rtfTmp,i, 1),"@#$%^") Then
            rtfTmp.SelStart = i - 1
            rtfTmp.SelLength = 1
            rtfTmp.SelColor = vbRed

        endif
        do events
    Next i

End If

Hope this helps...inthedark

0
 
inthedarkCommented:
The "do events" will cause your application to continue to respond to Windows events.

0
 
rkot2000Commented:
you can use Like Operator to compare two strings.

This example uses the Like operator to compare a string to a pattern.

Dim MyCheck
MyCheck = "aBBBa" Like "a*a"   ' Returns True.
MyCheck = "F" Like "[A-Z]"   ' Returns True.
MyCheck = "F" Like "[!A-Z]"   ' Returns False.
MyCheck = "a2a" Like "a#a"   ' Returns True.
MyCheck = "aM5b" Like "a[L-P]#[!c-e]"   ' Returns True.
MyCheck = "BAT123khg" Like "B?T*"   ' Returns True.
MyCheck = "CAT123khg" Like "B?T*"   ' Returns False.

0
 
TrueDrakeCommented:
Hi,

To really go fast, put the data in memory:

Private Sub Form_Load()
Dim b As String * 32000
Open "C:\MyFile.txt" For Binary As #1
Get 1, 1, b
Close
b = Replace(b, "@", "")
b = Replace(b, "#", "")
b = Replace(b, "$", "")
b = Replace(b, "%", "")
rtb.Text = b
End Sub

You can take chunks of 32000 characters and treat them in one swoop. In this case the characters were replaces with empty characters, but you can replace them with other characters.

Enjoy
0
 
glass_cookieCommented:
Hi!

Why not use the Instr function.  That would automatically search the entire thingy without you having to read/scan the entire text yourself.

Of course, do something like

While Not Instr(1, Text1.Text, IllegalString1) = 0
'blah, blah, blah (ie. your code/action)
Wend

While Not Instr(1, Text1.Text, IllegalString2) = 0
'blah, blah, blah (ie. your code/action)
Wend

While Not Instr(1, Text1.Text, IllegalString3) = 0
'blah, blah, blah (ie. your code/action)
Wend

Something like that?

That's it!

glass cookie : )
0
 
mutrusAuthor Commented:
TrueDrake - boy thats fast. Unfortunetly I need to be able to indicate to the user what characters are bad. I achieve this by changing their color to red. I can't see how I can do this if I use the replace function because that wont work once the text is back in the RichTextBox and thats the only place I can figure out where to change the chr color.

deighton and angellll - both routines functioned exactly the same (pretty much same coding anyway). Benchmarks were as follows:

Total No of Chrs    No of invalid found   Time
20826               181                   3 secs
67664               4975                  1 min 5 sec

There were 21 invalid chrs to search for. This on a PIII with 128M RAM

inthedark - your benchmarks were 25sec and >5 min

so unless TrueDrake can come up with a better one Im leaning towards deighton - sorry angellll pipped at the post    
0
 
TrueDrakeCommented:
Hi,

All you have to do is to add the markup monikers that can be read with Notepad giving

Private Sub Form_Load()
   Dim b As String * 32000
   Open "D:\Hello2.rtf" For Binary As #1
   Get 1, 1, b
   Close
   b = Replace(b, "@", "\cf6 @ }{")
   b = Replace(b, "#", "\cf6 # }{")
   b = Replace(b, "$", "\cf6 $ }{")
   b = Replace(b, "%", "\cf6 % }{")
   rtb.Text = b
End Sub

It will change the color to red

Enjoy

0
 
mutrusAuthor Commented:
Sorry - all I managed to get was the string \cf6 @ }{ instead of a red @

What am I doing wrong?
0
 
mutrusAuthor Commented:
TrueDrake - any idea on why I cant get your solution to work?
0
 
TrueDrakeCommented:
Hi,

The trouble is that there are differences between the RTF control in VB and the RTF in Word for example. The one in VB hasn't been updated and should be replaced. I'm not about to put any more time on this, sorry!

Enjoy
0
 
mutrusAuthor Commented:
Looks like you got the points
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.