[RESOLVED] Detect words in a listbox (Resolved)

Hi,

I am trying to detect words that are in a listbox by typing a word in a textbox then click if the word is in the box.
VB Code:
Private Sub Command1_Click()
For b = 0 To frmSetup.Lstblock.ListCount
If Text1.Text = frmSetup.Lstblock.List(b) Then
MsgBox ("Word is not allowed")
Else
If Not Text1.Text = Text1.Text & frmSetup.Lstblock.List(b) Then
Exit Sub
End If
End If
Next b
frmSetup.Show
End Sub
This code works only when I type in the word that is the first word listed in the listbox. How can I make in so it checks for all the wors typed into the listbox?

you can either use InStr or the Like operator :

VB Code:

Option Explicit
 
Private Sub Command1_Click()
    Dim i As Integer
    For i = 0 To List1.ListCount - 1
        If UCase(List1.List(i)) Like UCase("*" & Text1.Text & "*") Then List1.ListIndex = i
    Next i
End Sub
 
Private Sub Form_Load()
    With List1
    .Clear
    .AddItem "CPU"
    .AddItem "RAM"
    .AddItem "ROM"
    .AddItem "Cache"
    .AddItem "Motherboard"
    .AddItem "Hard Disk"
    .AddItem "Floppy Disk"
    End With
End Sub

Re: Detect words in a listbox

Quote:

Originally posted by Nightwalker83
Hi,

I am trying to detect words that are in a listbox by typing a word in a textbox then click if the word is in the box.

VB Code:

Private Sub Command1_Click()
For b = 0 To frmSetup.Lstblock.ListCount
If Text1.Text = frmSetup.Lstblock.List(b) Then
MsgBox ("Word is not allowed")
Else
If Not Text1.Text = Text1.Text & frmSetup.Lstblock.List(b) Then
Exit Sub
End If
End If
Next b
frmSetup.Show
End Sub

This code works only when I type in the word that is the first word listed in the listbox. How can I make in so it checks for all the wors typed into the listbox?

u can use API..

VB Code:

'This project needs a ListBox, named List1 and a TextBox, named Text1
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
Const LB_FINDSTRING = &H18F
Private Sub Form_Load()
    'KPD-Team 1998
    'URL: [url]http://www.allapi.net/[/url]
    'E-Mail: [email][email protected][/email]
    'Add some items to the listbox
    With List1
        .AddItem "Computer"
        .AddItem "Screen"
        .AddItem "Modem"
        .AddItem "Printer"
        .AddItem "Scanner"
        .AddItem "Sound Blaster"
        .AddItem "Keyboard"
        .AddItem "CD-Rom"
        .AddItem "Mouse"
    End With
End Sub
Private Sub Text1_Change()
    'Retrieve the item's listindex
    List1.ListIndex = SendMessage(List1.hwnd, LB_FINDSTRING, -1, ByVal CStr(Text1.Text))
End Sub

Re: Detect words in a listbox

Quote:

Originally posted by Nightwalker83
Hi,

I am trying to detect words that are in a listbox by typing a word in a textbox then click if the word is in the box.

VB Code:

Private Sub Command1_Click()
For b = 0 To frmSetup.Lstblock.ListCount
If Text1.Text = frmSetup.Lstblock.List(b) Then
MsgBox ("Word is not allowed")
Else
If Not Text1.Text = Text1.Text & frmSetup.Lstblock.List(b) Then
Exit Sub
End If
End If
Next b
frmSetup.Show
End Sub

This code works only when I type in the word that is the first word listed in the listbox. How can I make in so it checks for all the wors typed into the listbox?

u can use API..

VB Code:

'This project needs a ListBox, named List1 and a TextBox, named Text1
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
Const LB_FINDSTRING = &H18F
Private Sub Form_Load()
    'KPD-Team 1998
    'URL: [url]http://www.allapi.net/[/url]
    'E-Mail: [email][email protected][/email]
    'Add some items to the listbox
    With List1
        .AddItem "Computer"
        .AddItem "Screen"
        .AddItem "Modem"
        .AddItem "Printer"
        .AddItem "Scanner"
        .AddItem "Sound Blaster"
        .AddItem "Keyboard"
        .AddItem "CD-Rom"
        .AddItem "Mouse"
    End With
End Sub
Private Sub Text1_Change()
    'Retrieve the item's listindex
    List1.ListIndex = SendMessage(List1.hwnd, LB_FINDSTRING, -1, ByVal CStr(Text1.Text))
End Sub

Cheers...

Quote:

Originally posted by peet
you can either use InStr or the Like operator :

VB Code:

