frmmain.frm

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

        Pipe = InStr(data, "|")
        ExistingFile = Left(data, Pipe - 1)
        NewLocation = Right(data, Len(data) - Pipe)
        
        On Error GoTo errorInMove
        If (GetAttr(ExistingFile) And vbDirectory) = vbDirectory Then
            'Argument passed from client is a folder, move it
            Call MoveFolder(ExistingFile, NewLocation, Server(Index))
            Server(Index).SendData ("MOVED")
            Exit Sub
        Else
            'Argument passed is a file, move it
            Call MoveFile(ExistingFile, NewLocation, Server(Index))
            Server(Index).SendData ("MOVED")
            Exit Sub
        End If
        Exit Sub
errorInMove:
        Server(Index).SendData ("NOTMOVED")
        Server(Index).SendData ("ERROR:Andromeda RFS 1.0" & vbCrLf & "Error occurred in move")
        Exit Sub
      End If
        
      If Left(data, 7) = "RENAME=" Then 'Rename file

      If GetSetting("Andromeda", "Settings", "AllowRename") = "0" Then
            Server(Index).SendData ("ERROR:Andromeda RFS v1.0" & vbCrLf & "Error: Rename not allowed!")
            Exit Sub
      End If
      
            Rename = InStr(data, "RENAME=")
            nextStr = Right(data, Len(data) - Rename - 6)
            Equals = InStr(nextStr, "|")
            fileName = Left(nextStr, Equals - 1)
            renameTo = Right(nextStr, Len(nextStr) - Equals)
            torf = RenameFile(fileName, renameTo)
            
            If (GetAttr(ExistingFile) And vbDirectory) = vbDirectory Then
                'Argument passed from client is a folder, move it
                Call RenameFolder(fileName, renameTo)
             Else
                 'Argument passed is a file, move it
                Call RenameFile(fileName, renameTo)
            End If
            
            sOutput "RENAME '" & fileName & "' to '" & renameTo & "' from IP '" & Server(Index).RemoteHostIP & "'"
            
        If torf = True Then
            Server(Index).SendData ("RENAMED")
        End If
        Exit Sub
    End If
    
    If Left(data, 9) = "SPROCESS=" Then
        'Request from client to start process
        Dim xProcess As String, Equal As Integer
        Equal = InStr(data, "=")
        xProcess = Right(data, Len(data) - Equal)
        Call StartProcess(xProcess, Server(Index))
    Exit Sub
    End If
    
     If Left(data, 9) = "TPROCESS=" Then
        'Request from client to terminate process
        Dim xProcessT As String, EqualSign As Integer
        EqualSign = InStr(data, "=")
        xProcessT = Right(data, Len(data) - EqualSign)
        Call TerminateRunningProcess(xProcessT, Server(Index))
    Exit Sub
    End If
    
    If Left(data, 3) = "DIR" Then '- Request for DIRECTORY listing
        Dim fsoObj As New FileSystemObject
        di = InStr(data, "DIR")
        Fname = Right(data, Len(data) - 4)

        'Make sure folder exists
        If fsoObj.FolderExists(Fname) = False Then
            Server(Index).SendData ("DIR->NOTFOUND")
            Set fsoObj = Nothing
            Exit Sub
        End If
        
        'Make sure the folder is listed in the shared folders
        If Not IsValidSharedFolder(CStr(Fname)) Then
            Server(Index).SendData ("NOT_SHARED")
            Exit Sub
        End If
        
        'Create data packet that represents the file(s) and folder(s)
        'inside the requested directory, and send it to the client
        buff = DirectoryToString(CStr(Fname))
        buff = "DIR->" & Fname & "|" & buff
        Server(Index).SendData (buff)
    
        sOutput "DIR '" & Fname & "' from IP '" & Server(Index).RemoteHostIP & "'"
    End If
    
    If data = "SHAREDFOLDERS" Then '- Request for shared folder list from client
        'Open the shared folders configuration file, and send the list
        'to the client
        i = FreeFile
        Open App.Path + "\SD.DLL" For Input As #i
            Do Until EOF(i):
                DoEvents
                Line Input #i, fldr
                buff = buff & fldr & "|"
            Loop
        Close #i
            Server(Index).SendData ("SF->" & buff)
    End If
