Mahdi Safsafi

IIRC Extended-Pascal had similar thing but it also applies to type(declared type can have default value as well).

Yep I missed that ... my bad 🙂 But still doesn't handle invalid chars.

@Kas Ob. @emailx45 Relying on AV is potentially dangerous ! Result := Result + lBinValues[Pos(UpperCase(lEachHexChar), lHexChars) - 1]; { Result = Result + Content Content = Address^ Address = @lBinValues[Pos(UpperCase(lEachHexChar), lHexChars) - 1] If pos fails => Address = lBinValues - 1 Address^ => if Address points to a valid location that has a read access then no AV ! Otherwise an AV. Result + Content => An exception may occur if content does not point to a valid location / invalid AnsiString ... otherwise no exception (HAZARD) ! } So far ... you just have been lucky because the location (lBinValues - 1) does not point to a valid Location/AnsiString. Why ? because you used an array of char before lBinValues. But remember, compilers in general can optimize/insert/remove/align/reorder things ! Here is what happens when I just simulate what I explained : const Boom: AnsiString = 'Boooom!!!'; // lBinValues - 1 function fncMyHexToBin(const lHexValue: string): string; // I just reordered constants const lBinValues: array [0 .. 15] of AnsiString = ('0000', '0001', '0010', '0011', '0100', '0101', '0110', '0111', '1000', '1001', '1010', '1011', '1100', '1101', '1110', '1111'); lHexChars: array [0 .. 15] of char = ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F'); var lEachHexChar: char; begin Result := ''; for lEachHexChar in lHexValue do try Result := Result + lBinValues[Pos(UpperCase(lEachHexChar), lHexChars) - 1]; except // case the "char" is not found, we have a "AV"! then.... doesnt matter for us! // If Embarcadero use... I can too! end; end; procedure test; var s: string; begin Writeln(Boom); // Just to prevent compiler from omitting Boom. s := fncMyHexToBin('123x2'); Writeln(s); // <------ Booooooommmmmm end; begin test(); readln; end.

