Sub LoginUser(Name As String, Index As Integer, Status As String)
On Error GoTo shoot:
If chkDisLog.Value = 1 Then ' Check box if enabled it sends to the index that the server is down and deny logging
SendSocket "ChatSock", "auth" & Chr(1) & "37", Index, Me
DoEvents
Exit Sub
End If
Dim sParts() As String, N As Long
Dim eParts() As String, EE As Long
SendSocket "ChatSock", "announce" & Chr(1) & txtAnnounce.Text, Index, Me 'send announcement to the status bar on the client
DoEvents
Set recSet = New Recordset
recSet.Open "Select * from Users where stUserName=""" & LCase(Name) & """", dbConn, 1, 3
XXYU = recSet("stUserName")
recSet("stlastlogin") = Format(Date, "dd.mm.yyyy") 'update this field
recSet.Update
LVU.ListItems.Add , "x" & Index, recSet("stUserName")
LVU.ListItems("x" & Index).SubItems(1) = recSet("stpassword")
BuddyList = recSet("stbudlist")
recSet.Close
Set recSet = Nothing
ListToSplit = CheckBudListField(XXYU)
StatusToBeSent = UserStatus(XXYU)
eParts = Split(ListToSplit, ",")
sParts = Split(BuddyList, ",")
For N = 0 To UBound(sParts)
If Int(CheckNickname(sParts(N))) = 0 Then
UsersPackage = UsersPackage & sParts(N) & Chr(2) & "5,"
DoEvents
Else
Select Case UserStatus(sParts(N))
Case "Available"
SS = "1"
Case "Away"
SS = "2"
Case "DND"
SS = "3"
Case "Invisible"
SS = "4"
End Select
UsersPackage = UsersPackage & sParts(N) & Chr(2) & SS & ","
DoEvents
End If
Next N
UsersPackageSent = Left(UsersPackage, Len(UsersPackage) - 1)
SendSocket "ChatSock", "budlist" & Chr(1) & UsersPackageSent, Index, Me
DoEvents
Set recSet = New Recordset
recSet.Open "Select * from Users where stUserName=""" & LCase(Name) & """", dbConn, 1, 3
If recSet("stoffmsgs") <> "" Then
OfflineText = recSet("stoffmsgs")
recSet.Close
SendSocket "ChatSock", "offmsgs" & Chr(1) & OfflineText, Index, Me ' here is my problem it is not doing this line, if i put message box before it and I click it when it shows, it execute this command, or if I put it over budlist command it executes it and not executing budlist command, but when I trace the code it does it, very weird
DoEvents
End If
Set recSet = Nothing
UsersPackage = ""
For EE = 0 To UBound(eParts)
DoEvents
If CheckNickname(eParts(EE)) = 1 Then
SendSocket "ChatSock", "loggedin" & Chr(1) & xxYU & Chr(2) & StatusToBeSent, (NameInUse(eParts(EE))), Me
DoEvents
End If
Next EE
Exit Sub
shoot:
ChatSock_Close Index
End Sub
Function NameInUse(Name As String) As String
On Error Resume Next
NameInUse = "0"
For i = 1 To LVU.ListItems.Count
If LCase(LVU.ListItems.Item(i)) = LCase(Name) Then
NameInUse = Right(LVU.ListItems.Item(i).Key, Len(LVU.ListItems.Item(i).Key) - 1)
Exit Function
End If
Next
End Function
Public Function CheckNickname(Nickname As String) As Integer
CheckNickname = 0
For i = 1 To LVU.ListItems.Count
If LVU.ListItems.Item(i).Text = Nickname Then
CheckNickname = 1
Exit Function
End If
Next i
End Function
' now in a module I have this
Sub SendSocket(wSck As String, msg As String, Index As Integer, Frm As Form)
If Frm.Controls(wSck)(Index).State = 7 Then
Frm.Controls(wSck)(Index).SendData msg & Chr(0)
End If
End Sub