Skip to content

Commit

Permalink
Initial commit
Browse files Browse the repository at this point in the history
  • Loading branch information
OlimilO1402 committed Jul 25, 2021
0 parents commit 775fd8b
Show file tree
Hide file tree
Showing 50 changed files with 4,391 additions and 0 deletions.
47 changes: 47 additions & 0 deletions .gitattributes
Original file line number Diff line number Diff line change
@@ -0,0 +1,47 @@
# Set the default behavior, in case people don't have core.autocrlf set.
# Auto detect text files and perform LF normalization
* text=auto

# Explicitly declare text files you want to always be normalized and converted
# to native line endings on checkout.
# none

# Declare files that will always have CRLF line endings on checkout.
*.frm text eol=crlf
*.cls text eol=crlf
*.bas text eol=crlf
*.ctl text eol=crlf
*.vbp text eol=crlf
*.vbw text eol=crlf
*.mak text eol=crlf
*.vbg text eol=crlf
*.vb text eol=crlf
*.cs text eol=crlf
*.rc text eol=crlf
*.txt text eol=crlf
*.bat text eol=crlf
*.scc text eol=crlf
*.ps1 text eol=crlf
*.h text eol=crlf
*.manifest text eol=crlf
*.html text eol=crlf

# Denote all files that are truly binary and should not be modified.
*.frx binary
*.png binary
*.jpg binary
*.bmp binary
*.ico binary
*.zip binary
*.dll binary
*.exe binary
*.ocx binary
*.tlb binary
*.res binary
*.exp binary
*.lib binary
*.xls binary
*.xlsm binary
*.doc binary
*.docx binary
*.syx binary
9 changes: 9 additions & 0 deletions .gitignore
Original file line number Diff line number Diff line change
@@ -0,0 +1,9 @@
# Exclude binary files
*.exe
*.dll
*.ocx
*.zip

# Exclude user-specific files
*.vbw
Thumbs.db
Original file line number Diff line number Diff line change
@@ -0,0 +1,111 @@
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "HeapEntry"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Implements ISnapShotEntry
'Public Type HEAPENTRY32
' dwSize As Long ' The size of the structure, in bytes.
' ' Before calling the Heap32First function, set this member.
' ' If you do not initialize dwSize, Heap32First fails. ' SIZE_T
' hHandle As Long ' A handle to the heap block.
' dwAddress As Long ' The linear address of the start of the block. ' As ULONG_PTR
' dwBlockSize As Long ' The size of the heap block, in bytes ' As SIZE_T
' dwFlags As Long ' This member can be one of the following values (see below LF32_...).
' dwLockCount As Long ' This member is no longer used and is always set to zero
' dwReserved As Long ' Reserved; do not use or alter.
' th32ProcessID As Long ' The identifier of the process that uses the heap
' th32HeapID As Long ' The heap identifier.
' ' This is not a handle, and has meaning only to the tool help functions'ULONG_PTR
'End Type
'Public Const LF32_FIXED As Long = &H1 'The memory block has a fixed (unmovable) location.
'Public Const LF32_FREE As Long = &H2 'The memory block is not used.
'Public Const LF32_MOVEABLE As Long = &H4 'The memory block location can be moved.
Public Enum HeapFlags
HeapFixed = &H1
HeapFree = &H2
HeapMoveable = &H4
End Enum
Private m_HeapEntry As HEAPENTRY32
Private m_Snapshot As SnapShot
Private m_Index As Long

Public Sub NewC(aSnapShot As SnapShot, ByVal Index As Long)
Set m_Snapshot = aSnapShot
m_Index = Index
End Sub

Public Property Get Ptr() As Long
Ptr = ISnapShotEntry_Ptr
End Property
Public Property Get Key() As String
Key = ISnapShotEntry_Key
End Property
Public Property Get Handle() As Long
Handle = m_HeapEntry.hHandle
End Property
Public Property Get Address() As Long
Address = m_HeapEntry.dwAddress
End Property
Public Property Get BlockSize() As Long
BlockSize = m_HeapEntry.dwBlockSize
End Property
Public Property Get Flags() As HeapFlags
Flags = m_HeapEntry.dwFlags
End Property
Public Property Get ProcessID() As Long
ProcessID = m_HeapEntry.th32ProcessID
End Property
Public Property Get HeapID() As Long
HeapID = m_HeapEntry.th32HeapID
End Property

Public Function ToString() As String
Dim s As String
With m_HeapEntry
s = s & "BlockHandle: " & .hHandle & vbCrLf
s = s & "Address: " & .dwAddress & vbCrLf
s = s & "BlockSize: " & .dwBlockSize & vbCrLf
s = s & "Flags: " & FlagsToString(.dwFlags) & vbCrLf
s = s & "ProcessID: " & .th32ProcessID & vbCrLf
s = s & "HeapID: " & .th32HeapID & vbCrLf
End With
ToString = s
End Function