Option Explicit

Private Sub Command1_Click()
Dim i As Integer
For i = 0 To List1.ListCount - 1
If UCase(List1.List(i)) Like UCase("*" & Text1.Text & "*") Then List1.ListIndex = i
Next i
End Sub

Private Sub Form_Load()
With List1
.Clear
.AddItem "CPU"
.AddItem "RAM"
.AddItem "ROM"
.AddItem "Cache"
.AddItem "Motherboard"
.AddItem "Hard Disk"
.AddItem "Floppy Disk"
End With
End Sub

Thanx it works but it shows the msgbox I am using even if you just enter the letters that are in the listbox. How can I stop this so you can enter those letters without the msgbox appearing? I also want to know how I can stop it from happening when the user empties the textbox?

Below is how I am using the code:

VB Code:

Private Sub txtSay_Change()
 Dim i As Integer
    For i = 0 To frmSetup.Lstblock.ListCount - 1
        If UCase(frmSetup.Lstblock.List(i)) Like UCase("*" & txtSay.Text & "*") Or LCase(frmSetup.Lstblock.List(i)) Like LCase("*" & txtSay.Text & "*") Then
        MsgBox ("This word is not allowed")
    End If
    Next i
End Sub

Quote:
Originally posted by Nightwalker83
Thanx it works but it shows the msgbox I am using even if you just enter the letters that are in the listbox. How can I stop this so you can enter those letters without the msgbox appearing? I also want to know how I can stop it from happening when the user empties the textbox?

Below is how I am using the code:

VB Code:

Private Sub txtSay_Change()
Dim i As Integer
For i = 0 To frmSetup.Lstblock.ListCount - 1
If UCase(frmSetup.Lstblock.List(i)) Like UCase("*" & txtSay.Text & "*") Or LCase(frmSetup.Lstblock.List(i)) Like LCase("*" & txtSay.Text & "*") Then
MsgBox ("This word is not allowed")
End If
Next i
End Sub
it all depends on how you want it to work ...

you want the search to be done when the user click a button, hit enter or something else ??

:confused:

in order to not do a search when the textbox is empty, you have to check the content of the textbox

if txtSay.text = "" then exit sub

Quote:

Originally posted by peet
it all depends on how you want it to work ...

you want the search to be done when the user click a button, hit enter or something else ??

:confused:

in order to not do a search when the textbox is empty, you have to check the content of the textbox

if txtSay.text = "" then exit sub

Peet,

I want the program to tell me if a word that has been banned, if then word has been entered into the textbox. I am trying to make it check when I type in the textbox.

I have changed this code of your by putting "a" instead of "i" but now it wont work.
VB Code:
Dim a As Integer
 For a = 0 To frmSetup.Lstblock.ListCount - 1
        If txtSay.Text = "" Then
        Exit Sub
        Else:
        If UCase(frmSetup.Lstblock.List(i)) Like UCase("*" & txtSay.Text & "*") Then
        MsgBox ("This word is not allowed")
    End If
    End If
    Next a
I actually put public "a" as integer in a module but is of in the form code but it still didn't work.

Hi again NW,
you have made a couple of mistakes... first you do not use option explicit. I think that would have found the first problem. You use i instead of a in this line

VB Code:

If UCase(frmSetup.Lstblock.List(i)) Like UCase("*" & txtSay.Text & "*") Then

it should have been

VB Code:

If UCase(frmSetup.Lstblock.List(a)) Like UCase("*" & txtSay.Text & "*") Then

I would do something like this:

VB Code:

Private Sub txtSay_Change()
    Dim a As Integer
    
    'any data at all ? if not exit
    If txtSay.Text = "" Then
        Lstblock.ListIndex = -1
        Exit Sub
    End If
    
    'check to see if there is data in the listbox that matches txtSay
    For a = 0 To frmSetup.Lstblock.ListCount - 1
        If UCase(frmSetup.Lstblock.List(a)) Like UCase("*" & txtSay.Text & "*") Then
            'found one that match current crit.
            'select it in the listbox, and then exit the loop
            Lstblock.ListIndex = a
            Exit For
        Else
            Lstblock.ListIndex = -1
        End If
    Next a
End Sub

a msgbox is no good in this case, because of the event you use.
hope this is what you are looking for :)

Quote:

Originally posted by peet
Hi again NW,
you have made a couple of mistakes... first you do not use option explicit. I think that would have found the first problem. You use i instead of a in this line

VB Code:

If UCase(frmSetup.Lstblock.List(i)) Like UCase("*" & txtSay.Text & "*") Then

it should have been

VB Code:

If UCase(frmSetup.Lstblock.List(a)) Like UCase("*" & txtSay.Text & "*") Then

I would do something like this:

VB Code:

Private Sub txtSay_Change()
Dim a As Integer

'any data at all ? if not exit
If txtSay.Text = "" Then
Lstblock.ListIndex = -1
Exit Sub
End If

'check to see if there is data in the listbox that matches txtSay
For a = 0 To frmSetup.Lstblock.ListCount - 1
If UCase(frmSetup.Lstblock.List(a)) Like UCase("*" & txtSay.Text & "*") Then
'found one that match current crit.
'select it in the listbox, and then exit the loop
Lstblock.ListIndex = a
Exit For
Else
Lstblock.ListIndex = -1
End If
Next a
End Sub

a msgbox is no good in this case, because of the event you use.
hope this is what you are looking for :)

Peet,

I was actually hoping that I could get it so I could enter the whole word before the msgbox appears. Is this possible?

I am only using the msgbox for testing my app.

how do you know when an entire word is added to the text box?

if you can answer that, Ï think you will find the solution :)

I would suggest moving the routine from the changeevent to keyupevent and check to see if the keypressed = enterkey. If so, do a search.

or move it to lost focus.

how do you want it to be?

Quote:

Originally posted by peet
how do you know when an entire word is added to the text box?

if you can answer that, Ï think you will find the solution :)

I would suggest moving the routine from the changeevent to keyupevent and check to see if the keypressed = enterkey. If so, do a search.

or move it to lost focus.

how do you want it to be?

I was think about checking a string is that possible? I am really wanting that code to detect the words that are been passed to it from the other chat app.

Evening NightWalker,

Can you 'trap' the unwanted word(s) before there loaded
into the TextBox?

Quote:

Originally posted by Bruce Fox
Evening NightWalker,

Can you 'trap' the unwanted word(s) before there loaded
into the TextBox?

What I am trying to do is something on this forum how if your post has a swear word(s) in it the swear word gets replaced with ****.

How about just doing a relpace on the textbox string with each of the listbox entries once the user is finished typing?

Quote:

Originally posted by Nightwalker83
I was think about checking a string is that possible? I am really wanting that code to detect the words that are been passed to it from the other chat app.

Maybe Split the incomming String into and Array at the " " (prior to being placed into a Display TextBox).

eg. arr = Split(sInputBuff, " ")

Then run the arr data against the ListBox, and at a 'match' replace
that array element with "****", then use:

eg. TextBoxDisplay = Join(arr, " ")

Bruce.

Quote:

Originally posted by Bruce Fox
Maybe Split the incomming String into and Array at the " " (prior to being placed into a Display TextBox).

eg. arr = Split(sInputBuff, " ")

Then run the arr data against the ListBox, and at a 'match' replace
that array element with "****", then use:

eg. TextBoxDisplay = Join(arr, " ")

Bruce.

How would I do this?

Quote:

Originally posted by Nightwalker83
How would I do this?

Well.... first; confirm what the incomming text is in. ie is the
chat text received in you app via a String?
Which is then placed into a TextBox?

:)

This is an example of what I mean. Place a ListBox on a Form.
Assume the String Buffer sInputBuff is the incomming Text:

VB Code:

Option Explicit
 
Private Sub Form_Load()
Dim sInputArr() As String
Dim sInputBuff As String: sInputBuff = "This is a test to see if it works"
Dim i As Integer
Dim x As Integer
 
   'Add some of the unwanted words to a ListBox
   With List1
      .AddItem "Badword1"
      .AddItem "Badword2"
      .AddItem "test"
      .AddItem "Badword4"
   End With
   
   'Split up the String into the Array
   If InStr(sInputBuff, " ") Then   'More than 1 word, so split
      sInputArr = Split(sInputBuff, " ")
   Else
      ReDim sInputArr(0)   'Only 1 word, so place it in the Array
      sInputArr(0) = sInputBuff
   End If
   
   For x = 0 To UBound(sInputArr)
      For i = 0 To List1.ListCount - 1
         If LCase(List1.List(i)) = LCase(sInputArr(x)) Then sInputArr(x) = "*****"
      Next
   Next
   
   MsgBox Join(sInputArr) 'Join this in a TextBox
 
End Sub

Quote:

Originally posted by Bruce Fox
This is an example of what I mean. Place a ListBox on a Form.
Assume the String Buffer sInputBuff is the incomming Text:

VB Code:

Option Explicit

Private Sub Form_Load()
Dim sInputArr() As String
Dim sInputBuff As String: sInputBuff = "This is a test to see if it works"
Dim i As Integer
Dim x As Integer

