[VB6] Loader, shellcode, without runtime...

[xxdoc123]

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsStream"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' // clsStream.cls - binary stream class
' // ?Krivous Anatoly Anatolevich (The trick), 2016

Option Explicit

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Declare Function ReadFile _
                Lib "kernel32" (ByVal hFile As Long, _
                                ByRef lpBuffer As Any, _
                                ByVal nNumberOfBytesToRead As Long, _
                                ByRef lpNumberOfBytesRead As Long, _
                                ByRef lpOverlapped As Any) As Long

Private Declare Function GetFileSizeEx _
                Lib "kernel32" (ByVal hFile As Long, _
                                ByRef lpFileSize As LARGE_INTEGER) As Long

Private Declare Function CreateFile _
                Lib "kernel32" _
                Alias "CreateFileW" (ByVal lpFileName As Long, _
                                     ByVal dwDesiredAccess As Long, _
                                     ByVal dwShareMode As Long, _
                                     ByRef lpSecurityAttributes As Any, _
                                     ByVal dwCreationDisposition As Long, _
                                     ByVal dwFlagsAndAttributes As Long, _
                                     ByVal hTemplateFile As Long) As Long

Private Declare Function WriteFile _
                Lib "kernel32" (ByVal hFile As Long, _
                                ByRef lpBuffer As Any, _
                                ByVal nNumberOfBytesToWrite As Long, _
                                ByRef lpNumberOfBytesWritten As Long, _
                                ByRef lpOverlapped As Any) As Long

Private Declare Sub ZeroMemory _
                Lib "kernel32" _
                Alias "RtlZeroMemory" (ByRef dest As Any, _
                                       ByVal numBytes As Long)

Private Declare Sub CopyMemory _
                Lib "kernel32" _
                Alias "RtlMoveMemory" (ByRef Destination As Any, _
                                       ByRef Source As Any, _
                                       ByVal Length As Long)

Private Declare Function RtlCompressBuffer _
                Lib "ntdll" (ByVal CompressionFormatAndEngine As Integer, _
                             ByRef UncompressedBuffer As Any, _
                             ByVal UncompressedBufferSize As Long, _
                             ByRef CompressedBuffer As Any, _
                             ByVal CompressedBufferSize As Long, _
                             ByVal UncompressedChunkSize As Long, _
                             ByRef FinalCompressedSize As Long, _
                             ByRef WorkSpace As Any) As Long

Private Declare Function IsBadWritePtr _
                Lib "kernel32" (ByRef lp As Any, _
                                ByVal ucb As Long) As Long

Private Declare Function RtlGetCompressionWorkSpaceSize _
                Lib "ntdll" (ByVal CompressionFormatAndEngine As Integer, _
                             ByRef CompressBufferWorkSpaceSize As Long, _
                             ByRef CompressFragmentWorkSpaceSize As Long) As Long

Private Declare Function IsBadReadPtr _
                Lib "kernel32" (ByRef lp As Any, _
                                ByVal ucb As Long) As Long

Private Const GRANULARITY              As Long = &H400  ' // Glanularity of memory allocation

Private Const COMPRESSION_FORMAT_LZNT1 As Long = 2

Private mBuffer()                      As Byte ' // Local buffer

Private mSizeOfBuffer                  As Long ' // Size of buffer

Const MAX_PATH                         As Long = 260

Const RT_RCDATA                        As Long = 10&

Private Const GENERIC_WRITE            As Long = &H40000000

Const INVALID_HANDLE_VALUE             As Long = -1

Private Const GENERIC_READ             As Long = &H80000000

Private Const CREATE_ALWAYS            As Long = 2

Private Const OPEN_EXISTING            As Long = 3

Private Const FILE_SHARE_READ          As Long = &H1

Private Const FILE_ATTRIBUTE_NORMAL    As Long = &H80

Private mSizeOfData                    As Long ' // Size of data

Private Type LARGE_INTEGER

    lowpart                     As Long
    highpart                    As Long

End Type

Private mCurIndex As Long ' // Current pointer

Private Declare Function GetProcessHeap Lib "kernel32" () As Long

Private Declare Function HeapAlloc _
                Lib "kernel32" (ByVal hHeap As Long, _
                                ByVal dwFlags As Long, _
                                ByVal dwBytes As Long) As Long

Private Declare Function HeapReAlloc _
                Lib "kernel32" (ByVal hHeap As Long, _
                                ByVal dwFlags As Long, _
                                lpMem As Any, _
                                ByVal dwBytes As Long) As Long

Private Declare Function RtlDecompressBuffer _
        Lib "ntdll.dll" (ByVal CompressionFormat As Integer, _
                         ByVal ptrDestBuffer As Any, _
                         ByVal DestBufferSize As Long, _
                         ByVal ptrSrceBuffer As Any, _
                         ByVal SceBufferSize As Long, _
                         ByRef pDestinationSize As Long) As Long
Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long

' // Size of data
Public Property Get Size() As Long
    Size = mSizeOfData

End Property

' // Current pointer
Public Property Get BufferPointer() As Long
    BufferPointer = mCurIndex

End Property

Public Property Let BufferPointer(ByVal Value As Long)

    If Value < 0 Then
        Err.Raise 5
        Exit Property

    End If

    mCurIndex = Value
    
End Property

' // Compress stream
Public Sub CompressStream()

    Dim szWorkSpace  As Long

    Dim WorkSpace()  As Byte

    Dim output()     As Byte

    Dim outputSize   As Long

    Dim returnedSize As Long
        
    If mSizeOfData = 0 Then
        Err.Raise 7

    End If
    
    If RtlGetCompressionWorkSpaceSize(COMPRESSION_FORMAT_LZNT1, szWorkSpace, 0) Then
        Err.Raise 7

    End If
    
    outputSize = mSizeOfData * 2
    ReDim WorkSpace(szWorkSpace - 1)
    ReDim output(outputSize - 1)
    
    If RtlCompressBuffer(COMPRESSION_FORMAT_LZNT1, mBuffer(0), mSizeOfData, output(0), outputSize, 4096, returnedSize, WorkSpace(0)) Then
        Err.Raise 7

    End If
    
    ReDim mBuffer(returnedSize - 1)
    
    CopyMemory mBuffer(0), output(0), returnedSize
    
    mSizeOfData = returnedSize
    
End Sub