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
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
[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…
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
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!
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
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.
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 SpecificsBy 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
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.
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)
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
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

Recent Comments