'Add some of the unwanted words to a ListBox
With List1
.AddItem "Badword1"
.AddItem "Badword2"
.AddItem "test"
.AddItem "Badword4"
End With

'Split up the String into the Array
If InStr(sInputBuff, " ") Then 'More than 1 word, so split
sInputArr = Split(sInputBuff, " ")
Else
ReDim sInputArr(0) 'Only 1 word, so place it in the Array
sInputArr(0) = sInputBuff
End If

For x = 0 To UBound(sInputArr)
For i = 0 To List1.ListCount - 1
If LCase(List1.List(i)) = LCase(sInputArr(x)) Then sInputArr(x) = "*****"
Next
Next

MsgBox Join(sInputArr) 'Join this in a TextBox

End Sub

I don't know what I am doing wrong this is the code I am using:

VB Code:

Private Sub Messlis_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim sInputArr() As String
Dim sInputBuff As String: sInputBuff = "This is a test to see if it works"
Messlis(intmax).GetData str
'Get the message string
If InStr(1, str, "|MESSAGE|") <> 0 Then
 mess = Mid$(str, 10, Len(str))
Dim objFrmMain As New frmMain
txtMess.SelStart = Len(mess)
txtMess.SelText = mess
End If
'check to see if there is data in the listbox that matches the mess string
   'Split up the String into the Array
   If InStr(sInputBuff, " ") Then   'More than 1 word, so split
      sInputArr = Split(sInputBuff, " ")
   Else
      ReDim sInputArr(0)   'Only 1 word, so place it in the Array
      sInputArr(0) = sInputBuff
   End If
   
   For X = 0 To UBound(sInputArr)
      For a = 0 To frmSetup.Lstblock.ListCount - 1
         If UCase(frmSetup.Lstblock.List(a)) = UCase(sInputArr(X)) Then sInputArr(X) = "*****"
      Next
   Next
   
   txtMess.Text = Join(sInputArr)  'Join this in a TextBox
End Sub

Whats the error? What line is highlighted?

What does sInputBuffer =?????
its just there by its self!

maybe sInputBuffer should 'mess' (or replace it)

Quote:

Originally posted by Bruce Fox
What does sInputBuffer =?????
its just there by its self!

maybe sInputBuffer should 'mess' (or replace it)
VB Code:
Dim sInputBuff As String: sInputBuff = mess 'mess being the string that was sent minus the instr part.
Is that right? When I use the code from my previous post:
VB Code:
Dim sInputBuff As String: sInputBuff = "This is a test to see if it works"
The only thing that appears it the other client window after the data is sent is what you put for sIntputBuff that is without the ****.

No, No, No :)

I set sInputBuff to that string to demonstrate how it may work.

You need to place the message text in there!

Does that make sense.

Bruce.

Quote:

Originally posted by Bruce Fox
No, No, No :)

I set sInputBuff to that string to demonstrate how it may work.

You need to place the message text in there!

Does that make sense.

Bruce.

Yes but when I put:
VB Code:
Dim sInputBuff As String: sInputBuff = mess 'mess being the string that was sent minus the instr part.
The other client main window is empty when I send a message.

OR

do you mean:
VB Code:
Dim sInputBuff As String: sInputBuff = txtmess.text

Aaron,

From you last post it would seem that you inadvertantly re-assigned the txtMess Box (if you did it the way u mentioned). Try this:

Please note where I cut your code so u can put it back in the right spoy :)

VB Code:

[b]sInputBuff = mess    'Load the string buffer with the INCOMMING message (wich may contain swear words!)[/b]
End If
'check to see if there is data in the listbox that matches the message string
   'Split up the String into the Array
   If InStr(sInputBuff, " ") Then   'More than 1 word, so split
      sInputArr = Split(sInputBuff, " ")
   Else
      ReDim sInputArr(0)   'Only 1 word, so place it in the Array
      sInputArr(0) = sInputBuff
   End If
   
   For X = 0 To UBound(sInputArr)
      For a = 0 To frmSetup.Lstblock.ListCount - 1
         If UCase(frmSetup.Lstblock.List(a)) = UCase(sInputArr(X)) Then sInputArr(X) = "*****"
      Next
   Next
   
   [b]txtMess.Text = Join(sInputArr)  'Write out to the TextBox the 'corrected' message text. ie hashed out the swear words.[/b]
   [b]txtMess.SelStart = Len(mess)[/b]
   [b]txtMess.SetFocus[/b] 'I also added this.
 
End Sub

Bruce.

Quote:

Originally posted by Bruce Fox

VB Code:

