Option Explicit
Private Const debuggo As Boolean = False
Private url As String
Private userson() As String
'Private sockettouser() As String
Private dataset As String
Private Const verstring As String = "VB2 messenger server v0.6"
Private x As Double
Private userdb(500, 1)
Private newestnick As String
Private timersocket As Double, timerdata As String
Private userdbcount As Double


Private Sub cmdoff_Click()
If (wsHTTP.State <> 0) Then
wsHTTP.Close
txtconnectips.Text = txtconnectips.Text & "Closing port: " & wsHTTP.LocalPort & vbCrLf

lblState = "Off."
Form2.Hide
End If
End Sub

Private Sub cmdOn_Click()
If (wsHTTP.State <> 2) Then
wsHTTP.LocalPort = 801
wsHTTP.Listen
txtconnectips.Text = txtconnectips.Text & "Listening to port: " & wsHTTP.LocalPort & vbCrLf & "Ammount of Sockets Ready: " & ws2.Count & vbCrLf

lblState = "Listening..."
Form2.Show
End If

End Sub

Private Sub Command1_Click()
Form2.Show
Form2.Move Form1.CurrentX + Form1.Width, 0
Form1.Move 0, 0
End Sub

Private Sub Command2_Click()
If (Not Val(txttimer.Text) = 0) Then
timershutdown.Interval = Val(txttimer.Text)
sendall ("0:SERVER: Server is shutting down in " & Val(txttimer.Text) & " seconds.")

timershutdown.Enabled = True
End If
End Sub

Private Sub Form_Load()
Dim temp As Double
'temp = Shell("stunnel-4.03.exe server.conf", vbNormalFocus)
'txtconnectips.Text = "Stunnel Initialized on port 802 (" & temp & ")" & vbCrLf
ReDim userson(1) As String
ReDim sockettouser(1) As String
lblstats.Caption = lblstats.Caption & wsHTTP.LocalHostName & vbCrLf
lblstats.Caption = lblstats.Caption & wsHTTP.LocalIP & vbCrLf
lblstats.Caption = lblstats.Caption & "Bytes Recieved: 0" & vbCrLf
Call getdb
wsHTTP.LocalPort = 801
txtconnectips.Text = txtconnectips.Text & "Listening to port: " & wsHTTP.LocalPort & vbCrLf & "Ammount of Sockets Ready: " & ws2.Count & vbCrLf
wsHTTP.Listen
lblState = "Listening..."
'x = ws2.LBound - 1
Form2.Show
Form2.Move Form1.CurrentX + Form1.Width, 0
Form1.Move 0, 0

'Form2.CurrentX =,form1.CurrentY
'Form2.CurrentY = Form1.CurrentY
End Sub
Function searchforuser(ByVal nick As String) As Double
Dim x As Double
Dim found As Boolean
For x = LBound(sockettouser) To UBound(sockettouser)
    If (sockettouser(x) = nick) Then
        found = True
        searchforuser = x
    End If
Next x
If found = False Then searchforuser = -1
End Function


Private Sub Form_Unload(Cancel As Integer)


Call TerminateTask("stunnel-4.03.exe")
End Sub


Private Sub sendslow_Timer()
Static x As Double
If x = 0 Then
    x = 1
    sendslow.Enabled = True
End If
    If x = 2 Then
        ws2(timersocket).SendData (timerdata)
        x = 0
        sendslow.Enabled = False
    Else: x = x + 1
End If
End Sub

Private Sub TimeoutTimer_Timer()
Dim x As Integer
For x = ws2.LBound To ws2.UBound
    If (ws2(x).State = 8) Then
        Call disconnectuserwsocket(x)
        ws2(x).Close
    End If
Next x
End Sub

Private Sub Timer1_Timer(index As Integer)

Static x As Double
If x = 0 Then x = ws2.LBound
If (ws2(x).State = 7) Then
    ws2(x).SendData dataset
End If

If (x + 1 < ws2.UBound) Then
If ws2(x + 1).State = 0 Then Timer1(index).Interval = 1
If ws2(x + 1).State = 7 Then Timer1(index).Interval = 25
End If
If x = ws2.UBound Then
    x = ws2.LBound - 1
    Timer1(index).Enabled = False
    
End If
x = x + 1

End Sub

Private Sub timernewnick_Timer()
sendall ("0:Server: " & newestnick & " has joined the conversation." & vbCrLf)
timernewnick.Enabled = False
End Sub

Private Sub timershutdown_Timer()
Call dbout
closeall ("Server closed")
Unload Form2
End
End Sub

Private Sub txtreqs_Change()
txtreqs.SelLength = 0
txtreqs.SelStart = Len(txtreqs)
End Sub

Private Sub ws2_DataArrival(index As Integer, ByVal bytesTotal As Long)
Dim blank As String
Dim temp As String
Dim nick As String
Dim identified As Boolean

