VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmMain
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Redirecthub"
   ClientHeight    =   4095
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5490
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   4095
   ScaleWidth      =   5490
   StartUpPosition =   2  'CenterScreen
   Begin VB.CheckBox chkWebServe
      Caption         =   "Enable WebServer [EXPERIMENTAL]"
      Height          =   255
      Left            =   120
      TabIndex        =   29
      Top             =   3840
      Width           =   3495
   End
   Begin VB.Timer tmrUptimeSec
      Interval        =   100
      Left            =   3960
      Top             =   3240
   End
   Begin VB.CheckBox chkUptime
      Caption         =   "Show uptime on connect?"
      Height          =   195
      Left            =   120
      TabIndex        =   23
      Top             =   1320
      Width           =   2175
   End
   Begin VB.TextBox txtArray
      BackColor       =   &H00FFFFFF&
      Height          =   645
      Left            =   1320
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   21
      Text            =   "frmMain.frx":2CFA
      Top             =   2640
      Width           =   2535
   End
   Begin VB.TextBox txtPort
      BeginProperty Font
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   285
      Left            =   1320
      TabIndex        =   1
      Text            =   "7778"
      Top             =   1560
      Width           =   615
   End
   Begin VB.CommandButton cmdToggle
      BackColor       =   &H00B56B00&
      Caption         =   "Start"
      BeginProperty Font
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   3960
      TabIndex        =   18
      Top             =   1290
      Width           =   1275
   End
   Begin VB.Timer tmrTick
      Interval        =   1000
      Left            =   4920
      Top             =   2760
   End
   Begin MSWinsockLib.Winsock sckListen
      Left            =   3960
      Top             =   2760
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock Socket
      Index           =   0
      Left            =   4440
      Top             =   2760
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.TextBox txtRdBotName
      Height          =   285
      Left            =   1320
      TabIndex        =   12
      Text            =   "LeGioN™"
      Top             =   2280
      Width           =   1335
   End
   Begin VB.TextBox txtNetwork
      Height          =   285
      Left            =   1320
      TabIndex        =   11
      Text            =   "ViCiouS LeGioN™"
      Top             =   1920
      Width           =   1335
   End
   Begin VB.CommandButton cmdLog
      Caption         =   "Hub Traffic"
      BeginProperty Font
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   3960
      Style           =   1  'Graphical
      TabIndex        =   10
      Top             =   1680
      Width           =   915
   End
   Begin VB.CommandButton cmdEditChat
      Caption         =   "Edit..."
      BeginProperty Font
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   2880
      TabIndex        =   5
      Top             =   120
      Width           =   855
   End
   Begin VB.CheckBox chkChat
      Caption         =   "Send chat message to clients"
      BeginProperty Font
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   4
      Top             =   120
      Width           =   2415
   End
   Begin VB.CommandButton cmdEditPM
      Caption         =   "Edit..."
      BeginProperty Font
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   2880
      TabIndex        =   3
      Top             =   480
      Width           =   855
   End
   Begin VB.CheckBox chkPM
      Caption         =   "Send private message to clients"
      BeginProperty Font
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   2
      Top             =   480
      Width           =   2655
   End
   Begin VB.Label lblUptime
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Uptime:"
      ForeColor       =   &H00000000&
      Height          =   195
      Left            =   120
      TabIndex        =   28
      Top             =   3600
      Width           =   540
   End
   Begin VB.Label lblUptimeDay
      AutoSize        =   -1  'True
      BackColor       =   &H00FFFFFF&
      BackStyle       =   0  'Transparent
      Caption         =   "0"
      ForeColor       =   &H00000000&
      Height          =   195
      Left            =   720
      TabIndex        =   27
      Top             =   3600
      Width           =   90
   End
   Begin VB.Label lblUptimeSec
      AutoSize        =   -1  'True
      BackColor       =   &H00FFFFFF&
      BackStyle       =   0  'Transparent
      Caption         =   "0"
      ForeColor       =   &H00000000&
      Height          =   195
      Left            =   1800
      TabIndex        =   26
      Top             =   3600
      Width           =   90
   End
   Begin VB.Label lblUptimeHour
      AutoSize        =   -1  'True
      BackColor       =   &H00FFFFFF&
      BackStyle       =   0  'Transparent
      Caption         =   "0"
      ForeColor       =   &H00000000&
      Height          =   195
      Left            =   1080
      TabIndex        =   25
      Top             =   3600
      Width           =   90
   End
   Begin VB.Label lblUptimeMin
      AutoSize        =   -1  'True
      BackColor       =   &H00FFFFFF&
      BackStyle       =   0  'Transparent
      Caption         =   "0"
      ForeColor       =   &H00000000&
      Height          =   195
      Left            =   1440
      TabIndex        =   24
      Top             =   3600
      Width           =   90
   End
   Begin VB.Label Label7
      AutoSize        =   -1  'True
      Caption         =   "Redirect Array:"
      Height          =   195
      Left            =   120
      TabIndex        =   22
      Top             =   2865
      Width           =   1050
   End
   Begin VB.Label Label1
      AutoSize        =   -1  'True
      Caption         =   "Listen Port:"
      BeginProperty Font
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Left            =   120
      TabIndex        =   0
      Top             =   1605
      Width           =   825
   End
   Begin VB.Image imgAbout2
      Height          =   480
      Left            =   4560
      Picture         =   "frmMain.frx":2D32
      Top             =   240
      Width           =   480
   End
   Begin VB.Image imgAbout
      Height          =   480
      Left            =   3960
      Picture         =   "frmMain.frx":35FC
      Top             =   240
      Width           =   480
   End
   Begin VB.Label lblAbout
      AutoSize        =   -1  'True
      Caption         =   "Redirect Hub"
      BeginProperty Font
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Left            =   3960
      TabIndex        =   20
      Top             =   810
      Width           =   930
   End
   Begin VB.Label Label4
      AutoSize        =   -1  'True
      Caption         =   "by aDe 2003"
      BeginProperty Font
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Left            =   3960
      TabIndex        =   19
      Top             =   1050
      Width           =   915
   End
   Begin VB.Label Label8
      AutoSize        =   -1  'True
      Caption         =   "Use "";"" to seperate hub addresses."
      ForeColor       =   &H000000FF&
      Height          =   195
      Left            =   1320
      TabIndex        =   17
      Top             =   3360
      Width           =   2490
   End
   Begin VB.Label cmdStart2
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H00B56B00&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Start"
      BeginProperty Font
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000009&
      Height          =   255
      Left            =   3960
      TabIndex        =   16
      Top             =   2040
      Width           =   1455
   End
   Begin VB.Label cmdChangeRd
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H00B56B00&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Change Redirect"
      Enabled         =   0   'False
      BeginProperty Font
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000009&
      Height          =   255
      Left            =   3960
      TabIndex        =   15
      Top             =   2400
      Visible         =   0   'False
      Width           =   1455
   End
   Begin VB.Label Label6
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Bot Name:"
      Height          =   195
      Left            =   120
      TabIndex        =   14
      Top             =   2325
      Width           =   750
   End
   Begin VB.Label Label5
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Network Name:"
      Height          =   195
      Left            =   120
      TabIndex        =   13
      Top             =   1965
      Width           =   1110
   End
   Begin VB.Label lblLastNick
      AutoSize        =   -1  'True
      Caption         =   "(none)"
      BeginProperty Font
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Left            =   3120
      TabIndex        =   9
      Top             =   960
      Width           =   480
   End
   Begin VB.Label lblCounter
      AutoSize        =   -1  'True
      Caption         =   "0"
      BeginProperty Font
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Left            =   1320
      TabIndex        =   8
      Top             =   960
      Width           =   90
   End
   Begin VB.Label Label3
      AutoSize        =   -1  'True
      Caption         =   "Last client:"
      BeginProperty Font
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Left            =   2280
      TabIndex        =   7
      Top             =   960
      Width           =   780
   End
   Begin VB.Label Label2
      AutoSize        =   -1  'True
      Caption         =   "Redirects done:"
      BeginProperty Font
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Left            =   120
      TabIndex        =   6
      Top             =   960
      Width           =   1140
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim addrArr() As String, addrIndex As Byte
Dim addr As String