@David Heffernan Few remarks about your code if you don't mind : 1- Its pointless to use string when characters are fixed in size ... Simply use static array of X char. 2- Its also pointless to calculate index when you already used a case ... Simply declare your array using char-range. In your case, compiler generated additional instructions to compute the index. function HexToBin2(const HexValue: string): string; type TChar4 = array [0 .. 3] of Char; PChar4 = ^TChar4; const Table1: array ['0' .. '9'] of TChar4 = ('0000', '0001', '0010', '0011', '0100', '0101', '0110', '0111', '1000', '1001'); Table2: array ['a' .. 'f'] of TChar4 = ('1010', '1011', '1100', '1101', '1110', '1111'); var HexDigit: Char; P: PChar4; begin SetLength(Result, Length(HexValue) * 4); P := PChar4(Result); for HexDigit in HexValue do begin case HexDigit of '0' .. '9': P^ := Table1[HexDigit]; 'a' .. 'f': P^ := Table2[HexDigit]; 'A' .. 'F': P^ := Table2[Chr(Ord(HexDigit) xor $20)]; else raise EConvertError.CreateFmt('Invalid hex digit ''%s'' found in ''%s''', [HexDigit, HexValue]); end; Inc(P); end; end;

Inserting lines one by one is a very expensive operation for memo. Also your 'All items at once' is wrong ! procedure TForm10.Button5Click(Sender: TObject); begin Memo1.Lines := ListBox1.Items; // this just inserts item one by one => same as 'One item with loop' ! // if you want to insert all items in a faster way than what you called 'One item with loop', you need to use text property or SetTextBuf (depending on your need): // - Memo1.Text := ListBox1.Items.Text; // - Memo1.SetTextBuf(PChar(ListBox1.Items.Text)); end;

I compiled the library myself (with some modification to support MSVC) and I run the benchmark with my own tests ... Here is some facts : - Unlike what was advertised, quadsort never beated qsort for generic order(I repeated the tests many time). - Stable/unstable test gave different/closest results. - For the rest of tests ... quadsort wins. - I didn't see any bug yet however the weird thing I saw : The author was validating the result using quadsort !!!

Yes that's right but at what cost ? Spinlock is good when the operation is lightweight ... otherwise its just an overhead on the System/CPU.

Wake Woke Woken ... I'm pretty sure I'm going to wake too early.

No! CS is not designed to work with inter-process. It may look from the first sight that putting it into a shared memory will do the trick ... but in fact things are more complex than what you think because there is a signaling mechanism involved usually a semaphore that has a local(private) visibility. @Kas Ob. WaitOnAddress apparently works only with threads in the same process.

Of course it will fail... you're loading all packages ! Some packages are just incompatible. Basically you need to: 1- Skip IDE package and runtime package -> See IOTAPackageInfo.[IDEPackage, RuntimeOnly, DesigntimeOnly]. 2- Skip incompatible packages -> See IOTAPackageInfo.[Producer, Consumer] 3- Skip all packages that do not appear on the Palette -> See register : Computer\HKEY_CURRENT_USER\Software\Embarcadero\BDS\20.0\Palette For 1 and 2 don'f forget to read the documentation. PS: I saw how you manually inlined GetClass2 ... That's definitely not the way how to go for.

Maybe you didn't understand my comment... A component class is just a reference that resides inside a package (which is just a dll). IDE needs to load a given package(dll) inside its address space in order to get component class and accessing it. Its not about being on the pallet or not ! standard packages (core packages) are loaded by defaults when the IDE starts up hence you can get their class ... 3rd party packages are loaded when you use them(i.e: dropping a component on a form) hence you can get their class only if they were loaded. PS:I think that you didn't test the code I gave ... So I suggest that you try it.

Somehow I'm understanding what's going on: A 3rd party package is loaded by request (when its component is being used). i.e: zControls package is loaded into the IDE if you drop TzObjectInspector on a form. So when package is not loaded your tst file will not contain components from that package. So you have a couple of options : 1- make sure that you're using your expert on the right place (when x package is loaded). 2- load x package if its not loaded : for PackageCounter := 0 to PackageServices.PackageCount - 1 do begin PackageInfo := PackageServices.Package[PackageCounter]; Unload := False; if not PackageInfo.Loaded then begin // current package is not loaded ! if PackageInfo.Name = 'zControls_D.bpl' then begin { Load zControls_D package } Unload := True; PackageInfo.Loaded := True; end; end; for ComponentCounter := 0 to PackageServices.GetComponentCount(PackageCounter) - 1 do begin xx := TPersistentClass(GetClass2(PackageCounter, ComponentCounter)); if not(xx = nil) then begin s.Add(xx.ClassName); end else s.Add('nil- ' + InstalledComponentName); end; if Unload then begin { No longer need package ? => Unload it } PackageInfo.Loaded := False; end; end; s.SaveToFile('C:\Users\smp\Desktop\tst.txt'); // Now this will contain TzObjectInspector !

Don't worry about that ... all what you need to know is that this line (assumed that initialization of GetClass2 moved outside) xx := TPersistentClass(GetClass2(PackageCounter, ComponentCounter)); runs faster than this : InstalledComponentName := PackageServices.ComponentNames[PackageCounter, ComponentCounter]; xx := GetClass(InstalledComponentName); Yes that's what you should do.

@limelect Yes that's the way you should go for when language fails ... thanks ! I tested with my code and it works perfectly ... all components (tst.txt) are assigned (no nil): // procedure TExampleDockableForm.Initilize; // ... for PackageCounter := 0 to PackageServices.PackageCount - 1 do begin for ComponentCounter := 0 to PackageServices.GetComponentCount(PackageCounter) - 1 do begin InstalledComponentName := PackageServices.ComponentNames[PackageCounter, ComponentCounter]; // xx := GetClass(InstalledComponentName); remove this line xx := TPersistentClass(GetClass2(PackageCounter, ComponentCounter)); // <-- use GetClass2 if not(xx = nil) then begin s.Add(xx.ClassName); end else s.Add('nil- ' + InstalledComponentName); end; end;

Sorry man ! I tried to assist you but definitely I'm not in a position to understand your words.

The code I provided is working perfectly for me ... In fact I'm able to access all components (fmx, vcl, indy, ...). Here is some contracts I made : // all true: Assert(Assigned(LClass)); Assert(LClass.ClassName = s); Assert(LClass.InheritsFrom(TPersistent)); So what exactly is not working ?

My bad ! I was too naive to download the source as a zip since I don't have a svn client ... I guess I need a portable TortoiseSVN.

Thanks! Sure it will be very useful for me as I organize my portable app in a folder that I keep in a closest location. Some things: I downloaded the source and got a little trouble with compilation ... perhaps I was too hurry to open directly the project without running any batch file and then some missing dzLib ... at the end I managed to compile it 🙂 and spotted one small thing the button '...' does nothing (you must forget to implement it ... I guess it should be an OpenfileDialog). Thanks again !

GetClass requires a class to be priory registered using RegisterClass function otherwise it will fail. Below, a sample that uses some undocumented functions to get all classes: type TDesignPackages = TObject; TDesignPackage = TObject; TIDEDesignPackage = TObject; TRegModule = TObject; TRegClass = TObject; TDesignPackagesGetPackages = function(Obj: TDesignPackages; PackageIndex: Integer): TObject; TIDEDesignPackageGetCount = function(Obj: TIDEDesignPackage): Integer; TRegModuleGetCount = function(Obj: TRegModule): Integer; TIDEDesignPackageGetModules = function(Obj: TIDEDesignPackage; Index: Integer): TRegModule; TRegModuleGetClasses = function(Obj: TRegModule; Index: Integer): TRegClass; var DesignPackagesGetPackages: TDesignPackagesGetPackages; IDEDesignPackageGetCount: TIDEDesignPackageGetCount; IDEDesignPackageGetModules: TIDEDesignPackageGetModules; RegModuleGetCount: TRegModuleGetCount; RegModuleGetClasses: TRegModuleGetClasses; function GetClass2(PackageIndex, ComponentIndex: Integer): TClass; var Coreide: THandle; Delphicoreide: THandle; LGlobalPackagesPtr: Pointer; LDesignPackages: TDesignPackages; LIDEDesignPackage: TIDEDesignPackage; LRegModule: TRegModule; LRegClass: TRegClass; LIDEDesignPackageCount: Integer; LRegModuleCount: Integer; LIndex: Integer; I: Integer; J: Integer; begin Result := nil; { --- Move me outside --- } // adapt 260 suffix according to your Delphi version. Coreide := GetModuleHandle('coreide260.bpl'); Delphicoreide := GetModuleHandle('delphicoreide260.bpl'); LGlobalPackagesPtr := GetProcAddress(Coreide, '@Pakmgr@Packages'); DesignPackagesGetPackages := GetProcAddress(Coreide, '@Pakmgr@TDesignPackages@GetPackages$qqri'); IDEDesignPackageGetCount := GetProcAddress(Delphicoreide, '@Pascpppakmgr@TIDEDesignPackage@GetCount$qqrv'); IDEDesignPackageGetModules := GetProcAddress(Delphicoreide, '@Pascpppakmgr@TIDEDesignPackage@GetModules$qqri'); RegModuleGetCount := GetProcAddress(Coreide, '@Pakmgr@TRegModule@GetCount$qqrv'); RegModuleGetClasses := GetProcAddress(Coreide, '@Pakmgr@TRegModule@GetClasses$qqri'); Assert(Assigned(LGlobalPackagesPtr), 'LGlobalPackagesPtr not assigned'); Assert(Assigned(DesignPackagesGetPackages), 'DesignPackagesGetPackages not assigned'); Assert(Assigned(IDEDesignPackageGetCount), 'IDEDesignPackageGetCount not assigned'); Assert(Assigned(IDEDesignPackageGetModules), 'IDEDesignPackageGetModules not assigned'); Assert(Assigned(RegModuleGetCount), 'RegModuleGetCount not assigned'); Assert(Assigned(RegModuleGetClasses), 'RegModuleGetClasses not assigned'); { --- End Move outside --- } if Assigned(LGlobalPackagesPtr) then begin LDesignPackages := TObject(PPointer(LGlobalPackagesPtr)^); LIDEDesignPackage := DesignPackagesGetPackages(LDesignPackages, PackageIndex); LIDEDesignPackageCount := IDEDesignPackageGetCount(LIDEDesignPackage); LIndex := 0; // Component Index. for I := 0 to LIDEDesignPackageCount - 1 do begin LRegModule := IDEDesignPackageGetModules(LIDEDesignPackage, I); LRegModuleCount := RegModuleGetCount(LRegModule); for J := 0 to LRegModuleCount - 1 do begin if LIndex = ComponentIndex then begin LRegClass := RegModuleGetClasses(LRegModule, J); Result := TClass(PPointer(PByte(LRegClass) + 4)^); exit; end; Inc(LIndex); end; end; end; end; procedure Test(Sender: TObject); var PackageServices: IOTAPAckageServices; I: Integer; J: Integer; LClass: TClass; s: string; begin if Supports(BorlandIDEServices, IOTAPAckageServices, PackageServices) then begin for I := 0 to PackageServices.PackageCount - 1 do begin for J := 0 to PackageServices.GetComponentCount(I) - 1 do begin s := PackageServices.ComponentNames[I, J]; LClass := GetClass2(I, J); if Assigned(LClass) then begin Assert(LClass.ClassName = s); end; end; end; end; end;

The Interlockedxxxx defined in Delphi are just a wrapper for System.Atomicxxxx. Yes it works as long as you respect the alignment requirement.

@Kas Ob. Yes that's what I meant. Good remark ! I made a test that asked for 100 byte and as you told exactly it reads 1024 bytes ! Asked for 4096 bytes and it reads 4096 bytes ... so I guess its doing that to cache the data because some IOTAProcess.ReadProcessMemory calls for small amount didn't pass all the time throw WinApi.ReadProcessMemory (fetched from the cache). The weird thing for me is the crashing you got.

@Roland Skinner Thanks a lot man ! That's a great news knowing that it works mostly on all architectures. Just wondering what was wrong with Android 64-bit. Possibly from Delphi ... @Kas Ob have reported similar thing.

No ! I'm 100% sure that the internal function returns HRESULT and IOTAProcess.ReadProcessMemory returns bytes count.

HRESULT. In fact ReadProcessMemory calls an internal function that returns a HRESULT and then checks the value and returns the bytes count. # ReadProcessMemory: # ... 203BF56E | 8B45 E8 | mov eax,dword ptr ss:[ebp-18] 203BF571 | 50 | push eax 203BF572 | 8B00 | mov eax,dword ptr ds:[eax] 203BF574 | FF50 40 | call dword ptr ds:[eax+40] # InternalReadProcessMemoryFunction that reads the bytes and returns a HRESULT 203BF577 | E8 7096FAFF | call <dbkdebugide260.@Dbkhelper@CheckRetVal$qqrxl> # check HRESULT # ... 203BF599 | 8B45 FC | mov eax,dword ptr ss:[ebp-4] # result = bytes count

Fluent Thomas how you used IOTAThread.Evaluate. I've one question (off-topic) : is Evaluate aware about others constants too ? For example can I use it to evaluate other System constants ?