Work at SourceForge, help us to make it a better place! We have an immediate need for a Support Technician in our San Francisco or Denver office.

Close

[r1]: xs / tracker / Form1.frm Maximize Restore History

Download this file

Form1.frm    371 lines (336 with data), 11.7 kB

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "ieframe.dll"
Begin VB.Form Form1 
   Caption         =   "..:.:: XST r2.4 ::.:.."
   ClientHeight    =   4140
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6165
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   4140
   ScaleWidth      =   6165
   StartUpPosition =   3  'Windows Default
   Begin VB.Frame Frame1 
      Caption         =   "XS-Tracker"
      Height          =   915
      Left            =   60
      TabIndex        =   0
      Top             =   0
      Width           =   6015
      Begin VB.CommandButton Command2 
         Caption         =   "Force Website Update"
         Height          =   315
         Left            =   1260
         TabIndex        =   9
         Top             =   540
         Width           =   2175
      End
      Begin VB.CommandButton Command1 
         Caption         =   "Activate Tracker"
         Height          =   315
         Left            =   1260
         TabIndex        =   7
         Top             =   180
         Width           =   2175
      End
      Begin VB.TextBox Text3 
         Alignment       =   1  'Right Justify
         Height          =   285
         Left            =   120
         TabIndex        =   4
         Text            =   "43234"
         Top             =   480
         Width           =   1035
      End
      Begin VB.Label Label5 
         Alignment       =   1  'Right Justify
         BorderStyle     =   1  'Fixed Single
         Caption         =   "0"
         Height          =   255
         Left            =   5040
         TabIndex        =   6
         Top             =   540
         Width           =   855
      End
      Begin VB.Label Label4 
         Alignment       =   1  'Right Justify
         BorderStyle     =   1  'Fixed Single
         Caption         =   "0"
         Height          =   255
         Left            =   5040
         TabIndex        =   5
         Top             =   240
         Width           =   855
      End
      Begin VB.Label Label3 
         Caption         =   "Listen on Port:"
         Height          =   255
         Left            =   120
         TabIndex        =   3
         Top             =   240
         Width           =   1095
      End
      Begin VB.Label Label2 
         Caption         =   "XS Client Requests:"
         Height          =   255
         Left            =   3540
         TabIndex        =   2
         Top             =   540
         Width           =   1515
      End
      Begin VB.Label Label1 
         Caption         =   "XS Hubs Listed:"
         Height          =   255
         Left            =   3540
         TabIndex        =   1
         Top             =   240
         Width           =   1635
      End
   End
   Begin SHDocVwCtl.WebBrowser WebBrowser1 
      Height          =   3135
      Left            =   60
      TabIndex        =   8
      Top             =   960
      Width           =   6015
      ExtentX         =   10610
      ExtentY         =   5530
      ViewMode        =   0
      Offline         =   0
      Silent          =   0
      RegisterAsBrowser=   0
      RegisterAsDropTarget=   1
      AutoArrange     =   0   'False
      NoClientEdge    =   0   'False
      AlignLeft       =   0   'False
      NoWebView       =   0   'False
      HideFileNames   =   0   'False
      SingleClick     =   0   'False
      SingleSelection =   0   'False
      NoFolders       =   0   'False
      Transparent     =   0   'False
      ViewID          =   "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
      Location        =   "http:///"
   End
   Begin MSWinsockLib.Winsock Winsock2 
      Index           =   9
      Left            =   1800
      Top             =   1020
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock Winsock2 
      Index           =   8
      Left            =   1380
      Top             =   1020
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock Winsock2 
      Index           =   7
      Left            =   960
      Top             =   1020
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock Winsock2 
      Index           =   6
      Left            =   540
      Top             =   1020
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock Winsock2 
      Index           =   5
      Left            =   120
      Top             =   1020
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock Winsock2 
      Index           =   4
      Left            =   1800
      Top             =   600
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock Winsock2 
      Index           =   3
      Left            =   1380
      Top             =   600
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock Winsock2 
      Index           =   2
      Left            =   960
      Top             =   600
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock Winsock2 
      Index           =   1
      Left            =   540
      Top             =   600
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock Winsock1 
      Left            =   120
      Top             =   120
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock Winsock2 
      Index           =   0
      Left            =   120
      Top             =   600
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Timer Timer1 
      Interval        =   60000
      Left            =   540
      Top             =   120
   End
   Begin XST.ShellIcon ShellIcon1 
      Left            =   2160
      Top             =   120
      _ExtentX        =   847
      _ExtentY        =   847
      Icon            =   "Form1.frx":08CA
      Visible         =   -1  'True
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Winsock1.LocalPort = Val(Text3)
Winsock1.Bind
Winsock1.Listen
Command1.Enabled = False
Text3.BackColor = &H8000000F
Text3.Enabled = False
Form1.WindowState = 1
End Sub

Private Sub Command2_Click()
hubliststring$ = ""

For z = 0 To 1000
If hubaddress$(z) = "" Then Exit For
hubliststring$ = hubliststring$ & hubname$(z) & "Ź" & hubaddress$(z) & ","
Next z

WebBrowser1.Navigate "(SITE NO LONGER EXISTS!!!)"

End Sub