ws2(index).GetData blank, "string"
Dim x As Double
If Mid(blank, 1, 1) = 8 And Mid(blank, 2, 1) = 0 And Mid(blank, 3, 1) = 1 And Mid(blank, 4, 1) = ":" Then
'outdated nick code
End If
If Mid(blank, 1, 4) = "500:" Then
'Code for Privmsg INC
    identified = True
    Dim incmsg() As String
    Dim outgoingsocket As Double
    Call explode(Mid(blank, 5), incmsg(), ":")
    outgoingsocket = searchforuser(incmsg(1))
    If (outgoingsocket = -1) Then
        timersocket = index
        timerdata = 599
        Call sendslow_Timer
        txtreqs.Text = txtreqs.Text & "599:" & incmsg(0) & "->" & incmsg(1) & vbCrLf
        'sendall (399)
    Else
        'ws2(index).SendData ("301:" & incmsg(1) & ": " & incmsg(2) & vbCrLf)
        timersocket = outgoingsocket
        timerdata = "501:" & incmsg(0) & ":" & incmsg(1) & ": " & incmsg(2)
        Call sendslow_Timer
        txtreqs.Text = txtreqs.Text & "501/2:" & incmsg(0) & " sais to " & incmsg(1) & ": " & incmsg(2) & vbCrLf
    End If

End If
If Mid(blank, 1, 1) = 4 And Mid(blank, 2, 1) = 0 And Mid(blank, 3, 1) = 0 And Mid(blank, 4, 1) = ":" Then
    'Code for registering
    identified = True
    Dim incarray() As String, inc As String, alreadyused As Boolean
    inc = Mid(blank, 5)
    Call explode(inc, incarray(), ":")
    
    For x = LBound(userdb, 1) To UBound(userdb, 1)
        If (userdb(x, 0) = incarray(0)) Then
        alreadyused = True
        End If
    Next x
    If (Not alreadyused) Then
        userdb(userdbcount, 0) = incarray(0)
        userdb(userdbcount, 1) = incarray(1)
        userdbcount = userdbcount + 1
        Call dbout
        
        ws2(index).SendData "401"
        txtreqs.Text = txtreqs.Text & "(" & index & ")401: " & incarray(0) & vbCrLf
    Else
        ws2(index).SendData "402"
        txtreqs.Text = txtreqs.Text & "(" & index & ")402: " & incarray(0) & vbCrLf
    End If
End If

If Mid(blank, 1, 1) = 8 And Mid(blank, 2, 1) = 0 And Mid(blank, 3, 1) = 2 And Mid(blank, 4, 1) = ":" Then
identified = True
    Dim incstr As String
    incstr = Mid(blank, 5)
    Dim userpw() As String
    Call explode(incstr, userpw(), ":")
    Dim xx As Double
    Dim logged As Boolean
    For xx = LBound(userdb, 1) To UBound(userdb, 1)
        If (userpw(0) = userdb(xx, 0) And userpw(1) = userdb(xx, 1)) Then logged = True
    Next xx
    If (logged = True) Then
        
        ws2(index).SendData "803"
        txtreqs.Text = txtreqs.Text & "(" & index & ")803: " & userpw(0) & vbCrLf
        nick = userpw(0)
        newestnick = nick
        timernewnick.Enabled = True
    
        'sendall (nick & " has connected to the room." & vbCrLf)
        sendall ("0:Server: " & nick & " has left the conversation." & vbCrLf)
        For x = LBound(userson) To UBound(userson)
            If (userson(x) = "") Then
                userson(x) = nick
                x = UBound(userson) + 1
            End If
        Next x
        sockettouser(index) = nick
        sendall ("1: " & implode(userson(), "ÿ") & vbCrLf)
        
        ReDim Preserve userson(UBound(userson) + 1)
        ReDim Preserve sockettouser(UBound(sockettouser) + 1)
    Else
        ws2(index).SendData "804"
        txtreqs.Text = txtreqs.Text & "(" & index & ")804: " & userpw(0) & vbCrLf
    End If
End If
If Mid(blank, 1, 1) = 3 And Mid(blank, 2, 1) = 0 And Mid(blank, 3, 1) = 1 And Mid(blank, 4, 1) = ":" Then
    identified = True
    Dim incmsg2() As String
    Dim outgoingsocketset As Double
    Call explode(Mid(blank, 5), incmsg2(), ":")
    outgoingsocketset = searchforuser(incmsg2(1))
    If (outgoingsocketset = -1) Then
        timersocket = index
        timerdata = 399
        Call sendslow_Timer
        txtreqs.Text = txtreqs.Text & "399:" & incmsg2(0) & "->" & incmsg2(1) & vbCrLf
        'sendall (399)
    Else
        'ws2(index).SendData ("301:" & incmsg(1) & ": " & incmsg(2) & vbCrLf)
        timersocket = outgoingsocketset
        timerdata = "301:" & incmsg2(0) & ":" & incmsg2(1) & ": " & incmsg2(2) & vbCrLf
        Call sendslow_Timer
        txtreqs.Text = txtreqs.Text & "301/2:" & incmsg2(0) & " sais to " & incmsg2(1) & ": " & incmsg2(2) & vbCrLf
    End If
