frmmain.frm

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

Private Sub About_MENU_Click()
frmAbout.Show , Me
End Sub

Private Sub ccommands_MENU_Click()
frmSharedFolders.Show
End Sub

Private Sub CNewUser_MENU_Click()
frmCreateUser.Show
End Sub

Private Sub Config_MENU_Click()
frmOptions.Show vbModal, Me
End Sub

Private Sub CreateNewUser_MENU_Click()
frmCreateUser.Show vbModal, Me
End Sub

Private Sub Disable_MENU_Click()
If sEnabled = False Then MsgBox "Server already stopped.", 16, "Error": Exit Sub
Call EnableServer(False)
End Sub

Private Sub Enable_MENU_Click()
If sEnabled = True Then MsgBox "Server already started.", 16, "Error": Exit Sub
Call EnableServer(True)
End Sub

Private Sub FileTransferHistory_MENU_Click()
DisplayLogFile "FileTransfer"
End Sub

Private Sub Form_Load()

If GetSetting("Andromeda", "Settings", "FirstRun") = "" Then
    'This is the first time the program has been run
    'Save default settings to registry, and inform user
    'that they must specify directories and users before
    'using the server
    SaveSetting "Andromeda", "Settings", "SplashScreen", "1"
    SaveSetting "Andromeda", "Settings", "MinimizeToTray", "0"
    SaveSetting "Andromeda", "Settings", "WriteLog", "1"
    SaveSetting "Andromeda", "Settings", "WriteTransferLog", "1"
    SaveSetting "Andromeda", "Settings", "AllowDelete", "0"
    SaveSetting "Andromeda", "Settings", "AllowMove", "1"
    SaveSetting "Andromeda", "Settings", "AllowRename", "1"
    SaveSetting "Andromeda", "Settings", "StartWithWindows", "0"
    SaveSetting "Andromeda", "Settings", "FirstRun", "1"
    SaveSetting "Andromeda", "Settings", "AllowProcessToggle", "1"
    MsgBox "Welcome to Andromeda RFS v1.0!" & vbCrLf & vbCrLf & "Since this is the first time you have started the server, you must specify shared directories by clicking on the Tools menu, and choosing 'Manage Shared Directories'. This will display the shared folder window. Add the folders you wish to share with Andromeda clients. You will also need to create user accounts for anyone that wishes to connect to your computer. You can do this by clicking on the Users menu, and choosing 'Create New User'." & vbCrLf & vbCrLf & "Thanks for trying Andromeda RFS!" & vbCrLf & "Ryan and Andrew Lederman", 64, "IMPORTANT NOTE"
End If

    If FileLen(App.Path + "\sd.dll") = 0 Then
        RetVal = MsgBox("You do not have any shared directories! Andromeda clients will not be able to access your files. It is suggested that you add some shared directories now. Would you like to add some shared directories?", 36, "No Shared Directories")
        Select Case RetVal
            Case vbYes
                frmSharedFolders.Show , Me
        End Select
    End If
    
    'Initialize the command accepting winsock on port 6969
    Server(0).LocalPort = 6969
    Server(0).Listen
    
    UP(0).LocalPort = 6971
    UP(0).Listen
   
    intMax2 = 0
    Me.Caption = AppName() & "(Enabled)"
    lblServerRunning.Caption = Server(0).LocalIP
    sEnabled = True
    
    With nid
        .cbSize = Len(nid)
        .hwnd = Me.hwnd
        .uId = vbNull
        .szTip = "Andromeda RFS 1.0" & vbNullChar
        .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
        .uCallBackMessage = WM_MOUSEMOVE
        .hIcon = Image1.Picture
    End With
    
    Shell_NotifyIcon NIM_ADD, nid
    
    KillApp "none", lstProcesses 'Initialize list of processes
End Sub



Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 'On Error Resume Next
    'This procedure receives the callbacks from the System Tray icon.
    '
    Dim Result As Long
    Dim msg As Long
    'The value of X will vary depending upon the scalemode setting


    If Me.ScaleMode = vbPixels Then
        msg = X
    Else
        msg = X / Screen.TwipsPerPixelX
    End If

    Select Case msg
        Case 517  '517 display popup menu

            Me.PopupMenu MNU
      
        Case 514
        Result = SetForegroundWindow(Me.hwnd)
        Me.WindowState = vbNormal
        Me.Show
    End Select

End Sub

