If you love to make your life miserable with complex VB6 source and inline ASM, you are in the right place!

Anyone said Multithreaded Apps?

Im not working on this anymore so, here it goes, its a multi-thread module, no ocx, dlls, timers or anything like that just API and black magic. Its 100% stable when compiled. Tested on W7. Im not taking full credit for this, I did coded it but is entirely based on a source that ntaryl gave me a week ago (I guess is from vbgood, but no author name was included)

OK,  the author is izero from slovakia.  =D

Download

Categories: Code

Calling Pointers in VB6

Option Explicit

Private Type SUBROUTINE
    lNull           As Long '// Must be 0
    lPtr            As Long
End Type

Private Declare Function GoSubReturn Lib "MSVBVM60" Alias "__vbaGosubReturn" (ByRef lpSubRoutine As Long) As Long

'---------------------------------------------------------------------------------------
' Procedure : GoToPtr
' Author    : Karcrack
' Date      : 08/05/2010
' Purpose   : GoTo a pointer
' Warning   : It's not a JMP, is a GoTo, so the execution of the program won't continue
'           where you made the GoTo...
'---------------------------------------------------------------------------------------
'
Public Sub GoToPtr(ByVal lPtr As Long)
    Dim tSubRoutine As SUBROUTINE

    tSubRoutine.lPtr = lPtr
    Call GoSubReturn(VarPtr(tSubRoutine))
End Sub

Due some problems with Stack you won’t be able to return the place you call this function… So generally you will need to close process in the code pointed by lPtr :)

Example:

Sub Main()
    Call GoToPtr(gP(AddressOf RMain))
End Sub

Function gP(ByVal lPtr As Long) As Long
    gP = lPtr
End Function

Sub RMain()
    MsgBox "Hi!"
    End
End Sub
Categories: Code

[ASM] Shellcode retrieve Kernel32 Base Address

Well, i’ve noticed that cInvoke coded by Cobein isn’t working on Windows 7 because W7 load first NTDLL and then KERNEL32 so when we read Peb->InInitOrder[0]->BaseAddress it isnt’ KERNEL32 base address… it’s NTDLL base address….
So i’ve coded that shellcode that retrieves K32 base address in any W$ NT system…

Code in PasteBin

If you want to use that Shellcode in the RunPe/cInvoke/… you just need to replace the const called THUNK_KERNELBASE with these ASM Opcodes:

8B4C2408565531C0648B70308B760C8B761C8B6E088B7E208B3638471875F3803F6B7407803F4B7402EBE789295D5EC3

Categories: Code

Accessing MSVBVM60 API [TUT]

Im reposting this here cause Ive been asked many times for this document.

This is a small tuto Ive made to explain a basic way to add some APIs and constants to your VB.
Hope you understand the basic concept and find this at least funny if not useful.
Have Funk!

Accessing MSVBVM60 API

Categories: Code

Remote process Environment Variables

A simple module to read Environment Variables from a remote process. Tested on XP and 7.

'---------------------------------------------------------------------------------------
' Module      : mRemoteGetEnviron
' DateTime    : 23/02/2010 21:29
' Author      : Cobein
' Mail        : cobein27@hotmail.com
' WebPage     : http://www.advancevb.com.ar
' Purpose     : Read remote process environment variables.
' 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.
'
' Reference   : http://www.codeproject.com/KB/threads/ReadProcEnv.aspx
'
' History     : 23/02/2010 First Cut....................................................
'---------------------------------------------------------------------------------------
Option Explicit

Private Const PROCESS_QUERY_INFORMATION As Long = &H400
Private Const PROCESS_VM_READ           As Long = 16&

Public Type PROCESS_BASIC_INFORMATION
    ExitStatus                      As Long
    PEBBaseAddress                  As Long
    AffinityMask                    As Long
    BasePriority                    As Long
    UniqueProcessId                 As Long
    InheritedFromUniqueProcessId    As Long