Private Sub Form_Resize()
If Form1.WindowState = 0 Then Form1.Move Form1.Left, Form1.Top, 6285, 4545
If Form1.WindowState = 1 Then Form1.Hide
End Sub

Private Sub ShellIcon1_Click(Button As Integer)
'Restore from system tray
    If Button = 1 Then WindowState = 0: Show: AppActivate Caption, wait
End Sub


Private Sub Timer1_Timer()
minutecount = minutecount + 1
min20cyc = min20cyc + 1

If min20cyc = 21 Then

hubliststring$ = ""

For z = 0 To 1000
If hubaddress$(z) = "" Then Exit For
hubliststring$ = hubliststring$ & hubname$(z) & "Ź" & hubaddress$(z) & ","
Next z

min20cyc = 0
WebBrowser1.Navigate "http://www.simplyclick.org/uploadertest/x.asp?cmd=update&hublist=" & hubliststring$

End If

For z = 0 To 1000
If hubaddress$(z) = "" Then Exit For
If hubminutecount(z) < minutecount - 6 Then cliphub z: z = z - 1
Next z
End Sub

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
X = 99
For k = 0 To 9
If Winsock2(k).State > 7 Then Winsock2(k).Close: X = k: Exit For
If Winsock2(k).State = 0 Then X = k: Exit For
Next k

If X < 99 Then commsbuffer$(X) = "": Winsock2(X).Accept requestID
If X = 99 Then MsgBox "Ran out of sockets for connections!!!"
End Sub


Private Sub Winsock2_DataArrival(index As Integer, ByVal bytesTotal As Long)
'dump the data into buffers
On Error Resume Next
Winsock2(index).GetData tempdata$
commsbuffer$(index) = commsbuffer$(index) & tempdata$
ipnum$ = Winsock2(index).RemoteHostIP
DoEvents

'Handshake bullshit
If Left$(commsbuffer$(index), 4) = "XSHI" Then
    On Error GoTo shutitdown
    Winsock2(index).SendData "XSLO"
    On Error GoTo 0
    If commsbuffer$(index) = "XSHI" Then commsbuffer$(index) = "" Else commsbuffer$(index) = Right$(commsbuffer$(index), Len(commsbuffer$(index)) - 4)
    End If


'Check for tracker entry submission from hubs
If Left$(commsbuffer$(index), 2) = Chr(10) & Chr(0) Then
    portnum = 256 * Asc(Mid(commsbuffer$(index), 3, 1))
    portnum = portnum + Asc(Mid(commsbuffer$(index), 4, 1))
    maxuser = 256 * Asc(Mid(commsbuffer$(index), 5, 1))
    maxuser = maxuser + Asc(Mid(commsbuffer$(index), 6, 1))
    curuser = 256 * Asc(Mid(commsbuffer$(index), 7, 1))
    curuser = curuser + Asc(Mid(commsbuffer$(index), 8, 1))
    namlen = Asc(Mid(commsbuffer$(index), 9, 1))
            
    If Len(commsbuffer$(index)) < 10 + namelen Then Exit Sub
    
    nam$ = Mid(commsbuffer$(index), 10, namlen)
    deslen = Asc(Mid(commsbuffer$(index), 10 + namlen, 1))
            
    If Len(commsbuffer$(index)) < 11 + namelen + deslen Then Exit Sub
    
    des$ = Mid(commsbuffer$(index), 11 + namlen, deslen)
    
    xxr = namlen + deslen
    On Error Resume Next
    dynamicnamelength = 0
    dynamicnamelength = Asc(Mid(commsbuffer$(index), 12 + namlen + deslen, 1))
    
    'dynamic name or not?
    If dynamicnamelength > 0 Then
        If Len(commsbuffer$(index)) < 12 + namelen + deslen Then Exit Sub
        ipnum$ = Mid(commsbuffer$(index), 12 + namlen + deslen, dynamicnamelength)
    End If

    
    addhub ipnum$ & ":" & portnum, Val(curuser), Val(maxuser), nam$, des$
    DoEvents
    Winsock2(index).Close
    DoEvents
    End If


'Check for hublist request, if it is, return it!!
If Left$(commsbuffer$(index), 2) = Chr(20) & Chr(0) Then
    Label5 = Val(Label5) + 1
    hlx$ = Right$("00000000" & Hex$(Len(hublist$)), 8)
    hublistlen$ = Chr$(Val("&H" & Mid$(hlx, 1, 2))) & Chr$(Val("&H" & Mid$(hlx, 3, 2))) & Chr$(Val("&H" & Mid$(hlx, 5, 2))) & Chr$(Val("&H" & Mid$(hlx, 7, 2)))
    On Error GoTo shutitdown
    Winsock2(index).SendData Chr(20) & Chr(1) & hublistlen$ & hublist$
    On Error GoTo 0
    If commsbuffer$(index) = Chr(20) & Chr(0) Then commsbuffer$(index) = "" Else commsbuffer$(index) = Right$(commsbuffer$(index), Len(commsbuffer$(index)) - 2)
End If

'Check if goodbye sent!!
If Left$(commsbuffer$(index), 2) = Chr(30) & Chr(0) Then
    Winsock2(index).Close: DoEvents
    commsbuffer$(index) = ""
End If
Exit Sub

shutitdown:
    Winsock2(index).Close: DoEvents
    commsbuffer$(index) = ""
End Sub