Jump to content


  • Content Count

  • Joined

  • Last visited

Community Reputation

4 Neutral

Technical Information

  • Delphi-Version
    Delphi Community Edition

Recent Profile Visitors

The recent visitors block is disabled and is not being shown to other users.

  1. I just found if I use SysUtils in any unit contained in the package then the problem is solved, no more AVs while closing the app!!! But what exactly SysUtils do to fix the problem ? no idea! I checked SysUtils and found some code related to package support in initialization section: {$IFDEF PACKAGE_SUPPORT} AddModuleUnloadProc(ModuleUnloaded); {$ENDIF PACKAGE_SUPPORT} finalization section {$IFDEF PACKAGE_SUPPORT} RemoveModuleUnloadProc(ModuleUnloaded); ClearHashTables; {$ENDIF PACKAGE_SUPPORT} So, it seems some packages need to use SysUtils to work correctly! Anyone knows if this is documented somewhere?! Just for testing I went a step further and extracted the package support code from SysUtils into a standalone unit named PackageSupport and then used this unit instead of SysUtils and the result is success too!, no more AVs. This unit is just for testing only, I will be using SysUtils of course. Here is the PackageSupport unit source , Sorry for the a bit long code but I don't know how to add collapse/expand on click feature like some other forums : unit PackageSupport; interface implementation uses Winapi.Windows; const cBucketSize = 1021; // better distribution than 1024 type PUnitHashEntry = ^TUnitHashEntry; TUnitHashEntry = record Next, Prev: PUnitHashEntry; LibModule: PLibModule; UnitName: MarshaledAString; DupsAllowed: Boolean; FullHash: Cardinal; end; TUnitHashArray = TArray<TUnitHashEntry>; TUnitHashBuckets = array[0..cBucketSize-1] of PUnitHashEntry; PModuleInfo = ^TModuleInfo; TModuleInfo = record Validated: Boolean; UnitHashArray: TUnitHashArray; end; var SysInitHC: Cardinal; ValidatedUnitHashBuckets: TUnitHashBuckets; UnitHashBuckets: TUnitHashBuckets; function AnsiStrUpper(Str: PWideChar): PWideChar; begin Result := CharUpperW(Str); end; function FindLibModule(Module: HModule): PLibModule; inline; begin Result := LibModuleList; while Result <> nil do begin if Result.Instance = Cardinal(Module) then Exit; Result := Result.Next; end; end; function HashNameMBCS(Name: MarshaledAString): Cardinal; const BufferLen = 261; var Len, NameLen: Cardinal; Data: PWideChar; Buffer: array[0..BufferLen - 1] of WideChar; I: Integer; begin NameLen := Length(Name); Len := UnicodeFromLocaleChars(CP_UTF8, 0, Name, NameLen, nil, 0); if Len > BufferLen then GetMem(Data, Len * SizeOf(Char)) else Data := @Buffer[0]; UnicodeFromLocaleChars(CP_UTF8, 0, Name, NameLen, Data, Len); AnsiStrUpper(Data); Result := 0; for I := 0 to Len - 1 do begin Result := (Result shl 5) or (Result shr 27); //ROL Result, 5 Result := Result xor Cardinal(Data[I]); end; if Data <> @Buffer[0] then FreeMem(Data); end; {$DEFINE X86ASM} function HashName(Name: MarshaledAString): Cardinal; {$IFDEF PUREPASCAL} var LCurr: MarshaledAString; begin { ESI -> Name } Result := 0; LCurr := Name; while LCurr^ <> #0 do begin { Abort on a MBCS character } if Ord(LCurr^) > 127 then begin Result := HashNameMBCS(LCurr); Exit; end; { Update the hash. Lowercase the uppercased charaters in the process } if LCurr^ in ['A' .. 'Z'] then Result := Result xor (Ord(LCurr^) or $20) else Result := Result xor Ord(LCurr^); { Go to next } Inc(LCurr); { Update the hashed value } Result := (Result shr 27) or (Result shl 5); end; end; {$ELSE !PUREPASCAL} {$IFDEF X86ASM} asm PUSH ESI PUSH EBX MOV ESI, Name XOR EAX, EAX PUSH ESI @@loop: ROL EAX, 5 MOV BL, [ESI] TEST BL, $80 // abort if there is a multibyte character and call HashNameMBCS JNZ @@MBCS CMP BL, 0 JE @@done CMP BL, 'A' JL @@LowerCased CMP BL, 'Z' JG @@LowerCased OR BL, 20H // make lower case @@LowerCased: XOR AL, BL INC ESI JMP @@loop @@done: POP ECX POP EBX POP ESI RET @@MBCS: POP EAX POP EBX POP ESI JMP HashNameMBCS end; {$ENDIF X86ASM} {$ENDIF !PUREPASCAL} procedure ModuleUnloaded(Module: HINST); var LibModule: PLibModule; ModuleInfo: PModuleInfo; I: Integer; HC: Cardinal; Buckets: ^TUnitHashBuckets; begin LibModule := FindLibModule(Module); if (LibModule <> nil) and (LibModule.Reserved <> 0) then begin ModuleInfo := PModuleInfo(LibModule.Reserved); if ModuleInfo.Validated then Buckets := @ValidatedUnitHashBuckets else Buckets := @UnitHashBuckets; for I := Low(ModuleInfo.UnitHashArray) to High(ModuleInfo.UnitHashArray) do begin if ModuleInfo.UnitHashArray[I].Prev <> nil then ModuleInfo.UnitHashArray[I].Prev.Next := ModuleInfo.UnitHashArray[I].Next else if ModuleInfo.UnitHashArray[I].UnitName <> nil then begin HC := HashName(ModuleInfo.UnitHashArray[I].UnitName) mod cBucketSize; if Buckets[HC] = @ModuleInfo.UnitHashArray[I] then Buckets[HC] := ModuleInfo.UnitHashArray[I].Next; end; if ModuleInfo.UnitHashArray[I].Next <> nil then ModuleInfo.UnitHashArray[I].Next.Prev := ModuleInfo.UnitHashArray[I].Prev; end; Dispose(ModuleInfo); LibModule.Reserved := 0; end; end; procedure ClearHashTables; var Module: PLibModule; begin Module := LibModuleList; while Module <> nil do begin if Module.Reserved <> 0 then begin Dispose(PModuleInfo(Module.Reserved)); Module.Reserved := 0; end; Module := Module.Next; end; end; initialization {$IFDEF PACKAGE_SUPPORT} AddModuleUnloadProc(ModuleUnloaded); {$ENDIF PACKAGE_SUPPORT} finalization {$IFDEF PACKAGE_SUPPORT} RemoveModuleUnloadProc(ModuleUnloaded); ClearHashTables; {$ENDIF PACKAGE_SUPPORT} end.
  2. Thanks Peter!, useful information! indeed! I will try what you suggested soon, but for now I have a question: I used to unload/destroy anything I load /create, if I use LoadLibrary () I need to use UnLoadLibrary () and If I use LoadPackage I need to use UnloadPackage, ... but you said: if I remove the UnloadPackage from my code, the app does not report any memory leak which is good!, but handles are a Windows thing which Delphi memory manager does not have control of them. But it seems the package did not get unloaded because the finalization section of package unit did not get executed! I created a small test app and package, the package contains only one unit like this: unit PkgUnit1; interface implementation uses SysUtils, Classes; var FileName : string; procedure FinalizeProc; begin var slTest := TStringList.Create; try slTest.Add ('Finalizing PkgUnit1'); slTest.SaveToFile (FileName); finally slTest.Free; end; end; initialization FileName := ExtractFilePath (ParamStr(0)) + '_TestPlugIn.txt'; DeleteFile (FileName); finalization FinalizeProc; end. If I don't explicitly unload the package the _TestPlugIn.txt will not be created which means the finalization section did not execute which means the package was not unloaded by the RTL package management If I call UnloadPackage the file will be created. How is that? I'm using Delphi 11 Community.
  3. There are some changes to the question but I cannot edit my post above!! I'm working to apply suggestions Peter mentioned in the post below.
  4. Hi, (note: complete project in attachment) Was experimenting with dynamically loaded packages and call routines there. while it seems everything works properly I got problem which is the executable (project1.exe) stays in memory after closing the application. Running the app under the debugger shows AVs occurring during the call to UnloadPackage (PkgHandle) and the debugger jumps to GETMEM.INC showing assembly code YIIIIKES!!!, oh no not for me! and the call stack shows only 3 lines but nothing of my source code System.InsertMediumBlockIntoBin(???,???) System.SysFreeMem(???) :0092557a InsertMediumBlockIntoBin + $2A I saw the the AV dialog when I moved UnloadPackage (PkgHandle) from TForm1.FormDestroy to right after the calling code in TForm1.Button1Click and exe did not stay in memory. the shared definition unit: unit TestApi; interface type TIdentRec = record Name : string; Guid : string; Version : Integer; ApiVersion : Integer; end; type TPlugIdentifier = procedure (var IdentRec : TIdentRec); const PlugIdentifierName = 'Identify'; implementation end. In a package I have only one procedure unit TestPlugIn; interface uses TestApi; procedure Identify (var IdentRec : TIdentRec); exports Identify; implementation procedure Identify (var IdentRec : TIdentRec); begin IdentRec.Name := 'Sample PlugIn'; IdentRec.Guid := 'F84E4265C05D4854A2BD781ED7A1BA66'; IdentRec.Version := 1; IdentRec.ApiVersion := 1; end; Calling code: procedure TForm1.Button1Click (Sender: TObject); begin var Identify : TPlugIdentifier; @Identify := GetProcAddress (PkgHandle, PlugIdentifierName); if @Identify = nil then begin Log ('Cannot find Identifier proc!'); Exit; end; var IdentRec : TIdentRec := Default (TIdentRec); Identify (IdentRec); Log ('PlugIn Name: ' + IdentRec.Name); Log ('PlugIn Guid: ' + IdentRec.Guid); Log ('PlugIn Version: ' + IdentRec.Version.ToString); Log ('PlugIn API Version: ' + IdentRec.ApiVersion.ToString); end; Package loaded in TForm1.OnCreate and unloaded inTForm1.FormDestroy procedure TForm1.FormCreate (Sender : TObject); begin ReportMemoryLeaksOnShutdown := True; try PkgHandle := LoadPackage ('PlugInPkg.bpl'); Button1.Enabled := True; except on E : EPackageError do Log ('Cannot load package: ' + E.Message); end; end; // --------------------------------- procedure TForm1.FormDestroy (Sender : TObject); begin if PkgHandle <> 0 then UnloadPackage (PkgHandle) end; I noticed if I comment out the lines then problem goes away, so it seems it is related to strings : procedure Identify (var IdentRec : TIdentRec); begin // IdentRec.Name := 'Sample PlugIn'; // IdentRec.Guid := 'F84E4265C05D4854A2BD781ED7A1BA66'; IdentRec.Version := 1; IdentRec.ApiVersion := 1; end; I tried to reset the record after the call but no luck!: IdentRec := Default (TIdentRec); Pass Record to package 4.zip
  5. Marsil

    Removing String

    I don't understand what you just said!. As the OP did not completely describe what the input data will be, The answer is not meant to be valid for any data input. It's just a sample describing how to remove occurrences from a string. Can be adapter by OP to his own needs as he wish. If you have not noticed I didn't write this as ready to use function , Just a sample code snippet.
  6. Marsil

    Removing String

    As you changed your question I changed my answer above, I Hope it's what you are looking for. BTW, Your question has nothing to do with VCL, You should have posted it in General Help forum.
  7. Marsil

    Removing String

    var s:= 'This is (string) which need to (remove)'; var LeftIndex, RightIndex : Integer; LeftIndex := S.IndexOf (' ('); while LeftIndex > -1 do begin RightIndex := S.IndexOf (')'); if RightIndex = -1 then Break; S := S.Remove (LeftIndex, RightIndex - LeftIndex + 1); LeftIndex := S.IndexOf (' ('); end;
  8. I put a like for this hint! On the contrary I did get some useful information from this question and probably more coming
  9. Running a more realistic loop count of 100,000 times: TSearchRec var declared before loop : 0 ms inside loop: 3 ms 3 ms difference each 100,000 loop is a very small price to pay in exchange of encapsulation earned by limiting scope?? what do you think?
  10. Just ran a quick test (I'm not sure if it is a very good test) : // Before loop var FileRec : TSearchRec; var Stopwatch := TStopwatch.StartNew; for var i := 1 to 100000000 do begin FileRec.Name := 'Test'; end; Log (Stopwatch.ElapsedMilliseconds); // logs 205 // Inside loop var Stopwatch := TStopwatch.StartNew; for var i := 1 to 100000000 do begin var FileRec : TSearchRec; FileRec.Name := 'Test'; end; Log (Stopwatch.ElapsedMilliseconds); // logs 3129 (more than 15x) But when changing the inline variable type to Integer declare before loop timings: 161 161 161 161 161 declare Inside loop timings: 161 160 160 161 160 Increasing loop to 100 million times: before 1624 inside 1617 for a loop of millions times this is really negligible difference, nothing at all. So declaring simple types inside a loop may be the better choice after all??
  11. Yes I'm planning to do that but I thought I may get more useful insights by asking first. What I know now is that an inline variable is allocated at the point of declaration, not at the start of the block where it is declared. If I am not mistaken.
  12. That was one of my thoughts too!, Limiting scope is good, but we cannot get all good things at once can we?
  13. Thanks again, so a rule of thumb is never to declare inline variables inside a loop
  14. Thanks for the quick reply! I used to declare inline variables of simple types inside the loop, but this time it's a record of type TSearchRec, and I wondered if that was going to degrade performance. I guess that goes for other structured types too.
  15. Hello, Any differences between declaring an inline variable inside a loop and declaring it before the loop? I know that declaring an inline variable inside a loop limits its scope which is a good thing, but any difference in term of performance, memory allocation, extra work,...especially in big loops, or anything I don't know about? Many thanks! Outside loop var FileRec : TSearchRec; while not StopSearch do begin ... GetData (FileRec); UseData; ... end; Inside loop while not StopSearch do begin ... var FileRec : TSearchRec; GetData (FileRec); UseData; ... end;