End Type

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function NtQueryInformationProcess Lib "ntdll.dll" (ByVal ProcessHandle As Long, ByVal ProcessInformationClass As Long, ByVal ProcessInformation As Long, ByVal ProcessInformationLength As Long, ReturnLength As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32.dll" (ByVal hProcess As Long, ByRef lpBaseAddress As Any, ByRef lpBuffer As Any, ByVal nSize As Long, ByRef lpNumberOfBytesWritten As Long) As Long
Private Declare Function RtlAdjustPrivilege Lib "ntdll" (ByVal Privilege As Long, ByVal bEnablePrivilege As Long, ByVal bCurrentThread As Long, ByRef OldState As Long) As Long

Public Function ReadEnviron(ByVal lPid As Long) As Collection
    Dim lPtr            As Long
    Dim lProc           As Long
    Dim cData           As New Collection

    Set ReadEnviron = cData

    Call RtlAdjustPrivilege(20, 1, 0, 0)

    lPtr = GetPEB(lPid)

    lProc = OpenProcess(PROCESS_VM_READ, 0, lPid)

    If lProc Then

        If Not ReadProcessMemory(lProc, ByVal lPtr + &H10, lPtr, &H4, 0&) = 0 Then 'RTL_USER_PROCESS_PARAMETERS

            If Not ReadProcessMemory(lProc, ByVal lPtr + &H48, lPtr, &H4, 0&) = 0 Then 'environment variables block

                Dim bData As Byte
                Dim sData As String
                Dim lOffset As Long

                Do
                    lOffset = lOffset + 2
                    If bData = 0 Then
                        If Not sData = vbNullString Then cData.Add sData
                        sData = vbNullString
                        Call ReadProcessMemory(lProc, ByVal lPtr + lOffset, bData, &H1, 0&)
                        If bData = 0 Then
                            Exit Do
                        End If
                    Else
                        Call ReadProcessMemory(lProc, ByVal lPtr + lOffset, bData, &H1, 0&)
                    End If
                    sData = sData & Chr$(bData)
                Loop
            End If

        End If

        Call CloseHandle(lProc)

    End If

    Set ReadEnviron = cData

End Function

Private Function GetPEB(ByVal lPid As Long) As Long
    Dim tPBI    As PROCESS_BASIC_INFORMATION
    Dim lRet    As Long
    Dim lProc   As Long

    lProc = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lPid)
    If lProc Then
        If NtQueryInformationProcess(lProc, 0, VarPtr(tPBI), Len(tPBI), lRet) = 0 Then
            GetPEB = tPBI.PEBBaseAddress
        End If
        CloseHandle lProc
    End If

End Function
Categories: Code, NTDLL

Long time without activity

I got three things bouncing in my head to do,  but time is pretty limited, I want to implement a sysenter class,  a module to use activex objects without registration and a cool interface (using one DC to handle everything). Any ideas are welcome, Ill try to go for any of them soon.

Categories: Random

VBCorLib

This is not new but I totally forget about its existence. Go take a look you’ll find tons of great code.

Welcome to the Home of VBCorLib!!

VBCorLib is a set of classes that will make programming VB6 even easier!

This library is written using many of the available sources of information, including the ECMA-335 Specification.
ECMA-335 Specification
MSDN .NET Library
The Unicode Orginazation
UTF-8 Specification
UTF-7 Specification
Base64 Encoding
Hewbrew Calendar Specifics
More Hebrew Calendar Specifics
Hijri (Tabular Islamic) Calendar Specifics

By using the available information many of the classes found in the MS .NET mscorlib.dll have been reproduced in Visual Basic 6. This it NOT an implementation of the CLI runtime, only some of the unitlity classes that are in the mscorlib.dll library file.

There are many classes available to aid in the building of large and complex applications, and more are on the way!

VBCorLib is accompanied with a set of unit tests. Not only do these tests show that VBCorLib is very stable, it also shows how to interact with the numerous classes available.

Website: VBCorLib

Categories: Random

Inline ASM shell using Metasploit Payload

Meh, I was bored playing with Metasploit and decided to dig into the modules (it has some interesting stuff in there) and decided to use one of the payloads (shell_bind_tcp.rb) with VB.

Inline Shell

Some Extra Info:

The code is gonna get frozen waiting the the incoming connection and after execution is gonna end.

You can set the port on the source and then use telnet to interact with the shell (eg: open localhost 666)

Categories: Code

Delete version Info

Simple module to delete version info from a PE file.

'---------------------------------------------------------------------------------------
' Module      : mDelRes
' DateTime    : 16/05/2009 18:53
' Author      : Cobein
' Mail        : cobein27@hotmail.com
' WebPage     : http://www.advancevb.com.ar
' Purpose     : Delete Version Info from a PE file
' 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.
'
' History     : 16/05/2009 First Cut....................................................
'               16/05/2009  Replace PADDING string Added...........................
'---------------------------------------------------------------------------------------
Option Explicit

Private Const RT_VERSION    As Long = 16
Private Const FINDTHIS      As String = "PADDINGXXPADDING"

Private Declare Function BeginUpdateResource Lib "kernel32" Alias "BeginUpdateResourceA" (ByVal pFileName As String, ByVal bDeleteExistingResources As Long) As Long
Private Declare Function EndUpdateResource Lib "kernel32" Alias "EndUpdateResourceA" (ByVal lUpdate As Long, ByVal fDiscard As Long) As Long
Private Declare Function UpdateResource Lib "kernel32" Alias "UpdateResourceA" (ByVal lUpdate As Long, ByVal lpType As Long, ByVal lpName As Long, ByVal wLanguage As Long, lpData As Any, ByVal cbData As Long) As Long
Private Declare Function GetFileVersionInfo Lib "Version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwhandle As Long, ByVal dwlen As Long, lpData As Any) As Long
Private Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
Private Declare Function VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Any, puLen As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, Source As Any, ByVal Length As Long)