[b]sInputBuff = mess    'Load the string buffer with the INCOMMING message (wich may contain swear words!)<b>Aaron,
 
From you last post it would seem that you inadvertantly  re-assigned the txtMess Box (if you did it the way u mentioned). Try this:
 
Please note where I cut your code so u can put it back in the right spoy :)
 
</b>
End If
'check to see if there is data in the listbox that matches the message string
   'Split up the String into the Array
   If InStr(sInputBuff, " ") Then   'More than 1 word, so split
      sInputArr = Split(sInputBuff, " ")
   Else
      ReDim sInputArr(0)   'Only 1 word, so place it in the Array
      sInputArr(0) = sInputBuff
   End If
   
   For X = 0 To UBound(sInputArr)
      For a = 0 To frmSetup.Lstblock.ListCount - 1
         If UCase(frmSetup.Lstblock.List(a)) = UCase(sInputArr(X)) Then sInputArr(X) = "*****"
      Next
   Next
   
   [b]txtMess.Text = Join(sInputArr)  'Write out to the TextBox the 'corrected' message text. ie hashed out the swear words.[/b]
   [b]txtMess.SelStart = Len(mess)[/b]
   [b]txtMess.SetFocus[/b] 'I also added this.
 
End Sub

Bruce. [/B]

Thanx it worked but I am still having trouble if there is only one word being sent. I was wondering if a could get the number of * characters to match the word being blocked number of chacters?

Hmmm,

That was one of the tests I checked. Note how I commented the code
to place a series of words, or one word into the Array......

And I was going to assign the number of "*" to the lenght of each
word... but I ran outa time ... :D - You give it ago, youll figure it out.

Bruce.

Quote:

Originally posted by Bruce Fox
Hmmm,

That was one of the tests I checked. Note how I commented the code
to place a series of words, or one word into the Array......

And I was going to assign the number of "*" to the lenght of each
word... but I ran outa time ... :D - You give it ago, youll figure it out.

Bruce.

I tried the REPLACE function but I couldn't figure out how to make the number of "*" to equal the len of the word.

Quote:

Originally posted by Nightwalker83
I was wondering if a could get the number of * characters to match the word being blocked number of chacters?

Use the String Function; like:
VB Code:
If LCase(List1.List(i)) = LCase(sInputArr(x)) Then sInputArr(x) = [b]String(Len(List1.List(i)), "*")[/b]
Bruce.

Quote:
Originally posted by Bruce Fox
VB Code:
If LCase(List1.List(i)) = LCase(sInputArr(x)) Then sInputArr(x) = [b]String(Len(List1.List(i)), "*")<b>Use the <b>String</b> Function; like:
</b>
Bruce. [/B]
Thanx it works great:)

Bruce,

I am using this code to replace the words:
VB Code:
If InStr(sInputBuff, " ") Then   'More than 1 word, so split
      sInputArr = Split(sInputBuff, " ")
   Else
      ReDim sInputArr(0)   'Only 1 word, so place it in the Array
      sInputArr(0) = sInputBuff
   End If
   For x = 0 To UBound(sInputArr)
      For a = 0 To frmSetup.Lstblock.ListCount
         If UCase(frmSetup.Lstblock.List(a)) = UCase(sInputArr(x)) Then sInputArr(x) = String(Len(frmSetup.Lstblock.List(a)), "*")
 
      Next a
   Next x
   
   txtMess.Text = Join(sInputArr)  'Write out to the TextBox the 'corrected' message text. ie hashed out the swear words.
   txtMess.SelStart = Len(mess)
End Sub
I am have trouble because if I have one word or even two words in the listbox it works. If I have three or more words it the listbox it will not hash out all the words in the listbox. The program changes the words being hashed out each time which I don't want. I want all the words in the listbox to be hashed out.

Could you please help me solve this problem.

Thanx

Aaron

I have just about had it with this stupid thing. The code works fine in a test program I have made but it will not work in my chat app.

VB Code:

Private Sub Winsock1_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Winsock1(intmax).GetData str
If InStr(1, str, "|END|") <> 0 Then
End
End If
Dim sInputArr() As String
Dim sInputBuff As String
'Get the message string
If InStr(1, str, "|MESSAGE|") <> 0 Then
 mess = Mid$(str, 10, Len(str))
