Boneman Project

bonemanproject.txt

Dim SessionState(127) As Integer
Dim y(127) As String
Dim h As Integer
Private Sub about_Click(Index As Integer)

    frmAbout.Show

End Sub

Private Sub Clearlog_Click(Index As Integer)

    TxtLog.Text = ""

End Sub

Public Sub CmdSend_Click()
Dim x As Integer

    If Txtsend.Text <> "" Then
    txtchat = txtchat.Text & vbCrLf & "ADMIN: " & Txtsend.Text
    
    For spooze = 0 To Privatewinsock.UBound
            On Error Resume Next
            While x < 5
            
                Privatewinsock(spooze).SendData 22 & "," & "ADMIN: " & Txtsend.Text
                x = x + 1
            Wend
            
           Txtsend.Text = ""
           Txtsend.SetFocus
           
           
        Next spooze
    End If
    
End Sub

Private Sub Form_Load()
Dim i As Integer
h = 1
    For i = LBound(SessionState) To UBound(SessionState)
        SessionState(i) = 0
    Next i

    
    frmLog.Visible = True
    frmUsers.Visible = False
    frmBans.Visible = False
    frmMOtD.Visible = False
    FrmChat.Visible = False
    FrmSharedFiles.Visible = False
    PublicWinsock.LocalPort = 8888
    PublicWinsock.Listen
    addlog ("Server Started. Listing on IP- " & _
            PublicWinsock.LocalIP & " Port:" & _
            PublicWinsock.LocalPort)
End Sub

Private Sub Printlog_Click(Index As Integer)

CommonDialog1.ShowPrinter

End Sub

Private Sub Privatewinsock_Close(Index As Integer)
Dim i As Integer
Dim k As Integer

    addlog "User " & ListView1.ListItems(Index).Text & " has logged off"
    ListView1.ListItems.Remove (Index)
    Unload Privatewinsock(Index)
    For k = 0 To ListView3.ListItems.Count
    On Error Resume Next
        If Right(ListView3.ListItems(k - 1).Text, 1) = Index Then
            ListView3.ListItems.Remove (k - 1)
        End If
    Next k
    If ListView1.ListItems.Count = 0 Then
        ListView1.ListItems.Clear
    End If
    
    
End Sub

Private Sub Privatewinsock_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim z() As String, filenames() As String
Dim filesearch As String, files As String
Dim x As String, l As ListItem
Dim i As Integer, k As Integer
Dim h As Integer, c As Integer
Dim numbersent As Integer
Dim spooze As Integer


    Privatewinsock(Index).GetData x, vbString
    z = Split(x, ",", 99)
    Select Case z(0)

    Case 1
        Set l = ListView1.ListItems.Add(ListView1.ListItems.Count + 1, z(1) & " " & Index, z(1), "usr", "usr")
            l.SubItems(1) = Format(z(2))
            l.SubItems(2) = Format(z(3))
        l.SubItems(3) = Format(z(4))
        l.SubItems(4) = Format(z(5))
        Privatewinsock(Index).SendData 2 & "," & ListView3.ListItems.Count
    Case 3
        filenames = Split(z(2), "/", 99)
        c = ListView3.ListItems.Count
        
        For i = ListView3.ListItems.Count To (z(1) + ListView3.ListItems.Count - 1)
            If c <= i Then
                Set l = ListView3.ListItems.Add(i - c + 1, filenames(i - c) & "/" & _
                Index, i & " " & filenames(i - c) & Index, "file", "file")
                    l.SubItems(1) = Privatewinsock(Index).Index
                    
            ElseIf i < c Then
                Set l = ListView3.ListItems.Add(c - i + 1, filenames(c - i) & "/" & _
                Index, i & " " & filenames(i) & ListView3.ListItems.Item(i) & Index, "file", "file")
                l.SubItems(1) = Privatewinsock(Index).Index
            End If
        Next i
    Case 5
    
        txtfilestosend.Text = ""
        filesearch = z(1)
        For i = 1 To ListView3.ListItems.Count
        
            If InStr(1, ListView3.ListItems(i).Text, filesearch, vbBinaryCompare) _
            <> 0 Then
            
                Form1.txtfilestosend.Text = txtfilestosend.Text & _
                ListView3.ListItems(i).Text & "`" _
                & Privatewinsock(Right(ListView3.ListItems(i).Key, 1)).RemoteHostIP _
                & "|"
                numbersent = numbersent + 1
                
                
                
            End If
        Next i
        Privatewinsock(Index).SendData 7 & "," & numbersent & "," & txtfilestosend.Text & "|"
        
    Case 25
        txtchat = txtchat & z(1) & vbCrLf
        For spooze = 0 To Privatewinsock.UBound
            On Error Resume Next
                Privatewinsock(spooze).SendData 22 & "," & z(1)
           
        Next spooze
    
    Case 666
        Privatewinsock(i).Close
        Unload Privatewinsock(i)
        
    End Select
    