Private Sub Form_Resize()
    On Error Resume Next
    If Me.WindowState = 1 Then
    If GetSetting("Andromeda", "Settings", "MinimizeToTray", "0") = "1" Then
        Me.Hide
    End If
    End If
    
    lstOutput.Width = Me.Width - 320
    lstTransfer.Width = Me.Width - 320
    frameTop.Width = Me.Width + 300
      FrameStatus.Top = Me.Height - FrameStatus.Height - 760
    Frame1.Width = Me.Width - 320
    lstOutput.Height = Me.Height / 2 - 1350
    Frame1.Top = lstOutput.Top + lstOutput.Height + 120
    lblTransfer.Top = Frame1.Top + 80
  
    lstTransfer.Top = lblTransfer.Top + lblTransfer.Height + 20
    lstTransfer.Height = FrameStatus.Top - lstTransfer.Top - 20
    lstConnections.ColumnHeaders(4).Width = lstConnections.Width - lstConnections.ColumnHeaders(1).Width - lstConnections.ColumnHeaders(2).Width - lstConnections.ColumnHeaders(3).Width - 95
    lstOutput.ColumnHeaders(1).Width = lstOutput.Width - 2000
    lstOutput.ColumnHeaders(2).Width = lstOutput.Width - lstOutput.ColumnHeaders(1).Width - 90
    
End Sub


Private Sub lstConnections_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    lstConnections.SortKey = ColumnHeader.Index - 1
    lstConnections.Sorted = True
End Sub


Private Sub Form_Terminate()
Shell_NotifyIcon NIM_DELETE, nid
End Sub

Private Sub Form_Unload(Cancel As Integer)
Cancel = True
Me.Hide
End Sub

Private Sub LoginHistory_MENU_Click()
Call DisplayLogFile("Login")
End Sub

Private Sub ManageDirs_MENU_Click()
frmSharedFolders.Show vbModal, Me
End Sub

Private Sub ManageUsers_MENU_Click()
frmManageUsers.Show , Me
End Sub

Private Sub MUsers_MENU_Click()
frmManageUsers.Show , Me
End Sub

Private Sub Server_Close(Index As Integer)
    If Index = 0 Then GoTo skip
    If ttlLogins = 0 Then GoTo skip
    ttlLogins = ttlLogins - 1
    Server(Index).Close
skip:
    
End Sub

Private Sub Server_ConnectionRequest(Index As Integer, ByVal requestID As Long)

    'If Server(Index).State <> sckClosed Then Server(Index).Close
    'Server(Index).Accept (requestID)
    If Index = 0 Then
        dcount = Server.Count + 1
        Load Server(dcount)
        Server(dcount).Accept requestID
        Server(dcount).SendData ("LOGIN")
    End If
    

   
End Sub