Dim localPort As Long, bOn As Boolean
Dim strChat As String, strPM As String

Sub LogError(strSub As String, strError As String)
If Not frmErrors.Visible = True Then frmErrors.Show
    frmErrors.txtLog.Text = frmErrors.txtLog.Text & vbCrLf & "<" & strSub & "> " & strError
End Sub

Private Sub chkWebServe_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If chkWebServe.Value = 0 Then
    Unload webserve
Else
    Load webserve
End If
End Sub

'Moves on to the next address in the list. Is *required* by the redirecter.
Private Sub cmdChangeRd_Click()
    addr = addrArr(addrIndex)
    addrIndex = addrIndex + 1

If addrIndex > UBound(addrArr) Then
    addrIndex = 0
End If
End Sub

Private Sub cmdEditChat_Click()
On Error GoTo RepErr
GoTo RunSub
RepErr:
LogError "cmdEditChat", Error$
Exit Sub
RunSub:

Load frmEditText
frmEditText.txtEdit.Text = strChat
frmEditText.Show vbModal
strChat = frmEditText.txtEdit.Text
Unload frmEditText
End Sub

Private Sub cmdEditPM_Click()
On Error GoTo RepErr
GoTo RunSub
RepErr:
LogError "cmdEditPM", Error$
Exit Sub
RunSub:

