Programmatically get all units used in a dpr in Delphi - delphi

I am new in Delphi and I am trying to make an application in which I will give as an input a .dpr file and the application will create a list with all the .pas files used by this .dpr... I still cannot find a function in Delphi or a way to read the uses of the .dpr in order to navigate through the file system to these pas files and read their uses, and so on... Does anyone has any idea on how to achieve this?

It's not exactly straightforward: You don't just need to read the .dpr file, but you also need to parse the .dproj and registry to get Search Paths. If you're trying to do this right, you also have to parse the .dpr and .pas files as code files so you can find the uses statements, handle {$I '...'} includes, {$IFDEF} blocks, interface vs implementation sections, and so on.
All that said, you might want to look to the open source CnPack and GExperts projects for inspiration. Both of them have solved this problem, and you may be able to leverage their work towards whatever problem you're trying to solve.

If you let Delphi create a .map file (linker option), it will contain a list of all source and dcu files used in that project. GExperts does that, using a simple parser for a map file which is taken from my dzlib https://sourceforge.net/p/dzlib/code/HEAD/tree/dzlib/trunk/src/u_dzMapFileReader.pas

I would like to update this question for possible answer for future reference.
Create a separate unit file (PhonyObject.pas)
unit PhonyObject;
interface
uses
System.Classes, FMX.Forms, FMX.Dialogs;
type
TPhonyObject = class(TObject)
end;
TPhonyClass = class of TPhonyObject;
procedure FindUnitName(anObject: TObject);
var
PhonyName: string;
PhonyClass: TPhonyClass;
PhonyInstance: TObject;
PhonyClassName: procedure(anObject: TObject) = FindUnitName; //function: String = FindUnitName;
implementation
uses System.TypInfo;
procedure FindUnitName(anObject: TObject);
begin
if anObject <> nil then PhonyName := anObject.UnitName
else if not (TObject.UnitName <> 'System') then
begin
if TypInfo.GetTypeData(anObject.ClassInfo) <> nil then PhonyName := String(GetTypeData(anObject.ClassInfo)^.UnitName);
end else PhonyName := TObject.UnitName;
//FreeAndNilProperties
end;
initialization
PhonyClass := TPhonyObject;
PhonyInstance := PhonyClass.Create;
ShowMessage('Unit Name =' + PhonyInstance.UnitName);
PhonyInstance.Free;
finalization
PhonyClass := nil; //PhonyClass.Free;
end.
And in order to use this inside another (multiple) units, this is the code I have used so far, but I hope to update it later on. I have this showing up inside a hand made "console" with black background and white text in a TMemo. If anyone wants the code for the TMemo (its not commonly known), or how to show all these inside basically a debug window, all you just have to do let me know. This is the best I have gotten it so far, but I need a better understanding of the child/parent object/classes
unit AnotherUnit;
interface
uses
System.Classes, PhonyObject;
type
TPhonyObj = class(TPhonyObject)
end;
//var
implementation
{$R *.fmx}
uses ...;
initialization
PhonyClass := TPhonyObj;
PhonyInstance := PhonyClass.Create;
ShowMessage('UnitName= ' + PhonyInstance.UnitName + ' (AnotherUnit)'); // PhonyClass.UnitName // PhonyClassName(PhonyInstance);
PhonyInstance.Free;
finalization
PhonyClass := nil;
end;
I used as unique of Unit Names and class names, as I could and I realize I don't actually use any objects till the end, none the less it should work with out any problems. Please comment if there are some better ideas, but I think this is a powerful feature for Delphi programming when you can predict when certain unit names are going to suddenly show up. And how to predict for them too.

Related

Component is specific class - does not work in BPL structure