sInputBuff = mess    'Load the string buffer with the INCOMMING message (wich may contain swear words!)
End If
'Check to see if there is data in the listbox that matches the message string
   'Split up the String into the Array
   If InStr(sInputBuff, " ") Then   'More than 1 word, so split
      sInputArr = Split(sInputBuff, " ")
   Else
      ReDim sInputArr(0)   'Only 1 word, so place it in the Array
      sInputArr(0) = sInputBuff
   End If
 
   For x = 0 To UBound(sInputArr)
      For a = 0 To frmSetup.Lstblock.ListCount - 1
         If UCase(frmSetup.Lstblock.List(a)) = UCase(sInputArr(x)) Then sInputArr(x) = String(Len(frmSetup.Lstblock.List(a)), "*")
     Next a
      Next x
      txtmess.Text = txtmess.Text & Join(sInputArr, " ")   'Write out to the TextBox the 'corrected' message text. ie hashed out the swear words.
   txtmess.SelStart = Len(txtmess.Text)
 
End Sub

try this

What you first posted has an error I think
Try this...May be this is the thing you are looking for

For b = 0 To frmSetup.LstBlock.ListCount
If Text1.Text = frmSetup.LstBlock.List(b) Then
MsgBox ("Word is not allowed")
Else
If Text1.Text = "" or frmSetup.LstBlock.listcount=0 Then
Exit Sub
End If
End If
Next b
frmSetup.Show
End Sub

Aaron,

I unzipped both apps, and it ran fine!

I was able to type a string like : "this is a test" in the
Clien TYextBox, and the message appeared like "this is a ****"
in the Server end????

It worked great! whats it not doing your end?

(I had to add the WindSock Component)

Bruce. :)

Quote:

Originally posted by Bruce Fox
Aaron,

I unzipped both apps, and it ran fine!

I was able to type a string like : "this is a test" in the
Clien TYextBox, and the message appeared like "this is a ****"
in the Server end????

It worked great! whats it not doing your end?

(I had to add the WindSock Component)

Bruce. :)

I can get the client/sever demo to work except when I copy and paste the code in to my chat app it doesn't work properly.

Use Split Command to split the words then check them

Array = split(String," ")

Quote:

Originally posted by BodwadUK
Use Split Command to split the words then check them

Array = split(String," ")

Thanks BodwadUK, but thats what were doing :)

Oh HEHE Sorry Didnt Bother reading all:D :D :D :rolleyes:

Thanx Bruce:)

VB Code:

'Check to see if there is data in the listbox that matches the message string 
  'Split up the String into the Array 
 
  sInputBuff = Replace(sInputBuff, "Aaron Says:", "") 
 
  If InStr(sInputBuff, " ") > 0 Then   'More than 1 word, so split 
     sInputArr = Split(sInputBuff, " ") 
  Else 
     ReDim sInputArr(0)   'Only 1 word, so place it in the Array 
     sInputArr(0) = sInputBuff 
  End If 
 
  For x = 0 To UBound(sInputArr) 
     For a = 0 To frmSetup.Lstblock.ListCount - 1 
        'The following line removes vbCrLf from the array 
        sInputArr(x) = Replace(sInputArr(x), vbCrLf, "") 
        If UCase(frmSetup.Lstblock.List(a)) = UCase(sInputArr(x)) Then sInputArr(x) = String(Len(frmSetup.Lstblock.List(a)), "*") 
     Next a 
  Next x 
 
  txtMess.Text = txtMess.Text & Join(sInputArr, " ") & vbCrLf 'Write out to the TextBox the 'corrected' message text. ie hashed out the swear words. 
  txtMess.SelStart = Len(txtMess.Text) 
 
End Sub

WoooHooooo :D,

Baring the other minor 'bugs' (and future tweeking) its comming
along well :D

And.... If you use Option Explicit (at the top of each Forms code),
you'll will find all the un-assigend variables too (you may want to
keep that for another day tho :cool: ).

Bruce.

Re: Detect words in a listbox (UNResolved)

Quote:
Originally posted by Nightwalker83
Hi,

I am trying to detect words that are in a listbox by typing a word in a textbox then click if the word is in the box.

VB Code:

Private Sub Command1_Click()
For b = 0 To frmSetup.Lstblock.ListCount
If Text1.Text = frmSetup.Lstblock.List(b) Then
MsgBox ("Word is not allowed")
Else
If Not Text1.Text = Text1.Text & frmSetup.Lstblock.List(b) Then
Exit Sub
End If
End If
Next b
frmSetup.Show
End Sub

This code works only when I type in the word that is the first word listed in the listbox. How can I make in so it checks for all the wors typed into the listbox?
rewriting the entire code from scratch is going overboard. maybe
you all should have debugged his current code. the Else clause
checked to see if the word was illegal against the first entry, and if
it wasn't , it EXITED THE SUB. that is the problem! The following small change will fix that.
VB Code:
Private Sub Command1_Click()
For b = 0 To frmSetup.Lstblock.ListCount
   If Text1.Text = frmSetup.Lstblock.List(b) Then
      MsgBox ("Word is not allowed")
      exit sub
   Else
   
