Resolved : VB Winsock Help, IM Program Help Will Pay

Hello, I am looking for an experienced user in VB 6 that can help me fix some errors in my instant messenging program. I get it to connect, register whos online, etc. But when you send an im to a user over the internet, the receiver gets disconected. Please send me an email if you are willing to help, I can pay per job done. Please PM me if you are interested.
Thanks,
anony

Try: http://www.rentacoder.com

also, don't post your email address on an open forum. bots will pick it up and you will get spammed. Edit your post and remove it.

Thanks,
Here is the exact error i get when a user IM's another:
Run-Time Error 13
Type mismatch
Here is the code:

VB Code:

Private Sub cmdSend_Click()
typemsg.Text = Replace(typemsg.Text, vbCrLf, "")
If typemsg.Text <> "" And Len(typemsg) > 0 Then
    showmsg.SelStart = Len(showmsg.Text)
    showmsg.SelBold = True
    showmsg.SelColor = vbRed
    showmsg.SelText = Client.Caption & ": "
    
    
    showmsg.SelStart = Len(showmsg.Text)
    showmsg.SelBold = False
    showmsg.SelColor = vbBlack
    showmsg.SelText = typemsg.Text & vbCrLf
  
    PlaySound ("sounds/imsend.wav")
    Client.Winsock1.SendData ".msg " & Client.Caption & " " & Word(Me.Caption, 1) & " ..//.. " & typemsg.Text
    Client.WaitFor (".msgOK")
    typemsg.Text = ""
End If
typemsg.Text = Replace(typemsg.Text, vbCrLf, "")
typemsg.SetFocus
End Sub

on what line do you get the error?

also, both parts of this If construct do the same thing:

VB Code:

If typemsg.Text <> "" And Len(typemsg) > 0 Then
 
' make it:
 
If Len(typemsg.Text) Then

Is any part of that hi-lighted when the error occurs?

If LenLen doesnt work im trying If len now.

Quote:

---

Originally Posted by anonyentry

If LenLen doesnt work im trying If len now.

---

:lol: typo by me.

should just be Len

it now is:

VB Code:

Private Sub cmdSend_Click()
typemsg.Text = Replace(typemsg.Text, vbCrLf, "")
If Len(typemsg.Text) Then
    showmsg.SelStart = Len(showmsg.Text)
    showmsg.SelBold = True
    showmsg.SelColor = vbRed
    showmsg.SelText = Client.Caption & ": "
    
    
    showmsg.SelStart = Len(showmsg.Text)
    showmsg.SelBold = False
    showmsg.SelColor = vbBlack
    showmsg.SelText = typemsg.Text & vbCrLf
  
    PlaySound ("sounds/imsend.wav")
    Client.Winsock1.SendData ".msg " & Client.Caption & " " & Word(Me.Caption, 1) & " ..//.. " & typemsg.Text
    Client.WaitFor (".msgOK")
    typemsg.Text = ""
End If
typemsg.Text = Replace(typemsg.Text, vbCrLf, "")
typemsg.SetFocus
End Sub

And i still get the same runtime error.

i wasn't suggesting a resolution of the error - i was just telling you you had some unneeded code.

what line is the error occuring on? When the error happens click 'debug' and tell us which line is highlighted.

In data arrival:

VB Code:

ElseIf Word(strIncoming, 1) = ".statusUpdate" And Word(strIncoming, 2) <> "0" Then
        Call status_update(Word(strIncoming, 3), Word(strIncoming, 4))

can you post the code for the Word function

I think were going to need more code...