I am upgrading Delphi software from Delphi 6 (2001) to Delphi 11 Alexandria.
This software consists of many BPL's, but this code is not working properly. The is command is not returning True, when checking if the component from a BPL is an TIBQuery - although it really is.
procedure LoadDLLAndPassDatabaseConnection(const DLLName: string);
var
PackageHandle: HMODULE;
ServiceModule: TMyServiceModule;
I: Integer;
Component: TComponent;
begin
PackageHandle := LoadPackage(PChar(DLLName));
ServiceModule := TMyServiceModule(GetProcAddress(hInst,'GetServiceModule'));
if Assigned(ServiceModule) then
begin
for I:=0 to ServiceModule.ComponentCount - 1 do
begin
Component := ServiceModule.Components[I];
// This component is declared in another bpl.
// It really is an TIBQuery, but the following if never returns True...
// (Evaluating Component.ClassName results in 'TIBQuery')
if Component is TIBQuery then
begin
// this is never executed...
TIBQuery(Component).Database := GetDatabase;
end;
end;
end;
end;
I already considered to compare classnames, but this does not work for descendants. And we tried toggling project options such as "Emit runtime type information", but that's not making any difference.
How to get this working?
Thank you!
The is operator does not work across BPLs (DLLs) for the following reason:
The class you are inspecting is implemented inside its own unit file.
You build the BPL, link the unit, and a RTTI section is created inside the BPL file.
Then, you build the EXE, link the unit, and a new RTTI section is created inside the EXE file.
Now: the class name is the same for the two modules, but the RTTI, used by the is operator to check equality, are different, so the operator returns FALSE!
Solution: check equality againts class name.
I found this somewhere, but it seems to contradict Antionio's answer a bit.
When you use packages, there is only ever one copy of any unit in
memory. One copy of Forms, one copy of SysUtils, one copy of System
(well, most of it), one copy of StdCtrls, etc.
All class-related operations, such as the "is" and "as" operators, rely
on class references. Class references are actually just addresses. They
point to definitions for the layouts of the classes' internals. (They
point to what's called the virtual-method table, the VMT.) Two classes
are the same if they point to the same VMT -- if the addresses are equal.
When you have a class defined in the EXE's copy of StdCtrls and the same
class defined in a DLL's copy of StdCtrls, those classes will really
have different addresses. The "is" and "as" operators won't work with
cross-module clases. But when you use packages, there is only one copy
of the class, kept in vcl70.bpl, so all modules that reference that
package will share a single class definition.
As Antonio Petricca wrote (thank you!), it's not possible to use the is operator. I now have implemented this by comparing (ancestor) class names - I want to share the code:
function IsSameClassOrAncestor(const ClazzToCheck: TClass; const Clazz: TClass): Boolean;
begin
Result := SameText(ClazzToCheck.ClassName, Clazz.ClassName);
if not Result and not SameText(ClazzToCheck.ClassName, 'TObject') then
begin
Result := IsSameClassOrAncestor(ClazzToCheck.ClassParent, Clazz);
end;
end;
This way, I can check this as follows:
if IsSameClassOrAncestor(Component, TIBQuery)
begin
// The code is now executed correctly, also for descendants
TIBQuery(Component).Database := GetDatabase;
end;

Store array in TQueue possible?