End Sub


Private Sub PublicWinsock_ConnectionRequest(ByVal requestID As Long)
Dim Found As Boolean
Dim i As Integer
Dim s As String
Dim x As String

    Found = False
    i = Privatewinsock.LBound
    Privatewinsock(0).Connect loaclhost, 1
    Do While Not Found
        If Privatewinsock(i).State = sckClosed Then
            Found = True
        ElseIf i < Privatewinsock.UBound Then
            i = i + 1
        Else
            i = i + 1
            Load Privatewinsock(i)
            Found = True
        End If
    Loop
    Privatewinsock(i).LocalPort = 0
    Privatewinsock(i).Accept requestID
    addlog ("Connection Request from " & _
    PublicWinsock.RemoteHost & " (" & _
    PublicWinsock.RemoteHostIP & ") Session Number - " & _
    FormatNumber(i, 0))
    Privatewinsock(i).SendData 0 & "," & "Connection Accepted"
    Privatewinsock(0).Close
  
End Sub
Private Sub Savelog_Click(Index As Integer)

    If Dir("c:\bonemanProject\Server\log.txt") = "" Then
        MkDir ("C:\BonemanProject\Server\")
    End If
    Open "c:\bonemanProject\Server\log.txt" For Append As 1
    Write #1, TxtLog.Text
    Close #1

End Sub
Private Sub stopserver_Click(Index As Integer)

    Unload Me
    End
    
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Index
    
    Case 1
        frmLog.Visible = True
        frmUsers.Visible = False
        frmBans.Visible = False
        frmMOtD.Visible = False
        FrmSharedFiles.Visible = False
        FrmChat.Visible = False
    Case 2
        frmLog.Visible = False
        frmUsers.Visible = True
        frmBans.Visible = False
        frmMOtD.Visible = False
        FrmSharedFiles.Visible = False
        FrmChat.Visible = False
    Case 3
        frmLog.Visible = False
        frmUsers.Visible = False
        frmBans.Visible = True
        frmMOtD.Visible = False
        FrmSharedFiles.Visible = False
        FrmChat.Visible = False
    Case 4
        frmLog.Visible = False
        frmUsers.Visible = False
        frmBans.Visible = False
        frmMOtD.Visible = True
        FrmSharedFiles.Visible = False
        FrmChat.Visible = False
    Case 5
        frmLog.Visible = False
        frmUsers.Visible = False
        frmBans.Visible = False
        frmMOtD.Visible = False
        FrmSharedFiles.Visible = True
        FrmChat.Visible = False
    Case 6
        frmLog.Visible = False
        frmUsers.Visible = False
        frmBans.Visible = False
        frmMOtD.Visible = False
        FrmSharedFiles.Visible = False
        FrmChat.Visible = True
    End Select

End Sub
Private Sub addlog(s As String)

    TxtLog.Text = TxtLog.Text & FormatDateTime(Now, vbLongTime) & " " & s & vbCrLf


End Sub

Private Sub Txtsend_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    Call Form1.CmdSend_Click
    End If
End Sub


_______________SERVER_________________

Option Explicit

Private Sub Command1_Click()
FrmMain.DownLoad1.DownLoad

End Sub

Private Sub CmdAddServer_Click()
FrmInputServer.Show

End Sub

Private Sub CmdChatSend_Click()
    Dim chatwinsock As Integer
    On Error Resume Next
        chatwinsock = Left(LstChat.SelectedItem.Text, 1)
            Winsock(chatwinsock).SendData 25 & "," & TxtNick.Text & ": " & TxtChat.Text & vbCrLf
            
        TxtChat.Text = ""
    
    
End Sub

Private Sub CmdRemoveServer_Click()

    LstServers.ListItems.Remove (LstServers.SelectedItem.Index)
    
End Sub

Private Sub CmdSaveServers_Click()
Dim r As Integer

    If Dir("c:\bonemanproject\servers.dat") = "" Then
        MkDir ("c:\bonemanProject\")
    End If
        Open ("c:\bonemanProject\servers.dat") For Output As #1
        For r = 1 To LstServers.ListItems.Count
            Write #1, LstServers.ListItems(r).Text
            Write #1, LstServers.ListItems(r).ListSubItems(1).Text
        Next r
        Close #1
End Sub


Private Sub DownLoad1_DLError(lpErrorDescription As String)
MsgBox "error" & " " & lpErrorDescription

End Sub

Private Sub Form_Load()
FrmMain.Hide
frmSplash.Show

Dim l As ListItem
Dim r As String
Dim s As String
Dim t As String
Dim n As String

    If Dir("c:\bonemanProject\servers.dat") <> "" Then
    Else
        MkDir ("c:\bonemanProject\")
        Open ("c:\bonemanProject\servers.dat") For Output As #1
        Close #1
    End If
    
    FrmMain.frmservers.Visible = True
    FrmMain.frmchat.Visible = False
    FrmMain.FrmSearch.Visible = False
    FrmMain.frmShared.Visible = False
    FrmMain.FrmTransfers.Visible = False
    Combo1.AddItem "unknown"
    Combo1.AddItem "14.4 kbps"
    Combo1.AddItem "28.8 kpbs"
    Combo1.AddItem "33.6 kbps"
    Combo1.AddItem "56.7 kbps"
    Combo1.AddItem "64K ISDN"
    Combo1.AddItem "128K ISDN"
    Combo1.AddItem "Cable"
    Combo1.AddItem "DSL"
    Combo1.AddItem "T1"
    Combo1.AddItem "T3 or greater"


    If Dir("c:\bonemanproject\servers.dat") = "" Then
        Open "c:\bonemanproject\servers.dat" For Output As 1
        Close #1
    End If
    Open "c:\bonemanproject\servers.dat" For Input As 1
    Do While Not EOF(1)
        Input #1, r
        Input #1, s
        Set l = FrmMain.LstServers.ListItems.Add(, r, r, "file", "file")
        l.SubItems(1) = Format(s)
    Loop
    Close #1
    
    If Dir("c:\bonemanproject\name.dat") = "" Then
    Open "c:\bonemanproject\name.dat" For Output As 1
    Write #1, "User Name"
    Write #1, "E-Mail Address"
    Close #1
    End If
    
    Open "c:\bonemanproject\name.dat" For Input As 1
    Input #1, t
    TxtNick.Text = t
    Input #1, n
    txtemail.Text = n
    Close #1
    
    
    Dim x As String

    If Dir("C:\bonemanproject\shared.dat") <> "" Then
        Open "C:\bonemanproject\shared.dat" For Input As 1
        Input #1, x
        Dir1.Path = x
        Close #1
End If

File1.Path = Dir1.Path

End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim i As Integer

Open "C:\bonemanproject\shared.dat" For Output As 1
    Write #1, Dir1.Path
    Close #1
Open "c:\bonemanproject\name.dat" For Output As 1
    Write #1, TxtNick.Text
    Write #1, txtemail.Text
    Close #1
    
End
End Sub

Private Sub Inet1_StateChanged(ByVal State As Integer)

End Sub



Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Dim i As Integer

    Select Case Button.Index
    Case 1
        FrmMain.frmservers.Visible = True
        FrmMain.frmchat.Visible = False
        FrmMain.FrmSearch.Visible = False
        FrmMain.frmShared.Visible = False
        FrmMain.FrmTransfers.Visible = False
        '-------------------------------------
    Case 2
        FrmMain.frmservers.Visible = False
        FrmMain.frmchat.Visible = False
        FrmMain.FrmSearch.Visible = False
        FrmMain.frmShared.Visible = True
        FrmMain.FrmTransfers.Visible = False
        '-------------------------------------
    Case 3
        FrmMain.frmservers.Visible = False
        FrmMain.frmchat.Visible = True
        FrmMain.FrmSearch.Visible = False
        FrmMain.frmShared.Visible = False
        FrmMain.FrmTransfers.Visible = False
        '-------------------------------------
    Case 4
        FrmMain.frmservers.Visible = False
        FrmMain.frmchat.Visible = False
        FrmMain.FrmSearch.Visible = True
        FrmMain.frmShared.Visible = False
        FrmMain.FrmTransfers.Visible = False
        '-------------------------------------
    Case 5
        FrmMain.frmservers.Visible = False
        FrmMain.frmchat.Visible = False
        FrmMain.FrmSearch.Visible = False
        FrmMain.frmShared.Visible = False
        FrmMain.FrmTransfers.Visible = True
        '-------------------------------------
    Case 6
        '-------------------------------------
    Case 7
        frmAbout.Show
        '------------------------------------
    Case 8
        Unload Me
        For i = 0 To Winsock.UBound
            On Error Resume Next
            Winsock(i).SendData 666
        Next i
        End
    End Select
End Sub

Private Sub TxtChat_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then
    Call CmdChatSend_Click
    
    End If
End Sub

Private Sub WebBrowser1_StatusTextChange(ByVal Text As String)

End Sub

Private Sub Winsock_Close(Index As Integer)
Dim i As Integer
Dim j As Integer

    Winsock(Index).Close
    Unload Winsock(Index)
    LstServers.ListItems(Index).ForeColor = vbRed
    For i = 0 To LstChat.ListItems.Count
    On Error Resume Next
        If Right(LstChat.ListItems(i).Key, 2) = Index Then
        LstChat.ListItems.Remove (i)
    End If
    Next i
    
End Sub


Private Sub Winsock_Connect(Index As Integer)
Dim l As ListItem

    LstServers.ListItems(Index).ForeColor = vbGreen
    Set l = LstChat.ListItems.Add(, Index & " " & Winsock(Index).RemoteHost, Index & Winsock(Index).RemoteHost, "file", "file")
Beep

End Sub

Private Sub Winsock_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim x As String
Dim Y() As String
Dim i As Integer
Dim g As Integer
Dim i2 As Integer
Dim filegot() As String
Dim filefromip() As String
Dim l As ListView

    g = 0
    Winsock(Index).GetData x, vbString
    Y = Split(x, ",")

    Select Case Y(0)
    Case 0
        Winsock(Index).SendData (1 & "," & _
        TxtNick.Text & "," & _
        txtemail.Text & "," & _
        Combo1.Text & "," & _
        File1.ListCount & "," & "thebonemanproject" & App.Major & "." & App.Minor & "." & App.Revision)
    
    Case 2
        If File1.ListCount <> -1 Then
            File1.ListIndex = 0
            txtfilenames.Text = 3 & "," & File1.ListCount & ","
            For i2 = 0 To File1.ListCount - 1
                File1.ListIndex = i2
                    If File1.FileName <> "" Then
                        txtfilenames.Text = txtfilenames.Text & File1.Path & "\" & File1.FileName & "/"
                    End If
            Next i2
            Winsock(Index).SendData txtfilenames.Text
        End If
    Case 7
        filegot = Split(Y(2), "|", 99)
        For i = 1 To Y(1) - 1
       
            filefromip = Split(filegot(i), "`", 99)
            Set l = ListView1.ListItems.Add(, i & Right(filefromip(i), 25) & filefromip(i), filefromip(i - 1), 1, 1)
                
            l.ListItems(i).SubItems(1) = filefromip(i)
            i = i + 1
        Next i
    Case 22
        lblchat = lblchat & vbCrLf & Y(1)
    
    Case 74
        MsgBox "Connection Has been terminated by host", vbCritical, "Connection Terminated"
        
        
        
        
        
        
        
End Select
End Sub

Private Sub Winsock_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)
    
    MsgBox Description, vbExclamation, "Error"
    If Winsock(Index).State <> sckConnected Then
        Winsock(Index).Close
    End If
    Unload Winsock(Index)
    
End Sub
Private Sub lstservers_DblClick()
Dim i As Integer

    i = LstServers.SelectedItem.Index
    Load FrmMain.Winsock(i)
    FrmMain.Winsock(i).Close
    While FrmMain.Winsock(i).State <> sckClosed
        DoEvents
    Wend
    FrmMain.Winsock(i).RemoteHost = LstServers.SelectedItem.Text
    FrmMain.Winsock(i).RemotePort = Val(LstServers.SelectedItem.SubItems(1))
    FrmMain.Winsock(i).LocalPort = 666
    FrmMain.Winsock(i).Connect
     

End Sub

'   This is the form that holds the shared folders Filelist Box. The bonemanProject _
    shares .zip files (because this is what many video game ROMs are stored in.
    
Private Sub CmdSelectfolders_Click()
    
End Sub
Private Sub Dir1_Click()
    File1.Path = Dir1.Path
End Sub

Private Sub Drive1_Change()
    Dir1.Path = Drive1.Drive
    File1.Path = Dir1.Path
End Sub


Private Sub Timer1_Timer()

    File1.Path = Dir1.Path

End Sub



Private Sub CmdSearch_Click()
Dim x As Integer

    For x = 0 To Winsock.UBound
       On Error Resume Next
       
        If Winsock(x).State = sckConnected Then
            FrmMain.Winsock(x).SendData 5 & "," & txtsearch.Text
        End If
    Next x
    
End Sub