[原创]发段Hive格式解析的VB代码
信息来源：邪恶八进制信息安全团队（[url]www.eviloctal.com[/url]）文章作者：炉子
[language=vb]
Attribute VB_Name = "mHiveControl"
'By 炉子[0GiNr]
'http://hi.baidu.com/breakinglove_
'http://0ginr.com
Option Explicit
Public Declare Function RegRestoreKey Lib "advapi32.dll" Alias "RegRestoreKeyA" ( _
ByVal hKey As Long, _
ByVal lpFile As String, _
ByVal dwFlags As RegRestoreFlags) As Long
Public Declare Function RegSaveKeyEx Lib "advapi32.dll" Alias "RegSaveKeyExA" ( _
ByVal hKey As Long, _
ByVal lpFile As String, _
ByVal lpSecurityAttributes As Long, _
ByVal dwFlags As RegSaveExFlags) As Long
Public Enum RegKeys
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_USER = &H80000001
HKEY_LOCAL_MACHINE = &H80000002
HKEY_USERS = &H80000003
HKEY_CURRENT_CONFIG = &H80000005
End Enum
Public Enum RegRestoreFlags
REG_FORCE_RESTORE = &H8
REG_WHOLE_HIVE_VOLATILE = &H1
End Enum
Public Enum RegSaveExFlags
REG_STANDARD_FORMAT = &H1
REG_LATEST_FORMAT = &H2
REG_NO_COMPRESSION = &H4
End Enum
Public Type LARGE_INTEGER
LowPart As Long
HighPart As Long
End Type
Public Type RegfBlock
dwSignature As Long '字符串 - "regf" = 0x66676572
dwUnknown1 As Long '未知
dwUnknown2 As Long '总是为 0x00000004
liLastEdit As LARGE_INTEGER 'NT 时间格式
dwNumber1 As Long '恒为1
dwNumber2 As Long '恒为3
dwNumber3 As Long '恒为0
dwNumber4 As Long '恒为1 - 或许这个1301是版本1.3.0.1?
dwOffsetOfFirstKeyRecord As Long '第一个键纪录的偏移
dwBlockSize As Long '数据块大小(文件大小-4kb)
dwNumber5 As Long '恒为1
bytUnknownData(1 To &H1CC) As Byte '无需分析
dwSum As Long '从 0x00000000 至 0x000001FB 的所有DWORD的数据总和
End Type
Public Type UnkownDataAfterRegfBlock '紧随 RegfBlock 之后
bytReserved(1 To &HE00) As Byte '未知
End Type
Public Type HBinHeader
dwSignature As Long '字符串 - "hbin" = 0x6E696268
dwOffsetFromFirstHBinRecord As Long '第一个 Hbin 记录的偏移
dwOffsetFromNextHBinRecord As Long '下一个 Hbin 记录的偏移
dwUnknownData(1 To &H10) As Byte
dwBlockSize As Long 'Hbin 记录长度
End Type
Public Type HBinData '如果这个段是一个负值(第 31 位被置1)，则这个块是空的，并且长度被置为负的块大小
dwDataBlockSize As Long
szData() As Byte '长度取决于 dwDataBlockSize
End Type
Public Type NkRecord 'NameKey
wSignature As Integer '字符串 - "nk" = 0x6B6E
wKeyType As Integer '根键为 0x2C，否则为0x20
liLastEdit As LARGE_INTEGER 'NT 时间格式
bytUnknowData(1 To &H4) As Byte
dwOffsetOfParentKey As Long '父键的偏移
dwSubKeyNumber As Long '子键数目
bytUnknowData2(1 To &H4) As Byte
dwOffsetOfSubKeyLfRecords As Long '子键的 Lf 记录的偏移
bytUnknowData3(1 To &H4) As Byte
dwValuesNumber As Long '项的数目
dwOffsetOfValueList As Long 'NkRecordValueList 的偏移
dwOffsetOfSkRecord As Long 'Sk 记录的偏移
dwOffsetOfClassName As Long '类名的偏移(???)
bytUnused(1 To &H10) As Byte
dwUnused As Long '无用数据
wNameLength As Integer '项名长度
wClassNameLength As Integer '类名的长度(???)
szKeyName(1 To 1) As Byte '长度取决于 dwNameLength
End Type
Public Type NkRecordValueList
dwValueOffset(1) As Long '数组数量取决于 dwValuesNumber
End Type
Public Type VkRecord 'ValueKey
wSignature As Integer '字符串 - "vk" = 0x6B76
wNameLength As Integer '项名长度
dwDataLength As Long '数据长度 - 如果 dwDataLength <=4 那么这个值的数据就是该项的数据 (DWORD)；如果为 0 那么这个项无数据
dwDataOffset As Long '数据偏移
dwValueType As Long '数据类别 - 数据类别见 DataTypes
wFlags As Integer '如果第 0 位被置1，那么这条数据是有名称的，否则意味着这条数据是无名称的（“默认”）
wUnused As Integer '无用数据
szName(1 To 1) As Byte
End Type
Public Enum DataTypes
REG_SZ = &H1 '字符串 UNICODE
REG_EXPEND_SZ = &H2 '可展开的字符串(使用环境变量，例如 "%SystemRoot%\system32") UNICODE
REG_BINARY = &H3 '二进制数据
REG_DWORD = &H4 'DWORD
REG_MULTI_SZ = &H7 '多个字符串，使用 vbNullChar 分隔 UNICODE
REG_UNKNOWN = &HFFFFFFFF
End Enum
Public Type HashRecord 'Lf 记录的哈希记录
dwRecordOffset As Long '所属的 Lf 记录的偏移
szKeyName(1 To 4) As Byte '键名的前4字节 如果修改了键名，这个也需要修改
End Type
Public Type LfRecord
wSignature As Integer '字符串 - "lf" = 0x666C
wKeyNumber As Integer '键的数目
dwHashRecord(1 To 1) As HashRecord
End Type
Public Type SkRecord 'SecurityKey
wSignature As Integer '字符串 - "sk" = 0x6B73
wUnused As Integer
dwPreviousSkRecordOffset As Long '前一个Sk记录的偏移
dwNextSkRecordOffset As Long '后一个Sk记录的偏移
dwUsageCounter As Long '使用计数 (???)
dwRecordSize As Long 'Sk记录的字节数
'剩余部分为权限设置数据
End Type
Public Declare Function SafeCopyMemory _
Lib "NTDLL.DLL" Alias "ZwWriteVirtualMemory" _
(ByVal ProcessHandle As Long, _
ByVal pDest As Long, _
ByVal pSrc As Long, _
ByVal NumberOfBytesToCopy As Long, _
ByRef NumberOfBytesCopied As Long) As Long
Public Const ZwGetCurrentProcess As Long = -1 '//0xFFFFFFFF
Dim m_pHive As Long
Dim m_RegfBlock As RegfBlock, m_HBinHeader As HBinHeader, m_RootNkRecord As NkRecord
Dim m_RaisedErr As Boolean
Dim m_pRootNk As Long
Private Const GlobalOffset As Long = &H1004
Private Const RegDefault As String = "(Default)"
Public Sub dbg()
Dim a As NkRecord
Debug.Print Hex(LenB(a))
End Sub
'hHive should be the base of the hive file in memory
Public Function PreProcessHive(ByVal hHive As Long) As Boolean
Dim st As Long
Dim hBase As Long
Dim unKnownData As UnkownDataAfterRegfBlock
'save hive pointer
m_pHive = hHive
hBase = hHive
'read regf block
st = CopyMemory(VarPtr(m_RegfBlock), hBase, LenB(m_RegfBlock))
If (Not st) Then GoTo InitFaild_
'read hbin header
hBase = hBase + LenB(m_RegfBlock) + LenB(unKnownData)
st = CopyMemory(VarPtr(m_HBinHeader), hBase, LenB(m_HBinHeader))
If (Not st) Then GoTo InitFaild_
'read root nk header
Dim HbData As HBinData
st = CopyMemory(VarPtr(HbData), hBase + LenB(m_HBinHeader), LenB(HbData))
If (Not st) Then GoTo InitFaild_
hBase = hBase + GetHBinSize(HbData)
st = CopyMemory(VarPtr(m_RootNkRecord), hBase, LenB(m_RootNkRecord))
m_pRootNk = hBase
If (Not st) Then GoTo InitFaild_
'return
PreProcessHive = True
Exit Function
InitFaild_:
PreProcessHive = False
End Function
'这两段是测试用的。
Public Sub NOP()
NOP1 (m_pRootNk)
DoEvents
End Sub
Public Sub NOP1(ByVal lpNk As Long)
'MsgBox GetKeyNameByPointer(m_pRootNk)
Dim szReturn As String
Dim I As Long, J As Long
Dim nks() As Long
Dim lfs() As Long
lfs = GetSubKeyListNkPointers(lpNk)
For I = LBound(lfs) To UBound(lfs)
Dim vks() As Long
vks = GetValueListVkPointers(lfs(I))
szReturn = szReturn & "KeyName:" & GetKeyNameByPointer(lfs(I)) & vbCrLf
If (Not m_RaisedErr) Then
For J = LBound(vks) To UBound(vks)
If (vks(J)) = 0 Then Exit For
Dim dt As DataTypes
dt = GetValueTypeByPointer(vks(J))
Dim ret() As Byte
ret = GetValueDataByPointer(vks(J), dt)
If dt = REG_DWORD Then
Dim K As Long
Call CopyMemory(VarPtr(K), VarPtr(ret(1)), 4)
szReturn = szReturn & vbTab & GetValueNameByPointer(vks(J)) & vbTab & K & vbCrLf
ElseIf dt = REG_SZ Then
Dim szValue As String: szValue = ret
szReturn = szReturn & vbTab & GetValueNameByPointer(vks(J)) & vbTab & szValue & vbCrLf
Else
szReturn = szReturn & vbTab & GetValueNameByPointer(vks(J)) & vbTab & "(Unsupportted value type = " & dt & ")" & vbCrLf
End If
DoEvents
Next
Else
ClearError
End If
Next
DoEvents
WriteFile App.Path & "\Output.txt", StrConv(szReturn, vbFromUnicode)
End Sub
'get the size of the HBIN block
Private Function GetHBinSize(ByRef pHBinInfo As HBinData) As Long
Dim HBHdrInfo As HBinHeader
If (pHBinInfo.dwDataBlockSize And &H80000000) Then
'the 31bit of 0x80000000 is 1, others are 0
GetHBinSize = LenB(HBHdrInfo) + LenB(pHBinInfo.dwDataBlockSize)
Exit Function
Else
GetHBinSize = LenB(HBHdrInfo) + LenB(pHBinInfo.dwDataBlockSize) + pHBinInfo.dwDataBlockSize
End If
End Function
'get key name from NK record
Public Function GetKeyNameByPointer(ByVal pNkRecord As Long) As String
Dim retByt() As Byte
Dim szRetKeyName As String
Dim Offset As Long
Dim NkRec As NkRecord
Dim st As Boolean
ReDim pVkRec(1 To 1)
st = CopyMemory(VarPtr(NkRec), pNkRecord, LenB(NkRec))
If (Not st) Then GoTo ExitFunc_
With NkRec
If (.wNameLength = 0) Then GoTo ExitFunc_
ReDim retByt(.wNameLength)
Offset = VarPtr(.szKeyName(1)) - VarPtr(NkRec) + pNkRecord ' - m_pHive
st = CopyMemory(VarPtr(retByt(LBound(retByt))), Offset, .wNameLength)
If (Not st) Then GoTo ExitFunc_
szRetKeyName = StrConv(retByt, vbUnicode)
If (InStr(szRetKeyName, vbNullChar)) Then szRetKeyName = Left(szRetKeyName, InStr(szRetKeyName, vbNullChar) - 1)
End With
FinishFunc_:
Erase retByt
GetKeyNameByPointer = szRetKeyName
Exit Function
ExitFunc_:
m_RaisedErr = True
'Resume FinishFunc_
End Function
'get key name from NK record
Public Function GetValueNameByPointer(ByVal pVkRecord As Long) As String
Dim retByt() As Byte
Dim szRetName As String
Dim Offset As Long
Dim VkRec As VkRecord
Dim st As Boolean
ReDim pVkRec(1 To 1)
st = CopyMemory(VarPtr(VkRec), pVkRecord, LenB(VkRec))
If (Not st) Then GoTo ExitFunc_
With VkRec
If (.wNameLength = 0) Then szRetName = RegDefault: GoTo FinishFunc_
ReDim retByt(.wNameLength)
Offset = VarPtr(.szName(1)) - VarPtr(VkRec) + pVkRecord ' - m_pHive
st = CopyMemory(VarPtr(retByt(LBound(retByt))), Offset, .wNameLength)
If (Not st) Then GoTo ExitFunc_
szRetName = StrConv(retByt, vbUnicode)
If (InStr(szRetName, vbNullChar)) Then szRetName = Left(szRetName, InStr(szRetName, vbNullChar) - 1)
End With
FinishFunc_:
Erase retByt
GetValueNameByPointer = szRetName
Exit Function
ExitFunc_:
m_RaisedErr = True
'Resume FinishFunc_
End Function
'get value list, pNkRecord should be the NK record to list, return val is a array pointer to VK record
Public Function GetValueListVkPointers(ByVal pNkRecord As Long) As Long()
Dim pVkRec() As Long
Dim NkRec As NkRecord
Dim dwNumber As Long
Dim lOffset As Long
Dim st As Boolean
ReDim pVkRec(1 To 1)
st = CopyMemory(VarPtr(NkRec), pNkRecord, LenB(NkRec))
If (Not st) Then GoTo ExitFunc_
With NkRec
dwNumber = .dwValuesNumber
If (dwNumber = 0) Then GoTo ExitFunc_
ReDim pVkRec(1 To dwNumber)
st = CopyMemory(VarPtr(lOffset), VarPtr(.dwOffsetOfValueList) - VarPtr(NkRec) + pNkRecord, LenB(lOffset))
If (Not st) Then GoTo ExitFunc_
lOffset = lOffset + m_pHive + GlobalOffset
st = CopyMemory(VarPtr(pVkRec(LBound(pVkRec))), lOffset, dwNumber * LenB(pVkRec(LBound(pVkRec))))
If (Not st) Then GoTo ExitFunc_
End With
'add offset to them :)
Dim I As Long
For I = LBound(pVkRec) To UBound(pVkRec)
pVkRec(I) = pVkRec(I) + GlobalOffset + m_pHive
Next
FinishFunc_:
GetValueListVkPointers = pVkRec
Exit Function
ExitFunc_:
m_RaisedErr = True
'Resume FinishFunc_
End Function
'get sub-key list, pNkRecord should be the NK record to list, return val is a array pointer to HASH record
Public Function GetSubKeyListNkPointers(ByVal pNkRecord As Long) As Long()
Dim pNkRec() As Long
Dim NkRec As NkRecord
Dim LfRec As LfRecord
Dim HashRec() As HashRecord
Dim st As Boolean
ReDim pNkRec(1 To 1)
st = CopyMemory(VarPtr(NkRec), pNkRecord, LenB(NkRec))
If (Not st) Then GoTo ExitFunc_
With NkRec
Dim dwNumber As Long
Dim dwPosi As Long
dwNumber = .dwSubKeyNumber
If (dwNumber = 0) Then GoTo ExitFunc_
ReDim HashRec(1 To dwNumber)
st = CopyMemory(VarPtr(dwPosi), VarPtr(.dwOffsetOfSubKeyLfRecords) - VarPtr(NkRec) + pNkRecord, LenB(dwPosi))
If (Not st) Then GoTo ExitFunc_
dwPosi = dwPosi + GlobalOffset + m_pHive
st = CopyMemory(VarPtr(LfRec), dwPosi, LenB(LfRec))
If (Not st) Then GoTo ExitFunc_
dwPosi = dwPosi + VarPtr(LfRec.dwHashRecord(1)) - VarPtr(LfRec)
st = CopyMemory(VarPtr(HashRec(LBound(HashRec))), dwPosi, dwNumber * LenB(HashRec(LBound(HashRec))))
If (Not st) Then GoTo ExitFunc_
End With
'calc NK record address
Dim I As Long
ReDim pNkRec(1 To dwNumber)
For I = LBound(pNkRec) To UBound(pNkRec)
pNkRec(I) = HashRec(I).dwRecordOffset + GlobalOffset + m_pHive
Next
FinishFunc_:
GetSubKeyListNkPointers = pNkRec
Exit Function
ExitFunc_:
m_RaisedErr = True
'Resume FinishFunc_
End Function
'get NK record pointer by HASH record
Public Function GetKeyNkRecordPointer(ByVal pHashRecord As Long) As Long
Dim ret As Long
Dim HashRec As HashRecord
Dim st As Boolean
st = CopyMemory(VarPtr(HashRec), pHashRecord, LenB(HashRec))
If (Not st) Then GoTo ExitFunc_
With HashRec
ret = .dwRecordOffset + GlobalOffset + m_pHive
End With
FinishFunc_:
GetKeyNkRecordPointer = ret
Exit Function
ExitFunc_:
m_RaisedErr = True
'Resume FinishFunc_
End Function
'get key value by VK record
Public Function GetValueDataByPointer(ByVal pVkRecord As Long, ByVal dwValueType As DataTypes) As Byte()
Dim ret() As Byte
Dim VkRec As VkRecord
Dim lOffset As Long
Dim st As Boolean
ReDim ret(1 To 1)
st = CopyMemory(VarPtr(VkRec), pVkRecord, LenB(VkRec))
If (Not st) Then ReDim ret(1 To 1): GoTo ExitFunc_
With VkRec
lOffset = .dwDataOffset + GlobalOffset + m_pHive
Select Case dwValueType
Case REG_DWORD
ReDim ret(1 To LenB(.dwDataOffset))
st = CopyMemory(VarPtr(ret(LBound(ret))), VarPtr(.dwDataOffset), UBound(ret) - LBound(ret) + 1)
Case REG_SZ
If (.dwDataOffset = 0) Then GoTo ExitFunc_
ReDim ret(1 To .dwDataLength)
st = CopyMemory(VarPtr(ret(LBound(ret))), lOffset, UBound(ret) - LBound(ret) + 1)
Case Else
'unsupportted.
If (.dwDataOffset = 0) Then GoTo ExitFunc_
ReDim ret(1 To .dwDataLength)
st = CopyMemory(VarPtr(ret(LBound(ret))), lOffset, UBound(ret) - LBound(ret) + 1)
End Select
'If (.dwDataOffset < 5) Then GoTo ExitFunc_
'lOffset = .dwDataOffset + GlobalOffset + m_pHive
'ReDim ret(1 To .dwDataLength)
'st = CopyMemory(VarPtr(ret(LBound(ret))), lOffset, .dwDataLength)
'If (Not st) Then ReDim ret(1 To 1): GoTo ExitFunc_
End With
FinishFunc_:
GetValueDataByPointer = ret
Exit Function
ExitFunc_:
m_RaisedErr = True
'Resume FinishFunc_
End Function
'get key value by VK record
Public Function GetValueTypeByPointer(ByVal pVkRecord As Long) As DataTypes
Dim VkRec As VkRecord
Dim st As Boolean
Dim ret As DataTypes
ret = REG_UNKNOWN
st = CopyMemory(VarPtr(VkRec), pVkRecord, LenB(VkRec))
If (Not st) Then GoTo ExitFunc_
With VkRec
ret = .dwValueType
End With
FinishFunc_:
GetValueTypeByPointer = ret
Exit Function
ExitFunc_:
m_RaisedErr = True
'Resume FinishFunc_
End Function
Public Sub ClearError()
m_RaisedErr = False
End Sub
'return TRUE if the operation is successful
Public Function NT_SUCCESS(ByVal Status As Long) As Boolean
NT_SUCCESS = (Status >= 0)
End Function
'copy data
Public Function CopyMemory(ByVal pDst As Long, ByVal pSrc As Long, ByVal nLength As Long) As Boolean
Dim st As Long
st = SafeCopyMemory(ZwGetCurrentProcess, pDst, pSrc, nLength, ByVal 0)
CopyMemory = NT_SUCCESS(st)
End Function[/language]
页:
[1]