VB Code:

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim i As Long
    Winsock1.GetData strIncoming
   
    If strIncoming = ".badlogin" Then
        MsgBox "The screen name or password you entered is not valid. ", vbOKOnly + vbCritical
        If Winsock1.State <> sckClosed Then
            Winsock1.Close
        End If
    ElseIf strIncoming = ".goodlogin" Then
        Call good_login
        
    ElseIf Word(strIncoming, 1) = ".showonline" And Word(strIncoming, 2) <> "0" Then
        Call Show_Online_buddies(strIncoming)
        
    ElseIf Word(strIncoming, 1) = ".statusUpdate" And Word(strIncoming, 2) <> "0" Then
        Call status_update(Word(strIncoming, 3), Word(strIncoming, 4))
        
    ElseIf Word(strIncoming, 1) = ".msg" Then
        Call get_message(Word(strIncoming, 2), strIncoming)
        
    ElseIf Word(strIncoming, 1) = ".define" Then
        Call get_definition(Word(strIncoming, 2), Word(strIncoming, 3), strIncoming)
        
    ElseIf Word(strIncoming, 1) = ".spell" Then
            Call get_spelling(Word(strIncoming, 2), strIncoming)
 
    End If
End Sub

as I've already asked

Quote:

---

Originally Posted by bushmobile

can you post the code for the Word function

---

and post the value of strIncoming

Owrd function:
[Highlight=VB]Option Explicit

Const SP As String = " "
Dim pointer As Long 'start parameter of Instr()
Dim pos As Long 'position of target in InStr()
Dim x As Long 'word count
Dim lEnd As Long 'position of trailing word delimiter

sSource = CSpace(sSource)

'find the nth word
x = 1
pointer = 1

Do
Do While Mid$(sSource, pointer, 1) = SP 'skip consecutive spaces
pointer = pointer + 1
Loop
If x = n Then 'the target word-number
lEnd = InStr(pointer, sSource, SP) 'pos of space at end of word
If lEnd = 0 Then lEnd = Len(sSource) + 1 ' or if its the last word
Word = Mid$(sSource, pointer, lEnd - pointer)
Exit Do 'word found, done
End If

pos = InStr(pointer, sSource, SP) 'find next space
If pos = 0 Then Exit Do 'word not found
x = x + 1 'increment word counter

pointer = pos + 1 'start of next word
Loop

End Function

Public Function Words(ByVal sSource As String) As Long
'=================================================
' Words returns the number of words in a string
' Usage:
' Words("red blue green") 3
'=================================================
Const SP As String = " "
Dim lSource As Long 'length of sSource
Dim pointer As Long 'start parameter of Instr()
Dim pos As Long 'position of target in InStr()
Dim x As Long 'word count

sSource = CSpace(sSource)
lSource = Len(sSource)
If lSource = 0 Then Exit Function

'count words
x = 1
pointer = 1

Do
Do While Mid$(sSource, pointer, 1) = SP 'skip consecutive spaces
pointer = pointer + 1
Loop
pos = InStr(pointer, sSource, SP) 'find next space
If pos = 0 Then Exit Do 'no more words
x = x + 1 'increment word counter

pointer = pos + 1 'start of next word
Loop
If Mid$(sSource, lSource, 1) = SP Then x = x - 1 'adjust if trailing space
Words = x
End Function

Public Function WordCount(ByVal sSource As String, _
sTarget As String) As Long
'=====================================================
' WordCount returns the number of times that
' word, sTarget, is found in sSource.
' Usage:
' WordCount("a rose is a rose", "rose") 2
'=================================================
Const SP As String = " "
Dim pointer As Long 'start parameter of Instr()
Dim lSource As Long 'length of sSource
Dim lTarget As Long 'length of sTarget
Dim pos As Long 'position of target in InStr()
Dim x As Long 'word count

lTarget = Len(sTarget)
lSource = Len(sSource)
sSource = CSpace(sSource)


'find target word
pointer = 1
Do While Mid$(sSource, pointer, 1) = SP 'skip consecutive spaces
pointer = pointer + 1
Loop
If pointer > lSource Then Exit Function 'sSource contains no words

Do 'find position of sTarget
pos = InStr(pointer, sSource, sTarget)
If pos = 0 Then Exit Do 'string not found
If Mid$(sSource, pos + lTarget, 1) = SP _
Or pos + lTarget > lSource Then 'must be a word
If pos = 1 Then
x = x + 1 'word found
ElseIf Mid$(sSource, pos - 1, 1) = SP Then
x = x + 1 'word found
End If
End If
pointer = pos + lTarget
Loop
WordCount = x

End Function