End If
Next b
frmSetup.Show
End Sub

Aaron,

The Replace statement (above the Array Load) in the missLiss DataArrival Sub, isn't required..... if you don't write out
the vbCrLf in the Command3_Click event.

So, the reason why it wasn't detecting a single word - "beep"
was the Command3 event was appending a vbCrLf to the typed word.

Hence the Array held - "beep vbCrLf" which would result in a non-match.

Therefore, remove all the vbCrLf appends to the typed word,
prior to sending them (see below) and remove the Replace
statement above the Array load routine (in the messLiss Data arrival):
VB Code:
Private Sub Command3_Click()
 'Send a message
If messcon.State = 7 Then
User = frmProfile.txtHandle.Text & " " & "Says:" & " "
messcon.SendData "|MESSAGE|" & User & txtSay.Text ' & vbCrLf< ** Remove this****
Else
MsgBox (LoadResString(68 + i))
End If
txtMess.Text = txtMess.Text & User & txtSay.Text ' & vbCrLf< ** Remove this****
End Sub
(Also, a Carriage return IS being added when the txtMess box is loaded for the USER to see)

Bruce.

This will replace whole words only, if you'd like

VB Code:

Option Explicit
 
Private Sub Command1_Click()
 
    Dim sMyString       As String
    Dim sListArray()    As String
    Dim i               As Long
 
    ' This just adds stuff to the listbox.
    With List1
        .AddItem "fry"
        .AddItem "go"
        .AddItem "gumballs"
        .AddItem "hey"
        .AddItem "mamma"
        .AddItem "stick"
    End With
    
    ' This creates an array of listbox items because the
    ' ReplaceWholeWords function needs an array of
    ' replacement words.
    ReDim sListArray(List1.ListCount - 1)
    For i = 0 To List1.ListCount - 1
        sListArray(i) = List1.List(i)
    Next
        
    ' This would be the text that you get in (well, maybe...)
    sMyString = "Hey, sticky mamma! They are gonna go gobble " & _
                "Mamma's gumballs, and fry Daddy's Fish-Stick"
        
    ' This shows the unaltered string
    Text1.Text = sMyString
    
    ' Here we replace the "banned" words.
    ReplaceWholeWords sMyString, sListArray
    
    ' This shows the "declassified" string.
    Text2.Text = sMyString
        
 
End Sub
 
Function ReplaceWholeWords(ByRef Text As String, _
                           ByRef WordList() As String, _
                  Optional ByVal ReplaceChar As String = "*")
    
    ' Replaces whole words with the ReplaceCharacter.
    ' A whole word is considered to be any instance of the
    ' word that does not have a letter before or after it.
    ' Not case sensitive.
    ' Example: "Hello World!" with "world" in the
    ' word list and using default replacement character "*"
    ' returns "Hello *****!"
 
    Dim sWord       As String   ' A word from the replace list.
    Dim lWordLen    As Long     ' Length of the replace word.
    Dim lWordStart  As Long     ' Start of the found word.
    Dim lCharBefore As Long     ' ASCII value of character before found word.
    Dim lCharAfter  As Long     ' ASCII value of character after found word.
    Dim i           As Long     ' Loop counter.
 
    ' Pad the string with spaces so that there is always
    ' a before and after character.
    Text = " " & Text & " "
 
    ' Loop through the list of replacement words.
    For i = 0 To UBound(WordList)
        
        ' Get replacement word, length of the word, and
        ' the start of the first instance of the word in
        ' the text string.
        sWord = WordList(i)
        lWordLen = Len(sWord)
        lWordStart = InStr(1, Text, sWord, vbTextCompare)
        
        ' Check every instance of the found word.
        Do Until lWordStart = 0
            
            ' Get ASCII value of characters before and
            ' after found word.
            lCharBefore = Asc(UCase$(Mid$(Text, lWordStart - 1, 1)))
            lCharAfter = Asc(UCase$(Mid$(Text, lWordStart + lWordLen, 1)))
            
            ' Check if characters before and after found word
            ' are letters. If there are no letter on either side
            ' the it is a "whole" word.
            If (lCharBefore < 65 Or lCharBefore > 90) And _
               (lCharAfter < 65 Or lCharBefore > 90) Then
                ' Repalce found whole word with replacement characters.
                Mid$(Text, lWordStart, lWordLen) = String$(lWordLen, ReplaceChar)
            End If
            
            ' Find start of next instance of word.
            lWordStart = InStr(lWordStart + 1, Text, sWord, vbTextCompare)
        
        Loop
    
    Next
 
    ' Get rid of the padding that was added.
    Text = Mid$(Text, 2, Len(Text) - 2)
 