Load frmEditText
frmEditText.txtEdit.Text = strPM
frmEditText.Show vbModal
strPM = frmEditText.txtEdit.Text
Unload frmEditText
End Sub

Private Sub cmdLog_Click()
  frmLog.Show
End Sub

Private Sub cmdToggle_Click()
On Error GoTo RepErr
GoTo RunSub
RepErr:
LogError "cmdToggle_Click", Error$
Exit Sub
RunSub:

Dim i As Integer
Select Case bOn
  Case False
    If Not OpenPort(Val(txtPort.Text)) Then
      MsgBox "Sorry, could not open port '" & txtPort.Text & "' for TCP listening..."
      Exit Sub
    End If
    bOn = True
    cmdToggle.Caption = "Stop"
    tmrUptimeSec.Enabled = True
    txtPort.Enabled = False
  Case True
    If sckListen.State <> sckClosed Then sckListen.Close
    For i = 0 To Socket.UBound
      KillSocket i
    Next
    bOn = False
    cmdToggle.Caption = "Start"
    tmrUptimeSec.Enabled = False
    txtPort.Enabled = True
End Select
End Sub

Function OpenPort(iPort As Long) As Boolean
On Error GoTo RepErr
GoTo RunSub
RepErr:
LogError "OpenPort", Error$
Exit Function
RunSub:

On Error GoTo faill
sckListen.localPort = iPort
sckListen.Listen
localPort = iPort
OpenPort = True
Exit Function

faill:
localPort = 0
OpenPort = False
End Function

Private Sub Form_Load()
    lblAbout.Caption = "Redirect- hub v. " & verNum
    GetSettings
    'Splits each address using the symbol ";".
    addrArr = Split(txtArray.Text, ";")
    'Uptime timer. Home made uptime :).
    tmrUptimeSec.Interval = 1000
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    SaveSettings
End
End Sub

Private Sub Form_Unload(Cancel As Integer)
End
End Sub
Sub SaveSettings()
On Error GoTo RepErr
GoTo RunSub
RepErr:
LogError "SaveSettings", Error$
Exit Sub
RunSub:

Dim aPath As String
aPath = App.Path
dFile = "RedirectHub.cfg"
If Right(aPath, 1) <> "\" Then aPath = aPath & "\"