Private Function FlagsToString(ByVal f As Long) As String
Dim s As String
If (f And LF32_FIXED) <> 0 Then _
s = s & IIf(Len(s), " ", "") & "fixed"
If (f And LF32_FREE) <> 0 Then _
s = s & IIf(Len(s), " ", "") & "free"
If (f And LF32_MOVEABLE) <> 0 Then _
s = s & IIf(Len(s), " ", "") & "moveable"
FlagsToString = s
End Function

Private Function ISnapShotEntry_ID() As Long
ISnapShotEntry_ID = m_HeapEntry.hHandle
End Function
Private Function ISnapShotEntry_Key() As String
'ISnapShotEntry_Key = CStr(m_HeapEntry.hHandle)
ISnapShotEntry_Key = m_Index
End Function
Private Function ISnapShotEntry_Name() As String
ISnapShotEntry_Name = m_HeapEntry.hHandle
End Function

Private Function ISnapShotEntry_Ptr() As Long
m_HeapEntry.dwSize = LenB(m_HeapEntry)
ISnapShotEntry_Ptr = VarPtr(m_HeapEntry)
End Function

Original file line number Diff line number Diff line change
@@ -0,0 +1,102 @@
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "HeapList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Implements ISnapShotEntry

'Public Type HEAPLIST32
' dwSize As Long 'The size of the structure, in bytes. Before calling the Heap32ListFirst function, set this member. If you do not initialize dwSize, Heap32ListFirst will fail.
' th32ProcessID As Long 'The identifier of the process to be examined
' th32HeapID As Long 'The heap identifier. This is not a handle, and has meaning only to the tool help functions
' dwFlags As Long 'This member can be one of the following values.
'End Type
'Public Const HF32_DEFAULT As Long = 1

Private m_HeapList As HEAPLIST32
Private m_Snapshot As SnapShot
Private m_HeapEntries As Collection

Public Sub NewC(aSnapShot As SnapShot)
Set m_Snapshot = aSnapShot
'set
End Sub

Public Property Get Ptr() As Long
Ptr = ISnapShotEntry_Ptr
End Property
Public Property Get Key() As String
Key = ISnapShotEntry_Key
End Property
Public Sub FetchHeapEntries()
'Call HeapEntries
Set m_HeapEntries = HeapEntries
End Sub
Public Function ToString() As String
Dim s As String
With m_HeapList
s = s & "Flags: " & FlagsToString(.dwFlags) & vbCrLf
s = s & "HeapID: " & CStr(.th32HeapID) & vbCrLf
s = s & "ProcessID: " & CStr(.th32ProcessID) & vbCrLf
End With
ToString = s
End Function

Private Function FlagsToString(f As Long) As String
If (f And HF32_DEFAULT) <> 0 Then FlagsToString = "default"
End Function
Public Property Get ProcessID() As Long
ProcessID = m_HeapList.th32ProcessID
End Property
Public Property Get HeapID() As Long
HeapID = m_HeapList.th32HeapID
End Property

Public Property Get HeapEntries() As Collection
If (m_Snapshot.Flags And SnapHeapEntry) = SnapHeapEntry Then
If m_HeapEntries Is Nothing Then
'Dim snap As SnapShot: Set snap = New_Snapshot(SnapHeapLists)
Dim iter As SnapIter: iter = m_Snapshot.GetIterator(Me)
'MsgBox m_Snapshot.Flags
'iter = snap.GetIterator(Me)
Dim col As New Collection
'Dim ent As HeapEntry ': Set ent = MSnapIter.NextHeapEntry(iter)
'Do While Not ent Is Nothing
While MSnapIter.HasNextHeapEntry(iter)
'Set ent = iter.NNext
'If ent.HeapID = Me.HeapID Then 'm_HeapList.th32HeapID Then
'If iter.NNext.ID = Me.HeapID Then
' col.Add ent, ent.Key
col.Add iter.NNext, iter.NNext.Key
'End If
'Set ent = MSnapIter.NextHeapEntry(iter)
Wend
'Loop
Set m_HeapEntries = col
End If
End If
Set HeapEntries = m_HeapEntries
End Property