Public Function WordPos(ByVal sSource As String, _
sTarget As String) As Long
'=====================================================
' WordPos returns the word number of the
' word, sTarget, in sSource.
' Usage:
' WordPos("red blue green", "blue") 2
'=================================================
Const SP As String = " "
Dim pointer As Long 'start parameter of Instr()
Dim lSource As Long 'length of sSource
Dim lTarget As Long 'length of sTarget
Dim lPosTarget As Long 'position of target-word
Dim pos As Long 'position of target in InStr()
Dim x As Long 'word count

lTarget = Len(sTarget)
lSource = Len(sSource)
sSource = CSpace(sSource)


'find target word
pointer = 1
Do While Mid$(sSource, pointer, 1) = SP 'skip consecutive spaces
pointer = pointer + 1
Loop
If pointer > lSource Then Exit Function 'sSource contains no words

Do 'find position of sTarget
pos = InStr(pointer, sSource, sTarget)
If pos = 0 Then Exit Function 'string not found
If Mid$(sSource, pos + lTarget, 1) = SP _
Or pos + lTarget > lSource Then 'must be a word
If pos = 1 Then Exit Do 'word found
If Mid$(sSource, pos - 1, 1) = SP Then Exit Do
End If
pointer = pos + lTarget
Loop


'count words until position of sTarget
lPosTarget = pos 'save position of sTarget
pointer = 1
x = 1
Do
Do While Mid$(sSource, pointer, 1) = SP 'skip consecutive spaces
pointer = pointer + 1
Loop
If pointer >= lPosTarget Then Exit Do 'all words have been counted
pos = InStr(pointer, sSource, SP) 'find next space
If pos = 0 Then Exit Do 'no more words
x = x + 1 'increment word count
pointer = pos + 1 'start of next word
Loop
WordPos = x
End Function

Public Function WordIndex(ByVal sSource As String, _
vTarget As Variant) As Long
'===========================================================
' WordIndex returns the byte position of vTarget in sSource.
' vTarget can be a word-number or a string.
' Usage:
' WordIndex("two plus 2 is four", 2) 5
' WordIndex("two plus 2 is four", "2") 10
' WordIndex("two plus 2 is four", "two") 1
'===========================================================
Const SP As String = " "
Dim sTarget As String 'vTarget converted to String
Dim lTarget As Long 'vTarget converted to Long, or length of sTarget
Dim lSource As Long 'length of sSource
Dim pointer As Long 'start parameter of InStr()
Dim pos As Long 'position of target in InStr()
Dim x As Long 'word counter

lSource = Len(sSource)
sSource = CSpace(sSource)

If VarType(vTarget) = vbString Then GoTo strIndex
If Not IsNumeric(vTarget) Then Exit Function
lTarget = CLng(vTarget) 'convert to Long

'find byte position of lTarget (word number)
x = 1
pointer = 1


Do
Do While Mid$(sSource, pointer, 1) = SP 'skip consecutive spaces
pointer = pointer + 1
Loop

If x = lTarget Then 'word-number of Target
If pointer > lSource Then Exit Do 'beyond end of sSource
WordIndex = pointer 'position of word
Exit Do 'word found, done
End If

pos = InStr(pointer, sSource, SP) 'find next space
If pos = 0 Then Exit Do 'word not found
x = x + 1 'increment word counter
pointer = pos + 1
Loop

Exit Function
strIndex:
sTarget = CStr(vTarget)
lTarget = Len(sTarget)
If lTarget = 0 Then Exit Function 'nothing to count

'find byte position of sTarget (string)
pointer = 1
Do
pos = InStr(pointer, sSource, sTarget)
If pos = 0 Then Exit Do
If Mid$(sSource, pos + lTarget, 1) = SP _
Or pos + lTarget > lSource Then
If pos = 1 Then Exit Do
If Mid$(sSource, pos - 1, 1) = SP Then Exit Do
End If
pointer = pos + lTarget
Loop

WordIndex = pos

End Function

Public Function WordLength(ByVal sSource As String, _
n As Long) As Long
'=========================================================
' Wordlength returns the length of the nth word in sSource
' Usage:
' WordLength("red blue green", 2) 4
'=========================================================

