Mahdi Safsafi

33 minutes ago, Stefan Glienke said:

uses
  Spring;

type
  TExample = class(TManagedObject)
    [Default(-1)]
    Index: integer;
  end;

Just because I can 😎

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

5 minutes ago, Kas Ob. said:

Thank you Mahdi, and i can't agree more about letting exception lose and their danger and insecure bahaviour, for that i fixed it (for him!) and i think you missed that i removed the "-1" and added an empty string '' for the failed pos (=0), hence made it safe,

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;

3 hours ago, Stefan Glienke said:

Lots of bogus and bias benchmarks

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 !!!

1 hour ago, FPiette said:

InterlockedCompareExchange can be used to implement a spinlock. When using shared memory, this will work interprocess.

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.

47 minutes ago, Anders Melander said:

And it's extremely subject to race conditions. https://devblogs.microsoft.com/oldnewthing/20160826-00/?p=94185

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

4 hours ago, A.M. Hoornweg said:

Maybe a crazy idea, but since this block of memory is in a shared address space of two applications, would it be possible to place a "critical section" object in there?   



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.

1 hour ago, limelect said:

@Mahdi Safsafi you are wrong. Unless I did not understand you.

Maybe you didn't understand my comment...

Quote

So now I am looking for a DIFFERENT way to read the packages.

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. 

Quote

We are talking about components being on the component/Pallet.

Quote

If a component is on the pallet it is loaded, right?

 

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 !

29 minutes ago, limelect said:

@Mahdi Safsafi Just for general knowledge why there is a difference between

the getting of the component from the toolbar and from the package.

Since every component is going from a search through the bpl again and again

which is time-consuming.but still a lot of iterations.

So again why the difference? in nil

In the package the class is different?

 

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);

Quote

I guess I can leave most of the initialization outside of GetClass2

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;

Quote

Further more try to do if xx<>nil  then

qqqqq....

else

<<<< catch here and see

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 ?

1 hour ago, dummzeuch said:

You don't need to run any batch file, but you must be sure to check out the sources including the externals, in this case dzlib and buildtools. The pre- and post-build scripts need buildtools.

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;

Quote

does the "Interlockedxxxx" API work reliably across process boundaries ? 

The Interlockedxxxx defined in Delphi are just a wrapper for System.Atomicxxxx. 

Quote

The windows API documentation does not state that explicitly.

Yes it works as long as you respect the alignment requirement.

@Kas Ob. 

Quote

It is internal, means not the OS API, as shown here there is six calls up to the OS call

Yes that's what I meant.

Quote

I just tested it, but the strange thing is, i issued read for 100 bytes the monitor shows the actual API read 1024 byte instead and return 100 byte as result, after than my XE5 just keep crashing !

 

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.

Quote

 Get this exception message for Linux in Delphi, which should have had message "Error Message" (this could be a Delphi error; I noticed it also after disabling the exception expert the other day):

Possibly from Delphi ... @Kas Ob have reported similar thing.

38 minutes ago, David Heffernan said:

Seems unlikely. The winapi functions return a BOOL and call SetLastError. HRESULT seems very implausible. 

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

7 minutes ago, David Heffernan said:

what else could these integer return values hold? 

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                                                                                                         

19 minutes ago, dummzeuch said:

I now read those vmt offset values from the debugger using IOTAThread.Evaluate. Works fine for Win32 and Win64. Can't test other targets.

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 ?