Having problem storing an array in a TQueue. Any idea where I go wrong?
Code works fine in Delphi XE 5 but not in Delphi 10 Seattle.
(I can't decide if this is a bug or how it should work. Tried searching embarcadero for clues but failed.)
procedure TForm1.Button1Click(Sender: TObject);
var
FData: TQueue<TBytes>;
FsData: TQueue<String>;
arr: TBytes;
begin
FData := TQueue<TBytes>.Create;
FsData := TQueue<String>.Create;
try
setlength(arr, 3);
arr[0] := 1;
arr[1] := 2;
arr[2] := 3;
FData.Enqueue(arr);
Memo1.Lines.Add('Count, array:' + IntToStr(FData.Count)); // 0?
FsData.Enqueue('asada');
Memo1.Lines.Add('Count, string:' + IntToStr(FsData.Count)); // 1
finally
FData.Free;
FsData.Free;
end;
end;
This is a defect introduced in XE8. Here's the simplest reproduction that I can produce.
{$APPTYPE CONSOLE}
uses
System.Generics.Collections;
var
Queue: TQueue<TArray<Byte>>;
begin
Queue := TQueue<TArray<Byte>>.Create;
Queue.Enqueue(nil);
Writeln(Queue.Count);
end.
The output is 1 in XE7 and 0 in XE8 and Seattle.
This has already been reported to Embarcadero: RSP-13196.
The implementation of Enqueue looks like this:
procedure TQueue<T>.Enqueue(const Value: T);
begin
if IsManagedType(T) then
if (SizeOf(T) = SizeOf(Pointer)) and (GetTypeKind(T) <> tkRecord) then
FQueueHelper.InternalEnqueueMRef(Value, GetTypeKind(T))
else
FQueueHelper.InternalEnqueueManaged(Value)
else
case SizeOf(T) of
1: FQueueHelper.InternalEnqueue1(Value);
2: FQueueHelper.InternalEnqueue2(Value);
4: FQueueHelper.InternalEnqueue4(Value);
8: FQueueHelper.InternalEnqueue8(Value);
else
FQueueHelper.InternalEnqueueN(Value);
end;
end;
When T is a dynamic array, the FQueueHelper.InternalEnqueueMRef branch is chosen. This in turn looks like this:
procedure TQueueHelper.InternalEnqueueMRef(const Value; Kind: TTypeKind);
begin
case Kind of
TTypeKind.tkUString: InternalEnqueueString(Value);
TTypeKind.tkInterface: InternalEnqueueInterface(Value);
{$IF not Defined(NEXTGEN)}
TTypeKind.tkLString: InternalEnqueueAnsiString(Value);
TTypeKind.tkWString: InternalEnqueueWideString(Value);
{$ENDIF}
{$IF Defined(AUTOREFCOUNT)}
TTypeKind.tkClass: InternalEnqueueObject(Value);
{$ENDIF}
end;
end;
Note that there is no entry for TTypeKind.tkDynArray. Because these two methods are inlined, the inliner manages to compress it all down to nothing. No action is performed when you Enqueue a dynamic array.
Back in the good old days of XE7 the code looked like this:
procedure TQueue<T>.Enqueue(const Value: T);
begin
if Count = Length(FItems) then
Grow;
FItems[FHead] := Value;
FHead := (FHead + 1) mod Length(FItems);
Inc(FCount);
Notify(Value, cnAdded);
end;
No scope for type specific defects there.
I don't think that there's an easy workaround for you. Perhaps the most expedient way to proceed is to take the code for the XE7 TQueue and use that in place of the broken implementation from XE8 and Seattle. For the record, I've given up on the Embarcadero generic collections and use my own classes.
The back story here is that in XE8, Embarcadero decided to address a deficiency in their implementation of generics. Whenever you instantiate a generic type, copies of all the methods are created. For some methods, identical code is generated for different instantiations.
So it is quite common for TGeneric<TFoo>.DoSomething and TGeneric<TBar>.DoSomething to have identical code. Other compilers for other languages, C++ templates, .net generics, etc., recognise this duplication and merge together identical generic methods. The Delphi compiler does not. The end result is a larger executable than strictly necessary.
In XE8 Embarcadero decided to tackle this in what I regard was utterly the wrong way. Instead of attacking the root cause of the issue, the compiler, they decided to change the implementation of their generic collection classes. If you look at the code in Generics.Collections, you will see that it has been completely re-written in XE8. Where previously the code from XE7 and earlier was readable, from XE8 it is now exceedingly complex and opaque. This decision had the following consequences:
The complex code contained many errors. Many of these were found shortly after XE8 was released and have been fixed. You have stumbled upon another defect. One thing that we have learnt is that Embarcadero's internal test suite does not exercise their collection classes sufficiently. It is manifestly clear that their tests are inadequate.
By changing their library rather than the compiler, they have patched up the RTL classes. The original issue with generic code bloat remains for third party classes. Had Embarcadero fixed the issue at source then not only could they have retained the simple and correct collection class code from XE7, but all third generic code would have benefited.

Directory path manipulation in Delphi?

I have the full path name of a given folder for e.g.
c:\foo\bar
Now I would like to reference a file inside c:\foo named baz.txt,
c:\foo\bar\..\baz.txt
I am currently using the .. path operator to go down one level and get the file that I need.
Is there a function that can do path manipulations, for e.g. UpOneLevel(str) -> str ? I know I can write one by splitting the string and removing the last token, but I would rather it be a built-in / library function so I don't get into trouble later if there are for e.g. escaped backslashes.
Use the ExpandFileName function:
var
S: string;
begin
S := 'c:\foo\bar\..';
S := ExpandFileName(S);
ShowMessage(S);
end;
The message from the above example will show the c:\foo path.
Look at ExtractFilePath() and ExtractFileDir(). These are available in just about all Delphi versions, particularly those that do not have TDirectory, IOUtils, etc.
And before anyone says it, these work just fine whether the path ends with a filename or not. ForceDirectories() uses them internally to walk backwards through a hierarchy of parent folders, for example.
This answer is valid for Delphi XE +
Use the TDirectory class of the IOutils unit, which have the method GetParent, like this::
uses IOUtils;
procedure TForm1.Button1Click(Sender: TObject);
var
s: string;
begin
s := 'c:\foo\bar';
ShowMessage(TDirectory.GetParent(s));
end;
In older versions
Look at the other answers.
You can take a look at TPathBuilder record in SvClasses unit from delphi-oop library. This unit does not support Delphi 2007 but TPathBuilder implementation is compatible with this Delphi version. Example usage:
var
LFullPath: string;
begin
LFullPath := TPathBuilder.InitCustomPath('c:\foo\bar').GoUpFolder.AddFile('baz.txt').ToString;
//LFullPath = c:\foo\baz.txt

How to use this Hyphenation library in delphi?

This is a hyphenation lib by Synopse delphi open source.
The demo is a console application. I do not know how to use it in GUI application.
Below is my test, but not work. It does not display word with hyphen (or separaror). The lib can be downloaded here:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, hyphen, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
procedure testhyphenator;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
procedure TForm1.testhyphenator;
var
h: THyphen;
s: string;
F, L: Integer;
begin
s := 'hyph_en_US.txt'; //this is from the folder, is that correct to call?
if FileExists(s) then
begin
F := FileOpen(s, fmOpenRead);
L := FileSeek(F, 0, soFromEnd);
if L > 0 then
begin
SetLength(s, L);
FileSeek(F, 0, soFromBeginning);
FileRead(F, s[1], L);
end;
FileClose(F);
end;
h := THyphen.Create(s);
h.Execute('pronunciation'); //is this correct?
ShowMessage(h.filllist); //not display hyphenated word
end;
It does not display hyphenated word. In the demo, I am also confused about the constructor:
H := THyphen.create('ISO8859-1'#10'f1f'#10'if3fa/ff=f,2,2'#10'tenerif5fa');
writeln('"',H.Execute('SchiffahrT'),'"'); writeln(H.FillList);
...
The author has also enclosed the obj file. If I want to compile it into a single exe, how to do it?
Can you please help me understand how to use it correctly?
Thanks a lot.
Disclaimer: I have harnessed a not so recent distribution of Hyphen, it may not be in sync with the latest version.
Here are my points:
Compilation of the distribution
I have compiled it under Delphi 7 and it's OK.
hyphen.rc File
There is no hyph_en_EN.dic file in the distribution. If you are going to rebuild hyphen.res, you may need to fix hyphen.rc using the following:
hyphen Text HYPH_EN_US.dic
I have not checked the hyphen.res file in the distribution wether it contains hyph_en_EN.dic and/or hyph_en_US.dic.
*.dic Files available in my distribution
hyph_it_IT.dic
hyph_es_ES.dic
hyph_fr_FR.dic
hyp_en_US.dic
hyp_de_DE.dic
Answers to the comments in your snippet
s := 'hyph_en_US.txt'; //this is from the folder, is that correct to call?
No! The correct file extension is .dic. You should write instead:
s := 'hyph_en_US.dic;
The following is Ok (you can refer to the definition of THyphen class):
Execute('pronunciation'); // is this correct?
The following is Ok (but it doesn't work because h as a THyphen instance was not properly initialized):
ShowMessage(h.filllist); //not display hyphenated word
Your concern about the constructor
H := THyphen.create('ISO8859-1'#10'f1f'#10'if3fa/ff=f,2,2'#10'tenerif5fa');
It's just one of the proper way to set up THyphen (refer again to the definition of THyphen class among others).
E.g.:
H := THyphen.create('EN');
Harnessing hyphen in a GUI App using Delphi 2007
I can tell that it's OK so long as THyphen instance is properly constructed (Dont forget to include the hyphen.res resource file with {$R hyphen.res}, the hyphen.obj file is already linked in the hyphen.pas unit).
Last but not the least
Feel free to get in touch with Arnaud Bouchez the great man behind Synopse. He is a Stackoverflow member and always ready to help for sure, a top delphi user moreover.
I don't have my Delphi install handy, so understand you may need to tweak this a bit.
After looking at the hyphen code, I believe you are using it incorrectly. The parameter on the constructor is the language or character set.
h := THyphen.Create('UTF-8');
or (based on your file name, I think you need this next one)
h := THyphen.Create('EN');
Then "Execute" is used to generate a hyphenated version of the string passed in. "Execute" is a function that returns a new string. You are calling it, but not doing anything with the result.
NewStr := h.Execute('correct');
"NewStr" should now equal "cor-rect".
If I read the code correctly, the "FillList" function and procedure return a list of all of the possible hyphenation possibilities for the last word that was Execute'd.

How to use A-links and A-keywords with CHM help file in Delphi XE?

The "A" in A-links and A-keywords stands for "associative". This is because A-link keywords are actually not keywords at all. They are more like link or jump targets (known as anchors in H&M). They are never visible to the user like index keywords. They are known as "associative" because they are not absolute targets.
How to call CHM help by A-keyword in Delphi XE?
The Windows API function HTMLHelp is directly available in the Windows unit. You want the HH_ALINK_LOOKUP command.
If you're using the help system from HelpInfts, the HtmlHelpViewer unit contains THtmlHelpViewer, which contains various methods for dealing with ALinks - specifically LookupALink. Unfortunately, there seems to be no documentation of the type, so you'll have to drill down into the source yourself (it is quite simple, so you should not have too much trouble).
I don't see any support for it in helpintfs.
I tried myself once with D2006/FPC, and commited the results to FPC:
You'll need the unit "htmlhelp" from
http://svn.freepascal.org/cgi-bin/viewvc.cgi/trunk/packages/winunits-base/src/htmlhelp.pp?view=co
and do some ansi->unicode translation in that file (e.g. change all pchar to pansichar, replacint ptr(u)int with native(u)int etc)
This file has a constant HH_ALINK_LOOKUP that afaik can be used to lookup alinks and keywords.
This can be passed to the htmlhelp function. The below code is from Free Pascal and uses ansistrings, but it probably works analogous in Delphi
{$apptype console}
Uses HTMLHelp;
var
keyword : ansistring;
HelpfileName : AnsiString;
htmltopic : AnsiString;
res : Integer;
ah : PHH_AKLINK ;
Begin
Helpfilename:='rtl.chm';
keyword:='Sysutils' ;
New(ah);
fillchar(ah^,sizeof(ah^),#0);
ah.cbstruct:=sizeof(tagHH_AKLINK);
ah.fReserved := FALSE ;
ah.pszKeywords :=pansichar(keyword);
ah.pszUrl := NIL ;
ah.pszMsgText :='Text succes' ;
ah.pszMsgTitle :='Text fail';
ah.pszWindow := NIL ;
ah.fIndexOnFail:= false;
Res:=HtmlHelpA(0,pansichar(helpfilename) ,HH_DISPLAY_INDEX,PTRUINT(PAnsiChar(Keyword)));
// keyword search seems to have same effect.
Res:=HtmlHelpA(0,pansichar(helpfilename) ,HH_ALINK_LOOKUP,PTRUINT(AH));
writeln(ah.pszkeywords);
writeln(ah.pszurl);
writeln(ah.pszmsgtext);
writeln(ah.pszmsgtitle);
writeln(ah.pszwindow);
writeln(res);
readln;
end.

Resources