heres the rest:

VB Code:

Const SP    As String = " "
Dim lSource As Long   'length of sSource
Dim pointer As Long   'start parameter Instr()
Dim pos     As Long   'position of target with InStr()
Dim x       As Long   'word count
Dim lEnd    As Long   'position of trailing word delimiter
 
sSource = CSpace(sSource)
lSource = Len(sSource)
 
'find the nth word
x = 1
pointer = 1
 
Do
   Do While Mid$(sSource, pointer, 1) = SP     'skip consecutive spaces
      pointer = pointer + 1
   Loop
   If x = n Then                               'the target word-number
      lEnd = InStr(pointer, sSource, SP)       'pos of space at end of word
      If lEnd = 0 Then lEnd = lSource + 1      '   or if its the last word
      WordLength = lEnd - pointer
      Exit Do                                  'word found, done
   End If
  
   pos = InStr(pointer, sSource, SP)           'find next space
   If pos = 0 Then Exit Do                     'word not found
   x = x + 1                                   'increment word counter
  
   pointer = pos + 1                           'start of next word
Loop
 
End Function
 
Public Function DelWord(ByVal sSource As String, _
                                    n As Long, _
                      Optional vWords As Variant) As String
'===========================================================
' DelWord deletes from sSource, starting with the
' nth word for a length of vWords words.
' If vWords is omitted, all words from the nth word on are
' deleted.
' Usage:
'   DelWord("now is not the time", 3)     "now is"
'   DelWord("now is not the time", 3, 1)  "now is the time"
'===========================================================
Const SP    As String = " "
Dim lWords  As Long    'length of sTarget
Dim lSource As Long    'length of sSource
Dim pointer As Long    'start parameter of InStr()
Dim pos     As Long    'position of target in InStr()
Dim x       As Long    'word counter
Dim lStart  As Long    'position of word n
Dim lEnd    As Long    'position of space after last word
 
lSource = Len(sSource)
DelWord = sSource
sSource = CSpace(sSource)
If IsMissing(vWords) Then
   lWords = -1
ElseIf IsNumeric(vWords) Then
   lWords = CLng(vWords)
Else
   Exit Function
End If
 
If n = 0 Or lWords = 0 Then Exit Function      'nothing to delete
 
'find position of n
x = 1
pointer = 1
 
Do
   Do While Mid$(sSource, pointer, 1) = SP     'skip consecutive spaces
      pointer = pointer + 1
   Loop
   If x = n Then                               'the target word-number
      lStart = pointer
      If lWords < 0 Then Exit Do
   End If
   
   If lWords > 0 Then                          'lWords was provided
      If x = n + lWords - 1 Then               'find pos of last word
         lEnd = InStr(pointer, sSource, SP)    'pos of space at end of word
         Exit Do                               'word found, done
      End If
   End If
   
   pos = InStr(pointer, sSource, SP)           'find next space
   If pos = 0 Then Exit Do                     'word not found
   x = x + 1                                   'increment word counter
  
   pointer = pos + 1                           'start of next word
Loop
If lStart = 0 Then Exit Function
If lEnd = 0 Then
   DelWord = Trim$(Left$(sSource, lStart - 1))
Else
   DelWord = Trim$(Left$(sSource, lStart - 1) & Mid$(sSource, lEnd + 1))
End If
End Function
 
Public Function MidWord(ByVal sSource As String, _
                                    n As Long, _
                      Optional vWords As Variant) As String
'===========================================================
' MidWord returns a substring sSource, starting with the
' nth word for a length of vWords words.
' If vWords is omitted, all words from the nth word on are
' returned.
' Usage:
'   MidWord("now is not the time", 3)     "not the time"
'   MidWord("now is not the time", 3, 2)  "not the"
'===========================================================
Const SP    As String = " "
Dim lWords  As Long    'vWords converted to long
Dim lSource As Long    'length of sSource
Dim pointer As Long    'start parameter of InStr()
Dim pos     As Long    'position of target in InStr()
Dim x       As Long    'word counter
Dim lStart  As Long    'position of word n
Dim lEnd    As Long    'position of space after last word
 