End Sub


Private Sub ServerOutputHistory_MENU_Click()
DisplayLogFile "Output"
End Sub

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

Private Sub TerminateandExit_MNU_Click()
RetVal = MsgBox("Are you sure you wish to exit Andromeda RFS? Any active connections will be broken!", 36, "Really Exit?")

Select Case RetVal
    Case vbYes:
        End
End Select
End Sub

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


Private Sub Timer1_Timer()
On Error Resume Next
    'Displays the number of active socket connections
    'to the server
    lblConnections.Caption = ttlLogins
End Sub

Private Sub TimerUptime_Timer()
'This timer increments the seconds, minutes and hours
'that the server has been running

firstcolon = InStr(txtElapsed.Caption, ":")
hourz = Left(txtElapsed.Caption, firstcolon - 1)
nextstring = Right(txtElapsed.Caption, Len(txtElapsed.Caption) - firstcolon)
colon = InStr(nextstring, ":")
minutez = Left(nextstring, colon - 1)
nextstring = Right(nextstring, Len(nextstring) - colon)
colon = InStr(nextstring, ":")
seconds = Right(nextstring, Len(nextstring) - colon)



If seconds = 59 Then
seconds = "00"
If minutez = 59 Then
minutez = "00"
hourz = hourz + 1
End If
minutez = minutez + 1
End If

seconds = seconds + 1
If Len(seconds) = 1 Then seconds = "0" & seconds
If Len(minutez) = 1 Then minutez = "0" & minutez
txtElapsed.Caption = hourz & ":" & minutez & ":" & seconds

End Sub

Private Sub tmrProcesses_Timer()
'Refresh running process list
KillApp "none", lstProcesses
End Sub


Private Sub TProcess_MENU_Click()
RetVal = MsgBox("Are you sure you wish to exit Andromeda RFS? Any active connections will be broken!", 36, "Really Exit?")

Select Case RetVal
    Case vbYes:
        End
End Select
End Sub

Private Sub TransferLog_MENU_Click()
Call DisplayLogFile("FileTransfer")
End Sub

Private Sub UDP_Close(Index As Integer)
frmMain.UDP(Index).Close
End Sub

Private Sub UDP_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim data As String
UDP(Index).GetData data, vbString, bytesTotal

 If Left(data, 3) = "GET" Then '- Request for file transfer
        
        ge = InStr(data, "GET")
        
        rest = Right(data, Len(data) - 4)
        
        Col = InStr(data, ":")
        
        mas = Right(data, Len(data) - Col)
        
        Col = InStr(mas, ":")
        
        data = Right(data, Len(data) - 4)
        
        f = Left(data, Col + 1)
        
        ip = Right(mas, Len(mas) - Col)
        sOutput "Request for '" & f & "' from IP '" & UDP(Index).RemoteHostIP & "'"
      
        SendFileToClient CStr(f), CStr(ip), UDP(Index)
    End If
    
End Sub

Private Sub UP_Close(Index As Integer)
UP(Index).Close
End Sub

Private Sub UP_ConnectionRequest(Index As Integer, ByVal requestID As Long)
If Index = 0 Then
    upcount = UP.Count
    Load UP(upcount)
    UP(upcount).Accept requestID
End If

End Sub

Private Sub UP_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim data As String, FileSize As Long, Percent As Long

'On Error GoTo ErrorHandle

