Background
Windows Dynamic Link Library (DLL) or Delphi Runtime Package (BPL) are both shared library for Windows OS. As stated in MSDN:
The system maintains a per-process reference count on all loaded modules. Calling LoadLibrary increments the reference count. Calling the FreeLibrary or FreeLibraryAndExitThread function decrements the reference count. The system unloads a module when its reference count reaches zero or when the process terminates (regardless of the reference count).
If a DLL has been loaded for more than one time, Windows OS doesn't maintain separate copies of DLL image in the OS system. Only one DLL image is loaded and Windows OS use reference counting strategy to maintain the status. Once the reference count of a DLL has dropped to zero, the DLL image is completely remove from the process.
A bad news is there isn't any documented Windows API to allow us to retrieve the current reference count of a DLL.
But why I need to know the reference count of a DLL? It is very rare for us to know this information. Someone use this technique to kill spyware DLL.
I design my application with runtime packages. For example, I keep forms in runtime package and load the form from package when I open the form. The runtime package is not bind to my executable image statically but it will be invoked dynamically via LoadPackage.
I want to achieve these:
- The package isn't loaded when there isn't any form instance in the process.
- We may instantiate more than one form instance from same package in the process at the same time.
- Once all form instances has been destroyed, the runtime package image will remove from the process.
To get it done. I declare an export procedure that return a new form instance everytime it is invoked. Each form instance created will invoke LoadPackage(HInstance) to increase the reference count.
The most complex part is the 3rd point. An exception will raise If I invoke UnloadPackage before all code in package has been executed completely. I not even allow to invoke UnloadPackage in form's destructor. To overcome this problem, I create an notifier for each form instance. When the form instance is destroying, it will alert the notifier. The notifier will send a message using PostMessage to notify a controller to unload the package. The PostMessage will get execute only when the process is in idle state. This method has work so well.
Until then I encounter a situation where I have this coding:
var i: integer;
F: TForm;
H: THandle;
NewForm: function: TForm;
begin
H := LoadPackage('MyPackage.bpl');
@NewForm := GetProcAddress(H, 'NewForm');
for i := 1 to 10 do begin
F := NewForm;
F.Free;
end;
UnloadPackage(H);
end;
The above code works fine not until I increase the for loop count to 10000. I will be prompted
The reason is simple, each call to F.Free will invoke PostMessage to queue the message to the associated thread of the process. If I run the above code to 10000 times continuously, the system just doesn't has a free moment to perform the messages in queue. It will certainly reach a limit until the message prompt out.
I have revise the strategy to overcome such situation but I am not confident enough to state that the new strategy will not having other problems in future. I use unit testing to write test cases for all known situations, one of the test case will perform 10000 loops and I will then check the reference count of the runtime packages to make sure it falls into a suitable range.
After writing such a long description, I finally manage the deliver the situations I face in words and paragraphs.
Solution
After spending a day digging on Internet about retrieving the reference count of a DLL, I found the solution. I have coding it in Delphi:
windows.PEB.pas
unit Windows.PEB;
interface
uses Windows{,
untSttUnhooker}; // WinAPI UnHooker - by StTwister
type
PNtAnsiString = ^TNtAnsiString;
TNtAnsiString = packed record
Length: Word;
MaximumLength: Word;
Buffer: PAnsiChar;
end;
type
PNtUnicodeString = ^TNtUnicodeString;
TNtUnicodeString = packed record
Length: Word;
MaximumLength: Word;
Buffer: PWideChar;
end;
type
PClientId = ^TClientId;
TClientId = record
UniqueProcess: THandle;
UniqueThread: THandle;
end;
type
PCurDir = ^TCurDir;
TCurDir = packed record
DosPath: TNtUnicodeString;
Handle : THandle;
end;
type
PRtlDriveLetterCurDir = ^TRtlDriveLetterCurDir;
TRtlDriveLetterCurDir = packed record
Flags : Word;
Length : Word;
TimeStamp: Cardinal;
DosPath : TNtAnsiString;
end;
type
PRtlUserProcessParameters = ^TRtlUserProcessParameters;
TRtlUserProcessParameters = record
MaximumLength : Cardinal;
Length : Cardinal;
Flags : Cardinal;
DebugFlags : Cardinal;
ConsoleHandle : THandle;
ConsoleFlags : Cardinal;
StandardInput : THandle;
StandardOutput : THandle;
StandardError : THandle;
CurrentDirectory : TCurDir;
DllPath : TNtUnicodeString;
ImagePathName : TNtUnicodeString;
CommandLine : TNtUnicodeString;
Environment : Pointer;
StartingX : Cardinal;
StartingY : Cardinal;
CountX : Cardinal;
CountY : Cardinal;
CountCharsX : Cardinal;
CountCharsY : Cardinal;
FillAttribute : Cardinal;
WindowFlags : Cardinal;
ShowWindowFlags : Cardinal;
WindowTitle : TNtUnicodeString;
DesktopInfo : TNtUnicodeString;
ShellInfo : TNtUnicodeString;
RuntimeData : TNtUnicodeString;
CurrentDirectores: Array [0..31] of TRtlDriveLetterCurDir;
end;
type
PPebFreeBlock = ^TPebFreeBlock;
TPebFreeBlock = record
Next: PPebFreeBlock;
Size: Cardinal;
end;
type
PLdrModule = ^TLdrModule;
TLdrModule = packed record
InLoadOrderModuleList : TListEntry; // 0h
InMemoryOrderModuleList : TListEntry; // 8h
InInitializationOrderModuleList: TListEntry; // 10h
BaseAddress : THandle; // 18h
EntryPoint : THandle; // 1Ch
SizeOfImage : Cardinal; // 20h
FullDllName : TNtUnicodeString;// 24h
// Length (2) 24h
// MaximumLength (2) 26h
// Buffer (4) 28h
BaseDllName : TNtUnicodeString;// 2Ch
Flags : ULONG; // 34h
LoadCount : SHORT; // 38h
TlsIndex : SHORT; // 3Ah
HashTableEntry : TListEntry; // 3Ch
TimeDataStamp : ULONG; // 44h
end;
type
PPebLdrData = ^TPebLdrData;
TPebLdrData = packed record
Length : Cardinal; // 0h
Initialized : LongBool; // 4h
SsHandle : THandle; // 8h
InLoadOrderModuleList : TListEntry; // 0Ch
InMemoryOrderModuleList : TListEntry; // 14h
InInitializationOrderModuleList: TListEntry; // 1Ch
end;
type
PPeb = ^TPeb;
TPeb = packed record
InheritedAddressSpace : Boolean;
ReadImageFileExecOptions : Boolean;
BeingDebugged : Boolean;
SpareBool : Boolean;
Mutant : Pointer;
ImageBaseAddress : Pointer;
Ldr : PPebLdrData;
ProcessParameters : PRtlUserProcessParameters;
SubSystemData : Pointer;
ProcessHeap : Pointer;
FastPebLock : Pointer;
FastPebLockRoutine : Pointer;
FastPebUnlockRoutine : Pointer;
EnvironmentUpdateCount : Cardinal;
KernelCallbackTable : Pointer;
case Integer of
4: (
EventLogSection : Pointer;
EventLog : Pointer);
5: (
SystemReserved : Array [0..1] of Cardinal;
{ end; }
FreeList : PPebFreeBlock;
TlsExpansionCounter : Cardinal;
TlsBitmap : Pointer;
TlsBitmapBits : Array [0..1] of Cardinal;
ReadOnlySharedMemoryBase : Pointer;
ReadOnlySharedMemoryHeap : Pointer;
ReadOnlyStaticServerData : ^Pointer;
AnsiCodePageData : Pointer;
OemCodePageData : Pointer;
UnicodeCaseTableData : Pointer;
NumberOfProcessors : Cardinal;
NtGlobalFlag : Cardinal;
Unknown : Cardinal;
CriticalSectionTimeout : TLargeInteger;
HeapSegmentReserve : Cardinal;
HeapSegmentCommit : Cardinal;
HeapDeCommitTotalFreeThreshold: Cardinal;
HeapDeCommitFreeBlockThreshold: Cardinal;
NumberOfHeaps : Cardinal;
MaximumNumberOfHeaps : Cardinal;
ProcessHeaps : ^Pointer;
GdiSharedHandleTable : Pointer;
ProcessStarterHelper : Pointer;
GdiDCAttributeList : Cardinal;
LoaderLock : Pointer;
OSMajorVersion : Cardinal;
OSMinorVersion : Cardinal;
OSBuildNumber : Word;
OSCSDVersion : Word;
OSPlatformId : Cardinal;
ImageSubsystem : Cardinal;
ImageSubsystemMajorVersion : Cardinal;
ImageSubsystemMinorVersion : Cardinal;
ImageProcessAffinityMask : Cardinal;
GdiHandleBuffer : Array [0..33] of Cardinal;
PostProcessInitRoutine : ^Pointer;
TlsExpansionBitmap : Pointer;
TlsExpansionBitmapBits : Array [0..31] of Cardinal;
SessionId : Cardinal;
AppCompatInfo : Pointer;
CSDVersion : TNtUnicodeString);
end;
type
PNtTib = ^TNtTib;
TNtTib = record
ExceptionList : Pointer; // ^_EXCEPTION_REGISTRATION_RECORD
StackBase : Pointer;
StackLimit : Pointer;
SubSystemTib : Pointer;
case Integer of
0: (FiberData : Pointer);
1: (Version : ULONG;
ArbitraryUserPointer: Pointer;
Self : PNtTib);
end;
type
PTeb = ^TTeb;
TTeb = record
Tib : TNtTib;
Environment : PWideChar;
ClientId : TClientId;
RpcHandle : THandle;
ThreadLocalStorage: PPointer;
Peb : PPeb;
LastErrorValue : DWORD;
end;
implementation
end.
Windows.ntdll.pas
unit Windows.ntdll;
interface
uses Windows;
const
ntdll = 'ntdll.dll';
type
NTSTATUS = LongInt;
TProcessInfoClass = (
ProcessBasicInformation, ProcessQuotaLimits,
ProcessIoCounters, ProcessVmCounters,
ProcessTimes, ProcessBasePriority, ProcessRaisePriority,
ProcessDebugPort, ProcessExceptionPort,
ProcessAccessToken, ProcessLdtInformation,
ProcessLdtSize, ProcessDefaultHardErrorMode,
ProcessIoPortHandlers, ProcessPooledUsageAndLimits,
ProcessWorkingSetWatch, ProcessUserModeIOPL,
ProcessEnableAlignmentFaultFixup, ProcessPriorityClass,
ProcessWx86Information, ProcessHandleCount,
ProcessAffinityMask, ProcessPriorityBoost,
ProcessDeviceMap, ProcessSessionInformation,
ProcessForegroundInformation, ProcessWow64Information,
MaxProcessInfoClass
);
PROCESSINFOCLASS = TProcessInfoClass;
PPROCESS_BASIC_INFORMATION = ^PROCESS_BASIC_INFORMATION;
PROCESS_BASIC_INFORMATION = packed record
ExitStatus: DWORD;
PebBaseAddress: Pointer;
AffinityMask: DWORD;
BasePriority: DWORD;
UniqueProcessId: DWORD;
InheritedUniquePID: DWORD;
end;
TZwQueryInformationProcess = function(ProcessHandle: THandle;
ProcessInformationClass: PROCESSINFOCLASS;
var ProcessInformation: PROCESS_BASIC_INFORMATION;
ProcessInformationLength: ULONG;
var ReturnLength: ULONG): NTSTATUS; stdcall;
implementation
end.
WindowsEx.pas
unit WindowsEx;
interface
uses Windows, Windows.PEB;
type
TProcessModules = class
private
FPebLDrData: TPebLdrData;
FReady: boolean;
FProcessHandle: THandle;
FCurrentIndex: Pointer;
FCurrentModule: TLdrModule;
procedure CheckReady;
public
constructor Create(const aProcessHandle: THandle = 4294967295);
procedure Reset;
function HasNext: boolean;
function CurrentModule: TLdrModule;
end;
implementation
uses SysUtils, Windows.ntdll;
procedure TProcessModules.CheckReady;
begin
if not FReady then
raise Exception.Create('PEB Loader Data is not ready');
end;
constructor TProcessModules.Create(const aProcessHandle: THandle = 4294967295);
var H: THandle;
Proc: TZwQueryInformationProcess;
PBI: PROCESS_BASIC_INFORMATION;
i: ULONG;
PEB: TPeb;
begin
FProcessHandle := aProcessHandle;
if FProcessHandle = THandle(-1) then
FProcessHandle := GetCurrentProcess;
H := LoadLibrary(ntdll);
if H = 0 then RaiseLastOSError;
try
@Proc := GetProcAddress(H, 'ZwQueryInformationProcess');
if @Proc = nil then RaiseLastOSError;
ZeroMemory(@PBI, SizeOf(PBI));
FReady := Proc(FProcessHandle, ProcessBasicInformation, PBI, SizeOf(PBI), i) = 0;
if FReady then begin
ReadProcessMemory(FProcessHandle, PBI.PebBaseAddress, @PEB, 16, i);
ReadProcessMemory(FProcessHandle, PEB.Ldr, @FPebLDrData, sizeof(FPebLDrData), i);
Reset;
end;
finally
FreeLibrary(H);
end;
end;
function TProcessModules.CurrentModule: TLdrModule;
begin
Result := FCurrentModule;
end;
function TProcessModules.HasNext: boolean;
var i: ULONG;
begin
CheckReady;
Result := ReadProcessMemory(GetCurrentProcess, FCurrentIndex, @FCurrentModule, SizeOf(FCurrentModule), i);
if Result then begin
Result := FCurrentModule.BaseAddress <> 0;
if Result then
FCurrentIndex := FCurrentModule.InLoadOrderModuleList.Flink;
end;
if not Result then
FCurrentIndex := nil;
end;
procedure TProcessModules.Reset;
begin
CheckReady;
ZeroMemory(@FCurrentModule, SizeOf(FCurrentModule));
FCurrentIndex := FPebLDrData.InLoadOrderModuleList.Flink;
end;
end.
Example:
var Proc: TProcessModules;
S: string;
begin
Proc := TProcessModules.Create;
try
while Proc.HasNext do begin
S := Format('%6d : %s', [Proc.CurrentModule.LoadCount, Proc.CurrentModule.FullDllName.Buffer]);
Memo1.Lines.Add(S);
end;
finally
Proc.Free;
end;
end;