lSource = Len(sSource)
sSource = CSpace(sSource)
If IsMissing(vWords) Then
   lWords = -1
ElseIf IsNumeric(vWords) Then
   lWords = CLng(vWords)
Else
   Exit Function
End If
 
If n = 0 Or lWords = 0 Then Exit Function              'nothing to delete
 
'find position of n
x = 1
pointer = 1
 
Do
   Do While Mid$(sSource, pointer, 1) = SP     'skip consecutive spaces
      pointer = pointer + 1
   Loop
   If x = n Then                               'the target word-number
      lStart = pointer
      If lWords < 0 Then Exit Do               'include rest of sSource
   End If
   
   If lWords > 0 Then                          'lWords was provided
      If x = n + lWords - 1 Then               'find pos of last word
         lEnd = InStr(pointer, sSource, SP)    'pos of space at end of word
         Exit Do                               'word found, done
      End If
   End If
   
   pos = InStr(pointer, sSource, SP)           'find next space
   If pos = 0 Then Exit Do                     'word not found
   x = x + 1                                   'increment word counter
  
   pointer = pos + 1                           'start of next word
Loop
If lStart = 0 Then Exit Function
If lEnd = 0 Then
   MidWord = Trim$(Mid$(sSource, lStart))
Else
   MidWord = Trim$(Mid$(sSource, lStart, lEnd - lStart))
End If
End Function
 
Public Function CSpace(sSource As String) As String
'==================================================
'CSpace converts blank characters
'(ascii: 9,10,13,160) to space (32)
'
'  cSpace("a" & vbTab   & "b")  "a b"
'  cSpace("a" & vbCrlf  & "b")  "a  b"
'==================================================
Dim pointer   As Long
Dim pos       As Long
Dim x         As Long
Dim iSpace(3) As Integer
 
' define blank characters
iSpace(0) = 9    'Horizontal Tab
iSpace(1) = 10   'Line Feed
iSpace(2) = 13   'Carriage Return
iSpace(3) = 160  'Hard Space
 
CSpace = sSource
For x = 0 To UBound(iSpace) ' replace all blank characters with space
   pointer = 1
   Do
      pos = InStr(pointer, CSpace, Chr$(iSpace(x)))
      If pos = 0 Then Exit Do
      Mid$(CSpace, pos, 1) = " "
      pointer = pos + 1
   Loop
Next x
 
End Function
 
Public Function SplitString(iSource As String, iTarget As String, Optional BeforeTarget As Boolean = False) As String
'==================================================
'Returns the characters before or after the split
'identifier. By default will return text after id,
'set BeforeTarget as true to return the text before
'it.
'==================================================
If BeforeTarget = True Then
   SplitString = DelWord(iSource, WordPos(iSource, iTarget))
Else
   SplitString = DelWord(iSource, 1, WordPos(iSource, iTarget))
End If
 
End Function

[/Highlight]

What's the declaration for the Word function, you've missed it off.

on the error, does it highlight

VB Code:

ElseIf Word(strIncoming, 1) = ".statusUpdate" And Word(strIncoming, 2) <> "0" Then

or

VB Code:

Call status_update(Word(strIncoming, 3), Word(strIncoming, 4))

Call status_update(Word(strIncoming, 3), Word(strIncoming, 4))

Whats the code and declaration of that function? And what's the value of strIncoming? Also, just in case... what's the declaration of strIncoming?

Best to use a procedure level variable to hold the stream returned by GetData. strIncoming can be overwriiten by other data arrivals while midway through a data arrival.

The declaration is above in the large code post.

VB Code:

Dim dWord As String
 
Private Sub cmbFonts_Click()
    typemsg.SelFontName = cmbFonts.Text
    typemsg.SetFocus
End Sub
 