dStr = "[Settings]" & vbCrLf
dStr = dStr & "<Port>" & txtPort.Text & vbCrLf
dStr = dStr & "<Network>" & txtNetwork.Text & vbCrLf
dStr = dStr & "<BotName>" & txtRdBotName.Text & vbCrLf
dStr = dStr & "<RedirectArray>" & txtArray.Text & vbCrLf
dStr = dStr & "<ChatMSGOn>" & chkChat.Value & vbCrLf
dStr = dStr & "<PMOn>" & chkPM.Value & vbCrLf
dStr = dStr & "<UptimeOn>" & chkUptime.Value & vbCrLf
dStr = dStr & "<ChatMSG>" & strChat & "</ChatMSG>" & vbCrLf
dStr = dStr & "<PM>" & strPM & "</PM>" & vbCrLf
dStr = dStr & vbCrLf
Open aPath & dFile For Output As #1
Print #1, dStr
Close #1

End Sub

Sub GetSettings()
On Error GoTo RepErr
GoTo RunSub
RepErr:
LogError "GetSettings", Error$
Exit Sub
RunSub:

Dim aStr As String, aSect As String
aSect = "Settings"
aStr = aGetFile("RedirectHub.cfg")
If aStr = "" Then Exit Sub

txtPort.Text = aGEFS(aStr, aSect, "Port", "7778")
txtNetwork.Text = aGEFS(aStr, aSect, "Network", "ViCiouS LeGioN™")
txtRdBotName.Text = aGEFS(aStr, aSect, "BotName", "LeGioN™")
txtArray.Text = aGEFS(aStr, aSect, "Redirect", "1.legiondc.com;2.legiondc.com:443;3.legiondc.com:23")
strChat = aGTFS(aStr, aSect, "ChatMSG", "")
strPM = aGTFS(aStr, aSect, "PM", "")
chkPM.Value = Val(aGEFS(aStr, aSect, "PMOn", "0"))
chkChat.Value = Val(aGEFS(aStr, aSect, "ChatMSGOn", "0"))
chkUptime = Val(aGEFS(aStr, aSect, "UptimeOn", "0"))

End Sub

Sub SocketSend(sckIndex As Integer, sckData As String)
On Error GoTo RepErr
GoTo RunSub
RepErr:
LogError "SocketSend", Error$
Exit Sub
RunSub:

Socket(sckIndex).SendData sckData
If frmLog.Visible Then frmLog.txtLog.Text = frmLog.txtLog.Text & vbCrLf & "<" & sckIndex & "--> " & sckData
End Sub

Private Sub imgAbout_Click()
Dim dStr As String
dStr = "RedirectHub version " & verNum & " by aDe 2003." & vbCrLf
dStr = dStr & "dchub://phats0.d2g.com" & vbCrLf
dStr = dStr & "ade_n84@hotmail.com" & vbCrLf

MsgBox dStr, vbInformation
End Sub

Private Sub sckListen_ConnectionRequest(ByVal requestID As Long)
On Error GoTo RepErr
GoTo RunSub
RepErr:
LogError "sckListen_ConnectionRequest", Error$
Exit Sub
RunSub:

Dim i As Integer
i = NewSock("30")
Socket(i).Accept requestID
DoEvents
SocketSend i, "$Lock REDIRECTHUB-V" & verNum & "-ABCABCABCABCABCABC Pk=aDe2003|"

If frmLog.Visible Then frmLog.txtLog.Text = frmLog.txtLog.Text & vbCrLf & "<" & i & "> Opened"
End Sub

Public Function NewSock(addTag As String) As Integer
On Error GoTo RepErr
GoTo RunSub
RepErr:
LogError "NewSock", Error$
Exit Function
RunSub:

Dim i As Integer

 For i = 0 To Socket.UBound

  If Socket(i).Tag = "" Then
   Socket(i).Tag = addTag
   FindSocket = i
   Exit Function
  End If

 Next

 Load Socket(Socket.UBound + 1)
 Socket(Socket.UBound).Tag = addTag
 FindSocket = Socket.UBound