Private Sub Server_DataArrival(Index As Integer, ByVal bytesTotal As Long)
    
    Dim data As String, fileName As String, renameTo As String
    Call Server(Index).GetData(data, vbString, bytesTotal)

    
    If Left(data, 6) = "LOGIN=" Then
        'Client sent login information
        colon = InStr(data, ":")
        If colon = 0 Then
            frmMain.Server(Index).SendData ("INVALID_LOGIN")
        Exit Sub
        End If
        temp = Right(data, Len(data) - ln - 6)
        colon = InStr(temp, ":")
        
        'Intialize username and password variables
        Login = Left(temp, colon - 1)
        Password = Right(temp, Len(temp) - colon)
    
    'Check for existence of %Login%.alf in the application directory
    If Exists(App.Path + "\" + Login + ".alf") = True Then
     
        'Read encrypted password from user's configuration file
        If Password = ReadEncryptedINI("Andromeda", "PW", App.Path + "\" + Login + ".alf") Then
            'Login accepted, send welcome
            Call Server(Index).SendData("WELCOME")
            
            'Increment active socket connections count
            ttlLogins = ttlLogins + 1
            
            'Write the login time to the users configuration file
            'to use for last login time/date reference
            Call WriteEncryptedINI("Andromeda", "LastLogin", Format(Now, "MM/DD/YY - HH:MM:SS AM/PM"), App.Path + "\" + Login + ".alf")
            
            'If logging is enabled in options, write the login event
            'to log
            If GetSetting("Andromeda", "Settings", "WriteLog") = "1" Then
                WriteLog App.Path + "\Log.txt", "User '" & Login & "' logged in from IP '" & Server(Index).RemoteHostIP & "' Time/Date: '" & Format(Now, "mm/dd/yy - HH:MM:SS AM/PM")
            End If
                
            sOutput "User '" & Login & "' logged in from IP '" & Server(Index).RemoteHostIP & "'"
       Else
            'Password did not match, inform client
            Call Server(Index).SendData("INVALID_PASSWORD")
            sOutput "Invalid Password for '" & Login & "' : (" & Password & ") from IP '" & Server(Index).RemoteHostIP & "'"
            Login = "": Password = ""
            Exit Sub
        End If
    Else
        'Login name was not found
        Call Server(Index).SendData("INVALID_LOGIN")
        Call Server(Index).SendData(InvalidMessage)
        sOutput "Invalid Login received: '" & Login & "' from IP '" & Server(Index).RemoteHostIP & "'"
        Login = "": Password = ""
        Exit Sub
    End If
        Login = "": Password = ""
    Exit Sub
    End If
    
   
    
    If data = "BEGIN" Then
        'Client has informed server to start sending the data
        StartSending = True
    Exit Sub
    End If
    
    If data = "FILEUPPORT" Then
        'Client has asked for a port to upload a file
        'Find an open data port, inform the client that it should
        'send the data to that port, then create a new socket and
        'attach it to that port
        Dim Piz As Long
            Piz = FindPort
            intMax2 = intMax2 + 1
            Load frmMain.UP(intMax2)
            frmMain.UP(intMax2).LocalPort = Piz
            frmMain.UP(intMax2).Listen
             Do While frmMain.UP(intMax2).State <> 2: DoEvents
            Loop
            frmMain.Server(Index).SendData ("FILEUPPORT=" & Piz)
    Exit Sub
    End If
    
    If data = "FILEPORT" Then
        'Request for open file transfer port
        Dim Piz2 As Long
        Piz2 = FindPort
        frmMain.UDP(Index).LocalPort = Piz2
        frmMain.UDP(Index).Listen
        Do While frmMain.UDP(Index).State <> 2: DoEvents
        Loop
        frmMain.Server(Index).SendData ("FILEPORT=" & Piz2)
    End If
    
     If Left(data, 17) = "GET_DIR_CONTENTS=" Then
        'Request for folder contents to download
        'all files and subdirectories inside a folder
        Dim Col1 As New Collection
        Equals2 = InStr(data, "=")
        whichFolder2$ = Right(data, Len(data) - Equals2)
        Call SendDirectoryContents(whichFolder2$, Col1)
        If Col1.Count = 0 Then
            'Some error must have occurred
            Server(Index).SendData ("ERROR:An error occurred while trying to get the contents of that directory.")
            Exit Sub
        End If
        
        For X2 = 1 To Col1.Count
            temp = temp + Col1(X2) + "|"
        Next X2
       
        Server(Index).SendData ("DIR_CONTENTS->" & temp)
    
        sOutput "Contents of '" & whichFolder2$ & "' sent to IP '" & Server(Index).RemoteHostIP & "'"
        
        Exit Sub
      End If
      
    If Left(data, 12) = "GETPROCESSES" Then
        'Request from client for list of processes
        Call SendProcessesToClient(Server(Index))
        Exit Sub
    End If
    
    If Left(data, 14) = "BEGIN_DOWNLOAD" Then
        'Create new file sending winsock
        newudp = UDP.Count
        Load UDP(newudp)
        UDP(newudp).Close
        Call UDP(newudp).Connect(Server(Index).RemoteHostIP, 109)
        Exit Sub
    End If
    
   
    
        
        
      If Left(data, 7) = "DELETE=" Then
        'Request from client to delete a file
        'check if deletion is allowed in options
        If GetSetting("Andromeda", "Settings", "AllowDelete") = "0" Then
            Server(Index).SendData ("ERROR:Andromeda RFS v1.0" & vbCrLf & "Error: Deletion not allowed!")
            Exit Sub
        End If
            
        'Call DeleteFiles() to delete the potentially large list of files
        Dim dFiles As String, dSuccess As Boolean
        dFiles = Right(data, Len(data) - InStr(data, "DELETE=") - 6)
        
        dSuccess = DeleteFiles(dFiles, Server(Index).RemoteHostIP)
      
        If dSuccess Then
            'Inform client that the file(s) were deleted
            Server(Index).SendData ("DELETED")
        End If
        Exit Sub
      End If
      
      If Left(data, 10) = "NEWFOLDER=" Then
        'Request for creation of new directory
        'Call CreateFolder()
        Dim xFolder As String, EqualIndex As Integer
        EqualIndex = InStr(data, "=")
        xFolder = Right(data, Len(data) - EqualIndex)
        Call CreateFolder(xFolder, Server(Index))
        Exit Sub
      End If
      
      If Left(data, 5) = "MOVE=" Then
        'Request to move a directory or file(s)
      If GetSetting("Andromeda", "Settings", "AllowMove") = "0" Then
            Server(Index).SendData ("ERROR:Andromeda RFS v1.0" & vbCrLf & "Error: Moving not allowed!")
            Exit Sub
      End If
        
        Dim Equals As Integer, Pipe As Integer, ExistingFile As String, NewLocation As String
        Equals = InStr(data, "=")
        data = Right(data, Len(data) - Equals)