Well. We are encountering dll hell with a client basically. The Project references I'm guessing is only the dlls which the app directly accesses. But we want to find out what other dlls THEY are accessing and I'm assuming you can only do that at runtime...
Well, we are accessing SQL Server via an Access database using DAO and some clients work fine and others don't. The ones that don't, have Automation Errors which are normally fixed with an Office install. Overkill though.
Ah.. well DAO might be a problem (it hasn't been supported for a few years), but should be OK with a proper install process.
Are you using a proper installation package to distribute your program?
If not, see the article Why doesn't my program work on another computer? for an explanation of why it is needed, and a link to our Deployment FAQ.
Note that you need to install the drivers to connect to the databases (whichever ones you have used in your program), and you may find a download link in the "Installation" section of our Database Development FAQs/Tutorials(at the top of the Database Development forum)
The application is packaged using the package and deployment wizard and the relevant ODBC drivers are installed on all the systems. As I said, the only thing I think it could be is that the packaged dlls are making calls to other dlls which either do not exist on some Windows installations (this is true for example if the software is installed on Tablet Edition), are the wrong version, or are corrupt.
I see FM20.DLL in your Setup list. FM20.DLL is non-redistributable and the end user must have Office installed for these controls to be available. Although Microsoft clearly states that FM20.DLL is not redistributable they do not hide the fact that anyone can get FM20.DLL for free by downloading and installing ActiveXControlPad at http://download.microsoft.com/downlo...S/setuppad.exe.
FM20.DLL requires FM20ENU.Dll to instantiate controls in Vb6:
FM20ENU.Dll - Automatically installed with English versions of Office. Users who have installed Office with another language should check Windows\System32 folder for presence of this file. If it is not present you can download and install it free as part of ActiveXControlPad. You must have FM20ENU.Dll present to make Forms 2.0 Object Library controls available in Vb6. The symptoms are that the controls appear in the Vb Toolbox panel but an error occurs when you try to place one onto a form.
I see FM20.DLL in your Setup list. FM20.DLL is non-redistributable and the end user must have Office installed for these controls to be available. Although Microsoft clearly states that FM20.DLL is not redistributable they do not hide the fact that anyone can get FM20.DLL for free by downloading and installing ActiveXControlPad at http://download.microsoft.com/downlo...S/setuppad.exe.
FM20.DLL requires FM20ENU.Dll to instantiate controls in Vb6:
FM20ENU.Dll - Automatically installed with English versions of Office. Users who have installed Office with another language should check Windows\System32 folder for presence of this file. If it is not present you can download and install it free as part of ActiveXControlPad. You must have FM20ENU.Dll present to make Forms 2.0 Object Library controls available in Vb6. The symptoms are that the controls appear in the Vb Toolbox panel but an error occurs when you try to place one onto a form.
Ah ok cool. So it's possible that there is a versioning issue with this dll maybe?
I've trawled the web and I can't find anything on getting a list of dlls loaded in a VB6 app. Does anyone have any pointers?
Having done quite a bit of trawling myself, albeit a couple of decades later, I have stumbled upon the undocumented "RtlGetCurrentPeb" function (mentioned by Geoff Chappell). It returns a pointer to the PEB (Process Environment Block) which holds a list of all currently loaded DLL modules. This is actually how the well-known GetModuleHandle function gets the job done under the hood.
I never thought I'd go through doubly-linked lists in VB6, fun times! The following code serves as proof-of-concept on how to retrieve the currently loaded DLL modules and their corresponding addresses. While in IDE the list is almost twice as big than in the compiled EXE!
Module1.bas - copy and paste in an empty project:
Code:
Option Explicit
Private Type PROCESS_ENVIRONMENT_BLOCK
InheritedAddressSpace As Byte
ReadImageFileExecOptions As Byte
BeingDebugged As Byte
BitField As Byte
Mutant As Long
ImageBaseAddress As Long
Ldr As Long
ProcessParameters As Long
SubSystemData As Long
ProcessHeap As Long
FastPebLock As Long
' ...Snip
End Type
Private Type LIST_ENTRY
Flink As Long
Blink As Long
End Type
Private Type UNICODE_STRING
Length As Integer
MaximumLength As Integer
Buffer As Long
End Type
Private Type PEB_LDR_DATA
Length As Long
Initialized As Long
SsHandle As Long
InLoadOrderModuleList As LIST_ENTRY
InMemoryOrderModuleList As LIST_ENTRY
InInitializationOrderModuleList As LIST_ENTRY
EntryInProgress As Long
ShutdownInProgress As Long
ShutdownThreadId As Long
End Type
Private Type LDR_DATA_TABLE_ENTRY
InLoadOrderLinks As LIST_ENTRY
InMemoryOrderLinks As LIST_ENTRY
InInitializationOrderLinks As LIST_ENTRY
DllBase As Long
EntryPoint As Long
SizeOfImage As Long
FullDllName As UNICODE_STRING
BaseDllName As UNICODE_STRING
Flags As Long
ObsoleteLoadCount As Integer
TlsIndex As Integer
HashLinks As LIST_ENTRY
TimeDateStamp As Long
' ...Snip
End Type
Private Declare Sub CopyBytes Lib "msvbvm60" Alias "#183" (ByVal Length As Long, Destination As Any, Source As Any)
Private Declare Sub PutMem4 Lib "msvbvm60" Alias "#307" (Ptr As Any, ByVal NewVal As Long)
Private Declare Function RtlGetCurrentPeb Lib "ntdll" () As Long
Private Property Get GetProcessEnvironmentBlock(ProcessEnvironmentBlock As PROCESS_ENVIRONMENT_BLOCK, ByVal lpProcessEnvironmentBlock As Long) As PROCESS_ENVIRONMENT_BLOCK
PutMem4 ByVal VarPtr(lpProcessEnvironmentBlock) - 4, lpProcessEnvironmentBlock: GetProcessEnvironmentBlock = ProcessEnvironmentBlock
End Property
Private Property Get GetPebLdrData(PebLdrData As PEB_LDR_DATA, ByVal lpPebLdrData As Long) As PEB_LDR_DATA
PutMem4 ByVal VarPtr(lpPebLdrData) - 4, lpPebLdrData: GetPebLdrData = PebLdrData
End Property
Private Property Get GetListEntry(ListEntry As LIST_ENTRY, ByVal lpListEntry As Long) As LIST_ENTRY
PutMem4 ByVal VarPtr(lpListEntry) - 4, lpListEntry: GetListEntry = ListEntry
End Property
Private Property Get GetLdrDataTableEntry(LdrDataTableEntry As LDR_DATA_TABLE_ENTRY, ByVal lpLdrDataTableEntry As Long) As LDR_DATA_TABLE_ENTRY
PutMem4 ByVal VarPtr(lpLdrDataTableEntry) - 4, lpLdrDataTableEntry - LenB(LdrDataTableEntry.InMemoryOrderLinks): GetLdrDataTableEntry = LdrDataTableEntry
End Property
Private Function PtrToStr(lpString As Long, Length As Integer) As String
PtrToStr = String$(Length \ 2, vbNullChar)
CopyBytes Length, ByVal StrPtr(PtrToStr), ByVal lpString
End Function
Public Sub Main()
Dim lpListEntry As Long, sNames As String, PEB As PROCESS_ENVIRONMENT_BLOCK, PebLdrData As PEB_LDR_DATA, ListEntry As LIST_ENTRY, LdrDataTableEntry As LDR_DATA_TABLE_ENTRY
With GetProcessEnvironmentBlock(PEB, RtlGetCurrentPeb)
With GetPebLdrData(PebLdrData, .Ldr)
lpListEntry = GetListEntry(ListEntry, .InMemoryOrderModuleList.Flink).Flink
While GetListEntry(ListEntry, lpListEntry).Flink <> .InMemoryOrderModuleList.Flink
With GetLdrDataTableEntry(LdrDataTableEntry, lpListEntry)
sNames = sNames & PtrToStr(.BaseDllName.Buffer, .BaseDllName.Length) & " --- " & .DllBase & vbNewLine
End With
lpListEntry = GetListEntry(ListEntry, lpListEntry).Flink
Wend
End With
End With
MsgBox sNames
End Sub
On XP one can use CreateToolhelp32Snapshot from KERNEL32 like this:
Code:
Option Explicit
Private Const TH32CS_SNAPMODULE As Long = &H8
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Module32First Lib "kernel32" (ByVal hSnapShot As Long, lpMe32 As MODULEENTRY32) As Long
Private Declare Function Module32Next Lib "kernel32" (ByVal hSnapShot As Long, lpMe32 As MODULEENTRY32) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Type MODULEENTRY32
dwSize As Long
th32ModuleID As Long
th32ProcessID As Long
GlblcntUsage As Long
ProccntUsage As Long
modBaseAddr As Long
modBaseSize As Long
hModule As Long
szModule As String * 256
szExePath As String * 260
End Type
Private Sub Form_Click()
On Error GoTo EH
With GetProcessModules()
.Sort = "Module"
Do While Not .EOF
Print !Module, !ExeFile, !Version
.MoveNext
Loop
End With
Exit Sub
EH:
MsgBox Err.Description, vbCritical
End Sub
Public Function GetProcessModules() As Object
Const adInteger As Long = 3
Const adVarWChar As Long = 202
Dim hSnapShot As Long
Dim lProcessID As Long
Dim uModule As MODULEENTRY32
Dim lRet As Long
Dim rs As Object
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set rs = CreateObject("ADODB.Recordset")
rs.Fields.Append "Module", adVarWChar, 1000
rs.Fields.Append "BaseAddr", adInteger
rs.Fields.Append "ExeFile", adVarWChar, 1000
rs.Fields.Append "Version", adVarWChar, 1000
rs.Open
lProcessID = GetCurrentProcessId()
On Error Resume Next '--- checked
hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, lProcessID)
On Error GoTo 0
If hSnapShot <> 0 Then
uModule.dwSize = LenB(uModule)
lRet = Module32First(hSnapShot, uModule)
Do While lRet
If uModule.th32ProcessID = lProcessID Then
rs.AddNew
rs!Module.Value = Left$(uModule.szModule, InStr(uModule.szModule, vbNullChar) - 1)
rs!ExeFile.Value = Left$(uModule.szExePath, InStr(uModule.szExePath, vbNullChar) - 1)
rs!BaseAddr.Value = uModule.modBaseAddr
rs!Version.Value = oFSO.GetFileVersion(rs!ExeFile.Value)
End If
lRet = Module32Next(hSnapShot, uModule)
Loop
Call CloseHandle(hSnapShot)
End If
Set GetProcessModules = rs
End Function
cheers,
</wqw>
Last edited by wqweto; Oct 15th, 2024 at 02:53 AM.
#If VBA7 Then
Public Declare PtrSafe Function EnumerateLoadedModulesExW Lib "dbghelp" (ByVal hProcess As LongPtr, ByVal EnumModulesCallback As LongPtr, Optional ByVal UserContext As LongPtr) As Long
Public Declare PtrSafe Function GetCurrentProcess Lib "kernel32" () As LongPtr
Public Declare PtrSafe Function SysReAllocStringW Lib "oleaut32" Alias "SysReAllocString" (ByVal pBSTR As LongPtr, Optional ByVal pszStrPtr As LongPtr) As Long
Public Declare PtrSafe Sub CoTaskMemFree Lib "ole32" (ByVal pv As LongPtr)
#Else
Public Enum LongPtr
[_]
End Enum
Public Declare Function EnumerateLoadedModulesExW Lib "dbghelp" (ByVal hProcess As LongPtr, ByVal EnumModulesCallback As LongPtr, Optional ByVal UserContext As LongPtr) As Long
Public Declare Function GetCurrentProcess Lib "kernel32" () As LongPtr
Public Declare Function SysReAllocStringW Lib "oleaut32" Alias "SysReAllocString" (ByVal pBSTR As LongPtr, Optional ByVal pszStrPtr As LongPtr) As Long
Public Declare Sub CoTaskMemFree Lib "ole32" (ByVal pv As LongPtr)
#End If
Private Sub Command1_Click()
EnumerateLoadedModulesExW GetCurrentProcess(), AddressOf EnumerateLoadedModulesProc64, ByVal 0
End Sub
Public Function EnumerateLoadedModulesProc64(ByVal ModuleName As LongPtr, ByVal ModuleBase As LongLong, ByVal ModuleSize As Long, ByVal UserContext As LongPtr) As Long
Debug.Print "Loaded module: " & LPWSTRtoStr(ModuleName, False) & ", Base=0x" & Hex$(ModuleBase) & ", Size=" & CStr(ModuleSize)
EnumerateLoadedModulesProc64 = 1
End Function
Public Function LPWSTRtoStr(lPtr As LongPtr, Optional ByVal fFree As Boolean = True) As String
SysReAllocStringW VarPtr(LPWSTRtoStr), lPtr
If fFree Then
Call CoTaskMemFree(lPtr)
lPtr = 0
End If
End Function
(All declares and LPWSTRtoStr unnecessary in a WinDevLib project)
Last edited by fafalone; Oct 15th, 2024 at 01:57 AM.
I can't get EnumProcessModulesEx to work... it gives a return of 1 (success) and Err.LastDllErr = 0, but that's with a call of only 4 bytes (8 on x64) to get the size needed? All other methods of course correctly list more than 1 loaded module.
Code:
Public Declare PtrSafe Function EnumProcessModulesEx Lib "psapi" (ByVal hProcess As LongPtr, lphModule As LongPtr, ByVal cb As Long, lpcbNeeded As Long, ByVal dwFilterFlag As EnumModulesFlags) As BOOL
Dim hMod() As LongPtr
Dim cbNeeded As Long, cb As Long
ReDim hMod(1024)
Dim hr As Long
Dim sName As String
Dim cch As Long
Dim i As Long
cb = (UBound(hMod) + 1) * LenB(hMod(0))
Debug.Print "cb=" & cb
hr = EnumProcessModulesEx(GetCurrentProcess(), hMod(0), cb, cbNeeded, LIST_MODULES_32BIT)
If (hr = 1) /*And (Err.LastDllError = ERROR_PARTIAL_COPY)*/ Then
If cbNeeded > 0 Then
ReDim hMod((cbNeeded / 4) - 1)
If EnumProcessModulesEx(GetCurrentProcess(), hMod(0), (UBound(hMod) + 1) * LenB(hMod(0)), cbNeeded, LIST_MODULES_32BIT) Then
For i = 0 To UBound(hMod)
If hMod(i) = 0 Then Continue For
sName = String$(MAX_PATH, 0)
cch = GetModuleFileNameExW(GetCurrentProcess(), hMod(i), StrPtr(sName), MAX_PATH)
If cch Then
Debug.Print "Loaded 32bit module: " & Left$(sName, cch)
End If
Next
End If
Else
Debug.Print "0 bytes needed??"
End If
Else
Debug.Print "hr=" & hr & ",err=" & Err.LastDllError
End If
ReDim hMod(1024)
hr = EnumProcessModulesEx(GetCurrentProcess(), hMod(0), (UBound(hMod) + 1) * LenB(hMod(0)), cbNeeded, LIST_MODULES_64BIT)
If (hr = 1) /*And (Err.LastDllError = ERROR_PARTIAL_COPY)*/ Then
ReDim hMod((cbNeeded / 4) - 1)
If EnumProcessModulesEx(GetCurrentProcess(), hMod(0), (UBound(hMod) + 1) * LenB(hMod(0)), cbNeeded, LIST_MODULES_64BIT) Then
For i = 0 To UBound(hMod)
sName = String$(MAX_PATH, 0)
cch = GetModuleFileNameExW(GetCurrentProcess(), hMod(i), StrPtr(sName), MAX_PATH)
If cch Then
Debug.Print "Loaded 64bit module: " & Left$(sName, cch)
End If
Next
End If
Else
Debug.Print "hr=" & hr & ",err=" & Err.LastDllError
End If
(I tried using K32EnumProcessModulesEx in kernel32, no difference)
Edit: Seems the behavior is just weird. The documentation implies it should fail a 0-byte buffer, but it doesn't. It always succeeds and you just need to manually check cbNeeded.
Last edited by fafalone; Oct 14th, 2024 at 11:52 PM.
Having done quite a bit of trawling myself, albeit a couple of decades later, I have stumbled upon the undocumented "RtlGetCurrentPeb" function (mentioned by Geoff Chappell). It returns a pointer to the PEB (Process Environment Block) which holds a list of all currently loaded DLL modules. This is actually how the well-known GetModuleHandle function gets the job done under the hood.
I never thought I'd go through doubly-linked lists in VB6, fun times! The following code serves as proof-of-concept on how to retrieve the currently loaded DLL modules and their corresponding addresses. While in IDE the list is almost twice as big than in the compiled EXE!
Module1.bas - copy and paste in an empty project:
Code:
Option Explicit
#If (VBA7 = 0) Then
Private Enum LongPtr
[_]
End Enum
#End If
Public Type LARGE_INTEGER
#If (TWINBASIC = 1) Or (Win64 = 1) Then
QuadPart As LongLong
#Else
lowpart As Long
highpart As Long
#End If
End Type
' [Description("This is the base compatibility PEB, usuable from Windows XP through 11+. For additional members, see additional PEBs, e.g. PEB_VISTA.")]
Public Type PEB
InheritedAddressSpace As Byte
ReadImageFileExecOptions As Byte
BeingDebugged As Byte
BitField As Byte
Mutant As LongPtr
ImageBaseAddress As LongPtr
Ldr As LongPtr
ProcessParameters As LongPtr 'RTL_USER_PROCESS_PARAMETERS
SubSystemData As LongPtr
ProcessHeap As LongPtr
FastPebLock As LongPtr
AtlThunkSListPtr As LongPtr
SparePtr2 As LongPtr
EnvironmentUpdateCount As Long
KernelCallbackTable As LongPtr
SystemReserved(0) As Long
SpareUlong As Long
FreeList As LongPtr
TlsExpansionCounter As Long
TlsBitmap As LongPtr
TlsBitmapBits(1) As Long
ReadOnlySharedMemoryBase As LongPtr
ReadOnlySharedMemoryHeap As LongPtr
ReadOnlyStaticServerData As LongPtr
AnsiCodePageData As LongPtr
OemCodePageData As LongPtr
UnicodeCaseTableData As LongPtr
NumberOfProcessors As Long
NtGlobalFlag As Long 'NTGLB_Flags
#If (TWINBASIC = 0) And (Win64 = 0) Then
pad(3) As Byte
#End If
CriticalSectionTimeout As LARGE_INTEGER
HeapSegmentReserve As LongPtr
HeapSegmentCommit As LongPtr
HeapDeCommitTotalFreeThreshold As LongPtr
HeapDeCommitFreeBlockThreshold As LongPtr
NumberOfHeaps As Long
MaximumNumberOfHeaps As Long
ProcessHeaps As LongPtr
GdiSharedHandleTable As LongPtr
ProcessStarterHelper As LongPtr
GdiDCAttributeList As Long
LoaderLock As LongPtr
OSMajorVersion As Long
OSMinorVersion As Long
OSBuildNumber As Integer
OSCSDVersion As Integer
OSPlatformId As Long
ImageSubsystem As Long 'ImageSubsystemType Native(Kernel mode)=1,GUI=2,Console=3
ImageSubsystemMajorVersion As Long
ImageSubsystemMinorVersion As Long
ImageProcessAffinityMask As LongPtr
#If Win64 Then
GdiHandleBuffer(59) As Long
#Else
GdiHandleBuffer(33) As Long
#End If
PostProcessInitRoutine As LongPtr
TlsExpansionBitmap As LongPtr
TlsExpansionBitmapBits(31) As Long
SessionId As Long
AppCompatFlagsHi As Long
AppCompatFlags As Long 'APP_COMPAT_FLAGS 'ULARGE_INTEGER
AppCompatFlagUser As LARGE_INTEGER
pShimData As LongPtr
AppCompatInfo As LongPtr
CSDVersion As UNICODE_STRING
ActivationContextData As LongPtr
ProcessAssemblyStorageMap As LongPtr
SystemDefaultActivationContextData As LongPtr
SystemAssemblyStorageMap As LongPtr
MinimumStackCommit As LongPtr
#If (TWINBASIC = 0) And (Win64 = 0) Then
pad2(3) As Byte
#End If
End Type
Private Type LIST_ENTRY
Flink As LongPtr
Blink As LongPtr
End Type
Private Type UNICODE_STRING
Length As Integer
MaximumLength As Integer
Buffer As LongPtr
End Type
Private Type PEB_LDR_DATA
Length As Long
Initialized As Byte
SsHandle As LongPtr
InLoadOrderModuleList As LIST_ENTRY
InMemoryOrderModuleList As LIST_ENTRY
InInitializationOrderModuleList As LIST_ENTRY
EntryInProgress As LongPtr
ShutdownInProgress As Byte
ShutdownThreadId As LongPtr
End Type
' [Description("This structure is complete only up until Windows XP. Additional members have been added.")]
Public Type LDR_DATA_TABLE_ENTRY
InLoadOrderLinks As LIST_ENTRY
InMemoryOrderLinks As LIST_ENTRY
InInitializationOrderLinks As LIST_ENTRY
DllBase As LongPtr
EntryPoint As LongPtr
SizeOfImage As Long
FullDllName As UNICODE_STRING
BaseDllName As UNICODE_STRING
Flags As Long 'LDR_DATA_TABLE_FLAGS
LoadCount As Integer 'Obsolete starting in Win8
TlsIndex As Integer
HashLinks As LIST_ENTRY
TimeDateStamp As Long
EntryPointActivationContext As LongPtr
PatchInformationOrLock As LongPtr 'PatchInfo on XP-8, Lock on 10
End Type
#If Win64 Then
Private Declare PtrSafe Sub CopyBytes Lib "msvbvm60" Alias "__vbaCopyBytes" (ByVal Length As Long, Destination As Any, Source As Any)
Private Declare PtrSafe Sub PutMem4 Lib "msvbvm60" Alias "PutMem4" (Ptr As Any, ByVal NewVal As Long)
Private Declare PtrSafe Function RtlGetCurrentPeb Lib "ntdll" () As LongPtr
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#Else
Private Declare Sub CopyBytes Lib "msvbvm60" Alias "__vbaCopyBytes" (ByVal Length As Long, Destination As Any, Source As Any)
Private Declare Sub PutMem4 Lib "msvbvm60" Alias "PutMem4" (Ptr As Any, ByVal NewVal As Long)
Private Declare Function RtlGetCurrentPeb Lib "ntdll" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#End If
Private Property Get GetProcessEnvironmentBlock(ProcessEnvironmentBlock As PEB, ByVal lpProcessEnvironmentBlock As LongPtr) As PEB
#If TWINBASIC Then
' GetProcessEnvironmentBlock = CType(Of PEB)(lpProcessEnvironmentBlock)
CopyMemory GetProcessEnvironmentBlock, ByVal lpProcessEnvironmentBlock, LenB(Of PEB)
CopyMemory ProcessEnvironmentBlock, ByVal lpProcessEnvironmentBlock, LenB(Of PEB)
#Else
PutMem4 ByVal VarPtr(lpProcessEnvironmentBlock) - 4, lpProcessEnvironmentBlock: GetProcessEnvironmentBlock = ProcessEnvironmentBlock
#End If
End Property
Private Property Get GetPebLdrData(PebLdrData As PEB_LDR_DATA, ByVal lpPebLdrData As LongPtr) As PEB_LDR_DATA
#If TWINBASIC Then
' GetPebLdrData = CType(Of PEB_LDR_DATA)(lpPebLdrData)
CopyMemory GetPebLdrData, ByVal lpPebLdrData, LenB(Of PEB_LDR_DATA)
CopyMemory PebLdrData, ByVal lpPebLdrData, LenB(Of PEB_LDR_DATA)
#Else
PutMem4 ByVal VarPtr(lpPebLdrData) - 4, lpPebLdrData: GetPebLdrData = PebLdrData
#End If
End Property
Private Property Get GetListEntry(ListEntry As LIST_ENTRY, ByVal lpListEntry As LongPtr) As LIST_ENTRY
#If TWINBASIC Then
' GetListEntry = CType(Of LIST_ENTRY)(lpListEntry)
CopyMemory GetListEntry, ByVal lpListEntry, LenB(Of LIST_ENTRY)
CopyMemory ListEntry, ByVal lpListEntry, LenB(Of LIST_ENTRY)
#Else
PutMem4 ByVal VarPtr(lpListEntry) - 4, lpListEntry: GetListEntry = ListEntry
#End If
End Property
Private Property Get GetLdrDataTableEntry(LdrDataTableEntry As LDR_DATA_TABLE_ENTRY, ByVal lpLdrDataTableEntry As LongPtr) As LDR_DATA_TABLE_ENTRY
#If TWINBASIC Then
' GetLdrDataTableEntry = CType(Of LDR_DATA_TABLE_ENTRY)(lpLdrDataTableEntry)
CopyMemory GetLdrDataTableEntry, ByVal (lpLdrDataTableEntry - LenB(LdrDataTableEntry.InMemoryOrderLinks)), LenB(Of LDR_DATA_TABLE_ENTRY)
CopyMemory LdrDataTableEntry, ByVal (lpLdrDataTableEntry - LenB(LdrDataTableEntry.InMemoryOrderLinks)), LenB(Of LDR_DATA_TABLE_ENTRY)
#Else
PutMem4 ByVal VarPtr(lpLdrDataTableEntry) - 4, lpLdrDataTableEntry - LenB(LdrDataTableEntry.InMemoryOrderLinks): GetLdrDataTableEntry = LdrDataTableEntry
#End If
End Property
Private Function PtrToStr(lpString As LongPtr, Length As Integer) As String
PtrToStr = String$(Length \ 2, vbNullChar)
CopyBytes Length, ByVal StrPtr(PtrToStr), ByVal lpString
End Function
Public Sub Main()
Dim lpListEntry As LongPtr, sNames As String, PEB As PEB, PebLdrData As PEB_LDR_DATA, ListEntry As LIST_ENTRY, LdrDataTableEntry As LDR_DATA_TABLE_ENTRY
With GetProcessEnvironmentBlock(PEB, RtlGetCurrentPeb)
With GetPebLdrData(PebLdrData, .Ldr)
lpListEntry = GetListEntry(ListEntry, .InMemoryOrderModuleList.Flink).Flink
While GetListEntry(ListEntry, lpListEntry).Flink <> .InMemoryOrderModuleList.Flink
With GetLdrDataTableEntry(LdrDataTableEntry, lpListEntry)
Debug.Print .BaseDllName.Buffer, .BaseDllName.Length
sNames = sNames & PtrToStr(.BaseDllName.Buffer, .BaseDllName.Length) & " --- " & .DllBase & " (" & .BaseDllName.Length & ")" & vbNewLine
End With
lpListEntry = GetListEntry(ListEntry, lpListEntry).Flink
Wend
End With
End With
MsgBox sNames
End Sub
Good stuff but why did you comment out the CTypes? Also there's no point in the duplicate CopyMemory calls, the UDT parameters are never used outside the function.
Good stuff but why did you comment out the CTypes? Also there's no point in the duplicate CopyMemory calls, the UDT parameters are never used outside the function.
Hadn't been working and I tried a bunch of things, didn't undo them all. Turns out I missed your sneaky alteration of - LenB(LdrDataTableEntry.InMemoryOrderLinks) in one.
Haha, yeah it's not my fault Microsoft didn't put that LIST_ENTRY at the beginning of the structure so I had to subtract its offset. Spent about half an hour scratching my head as well until it dawned on me!
This is why we prefer VB over C! I hated linked lists with a passion in school!
I only took one intro programming course in college, in Java, but I remember the nightmare of linked lists from that too. Picked everything up super fast because I was already programming in VB for 8 years but still was never really able to grasp those.
Really nice.. can get the usage count too. I have this mousewheel addin dll running in VB5 and it won't unload because an extra usage reference count is hanging around which I can see now clearly with your code. Maybe hitting it with an extra FreeLibrary will work, or not.