Can anybody say please why this does not crypt/decrypt strings? It only crypts them but no way back to written text:
procedure TForm1.btnEncryptClick(Sender: TObject);
var
i: integer;
Cipher: TDCP_rc4;
KeyStr: string;
begin
KeyStr:= '';
if InputQuery('Passphrase','Enter passphrase',KeyStr) then // get the passphrase
begin
Cipher:= TDCP_rc4.Create(Self);
Cipher.InitStr(KeyStr,TDCP_sha1); // initialize the cipher with a hash of the passphrase
for i:= 0 to Memo1.Lines.Count-1 do // encrypt the contents of the memo
Memo1.Lines[i]:= Cipher.EncryptString(Memo1.Lines[i]);
Cipher.Burn;
Cipher.Free;
end;
end;
procedure TForm1.btnDecryptClick(Sender: TObject);
var
i: integer;
Cipher: TDCP_rc4;
KeyStr: string;
begin
KeyStr:= '';
if InputQuery('Passphrase','Enter passphrase',KeyStr) then // get the passphrase
begin
Cipher:= TDCP_rc4.Create(Self);
Cipher.InitStr(KeyStr,TDCP_sha1); // initialize the cipher with a hash of the passphrase
for i:= 0 to Memo1.Lines.Count-1 do // decrypt the contents of the memo
Memo1.Lines[i]:= Cipher.DecryptString(Memo1.Lines[i]);
Cipher.Burn;
Cipher.Free;
end;
end;
It is dcpcrypt library for Lazarus. The code is compiled without error, but no correct result in writeln procedure. Thanks for any help.
Related
So, once again I am learning new things and I came across Smart Pointers. I had code
procedure TForm3.BitBtn1Click(Sender: TObject);
var
_StringList: ISmartPointer<TStringList>;
begin
_StringList := TSmartPointer<TStringList>.Create(TStringList.Create);
end;
As you see variable declaration is kinda odd, and simplification is needed. I came across another solution
procedure TForm3.btnDelphiClick(Sender: TObject);
var
_StringList: TStringList;
begin
_StringList := SmartGuard.SmartGuard<TStringList>(TStringList.Create(False));
end;
Sadly, it does not work with parameterless constructor
procedure TForm3.btnDelphiClick(Sender: TObject);
var
_StringList: TStringList;
begin
_StringList := SmartGuard.SmartGuard<TStringList>(TStringList.Create);
end;
[dcc32 Error] Main.pas(47): E2089 Invalid typecast
Am I out of luck here?
P.S. I know some of you would argue I should stick to try..finally block, but this is out of curiosity.
unit SmartGuard;
interface
type
IGuard = interface
['{CE522D5D-41DE-4C6F-BC84-912C2AEF66B3}']
end;
TGuard = class(TInterfacedObject, IGuard)
private
FObject: TObject;
public
constructor Create(AObject: TObject);
destructor Destroy; override;
end;
SmartGuard<T: class> = record
private
FGuard: IGuard;
FGuardedObject: T;
public
class operator Implicit(GuardedObject: T): SmartGuard<T>;
class operator Implicit(Guard: SmartGuard<T>): T;
end;
implementation
uses
{Delphi}
System.SysUtils
{Project}
;
constructor TGuard.Create(AObject: TObject);
begin
FObject := AObject;
end;
destructor TGuard.Destroy;
begin
FObject.Free;
inherited;
end;
{ SmartGuard }
class operator SmartGuard<T>.Implicit(GuardedObject: T): SmartGuard<T>;
begin
Result.FGuard := TGuard.Create(GuardedObject);
Result.FGuardedObject := GuardedObject;
end;
class operator SmartGuard<T>.Implicit(Guard: SmartGuard<T>): T;
begin
Result := Guard.FGuardedObject;
end;
end.
I would love to find a solution that would not require additional "method" calling as in here https://github.com/marcocantu/DelphiSessions/blob/master/DelphiLanguageCodeRage2018/02_SmartPointers/SmartPointerClass.pas e.g. _StringList.Value.Add('foo'); and "special" brackets e.g. _StringList := TSmartPointer<TStringList>.Create(TStringList.Create)();
The compiler needs help disambiguating
TStringList.Create
The compiler doesn't know whether this is a reference to a method, or a call to the method.
Disambiguate by adding parens to indicate that it is a call.
_StringList := SmartGuard.SmartGuard<TStringList>(TStringList.Create());
(First, I am not sure whether this question is placed in the correct section of Stack Exchange. If not so, please give me a notice and delete the question.)
I have 8 Arduino's (Ards). Some Uno's and some 2650 Mega's. In an attempt to automatize the connection process (I use Delphi D-7 SE as I/O), I want to differentate between the UNO and the 2650 (mostly because the hardware differences in the appropriate chip). The way to do this (I think), is to get the PID and VID from the board. But I don't know how to do this. The code below gives me the correct driver, but not PID/VID . Is it possible to get PID/VID for this code-snippet ?? IF so, HOW ?
Thanks a lot.
Code here:
unit ArduinoTestU;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, JVsetupAPI, Registry, StdCtrls,
CPortCtl, CPort, Menus, XPMan;
type
TMainForm = class(TForm)
ListBox1: TListBox;
Label1: TLabel;
Button1: TButton;
procedure FormCreate(Sender: TObject);
function SetupEnumAvailableComPorts : TstringList;
procedure ListBox1Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
ArdType : Integer;
end;
var
MainForm : TMainForm;
ComPortStringList : TStringList;
MyComPort : String;
CurDir : String;
implementation
uses Form1Unit, ArdFormU; (* , ArdFormU; *)
{$R *.dfm}
procedure TMainForm.Button1Click(Sender: TObject);
begin
MainForm.FormActivate(NIL);
end;
procedure TMainForm.FormActivate(Sender: TObject);
var
index : integer;
begin
ComPortStringList := SetupEnumAvailableComPorts;
if (ComPortStringList <> nil) and (ComPortStringList.Count > 0) then
for Index := 0 to ComPortStringList.Count - 1 do
Listbox1.Items.Add(ComPortStringList[Index]);
if Listbox1.Items.Count <> 0 then
BEGIN
Listbox1.Enabled := True;
Button1.Enabled := False;
END;
end;
procedure TMainForm.FormCreate(Sender: TObject);
BEGIN
Curdir := ExtractFileDir(Application.Exename);
end;
(*
The function below returns a list of available COM-ports
(not open by this or an other process), with friendly names. The list is formatted as follows:
COM1: = Communications Port (COM1)
COM5: = NI Serial Port (Com5)
COM6: = NI Serial Port (Com6)
COM7: = USB Serial Port (COM7)
COM8: = Bluetooth Communications Port (COM8)
COM9: = Bluetooth Communications Port (COM9)
This code originally posted at http://www.delphi3000.com/articles/article_4001.asp?SK=
errors have been fixed so it will work with Delphi 7 and SetupAPI from JVCL
*)
function TMainForm.SetupEnumAvailableComPorts : TstringList;
//
// Enumerates all serial communications ports that are available and ready to
// be used.
//
var
RequiredSize: Cardinal;
GUIDSize: DWORD;
Guid: TGUID;
DevInfoHandle: HDEVINFO;
DeviceInfoData: TSPDevInfoData;
MemberIndex: Cardinal;
PropertyRegDataType: DWord;
RegProperty: Cardinal;
RegTyp: Cardinal;
Key: Hkey;
Info: TRegKeyInfo;
S1,S2: string;
hc: THandle;
begin
Result := Nil;
//
//If we cannot access the setupapi.dll then we return a nil pointer.
//
if not LoadsetupAPI then
exit;
try
//
// get 'Ports' class guid from name
//
GUIDSize := 1; // missing from original code - need to tell function that the Guid structure contains a single GUID
if SetupDiClassGuidsFromName('Ports',#Guid,GUIDSize,RequiredSize) then
begin
//
//get object handle of 'Ports' class to interate all devices
//
DevInfoHandle := SetupDiGetClassDevs(#Guid,Nil,0,DIGCF_PRESENT);
if Cardinal(DevInfoHandle) <> Invalid_Handle_Value then
begin
try
MemberIndex := 0;
result := TStringList.Create;
//iterate device list
repeat
FillChar(DeviceInfoData,SizeOf(DeviceInfoData),0);
DeviceInfoData.cbSize := SizeOf(DeviceInfoData);
//get device info that corresponds to the next memberindex
if Not SetupDiEnumDeviceInfo(DevInfoHandle,MemberIndex,DeviceInfoData) then
break;
//query friendly device name LIKE 'BlueTooth Communication Port (COM8)' etc
RegProperty := SPDRP_FriendlyName; {SPDRP_Driver, SPDRP_SERVICE, SPDRP_ENUMERATOR_NAME,SPDRP_PHYSICAL_DEVICE_OBJECT_NAME,SPDRP_FRIENDLYNAME,}
SetupDiGetDeviceRegistryProperty(DevInfoHandle, DeviceInfoData,RegProperty, PropertyRegDataType,NIL,0,RequiredSize);
SetLength(S1,RequiredSize);
// ShowMessage('TEST: ' + S1);
if SetupDiGetDeviceRegistryProperty(DevInfoHandle,DeviceInfoData,RegProperty,PropertyRegDataType,#S1[1],RequiredSize,RequiredSize) then
begin
KEY := SetupDiOpenDevRegKey(DevInfoHandle,DeviceInfoData,DICS_FLAG_GLOBAL,0,DIREG_DEV,KEY_READ);
if key <> INValid_Handle_Value then
begin
FillChar(Info, SizeOf(Info), 0);
//query the real port name from the registry value 'PortName'
if RegQueryInfoKey(Key, nil, nil, nil, #Info.NumSubKeys,#Info.MaxSubKeyLen, nil, #Info.NumValues, #Info.MaxValueLen,
#Info.MaxDataLen, nil, #Info.FileTime) = ERROR_SUCCESS then
begin
RequiredSize := Info.MaxValueLen + 1;
SetLength(S2,RequiredSize);
if RegQueryValueEx(KEY,'PortName',Nil,#Regtyp,#s2[1],#RequiredSize) = Error_Success then
begin
If (Pos('COM',S2) = 1) then
begin
//Test if the device can be used
hc := CreateFile(pchar('\\.\' + S2 + #0), GENERIC_READ or GENERIC_WRITE,
0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if hc <> INVALID_HANDLE_VALUE then
begin
Result.Add(Strpas(PChar(S2)) + ' := ' + StrPas(PChar(S1)));
CloseHandle(hc);
end;
end;
end;
end;
RegCloseKey(key);
end;
end;
Inc(MemberIndex);
until False;
//If we did not found any free com. port we return a NIL pointer.
if Result.Count = 0 then
begin
Result.Free;
Result := NIL;
end
finally
SetupDiDestroyDeviceInfoList(DevInfoHandle);
end;
end;
end;
finally
UnloadSetupApi;
end;
end;
procedure TMainForm.ListBox1Click(Sender: TObject);
begin
Ardtype := Listbox1.ItemIndex;
MainForm.Hide;
ArdForm.ShowModal;
if Ardform.ModalResult <> mrOK then
ShowMessage('Der opstod en fejl ')
ELSE
BEGIN
MainForm.Show;
END;
end;
end.
Kris aka snestrup2016
I am creating a program that moves through an array of records and save these student records to a file.
However I now wish to reload the data (StudentName,Class,Grade) back into the array and subsequently display them in a list box on another form.
I have tried a few methods but with no success.
This is the code that wrote the file:
unit NewStudent;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, studentdata;
{ TFormNewStudent }
Type
TFormNewStudent = class(TForm)
Button1: TButton;
ButtonAddStudent: TButton;
Button3: TButton;
ComboBoxPredictedGrade: TComboBox;
EditClass: TEdit;
EditName: TEdit;
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure ButtonAddStudentClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
Type
TPupil = Record
Name:String[30];
ClassGroup:String;
ComboBoxPredictedGrade:Integer;
end;
var
FormNewStudent: TFormNewStudent;
StudentRecArray : Array[1..30] of TPupil;
StudentNo:integer;
studentFile:TextFile;
implementation
{$R *.lfm}
{ TFormNewStudent }
procedure TFormNewStudent.Button1Click(Sender: TObject);
begin
FormStudentData.visible:=true;
FormNewStudent.visible:=false;
end;
procedure TFormNewStudent.Button3Click(Sender: TObject);
begin
FormStudentData.visible:=False;
FormNewStudent.visible:=True;
end;
procedure TFormNewStudent.ButtonAddStudentClick(Sender: TObject);
var
newStudent:string;
Begin
assignfile(studentFile,'G:\ExamGen\studentfile.txt');
StudentRecArray[StudentNo].Name:=EditName.text;
StudentRecArray[StudentNo].ClassGroup:=EditClass.text;
StudentRecArray[StudentNo].ComboBoxPredictedGrade:=ComboBoxPredictedGrade.ItemIndex;
append(studentFile);
newStudent:=(StudentRecArray[StudentNo].Name)+','+(StudentRecArray[StudentNo].ClassGroup)+','+(IntToStr(StudentRecArray[StudentNo].ComboBoxPredictedGrade));
writeln(studentFile,newStudent);
closefile(StudentFile);
StudentNo := StudentNo + 1;
end;
procedure TFormNewStudent.FormCreate(Sender: TObject);
begin
ComboBoxPredictedGrade.Items.Add('A');
ComboBoxPredictedGrade.Items.Add('B');
ComboBoxPredictedGrade.Items.Add('C');
ComboBoxPredictedGrade.Items.Add('D');
ComboBoxPredictedGrade.Items.Add('E');
ComboBoxPredictedGrade.Items.Add('U');
end;
end.
ScreenShot 1: StudentFile
ScreenShot 2: AddStudent Form
Answer given by Zamrony P. Juhara is correct, but your approach here may be not the most convenient. You define record which contains information about each student, then you write procedures to write this record to file and another one to read it. If you'll eventually change format of your record, you'll have to rewrite this code also. There are better ways, in my opinion.
You can define record containing only simplest members, like Ken White suggested:
TPupil = Record
Name:String[30];
ClassGroup:String[20]; //some convenient value
ComboBoxPredictedGrade:Integer;
end;
Such a record have fixed size and contains all needed information in itself (version with ClassGroup:String actually stores pointer to another area in memory where your string is), and then you can save and load it extremely easy:
var
myFile : File of TPupil;
procedure TFormNewStudent.ButtonAddStudentClick(Sender: TObject);
Begin
assignfile(studentFile,'G:\ExamGen\studentfile.txt');
StudentRecArray[StudentNo].Name:=EditName.text;
StudentRecArray[StudentNo].ClassGroup:=EditClass.text;
StudentRecArray[StudentNo].ComboBoxPredictedGrade:=ComboBoxPredictedGrade.ItemIndex;
append(studentFile);
Write(studentFile,StudentRecArray[StudentNo]); //THAT'S IT!
closefile(StudentFile);
inc(StudentNo);
end;
procedure TFormNewStudent.ReadFromFile;
begin
AssignFile(myFile,'G:\ExamGen\studentfile.txt');
Reset(studentFile);
StudentNo:=1;
while not Eof(studentFile) do begin
Read(studentFile,StudentRecArray[i]);
inc(StudentNo);
end;
end;
There is little drawback: file is not so readable as it was before, because Integer is saved exactly as 4-byte value, not its decimal representation.
There is much more interesting possibilities if you move from record to class, in that case you can use streaming system in a way as IDE saves forms to disc, in .dfm or .lfm files, so you'll be able to automatically save complex ierarchies of objects and load them back.
var
myFile : TextFile;
text : string;
lines : TStringList;
i : integer;
...
lines := TStringList.Create();
AssignFile(studentFile,'G:\ExamGen\studentfile.txt');
Reset(studentFile);
i:=1;
while not Eof(studentFile) do
begin
ReadLn(studentFile, text);
lines.CommaText := text;
studentRecArray[i].Name := lines[0];
studentRecArray[i].ClassGroup := lines[1];
studentRecArray[i].ComboBoxPredictedGrade := StrToInt(lines[2]);
inc(i);
end;
CloseFile(studentFile);
lines.Free();
I have tried the following code (and varients) without any sucess, nor can I find any examples of how to call these Windows Functions from Delphi out there. Any clues would be very gratefully received.
The CryptProtectMemory does appear to produce some possibly encrypted result, but the unprotect does not change that result at all.I suspect I have done something charactisticly stupid, but I havent found it all day...
function WinMemEnc(PlnTxt: String): String;
var
Enc: Pointer;
j: Integer;
EncSze: Cardinal;
ws: String;
const
CRYPTPROTECTMEMORY_SAME_PROCESS: Cardinal = 0;
EncryptionBlockSize: Integer = 8;
begin
if Length(PlnTxt) mod EncryptionBlockSize = 0 then
j := Length(PlnTxt)
else
j := ((Length(PlnTxt) div 8) + 1) * 8;
ws := StringofChar(' ', j);
Move(PlnTxt[1], ws[1], j);
Enc := Pointer(ws);
EncSze := j * 2;
if CryptProtectMemory(Enc, EncSze, CRYPTPROTECTMEMORY_SAME_PROCESS) then
begin
Setlength(Result, j);
Move(Enc, Result[1], EncSze);
end;
end;
function WinMemDcr(EncInp: String): String;
var
Enc: Pointer;
j: Integer;
EncSze: Cardinal;
ws: String;
const
CRYPTPROTECTMEMORY_SAME_PROCESS: Cardinal = 0;
begin
j := Length(EncInp);
EncSze := j * 2;
ws := EncInp;
Enc := Pointer(ws);
if CryptUnprotectMemory(Enc, EncSze, CRYPTPROTECTMEMORY_SAME_PROCESS) then
begin
Setlength(Result, j);
Move(Enc, Result[1], EncSze);
end;
end;
You have set EncryptionBlockSize := 8; while in my library CRYPTPROTECTMEMORY_BLOCK_SIZE = 16.
You also mistakenly move only half of the input string to ws, because j holds the length of the string while Move() moves Count number of bytes. A Unicode Char is 2 bytes.
As said in the comments, encryption/decryption works on bytes and storing an encryption in a string is a potential disaster.
So here's my suggestion for a encryption/decryption of a string with encrypted storage in TBytes.
function MemEncrypt(const StrInp: String): TBytes;
begin
Result := TEncoding.Unicode.GetBytes(StrInp);
if Length(Result) mod CRYPTPROTECTMEMORY_BLOCK_SIZE <> 0 then
SetLength(Result, ((Length(Result) div CRYPTPROTECTMEMORY_BLOCK_SIZE) + 1) * CRYPTPROTECTMEMORY_BLOCK_SIZE);
if not CryptProtectMemory(Result, Length(Result), CRYPTPROTECTMEMORY_SAME_PROCESS) then
raise Exception.Create('Error Message: '+IntToStr(GetLastError));
end;
function MemDecrypt(const EncInp: TBytes): String;
var
EncTmp: TBytes;
begin
EncTmp := Copy(EncInp);
if CryptUnprotectMemory(EncTmp, Length(EncTmp), CRYPTPROTECTMEMORY_SAME_PROCESS) then
result := TEncoding.Unicode.GetString(EncTmp)
else
raise Exception.Create('Error Message: '+IntToStr(GetLastError));
end;
In the decryption a copy of the input TBytes is made to preserve the encrypted data.
And finally a test procedure:
procedure TForm13.Button2Click(Sender: TObject);
const
Txt = '1234567890123456789012345678901';
var
s: string;
b: TBytes;
begin
s := Txt;
Memo1.Lines.Add(s);
b := MemEncrypt(Txt);
s := MemDecrypt(b);
Memo1.Lines.Add(s);
end;
Without testing it (purely from the looks of your code), I believe the problem lies in the MOVE statement:
Move(Enc, Result[1], EncSze);
You are moving data from the location of the pointer - not from the data that the pointer is pointing to.
You should use
Move(Enc^, Result[1], EncSze);
to move data from the location that is POINTED TO by the pointer, and not from the pointer itself.
To clarify: The Enc variable is - say - located at address $12345678 and the data you are manipulating is located at address $99999999
This means that at address $12345678 is located 4 bytes ($99 $99 $99 and $99). And at address $99999999 is located the data you are manipulating.
The statement
Move(Enc, Result[1], EncSze);
thus moves EncSize bytes from the address $12345678 to the 1st character of the string variable Result. This you do not want, as it will only move 4 bytes of $99 and then whatever follows at address $1234567C and on.
To move data from the address $99999999 you need to tell the compiler, that you want to move data from the location POINTED TO by the pointer, and not from the POINTER itself:
Move(Enc^, Result[1], EncSze);
But other that that, I agree with David. You should stop using strings as storage for non-string data. It'll bite you in the a** at some point. Use a byte array (TBytes) instead.
I am hunting a bug which might be connected to unit initialization order. Is there a way to see which initialization section was executed when? I need to know the order. This is during debugging, so I have the full power of the Delphi IDE, in my case Delphi 2009.
I could set breakpoints, but this is rather tedious when having many units.
Do you have any suggestions?
Here is some code I just tested in D2010, note that you need to set a Breakpoint in System.InitUnits and get the address of InitContext var (#InitContext). Then modify CtxPtr to have this address WHILE STILL RUNNING. (Maybe someone knows a smarter way for this).
procedure TForm3.Button2Click(Sender: TObject);
var
sl: TStringList;
ps: PShortString;
CtxPtr: PInitContext;
begin
// Get the address by setting a BP in SysUtils.InitUnits (or map file?)
CtxPtr := PInitContext($4C3AE8);
sl := TStringList.Create;
try
ps := CtxPtr^.Module^.TypeInfo^.UnitNames;
for i := 0 to CtxPtr^.Module^.TypeInfo^.UnitCount - 1 do
begin
sl.Add(ps^);
// Move to next unit
DWORD(ps) := DWORD(ps) + Length(ps^) + 1;
end;
Memo1.Lines.Assign(sl);
finally
sl.Free;
end;
end;
/EDIT: and here is a version using JclDebug and a mapfile:
type
TForm3 = class(TForm)
...
private
{ Private declarations }
var
Segments: array of DWORD;
procedure PublicsByValue(Sender: TObject; const Address: TJclMapAddress; const Name: string);
procedure MapSegment(Sender: TObject; const Address: TJclMapAddress; Len: Integer; const GroupName, UnitName: string);
procedure MapClassTable(Sender: TObject; const Address: TJclMapAddress; Len: Integer; const SectionName, GroupName: string);
public
{ Public declarations }
end;
var
Form3: TForm3;
CtxPtr: PInitContext = nil; // Global var
procedure TForm3.MapClassTable(Sender: TObject; const Address: TJclMapAddress;
Len: Integer; const SectionName, GroupName: string);
begin
SetLength(Segments, Length(Segments) + 1);
SegMents[Address.Segment-1] := Address.Offset;
end;
procedure TForm3.PublicsByValue(Sender: TObject; const Address: TJclMapAddress;
const Name: string);
const
InitContextStr = 'System.InitContext';
begin
if RightStr(Name, Length(InitContextStr)) = InitContextStr then
begin
CtxPtr := PInitContext(Segments[Address.Segment-1] + Address.Offset);
end;
end;
procedure TForm3.Button2Click(Sender: TObject);
var
MapParser: TJclMapParser;
MapFile: String;
sl: TStringList;
ps: PShortString;
i: Integer;
begin
MapFile := ChangeFileExt(Application.ExeName, '.map');
MapParser := TJclMapParser.Create(MapFile);
try
MapParser.OnPublicsByValue := PublicsByValue;
MapParser.OnClassTable := MapClassTable;
MapParser.Parse;
finally
MapParser.Free;
end;
if CtxPtr = nil then
Exit;
sl := TStringList.Create;
try
ps := CtxPtr^.Module^.TypeInfo^.UnitNames;
for i := 0 to CtxPtr^.Module^.TypeInfo^.UnitCount - 1 do
begin
sl.Add(ps^);
// Move to next unit
DWORD(ps) := DWORD(ps) + Length(ps^) + 1;
end;
Memo1.Lines.Assign(sl);
finally
sl.Free;
end;
end;
Output in my case:
Variants
VarUtils
Windows
Types
SysInit
System
SysConst
SysUtils
Character
RTLConsts
Math
StrUtils
ImageHlp
MainUnit
JwaWinNetWk
JwaWinType
JwaWinNT
JwaWinDLLNames
JwaWinError
StdCtrls
Dwmapi
UxTheme
SyncObjs
Classes
ActiveX
Messages
TypInfo
TimeSpan
CommCtrl
Themes
Controls
Forms
StdActns
ComCtrls
CommDlg
ShlObj
StructuredQueryCondition
PropSys
ObjectArray
UrlMon
WinInet
RegStr
ShellAPI
ComStrs
Consts
Printers
Graphics
Registry
IniFiles
IOUtils
Masks
DateUtils
Wincodec
WinSpool
ActnList
Menus
ImgList
Contnrs
GraphUtil
ZLib
ListActns
ExtCtrls
Dialogs
HelpIntfs
MultiMon
Dlgs
WideStrUtils
ToolWin
RichEdit
Clipbrd
FlatSB
Imm
TpcShrd
/EDIT2: And here a version for D2009 (requires JclDebug):
unit MainUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StrUtils, JclDebug, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
var
Segments: array of DWORD;
procedure PublicsByValue(Sender: TObject; const Address: TJclMapAddress; const Name: string);
procedure MapClassTable(Sender: TObject; const Address: TJclMapAddress; Len: Integer; const SectionName, GroupName: string);
public
{ Public declarations }
end;
var
Form1: TForm1;
CtxPtr: PInitContext = nil; // Global var
Symbols: TStringList;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
MapParser: TJclMapParser;
MapFile: String;
sl: TStringList;
ps: PShortString;
i: Integer;
s: String;
Idx: Integer;
begin
MapFile := ChangeFileExt(Application.ExeName, '.map');
MapParser := TJclMapParser.Create(MapFile);
try
MapParser.OnPublicsByValue := PublicsByValue;
MapParser.OnClassTable := MapClassTable;
Memo1.Lines.BeginUpdate;
MapParser.Parse;
Memo1.Lines.EndUpdate;
finally
MapParser.Free;
end;
if CtxPtr = nil then
Exit;
sl := TStringList.Create;
try
for i := 0 to CtxPtr^.InitTable.UnitCount-1 do
begin
if Assigned(CtxPtr^.InitTable.UnitInfo^[i].Init) then
begin
s := Format('$%.8x', [DWORD(CtxPtr^.InitTable.UnitInfo^[i].Init)]);
Idx := Symbols.IndexOfObject(TObject(CtxPtr^.InitTable.UnitInfo^[i].Init));
if Idx > -1 then
begin
Memo1.Lines.Add(Format('%.4d: %s', [i, Symbols[Idx]]));
end;
end;
end;
finally
sl.Free;
end;
end;
procedure TForm1.MapClassTable(Sender: TObject; const Address: TJclMapAddress;
Len: Integer; const SectionName, GroupName: string);
begin
SetLength(Segments, Length(Segments) + 1);
SegMents[Address.Segment-1] := Address.Offset;
end;
procedure TForm1.PublicsByValue(Sender: TObject; const Address: TJclMapAddress;
const Name: string);
const
InitContextStr = 'System.InitContext';
begin
if RightStr(Name, Length(InitContextStr)) = InitContextStr then
begin
CtxPtr := PInitContext(Segments[Address.Segment-1] + Address.Offset);
end
else begin
Symbols.AddObject(Name, TObject(Segments[Address.Segment-1] + Address.Offset));
end;
end;
initialization
Symbols := TStringList.Create;
Symbols.Sorted := True;
Symbols.Duplicates := dupIgnore;
finalization
FreeAndNil(Symbols);
end.
Output on my system (Unitname.Unitname is actually Unitname.Initialization):
0001: System.System
0003: Windows.Windows
0011: SysUtils.SysUtils
0012: VarUtils.VarUtils
0013: Variants.Variants
0014: TypInfo.TypInfo
0016: Classes.Classes
0017: IniFiles.IniFiles
0018: Registry.Registry
0020: Graphics.Graphics
0023: SyncObjs.SyncObjs
0024: UxTheme.UxTheme
0025: MultiMon.MultiMon
0027: ActnList.ActnList
0028: DwmApi.DwmApi
0029: Controls.Controls
0030: Themes.Themes
0032: Menus.Menus
0033: HelpIntfs.HelpIntfs
0034: FlatSB.FlatSB
0036: Printers.Printers
0047: GraphUtil.GraphUtil
0048: ExtCtrls.ExtCtrls
0051: ComCtrls.ComCtrls
0054: Dialogs.Dialogs
0055: Clipbrd.Clipbrd
0057: Forms.Forms
0058: JclResources.JclResources
0059: JclBase.JclBase
0061: JclWin32.JclWin32
0063: ComObj.ComObj
0064: AnsiStrings.AnsiStrings
0065: JclLogic.JclLogic
0066: JclStringConversions.JclStringConversions
0067: JclCharsets.JclCharsets
0068: Jcl8087.Jcl8087
0073: JclIniFiles.JclIniFiles
0074: JclSysInfo.JclSysInfo
0075: JclUnicode.JclUnicode
0076: JclWideStrings.JclWideStrings
0077: JclRegistry.JclRegistry
0078: JclSynch.JclSynch
0079: JclMath.JclMath
0080: JclStreams.JclStreams
0081: JclAnsiStrings.JclAnsiStrings
0082: JclStrings.JclStrings
0083: JclShell.JclShell
0084: JclSecurity.JclSecurity
0085: JclDateTime.JclDateTime
0086: JclFileUtils.JclFileUtils
0087: JclConsole.JclConsole
0088: JclSysUtils.JclSysUtils
0089: JclUnitVersioning.JclUnitVersioning
0090: JclPeImage.JclPeImage
0091: JclTD32.JclTD32
0092: JclHookExcept.JclHookExcept
0093: JclDebug.JclDebug
0094: MainUnit.MainUnit
For units in the interface uses list,
the initialization sections of the
units used by a client are executed in
the order in which the units appear in
the client's uses clause.
see Online Help \ Programs and Units \ The Initialization Section and this article: Understanding Delphi Unit initialization order
ICARUS computes the Runtime initialization order for its Uses Report:
This section lists the order in which the initialization sections are executed at runtime.
You might check out the unit System and SysInit and look for the procedure InitUnits. Here you see that every module compiled with Delphi has a list of units initialization and finalization pointers. Using those plus a map file might give you the exact initialization order, but it will take some pointer hackery.
How about adding
OutputDebugString('In MyUnit initialization');
to the initialization sections?
You can set breakpoints on all initialization sections that don't break but write a message to the debugger log. It will give you the same list as adding OutputDebugString('...') calls but without having to modify the source code of all units.