Private Sub cmdSend_Click()
typemsg.Text = Replace(typemsg.Text, vbCrLf, "")
If Len(typemsg.Text) Then
    showmsg.SelStart = Len(showmsg.Text)
    showmsg.SelBold = True
    showmsg.SelColor = vbRed
    showmsg.SelText = Client.Caption & ": "
    
    
    showmsg.SelStart = Len(showmsg.Text)
    showmsg.SelBold = False
    showmsg.SelColor = vbBlack
    showmsg.SelText = typemsg.Text & vbCrLf
  
    PlaySound ("sounds/imsend.wav")
    Client.Winsock1.SendData ".msg " & Client.Caption & " " & Word(Me.Caption, 1) & " ..//.. " & typemsg.Text
    Client.WaitFor (".msgOK")
    typemsg.Text = ""
End If
typemsg.Text = Replace(typemsg.Text, vbCrLf, "")
typemsg.SetFocus
End Sub
 
Private Sub Form_Load()
Dim i As Integer
    mnuFont.Visible = False
    mnuSpellDefine2.Visible = False
    'bAllowScroll = True
    'Call SetHook(showmsg.hwnd, True)
    For i = 1 To Screen.FontCount
        cmbFonts.AddItem Screen.Fonts(i)
    Next i
    cmbFonts.RemoveItem (0)
    cmbFonts.SelText = "Verdana"
End Sub
 
'Private Sub Form_Unload(Cancel As Integer)
    'Call SetHook(showmsg.hwnd, False)
'End Sub
 
Private Sub mnuFontBold_Click()
 
If typemsg.SelBold = True Then
   typemsg.SelBold = False
   tbFonts.Buttons(1).Value = tbrUnpressed
Else
   typemsg.SelBold = True
   tbFonts.Buttons(1).Value = tbrPressed
End If
 
End Sub
 
Private Sub mnuFontItalic_Click()
 
If typemsg.SelItalic = True Then
   typemsg.SelItalic = False
   tbFonts.Buttons(2).Value = tbrUnpressed
Else
   typemsg.SelItalic = True
   tbFonts.Buttons(2).Value = tbrPressed
End If
 
End Sub
 
Private Sub mnuFontUnderline_Click()
 
If typemsg.SelUnderline = True Then
   typemsg.SelUnderline = False
   tbFonts.Buttons(3).Value = tbrUnpressed
Else
   typemsg.SelUnderline = True
   tbFonts.Buttons(3).Value = tbrPressed
End If
 
End Sub
 
Private Sub mnuFontPT_Click(Index As Integer)
   typemsg.SelFontSize = Word(mnuFontPT(Index).Caption, 1)
End Sub
 
Private Sub showmsg_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbRightButton Then
       If showmsg.SelText <> "" And is_chars(Replace(Trim(showmsg.SelText), vbCrLf, "")) = True Then
            dWord = Replace(Trim(showmsg.SelText), vbCrLf, "")
        Else
            dWord = "- Please highlight a word."
        End If
        mnuSpell2.Caption = "Spellcheck " & dWord
        mnuDefine2.Caption = "Define " & dWord
        PopupMenu mnuSpellDefine2
End If
End Sub
 
Private Function is_chars(x As String) As Boolean
Dim i As Integer
Dim flag As Integer
For i = 1 To Len(x)
    If (Asc(UCase(Mid(x, i, 1))) >= vbKeyA And Asc(UCase(Mid(x, i, 1))) <= vbKeyZ) Or Mid(x, i, 1) = " " Then
        flag = 0
    Else
        flag = 1
        Exit For
        is_chars = False
    End If
Next i
 
If flag = 0 Then
    is_chars = True
End If
    
End Function
 
Private Sub tbFonts_ButtonClick(ByVal Button As MSComctlLib.Button)
 
Select Case Button.Index
    Case 1
        mnuFontBold_Click
    Case 2
        mnuFontItalic_Click
    Case 3
        mnuFontUnderline_Click
    Case 5
        If typemsg.SelFontSize > 8 Then
            typemsg.SelFontSize = typemsg.SelFontSize - 2
        End If
    Case 6
        If typemsg.SelFontSize < 14 Then
            typemsg.SelFontSize = typemsg.SelFontSize + 2
        End If
End Select
 
End Sub
 
Private Sub typemsg_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyRight Or KeyCode = vbKeyLeft Or KeyCode = vbKeyDown Or KeyCode = vbKeyUp Then
    typemsg_Click
End If
End Sub
 