Public Function DelVerInfoResource(ByVal sFile As String, Optional bReplacePadd As Boolean = True) As Boolean
    Dim lUpdate     As Long
    Dim lLangId     As Long

    lLangId = GetLangID(sFile)
    If Not lLangId = 0 Then
        lUpdate = BeginUpdateResource(sFile, False)
        If Not lUpdate = 0 Then
            If Not UpdateResource(lUpdate, RT_VERSION, 1, lLangId, 0, 0) = 0 Then
                If EndUpdateResource(lUpdate, False) Then

                    If bReplacePadd Then
                        Dim iFile       As Integer
                        Dim sBuff       As String
                        Dim sReplace    As String

                        sReplace = String$(Len(FINDTHIS), vbNullChar)
                        iFile = FreeFile
                        Open sFile For Binary Access Read Write As iFile
                        sBuff = Space(LOF(iFile))
                        Get iFile, , sBuff
                        sBuff = Replace(sBuff, FINDTHIS, sReplace)
                        Put iFile, 1, sBuff
                        Close iFile
                    End If

                    DelVerInfoResource = True
                    Exit Function
                End If
            End If
            Call EndUpdateResource(lUpdate, True)
        End If
    End If
End Function

Private Function GetLangID(ByVal sFile As String) As Long
    Dim lLen        As Long
    Dim lHandle     As Long
    Dim bvBuffer()  As Byte
    Dim lVerPointer As Long
    Dim iVal        As Integer

    lLen = GetFileVersionInfoSize(sFile, lHandle)

    If Not lLen = 0 Then
        ReDim bvBuffer(lLen)
        If Not GetFileVersionInfo(sFile, 0&, lLen, bvBuffer(0)) = 0 Then

            If Not VerQueryValue(bvBuffer(0), _
               "\VarFileInfo\Translation", _
               lVerPointer, _
               lLen) = 0 Then

                CopyMemory iVal, ByVal lVerPointer, 2
                GetLangID = iVal

            End If
        End If
    End If

End Function
Categories: Code, PE

Encode/Decode 7-Bit PDU Format (Fixed)

A simple routine to encode/decode data like PDU format used by cellphones .

Properly tested and fixed, I did run a loop with a pseudo random string gen. to make sure is not doing crazy $hit.

'---------------------------------------------------------------------------------------
' Module      : mEnDec7Bit
' DateTime    : 12/29/2009 16:30
' Author      : Cobein
' Mail        : cobein27@hotmail.com
' WebPage     : http://www.advancevb.com.ar
' Purpose     : Simple routine to encode/decode data in 7-bits like PDU cellphone format.
' 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.
'
' Reference   : http://www.dreamfabric.com
'
' History     : 12/29/2009 First Cut....................................................
'               12/30/2009 Minor cleanup, removed copymem...............................
'               01/06/2010 Totally fixed and tested properly............................
'---------------------------------------------------------------------------------------
Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long

Public Function Encode(ByVal sData As String) As String
    Dim bvData()    As Byte
    Dim i           As Long
    Dim lBits       As Long
    Dim bChar       As Byte

    bvData = StrConv(sData & vbNullChar, vbFromUnicode)

    For i = 0 To UBound(bvData) - 1
        lBits = lBits + 1
        If Not lBits = 8 Then
            Encode = Encode & Right("0" & Hex(ShiftR(ShiftL(bvData(i), 1), lBits) Or _
               ShiftL(bvData(i + 1), 8 - lBits)), 2)
        Else
            lBits = 0
        End If
    Next
End Function

Public Function Decode(ByVal sData As String) As String
    Dim bvData()    As Byte
    Dim i           As Long
    Dim lBits       As Long
    Dim bChar       As Byte

    ReDim bvData((Len(sData) + 0.5) \ 2 - 1)

    For i = 0 To Len(sData) - 1 Step 2
        bvData(i / 2) = CByte("&h" & Mid$(sData, i + 1, 2))
    Next

    For i = 0 To UBound(bvData)
        lBits = lBits + 1
        If lBits = 1 Then
            bChar = bvData(i) And Not &H80
            Decode = Decode & Chr$(bChar)
        Else
            bChar = (ShiftL(bvData(i), lBits - 1) Or _
               ShiftR(bvData(i - 1), 9 - lBits)) And Not &H80
            Decode = Decode & Chr$(bChar)
        End If
        If lBits = 7 Then
            bChar = ShiftR(bvData(i), 1) And Not &H80
            lBits = 0
            Decode = Decode & Chr$(bChar)
        End If
    Next

    Decode = Left$(Decode, lstrlen(Decode))
End Function

Private Function ShiftL(ByVal bVal As Byte, ByVal lNumOfBits As Long) As Byte
    Dim lRet As Long
    lRet = bVal * (2 ^ lNumOfBits)
    'This line can be removed to use the "right" vb command
    CopyMemory ShiftL, lRet, 1
    'ShiftL = "&h" & Right$(Hex(lRet), 2)
End Function

Private Function ShiftR(ByVal bVal As Byte, ByVal lNumOfBits As Long) As Byte
    ShiftR = bVal \ (2 ^ lNumOfBits)
End Function
Categories: Code