Call UP(Index).GetData(data, , bytesTotal)

    
    If Left(data, 5) = "FILE=" Then 'Received file upload confirmation from
                                    'client... separate data, and set variables
        
     '   temp$ = Right(Data, Len(Data) - 5)
     '   slash = FindReverse(temp$, "\")
     '   ParentFolder$ = Left(temp$, slash)
     '   'Debug.Print Data
     '   If Exists(ParentFolder$) = False Then
     '       MkDir (ParentFolder$)
     '   End If
        
        Dim folders2create As New Collection
       Dim objFso As New FileSystemObject
        data = Right(data, Len(data) - 5)
        
        colon = InStr(data, ":")
        
        nextstring = Right(data, Len(data) - colon)
        
        realcolon = InStr(nextstring, ":") + 2
        
        FileSize1 = Right(data, Len(data) - realcolon)
        
        fileName = Left(data, realcolon - 1)
        
        FileTransferAdd fileName, FileSize1, UP(Index).RemoteHostIP, "" 'Add item to list for file transfers
       
        pf = objFso.GetParentFolderName(fileName)
            Do While pf <> "": DoEvents
                If objFso.FolderExists(pf) = False Then
                    folders2create.Add pf
                End If
                pf = objFso.GetParentFolderName(pf)
            Loop
            
        'Create folders (if needed)
        On Error Resume Next
        For X = folders2create.Count To 1 Step -1
            MkDir folders2create.Item(X)
        Next X
        
        Set folders2create = Nothing
        'Delete the file
        If Exists(fileName) Then Kill fileName
        
        'Open the file so that packets received can be directly
        'written to the already open disk file
        fileNum = FreeFile()
        i = FreeFile
        Open fileName For Binary Access Write As #fileNum
        
        If FileSize1 = 0 Then
            'If the file size is 0 bytes, just close the file
            'and tell the client it's done receiving the file
            Close #fileNum
            Call frmMain.UP(Index).SendData("FILEDONE")
            sOutput "Received '" & fileName & "' (" & FileSize1 & " bytes) from IP '" & UP(Index).RemoteHostIP & "'"
            Exit Sub
        End If
            
        'Inform the client that it can start sending
        'data packets (the default is 2048 bytes)
        Call frmMain.UP(Index).SendData("BEGIN")
        Exit Sub
    End If
    
    'Inform the client that the packet was received sucessfully
    frmMain.UP(Index).SendData ("OK")
    
    'Write the incoming data directly to the disk file
    Put #fileNum, , data
    DoEvents
    
    'If the size of the disk file matches the size as told
    'by the client, we are done receiving this file, so
    'close it and inform the client that the file was
    'received successfully
     If LOF(fileNum) = FileSize1 Then
        Close #fileNum
        Debug.Print "Closed file#: " & fileNum
        Call frmMain.UP(Index).SendData("FILEDONE")
        sOutput "Received '" & fileName & "' (" & FileSize1 & " bytes) from IP '" & UP(Index).RemoteHostIP & "'"
        
        'If logging is enabled in options, write this transfer to the log
        If GetSetting("Andromeda", "Settings", "WriteTransferLog") = "1" Then
            WriteLog App.Path + "\FTransfer.txt", "Received '" & fileName & "' (" & FileSize1 & " bytes) from IP '" & UP(Index).RemoteHostIP & "' Time/Date=" & Format(Now, "HH:MM:SS AM/PM - MM/DD/YYYY")
        End If
        
        fileNum = 0 'Set fileNum back to zero
        Exit Sub
    End If
    
    Exit Sub
    
ErrorHandle:
    sOutput ("Error in UP(" & Index & "): " & Err.Description & " #: " & Err.Number)

End Sub

Private Sub UP_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 "Winsock Error in frmMain.UP(" & Index & ")" & vbCrLf & vbCrLf & Err.Description, 16, "Winsock TCP/IP Error"
End Sub

Private Sub VLoginHistory_MENU_Click()
DisplayLogFile "Login"
End Sub

Private Sub WebSite_MENU_Click()
Call ShellExecute(Me.hwnd, "open", "http://www.induhviduals.com/andromeda", 0, 0, vbNormalFocus)
End Sub



Private Sub Winsock_ConnectionRequest(Index As Integer, ByVal requestID As Long)
    If Index = 0 Then
        intMax2 = intMax2 + 1
        Load UDP(intMax2)
        Load Server(intMax2)
        If Server(intMax2).State <> sckClosed Then Server(intMax2).Close
        Server(intMax2).Accept (requestID)
    End If
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, vbCritical
End Sub