Private Sub typemsg_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
    Call cmdSend_Click
End If
End Sub
 
Private Sub typemsg_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error GoTo HandleError
If Button = vbRightButton Then
        If typemsg.SelText <> "" And is_chars(Replace(Trim(typemsg.SelText), vbCrLf, "")) = True Then
            dWord = Replace(Trim(typemsg.SelText), vbCrLf, "")
        Else
            dWord = "- Please highlight a word."
        End If
        mnuSpell.Caption = "Spellcheck " & dWord
        mnuDefine.Caption = "Define " & dWord
    
    If typemsg.SelBold = True Then
       mnuFontBold.Checked = True
    Else
       mnuFontBold.Checked = False
    End If
    
    If typemsg.SelItalic = True Then
       mnuFontItalic.Checked = True
    Else
       mnuFontItalic.Checked = False
    End If
    
    If typemsg.SelUnderline = True Then
       mnuFontUnderline.Checked = True
    Else
       mnuFontUnderline.Checked = False
    End If
    PopupMenu mnuFont
End If
 
HandleError:
    'MsgBox Err.Number & " - " & Err.Description, vbOKOnly
End Sub
 
Private Sub typemsg_Click()
If cmbFonts.Text <> typemsg.SelFontName Then
    cmbFonts.Text = ""
    cmbFonts.SelText = typemsg.SelFontName
End If
 
    If typemsg.SelBold = True Then
       tbFonts.Buttons(1).Value = tbrPressed
    Else
       tbFonts.Buttons(1).Value = tbrUnpressed
       
    End If
    
    If typemsg.SelItalic = True Then
       tbFonts.Buttons(2).Value = tbrPressed
    Else
       tbFonts.Buttons(2).Value = tbrUnpressed
    End If
    
    If typemsg.SelUnderline = True Then
       tbFonts.Buttons(3).Value = tbrPressed
    Else
       tbFonts.Buttons(3).Value = tbrUnpressed
    End If
End Sub
 
Private Sub mnuSpell_Click()
    Call DefineSpell(".spell")
End Sub
 
Private Sub mnuDefine_Click()
    Call DefineSpell(".define")
End Sub
 
Private Sub mnuSpell2_Click()
    Call DefineSpell(".spell")
End Sub
 
Private Sub mnuDefine2_Click()
    Call DefineSpell(".define")
End Sub
 
Private Function DefineSpell(wtd As String)
If Word(dWord, 1) <> "-" Then
    'MsgBox "Gonna DO IT", vbOKOnly
    Client.Winsock1.SendData wtd & " " & Word(Me.Caption, 1) & " " & dWord
    Client.WaitFor (wtd)
End If
End Function

All the code you just posted is irrelevant. what's the function / sub declaration of status_update, i.e. where it goes:

Private Function status_update(..................

In addition to the pending requests... I would like to see the code of WaitFor

May be irrelevant but for sign on/off:

VB Code:

Private Function status_update(buddy As String, status As Integer)
    Dim tn As Node
    Dim n As String
    Dim frmNum As Integer
 
        If status = 2 Then
            n = "Offline"
        Else
            n = "Online"
        End If
    For Each tn In TreeView1.Nodes
        If LCase(tn.Key) = LCase(buddy) Then
            'TreeView1.Nodes.Remove tn.Key
            'TreeView1.Nodes.Add n, tvwChild, buddy, buddy, status, status
            If Word(TreeView1.Nodes(tn.Key).Parent, 1) <> "Buddies" Then
                If status = 1 Then
                    Call PlaySound("sounds\dooropen.wav")
                    runlog.SelStart = Len(runlog.Text)
                    runlog.SelColor = vbBlue
                    runlog.SelText = buddy & " has signed on (" & Time & ")" & vbCrLf
                End If
                If status <> 2 Then
                    frmNum = GetFormNumber(LCase(buddy))
                    If frmNum <> 0 Then
                        Forms(frmNum).cmdSend.Enabled = True
                        Forms(frmNum).typemsg.Enabled = True
                        Forms(frmNum).tbFonts.Enabled = True
                        Forms(frmNum).showmsg.SelStart = Len(Forms(frmNum).showmsg.Text)
                        Forms(frmNum).showmsg.SelColor = vbBlue
                        Forms(frmNum).showmsg.SelText = buddy & " has signed on (" & Time & ")." & vbCrLf
                    End If
                End If
            End If
            If Word(TreeView1.Nodes(tn.Key).Parent, 1) <> "Offline" Then
                If status = 2 Then
                    Call PlaySound("sounds\doorslam.wav")
                    runlog.SelStart = Len(runlog.Text)
                    runlog.SelColor = vbRed
                    runlog.SelText = buddy & " has signed off (" & Time & ")" & vbCrLf
                    frmNum = GetFormNumber(LCase(buddy))
                    If frmNum <> 0 Then
                        Forms(frmNum).cmdSend.Enabled = False
                        Forms(frmNum).typemsg.Enabled = False
                        Forms(frmNum).tbFonts.Enabled = False
                        Forms(frmNum).showmsg.SelStart = Len(Forms(frmNum).showmsg.Text)
                        Forms(frmNum).showmsg.SelColor = vbRed
                        Forms(frmNum).showmsg.SelText = buddy & " has signed off (" & Time & ")." & vbCrLf
                    End If
                End If
            End If
            TreeView1.Nodes.Remove tn.Key
            TreeView1.Nodes.Add n, tvwChild, buddy, buddy, status, status
            Call Online_Offline_Text
            Exit For
        End If
    Next
End Function

WaitFor:

VB Code:

Private Sub TreeView2_AfterLabelEdit(Cancel As Integer, NewString As String)
Dim tn As Node
If oldLabel <> "Buddies" Then
    If UCase(NewString) <> UCase(oldLabel) Then
        If Correct_Screenname(NewString) = True Then
            If check_for_duplicate(NewString) = True Then
                TreeView2.SelectedItem.Key = NewString
                For Each tn In TreeView1.Nodes
                    If UCase(tn.Key) = UCase(oldLabel) Then
                        tn.Key = NewString
                        tn.Text = NewString
                        Winsock1.SendData ".updateBuddy " & LCase(Me.Caption) & " " & oldLabel & " " & NewString
                        WaitFor (".statusUpdate")
                        Exit For
                    End If
                Next
            Else
                MsgBox "A buddy with the user name " & UCase(NewString) & " already exists.", vbOKOnly + vbCritical
                Cancel = 1
            End If
            Else
                Cancel = 1
            End If
        Else
            Cancel = 1
        End If
    Else
        Cancel = 1
End If
End Sub

here's your error:

VB Code:

Private Function status_update(buddy As String, status As Integer)

you are passing two strings to this function here:

VB Code:

Call status_update(Word(strIncoming, 3), Word(strIncoming, 4))

If Word(strIncoming, 4) is definitely a number try:

VB Code:

Call status_update(Word(strIncoming, 3), Val(Word(strIncoming, 4)))

So, I should delete Call status_update(Word(strIncoming, 3), Word(strIncoming, 4))
?

have you tried doing:

VB Code:

Call status_update(Word(strIncoming, 3), Val(Word(strIncoming, 4)))

Ok, when i replaced Call status_update(Word(strIncoming, 3), Word(strIncoming, 4)) with
Call status_update(Word(strIncoming, 3), Val(Word(strIncoming, 4)))
The runtime error stopped so I then compiled. Here is what happens now.*edit
When a user sends someone an IM, the first one is not seen by the receiever, the second time they send one a box pops up for the receiver. I think I know why, the first time someone sends an IM to someone on their buddy list, instead of the im popping up for the receiver, the sender then appears online. After the receiver appears online for both buddies, they can talk freely. Although, they both must appear online for each buddy, and this is only done so by sending 1 im, or by having 1 buddy sign in when the other is allready signed in.

Mabey, is there a way to program it so when the first message sent to start a concersation includes2, one blank one wich signs the sender on in the receiver's list and then the message the sender types?

I'm afraid I don't know anything about WinSock.

Perhaps work out what your question is, and then post a new thread. That way you've got more chance of people looking (as very few are likely to wade through all these posts).