End Function

Private Sub Socket_DataArrival(Index As Integer, ByVal bytesTotal As Long)
On Error GoTo RepErr
GoTo RunSub
RepErr:
LogError "Socket_DataArrival", Error$
Exit Sub
RunSub:

Dim dStr As String, cNick As String
Socket(Index).GetData dStr

If frmLog.Visible Then frmLog.txtLog.Text = frmLog.txtLog.Text & vbCrLf & "<--" & Index & "> " & dStr

If InStr(1, dStr, "$ValidateNick ") Then
  cNick = BeforeFirst(AfterFirst(dStr, "$ValidateNick "), "|")
  lblCounter.Caption = Val(lblCounter.Caption) + 1
  lblLastNick.Caption = cNick
  If chkChat.Value Then SocketSend Index, "<Hub> " & strChat & "|"
  If chkPM.Value Then SocketSend Index, "$To: " & cNick & " From: " & "Hub $" & strPM & "|"
  'Rotates the array and prepares the next address to redirect to.
  cmdChangeRd_Click
  SocketSend Index, "$ForceMove " & addr & "|"
  DoEvents
  Socket(Index).Tag = "2"
End If
End Sub


Sub KillSocket(Index As Integer)
On Error GoTo RepErr
GoTo RunSub
RepErr:
LogError "KillSocket", Error$
Exit Sub
RunSub:

 If Socket(Index).State <> sckClosed Then Socket(Index).Close
 Socket(Index).Tag = ""
 If frmLog.Visible Then frmLog.txtLog.Text = frmLog.txtLog.Text & vbCrLf & "<" & Index & "> Closed"
End Sub

Private Sub tmrTick_Timer()
On Error GoTo RepErr
GoTo RunSub
RepErr:
LogError "tmrTick_Timer", Error$
Exit Sub
RunSub:

Dim cVal As Integer
Dim i As Integer
For i = 0 To Socket.UBound
  If Len(Socket(i).Tag) Then
    cVal = Int(Val(Socket(i).Tag))
    If cVal = 0 Then
      KillSocket i
    Else
      Socket(i).Tag = cVal - 1
    End If
  End If
Next

End Sub

Private Sub tmrUptimeSec_Timer()
    'Only keep track of uptime if the array is turned on. If it is then starting counting uptime.
    If bOn = True Then

    lblUptimeSec.Caption = Format(lblUptimeSec.Caption + 1, "00")
    'Once the uptime in seconds reaches 60 then it resets to 0 and adds 1 minute.
    If lblUptimeSec.Caption > 59 Then
        lblUptimeSec.Caption = Format(lblUptimeSec.Caption - 60, "00")
        lblUptimeMin.Caption = Format(lblUptimeMin.Caption + 1, "00")
    End If
    'Once the uptime in minutes reaches 60 then it resets to 0 and adds 1 hour.
    If lblUptimeMin.Caption > 59 Then
        lblUptimeMin.Caption = Format(lblUptimeMin.Caption - 60, "00")
        lblUptimeHour.Caption = Format(lblUptimeHour.Caption + 1, "00")
    End If

    'Once the uptime in hours reaches 24 then it resets to 0 and adds 1 day.
    If lblUptimeHour.Caption > 23 Then
        lblUptimeHour.Caption = lblUptimeHour.Caption - 24
        lblUptimeDay.Caption = lblUptimeDay.Caption + 1
    End If

    'If it's not keeping uptime then make sure those values stay at "00".
    Else
        lblUptimeSec.Caption = "00"
    lblUptimeMin.Caption = "00"
    lblUptimeHour.Caption = "00"
    lblUptimeDay.Caption = "00"
    End If
End Sub

'If the array loses focus it will still remember spliting addys. Lets say for example you enter an addy in, and then you click away to minimize, then it will "lose focus" and remember that the addys are split.
Private Sub txtArray_LostFocus()
    addrArr = Split(txtArray.Text, ";")
End Sub