End Function

Bruce,

I solved the problem using:

VB Code:

Private Sub Command3_Click()
 'Send a message
If messcon.State = sckConnected Then
User = frmProfile.txtHandle.Text & " " & "Says:" & " "
messcon.SendData "|MESSAGE|" & User & txtSay.Text
txtMess.Text = txtMess.Text & User & txtSay.Text & vbCrLf ' This vbcrlf is needed so the client sending the data also goes to the next line. 
Else
MsgBox (LoadResString(68 + i))
End If
End Sub

Quote:

Originally posted by WorkHorse
This will replace whole words only, if you'd like

VB Code:

Option Explicit

Private Sub Command1_Click()

Dim sMyString As String
Dim sListArray() As String
Dim i As Long

' This just adds stuff to the listbox.
With List1
.AddItem "fry"
.AddItem "go"
.AddItem "gumballs"
.AddItem "hey"
.AddItem "mamma"
.AddItem "stick"
End With

' This creates an array of listbox items because the
' ReplaceWholeWords function needs an array of
' replacement words.
ReDim sListArray(List1.ListCount - 1)
For i = 0 To List1.ListCount - 1
sListArray(i) = List1.List(i)
Next

' This would be the text that you get in (well, maybe...)
sMyString = "Hey, sticky mamma! They are gonna go gobble " & _
"Mamma's gumballs, and fry Daddy's Fish-Stick"

' This shows the unaltered string
Text1.Text = sMyString

' Here we replace the "banned" words.
ReplaceWholeWords sMyString, sListArray

' This shows the "declassified" string.
Text2.Text = sMyString

End Sub

Function ReplaceWholeWords(ByRef Text As String, _
ByRef WordList() As String, _
Optional ByVal ReplaceChar As String = "*")

' Replaces whole words with the ReplaceCharacter.
' A whole word is considered to be any instance of the
' word that does not have a letter before or after it.
' Not case sensitive.
' Example: "Hello World!" with "world" in the
' word list and using default replacement character "*"
' returns "Hello *****!"

Dim sWord As String ' A word from the replace list.
Dim lWordLen As Long ' Length of the replace word.
Dim lWordStart As Long ' Start of the found word.
Dim lCharBefore As Long ' ASCII value of character before found word.
Dim lCharAfter As Long ' ASCII value of character after found word.
Dim i As Long ' Loop counter.

' Pad the string with spaces so that there is always
' a before and after character.
Text = " " & Text & " "

' Loop through the list of replacement words.
For i = 0 To UBound(WordList)

' Get replacement word, length of the word, and
' the start of the first instance of the word in
' the text string.
sWord = WordList(i)
lWordLen = Len(sWord)
lWordStart = InStr(1, Text, sWord, vbTextCompare)

' Check every instance of the found word.
Do Until lWordStart = 0

' Get ASCII value of characters before and
' after found word.
lCharBefore = Asc(UCase$(Mid$(Text, lWordStart - 1, 1)))
lCharAfter = Asc(UCase$(Mid$(Text, lWordStart + lWordLen, 1)))

' Check if characters before and after found word
' are letters. If there are no letter on either side
' the it is a "whole" word.
If (lCharBefore < 65 Or lCharBefore > 90) And _
(lCharAfter < 65 Or lCharBefore > 90) Then
' Repalce found whole word with replacement characters.
Mid$(Text, lWordStart, lWordLen) = String$(lWordLen, "*")
End If

' Find start of next instance of word.
lWordStart = InStr(lWordStart + 1, Text, sWord, vbTextCompare)

Loop

Next

' Get rid of the padding that was added.
Text = Mid$(Text, 2, Len(Text) - 2)

End Function

I have already done what you're suggesting:

And...

Look at the User = frmProfile.txtHandle.Text & " " & "Says:" & " "
You are ADDING " " (space) prior to sending the string.....

That is why we needed to Replace the " " with "" in the
missLissDataArrival too.

I would personaly not send the space, so I didn't need to
remove it on the other end - similar to not sending the vbCrlf :)

Bruce.

Quote:

Originally posted by WorkHorse

Thanks for the input WokHorse,

The problems were that a vbCrLf and a space were being sent
over in the message string. So that made it difficult to get a match
on the other end. :)

I guess it was a simple debug :eek: at the end of te day.

Bruce.