End If

If (Mid(blank, 1, 1) = 0) Then
identified = True
    Dim sendstring As String
    sendstring = blank & vbCrLf
    sendall (sendstring)
End If
If identified = False Then
    txtreqs.Text = "CANT IDENTIFY! " & blank
End If
If debuggo Then
'debug code -->
    txtreqs.Text = txtreqs & blank & vbCrLf
    txtreqs.SetFocus
    txtreqs.SelLength = 0
    txtreqs.SelStart = Len(txtreqs.Text)
    
'<-- debug code
End If
End Sub
Function implode(ByRef data() As String, ByVal connectchar As String) As String
Dim x As Double
For x = LBound(data) To UBound(data)
    If (data(x) <> "") Then implode = implode & data(x) & connectchar
Next x

End Function
Private Sub closeall(ByVal data As String)
Dim x As Double
For x = ws2.LBound To ws2.UBound
    If (ws2(x).State = 7) Then
    ws2(x).SendData data
    ws2(x).Close
    End If
Next x
End Sub

Private Sub ws2_Error(index As Integer, ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
If (Number = 8 Or Number = 10053) Then
    Call disconnectuserwsocket(index)
    ws2(index).Close
Else
MsgBox Number & " " & Description
End If
End Sub

Private Sub ws2_SendComplete(index As Integer)
Static datarecievedbytes As Double
Static linkscompleted As Double
linkscompleted = linkscompleted + 1
datarecievedbytes = datarecievedbytes + ws2(index).BytesReceived
lblstats.Caption = ""
lblstats.Caption = lblstats.Caption & wsHTTP.LocalHostName & vbCrLf
lblstats.Caption = lblstats.Caption & wsHTTP.LocalIP & vbCrLf
lblstats.Caption = lblstats.Caption & "Bytes Recieved: " & datarecievedbytes & vbCrLf
lblstats.Caption = lblstats.Caption & "Completed Connections: " & linkscompleted & vbCrLf
End Sub

Private Sub wsHTTP_ConnectionRequest(ByVal requestID As Long)
Dim x As Double
For x = ws2.LBound To ws2.UBound
    If (ws2(x).State = 0) Then
        ws2(x).LocalPort = 80
        ws2(x).Accept requestID
        txtconnectips.Text = txtconnectips & ws2(x).RemoteHostIP & " (" & ws2(x).RemoteHost & ")" & " Connected on Socket " & x & vbCrLf
        x = ws2.UBound + 1
    End If
Next x

End Sub

Private Sub disconnectuserwsocket(ByVal index As Integer)
Dim nick As String
Dim x As Double
nick = sockettouser(index)
killslow.Enabled = True
killslow.Tag = nick
For x = LBound(userson) To UBound(userson)
    If (userson(x) = nick) Then userson(x) = ""
Next x
sendall ("1: " & implode(userson(), "ÿ"))
End Sub
Private Sub sendall(ByVal data As String)
dataset = data
Dim x As Double
For x = Timer1.LBound To Timer1.UBound
    If (Not Timer1(x).Enabled) Then
        Timer1(x).Enabled = True
        'txtconnectips.Text = txtconnectips & wsHTTP.RemoteHost & ":" & x
        x = Timer1.UBound + 1
    End If
Next x

txtreqs.Text = txtreqs.Text & data
End Sub
Private Sub explode(ByVal data As String, ByRef newarray() As String, ByVal explchar As String)
Dim x As Integer
Dim lastx As Integer
Dim usercount As Double

For x = 1 To Len(data)
If (Mid(data, x, 1) = explchar) Then
    ReDim Preserve newarray(usercount)
    newarray(usercount) = Mid(data, lastx + 1, x - lastx - 1)
    lastx = x
    usercount = usercount + 1
End If
Next x

End Sub
Private Sub getdb()
   Dim nFileNumber     As Integer
   Dim sLine           As String
   Dim x As Double
   Dim temparray() As String
   nFileNumber = FreeFile()
   Open "vbmsgDB.txt" For Input As #nFileNumber
   Do While Not EOF(nFileNumber)
       Line Input #nFileNumber, sLine
       sLine = Mid(sLine, 2)
       sLine = Mid(sLine, 1, Len(sLine) - 1)
       Call explode(sLine, temparray(), ":")
       userdb(x, 0) = temparray(0)
       userdb(x, 1) = temparray(1)
       x = x + 1
   Loop
   Close #nFileNumber
   userdbcount = x
End Sub

Private Sub dbout()
Dim intnewfilenum As Integer, x As Double
intnewfilenum = FreeFile()
Open "vbmsgDB.txt" For Output As #intnewfilenum
For x = 0 To userdbcount - 1
    Write #intnewfilenum, userdb(x, 0) & ":" & userdb(x, 1) & ":"
Next x
Close #intnewfilenum
End Sub