Private Function ISnapShotEntry_ID() As Long
ISnapShotEntry_ID = m_HeapList.th32HeapID
End Function
Private Function ISnapShotEntry_Key() As String
ISnapShotEntry_Key = CStr(m_HeapList.th32HeapID)
End Function
Private Function ISnapShotEntry_Name() As String
ISnapShotEntry_Name = CStr(m_HeapList.th32HeapID)
End Function
Private Function ISnapShotEntry_Ptr() As Long
m_HeapList.dwSize = LenB(m_HeapList)
ISnapShotEntry_Ptr = VarPtr(m_HeapList)
End Function
Original file line number Diff line number Diff line change
@@ -0,0 +1,27 @@
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "ISnapShotEntry"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public Function Ptr() As Long
End Function

Public Function ID() As Long
End Function

Public Function Key() As String
End Function

Public Function Name() As String
End Function

Original file line number Diff line number Diff line change
@@ -0,0 +1,94 @@
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "ModuleEntry"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Implements ISnapShotEntry

'Public Type MODULEENTRY32
' dwSize As Long 'The size of the structure, in bytes. Before calling the Module32First function, set this member to sizeof(MODULEENTRY32). If you do not initialize dwSize, Module32First fails.
' th32ModuleID As Long 'This member is no longer used, and is always set to one.
' th32ProcessID As Long 'The identifier of the process whose modules are to be examined
' GlblcntUsage As Long 'The load count of the module, which is not generally meaningful, and usually equal to 0xFFFF
' ProccntUsage As Long 'The load count of the module (same as GlblcntUsage), which is not generally meaningful, and usually equal to 0xFFFF.
' modBaseAddr As Long 'The base address of the module in the context of the owning process.
' modBaseSize As Long 'The size of the module, in bytes.
' hModule As Long 'A handle to the module in the context of the owning process.
' szModule As String * MAX_MODULE_NAME32 'The module name.
' szExePath As String * MAX_PATH 'The module path.
'End Type
Private m_ModuleEntry As MODULEENTRY32
Private m_Snapshot As SnapShot

Public Sub NewC(aSnapShot As SnapShot)
Set m_Snapshot = aSnapShot
End Sub

Public Property Get Ptr() As Long
Ptr = ISnapShotEntry_Ptr
End Property
Public Property Get Key() As String
Key = ISnapShotEntry_Key
End Property

Public Property Get ProcessID() As Long
ProcessID = m_ModuleEntry.th32ProcessID
End Property
'Public Property Get GlobalUsageLoadCount() As Long
' GlobalUsageLoadCount = m_ModuleEntry.GlblcntUsage
'End Property
Public Property Get BaseAddress() As Long
BaseAddress = m_ModuleEntry.modBaseAddr
End Property
Public Property Get BaseSize() As Long
BaseSize = m_ModuleEntry.modBaseSize
End Property
Public Property Get ProcessModuleHandle() As Long
ProcessModuleHandle = m_ModuleEntry.hModule
End Property
Public Property Get Name() As String
Name = GetStringFromByteArr(m_ModuleEntry.szModule) ' ISnapShotEntry_Name '= GetString(m_ModuleEntry.szModule)
End Property
Public Property Get Path() As String
Path = GetStringFromByteArr(m_ModuleEntry.szExePath) 'GetString(m_ModuleEntry.szExePath)
End Property

Public Function ToString() As String
Dim s As String
With m_ModuleEntry
s = s & "ModuleID: " & CStr(.th32ModuleID) & vbCrLf
s = s & "ProcessID: " & CStr(.th32ProcessID) & vbCrLf
s = s & "glob.UsageLoad: " & CStr(.GlblcntUsage) & vbCrLf
s = s & "proc.UsageLoad: " & CStr(.ProccntUsage) & vbCrLf
s = s & "Mod. Base Addr: " & CStr(.modBaseAddr) & vbCrLf
s = s & "Mod. Base Size: " & CStr(.modBaseSize) & vbCrLf
s = s & "Module Handle: " & CStr(.hModule) & vbCrLf
s = s & "Module name: " & Me.Name & vbCrLf 'GetString(.szModule) & vbCrLf
s = s & "Exe path: " & Me.Path & vbCrLf 'GetString(.szExePath) & vbCrLf
End With
ToString = s
End Function

Private Function ISnapShotEntry_ID() As Long
ISnapShotEntry_ID = m_ModuleEntry.hModule
End Function
Public Function ISnapShotEntry_Key() As String
ISnapShotEntry_Key = CStr(m_ModuleEntry.hModule)
End Function
Private Function ISnapShotEntry_Name() As String
ISnapShotEntry_Name = GetStringFromByteArr(m_ModuleEntry.szModule)
End Function
Private Function ISnapShotEntry_Ptr() As Long
m_ModuleEntry.dwSize = LenB(m_ModuleEntry)
ISnapShotEntry_Ptr = VarPtr(m_ModuleEntry)
End Function

Loading

0 comments on commit 775fd8b

Please sign in to comment.