How to Sort Sections on TMemIniFile - oop

I am using TMemIniFile to store configuration and I need to sort the sections in alpha order.
For that I have created a descendant of TMemIniFile
TRWStudioMemIniFile = class(TMemIniFile)
public
procedure UpdateFile; override;
procedure GetSortedStrings(List: TStrings);
end;
{ TRWStudioMemIniFile }
procedure TRWStudioMemIniFile.GetSortedStrings(List: TStrings);
var
I, J: Integer;
Strings: TStrings;
begin
List.BeginUpdate;
try
Sections.Sort;
for I := 0 to Sections.Count - 1 do
begin
List.Add('[' + Sections[I] + ']');
Strings := TStrings(Sections.Objects[I]);
for J := 0 to Strings.Count - 1 do List.Add(Strings[J]);
List.Add('');
end;
finally
List.EndUpdate;
end;
end;
procedure TRWStudioMemIniFile.UpdateFile;
var
List: TStringList;
begin
List := TStringList.Create;
try
GetSortedStrings(List);
List.SaveToFile(FileName, Encoding);
finally
List.Free;
end;
end;
but it needs to have access to the Sections (actually FSections: TStringList, that is a private member of TMemIniFile)
I have created a Helper class to expose that member thru a property. However this behavior is not supported anymore in Delphi 10.1
I started copy/paste the TMemIniFile to my unit and after and endless process I am ending up making a copy of the entire System.IniFile, just to access the FSections.
My question is how to access that FSections member without need to duplicate everything from that unit just to gain visibility
OR is there another way that I can Sort the Sections before saving? (I am just calling the TStringList.Sort from FSections)

Rather than relying on type-casting and "cracking open" the private member, you can instead get the sections into your own TStringList using the inherited ReadSections() method, sort that list as needed, and then use the inherited ReadSectionValues() method to read the strings for each section:
var
sections: TStringList;
values: TStringList;
begin
sections := TStringList.Create;
try
ReadSections(sections);
sections.Sort;
values := TStringList.Create;
try
List.BeginUpdate;
try
for I := 0 to sections.Count - 1 do
begin
List.Add('[' + sections[I] + ']');
values.Clear; // Just in case
ReadSectionValues(sections[i], values);
for J := 0 to values.Count - 1 do
List.Add(values[J]);
List.Add('');
end;
finally
List.EndUpdate;
end;
finally
values.Free;
end;
finally
sections.Free;
end;
end;

Related

Delphi Syntax error in FROM clause, but no from clause

I'm really new to Delphi and have not yet worked with SQL (I'm a complete beginner).
I use code to connect my database and tables to my program, but as soon as I run my program, I get a Syntax error in FROM clause message.
When I select break, it highlights end; of a part of the code.
function TADOCommand.Execute(var RecordsAffected: Integer;
const Parameters: OleVariant): _Recordset;
var
VarRecsAffected: OleVariant;
begin
SetConnectionFlag(cfExecute, True);
try
Initialize;
Result := CommandObject.Execute(VarRecsAffected, Parameters,
Integer(CommandObject.CommandType) + ExecuteOptionsToOrd
(FExecuteOptions));
RecordsAffected := VarRecsAffected;
finally
SetConnectionFlag(cfExecute, False);
end;
end;
I have three tables, of which two display on their grids, but one is not displaying on the grid, and also gives me the Syntax error in FROM clause when I want to do anything with it.
This is the code that I used to connect my database in the datamodule:
unit dmChamps_u;
interface
uses
System.SysUtils, System.Classes, ADODB, DB; // add Ado and DB
type
TdmChamps = class(TDataModule)
procedure DataModuleCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
conArchers: TADOConnection;
tblArchers: TADOTable;
tblJT: TADOTable;
tblMatches: TADOTable;
dscArchers: TDataSource;
dscMatches: TDataSource;
dscJT: TDataSource;
end;
var
dmChamps: TdmChamps;
implementation
{%CLASSGROUP 'Vcl.Controls.TControl'}
{$R *.dfm}
procedure TdmChamps.DataModuleCreate(Sender: TObject);
begin
// create objects
conArchers := TADOConnection.Create(dmChamps);
tblArchers := TADOTable.Create(dmChamps);
tblMatches := TADOTable.Create(dmChamps);
tblJT := TADOTable.Create(dmChamps);
dscArchers := TDataSource.Create(dmChamps);
dscMatches := TDataSource.Create(dmChamps);
dscJT := TDataSource.Create(dmChamps);
// setup connection
conArchers.ConnectionString :=
'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=ArchChampsDB.mdb;Mode=ReadWrite;Persist Security Info=False';
conArchers.LoginPrompt := false;
conArchers.Open;
// setup table archers
tblArchers.Connection := conArchers;
tblArchers.TableName := 'Archers';
// setup data source
dscArchers.DataSet := tblArchers;
tblArchers.Open;
// setup table matches
tblMatches.Connection := conArchers;
tblMatches.TableName := 'Matches';
// setup data source
dscMatches.DataSet := tblMatches;
tblMatches.Open;
// setup table JT
tblJT.Connection := conArchers;
tblJT.TableName := 'Judges/Timekeepers';
// setup data source
dscJT.DataSet := tblJT;
tblJT.Open;
end;
end.
I've looked through all of the questions on the From clause error already on the site, but none of the scenarios quite match my problem. I also went to Embarcadero's site and read about TableDirect, which I thought might be a possible solution, but it was already in the code.
Your error is here
tblJT.TableName := 'Judges/Judges';
You can't has a table with that name, or Judges or Timekeepers
You can solve do it:
// setup table J
tblJT.Connection := conArchers;
tblJT.TableName := 'Judges';
// setup data source
dscJT.DataSet := tblJT;
tblJT.Open;
Separated
// setup table T
tblJT.Connection := conArchers;
tblJT.TableName := 'Timekeepers';
// setup data source
dscJT.DataSet := tblJT;
tblJT.Open;
Maybe it is because of the slash in 'Judges/Timekeepers'.
Did you try to debug step by step going to the code in DataModuleCreate?

Invalid Pointer Operation on TObjectList.DisposeOf

Hello folks and sorry if this is a duplicate but my specific issue I haven't seen answered anywhere yet.
I have an "Invalid Pointer Operation" when I try to free an ObjectList created at runtime at the following lines:
Prods := TItemProcedimento.Create(DM.FDQ).lerProdutos;
Prods.DisposeOf; // <- Invalid Pointer Operation at 2nd iteration
So, here's my classes:
unit uItemProcedimento;
interface
[...]
type
TItemProcedimento = class
[...]
public
constructor Create(DataSet: TFDQuery);
function lerProdutos: TObjectList<TItemProcedimento>;
[...]
constructor TItemProcedimento.Create(DataSet: TFDQuery);
begin
FDataSet := DataSet;
end;
function TItemProcedimento.lerProdutos: TObjectList<TItemProcedimento>;
begin
Result := TObjectList<TItemProcedimento>.Create;
try
FDataSet.Close;
FDataSet.SQL.Clear;
FDataSet.SQL.Add('SELECT *');
FDataSet.SQL.Add('FROM Produto p');
FDataSet.SQL.Add('JOIN ItensProcedimento IP on p.PRO_ID = IP.PRO_ID');
FDataSet.SQL.Add('ORDER BY p.PRO_Nome');
FDataSet.Open;
while not FDataSet.Eof do
begin
PRO_ID := FDataSet.FieldByName('PRO_ID').AsInteger;
PRO_Rendimento := FDataSet.FieldByName('PRO_Rendimento').AsInteger;
PRO_Nome := FDataSet.FieldByName('PRO_Nome').AsString;
PRO_Tipo := FDataSet.FieldByName('PRO_Tipo').AsInteger;
PRO_Custo := FDataSet.FieldByName('PRO_Custo').AsFloat;
PRO_Potencia := FDataSet.FieldByName('PRO_Potencia').AsFloat;
IPR_Uso := FDataSet.FieldByName('IPR_Uso').AsFloat;
Result.Add(self);
FDataSet.Next;
end;
finally
FDataSet.Close;
end;
The weirdest thing about this is that I have another class with the exact same behaviour and the method works without issues. Yes I am creating the object and immediately destroying it to test if I'm destroying it correctly.
In another class I have another example with the same code, but this time it works without errors
test := TMyClass.Create(DM.FDQ).lerTeste;
test.DisposeOf;
Why? What am I doing wrong? This test code is running before the current code btw, maybe its related?
UPDATE:
By applying the changes that Remy Lebeau suggested I managed to add properly the items to the list and dispose them so this particular part of the code has no leaks. But in another part of the code I have an ObjectList leak that I have no idea on how to fix.
Inside my class I have a property that is a TObjectList property, I have a method that checks if the list is assigned, if not, it creates it and returns it to whoever is calling the list.
[...]
type
TProcedimento = class
private
[...]
FPRC_Produtos: TObjectList<TItemProcedimento>;
public
[...]
function getPRC_Produtos: TObjectList<TItemProcedimento>;
function criaProcedimentos: TObjectList<TProcedimento>;
[...]
function TProcedimento.GetPRC_Produtos: TObjectList<TItemProcedimento>;
begin
if not Assigned(FPRC_Produtos) then
FPRC_Produtos:= TObjectList<TItemProcedimento>.Create;
result := FPRC_Produtos;
end;
function TProcedimento.criaProcedimentos: TObjectList<TProcedimento>;
var
IPR: TItemProcedimento;
Procedimento: TProcedimento;
ds: TFDQuery;
begin
result := TObjectList<TProcedimento>.Create;
ds := TFDQuery.Create(nil);
ds.Connection := FDataSet.Connection;
IPR := TItemProcedimento.Create(ds);
try
FDataSet.Close;
FDataSet.Open('SELECT * FROM Procedimento');
while not FDataSet.Eof do
begin
Procedimento := TProcedimento.Create(FDataSet);
Procedimento.PRC_ID := FDataSet.FieldByName('PRC_ID').AsInteger;
Procedimento.PRC_Nome := FDataSet.FieldByName('PRC_Nome').AsString;
Procedimento.PRC_Duracao := FDataSet.FieldByName('PRC_Duracao')
.AsDateTime;
Procedimento.PRC_Preco := FDataSet.FieldByName('PRC_Preco').AsCurrency;
Procedimento.PRC_Custo := FDataSet.FieldByName('PRC_Custo').AsCurrency;
Procedimento.PRC_Consumo := FDataSet.FieldByName('PRC_Consumo').AsFloat;
Procedimento.FPRC_Produtos := IPR.getItensProcedimento(FPRC_ID);
result.Add(Procedimento);
FDataSet.Next;
end;
finally
FDataSet.Close;
IPR.DisposeOf;
ds.DisposeOf;
end;
end;
I then use this property in a for-in loop to feed a list with the procs in my database
procedure TKBForm1.CarregaProcedimento;
var
Procedimento: TProcedimento;
Procs: TObjectList<TProcedimento>;
[...]
begin
Procs := TProcedimento.Create(DM.FDQ).criaProcedimentos;
try
LV_Procedimento.Items.Clear;
LV_Procedimento.BeginUpdate;
for Procedimento in Procs do
begin
with LV_Procedimento.Items.Add do
[...]
finally
Procs.DisposeOf;
Procedimento.GetPRC_Produtos.DisposeOf;
end;
end;
But there's still leaks happening after this part runs:
73 - 88 bytes: TProcedimento x 1, TItemProcedimento x 2
How do I fix this?

Does HelpNDoc Pascal Script support structures?

I am trying to create a structure:
MyTopic
TopicID : String;
HelpID : Integer;
I wanted to create an array of these structures so I could sort them.
I have tried using this type / record syntax but it is failing.
Update
I defined this type and procedure:
type
TMyTopicRecord = record
idTopic : String;
idContextHelp : integer;
End;
procedure GetSortedTopicIDs(aTopics : array of String; size : Integer);
var
aMyTopicRecords : array of TMyTopicRecord;
temp : TMyTopicRecord;
iTopic, i, j : Integer;
begin
// Init the array
SetLength(aMyTopicRecords, size);
// Fill the array with the existing topid ids.
// Get the context ids at the same time.
for iTopic := 0 to size - 1 do
aMyTopicRecords[iTopic].idTopic := aTopics[iTopic];
aMyTopicRecords[iTopic].idContextHelp := HndTopics.GetTopicHelpContext(aTopics[iTopic]);
// Sort the array on context id
for i := size-1 DownTo 1 do
for j := 2 to i do
if (aMyTopicRecords[j-1].idContextHelp > aMyTopicRecords[j].idContextHelp) Then
begin
temp := aMyTopicRecords[j-1];
aMyTopicRecords[j-1] := aMyTopicRecords[j];
aMyTopicRecords[j] := temp;
end;
// Rebuild the original array of topic ids
for iTopic := 0 to size - 1 do
aTopics[iTopic] := aMyTopicRecords[iTopic].idTopic;
end;
The procedure gets called in a loop of the parent function (code snipped):
function GetKeywordsAsHtml(): string;
var
aKeywordList: THndKeywordsInfoArray;
aAssociatedTopics: array of string;
nBlocLevel, nDif, nClose, nCurKeywordLevel, nCurKeywordChildrenCnt: Integer;
nCurKeyword, nCurKeywordTopic: Integer;
nCountAssociatedTopics: Integer;
sCurrentKeyword, sKeywordLink, sKeywordRelated: string;
sKeywordJsCaption: string;
begin
Result := '<ul>';
nBlocLevel := 0;
try
aKeywordList := HndKeywords.GetKeywordList(False);
for nCurKeyword := 0 to length(aKeywordList) - 1 do
begin
sCurrentKeyword := aKeywordList[nCurKeyword].id;
nCurKeywordLevel := HndKeywords.GetKeywordLevel(sCurrentKeyword);
nCurKeywordChildrenCnt := HndKeywords.GetKeywordDirectChildrenCount(sCurrentKeyword);
sKeywordLink := '#';
sKeywordRelated := '[]';
aAssociatedTopics := HndTopicsKeywords.GetTopicsAssociatedWithKeyword(sCurrentKeyword);
nCountAssociatedTopics := Length(aAssociatedTopics);
if nCountAssociatedTopics > 0 then
begin
GetSortedTopicIDs(aAssociatedTopics, nCountAssociatedTopics);
// Code snipped
end;
end;
finally
Result := Result + '</ul>';
end;
end;
The script compiled in the HelpNDoc internal editor with no issues. But when I go to actually build my HTML documentation I encounter a problem:
The HelpNDoc API is explained here.
Is there something wrong with my code?
I decided to go about it a different way and used a simpler technique:
procedure GetSortedTopicIDs(var aTopics : array of String; iNumTopics : Integer);
var
iTopic : Integer;
// List of output
aList: TStringList;
begin
// Init list
aList := TStringList.Create;
// Build a new array of "nnn x"
// - nnn is the help context id
// - x is the topid id
// Note: I know that the context ID values are within the range 0 - 200
for iTopic := 0 to iNumTopics - 1 do
// We pad the context id with 0. We could increase the padding width to
// make the script mre useful
aList.Add(Format('%0.3d %s', [
HndTopics.GetTopicHelpContext(aTopics[iTopic]),
aTopics[iTopic]
]));
// Now we sort the new array (which basically sorts it by context id)
aList.Sort;
// Update original array
for iTopic := 0 to iNumTopics - 1 do
// We ignore the "nnn " part of the string to get just the topic id
aTopics[iTopic] := copy(aList[iTopic],5, length(aList[iTopic])-4);
// Tidy up
aList.Free;
end;
This compiles and I get the sorted array of topic IDs at the end of it. So the pop-up help is now listed as I want.

How to fix Access Violation at address in Delphi

I'm new to delphi and am trying to start OOP. However I get an access violation when using public property to set a private field.
type
User = class;
TData = class
private
CurrUser: User;
Connection: TFDConnection;
Query: TFDQuery;
procedure SetUser(newUser: User);
procedure SetConnection(newConn: TFDConnection);
procedure SetQuery(newQry: TFDQuery);
public
property CUser: User read CurrUser write SetUser;
property Conn: TFDConnection read Connection write SetConnection;
property Qry: TFDQuery read Query write SetQuery;
class procedure Login(uID: integer); static;
class procedure Logout(uID: integer); static;
class procedure ExitApp(); static;
end;
implementation
{$R *.fmx}
procedure TData.SetUser(newUser: User);
begin
CurrUser := newUser;
end;
procedure TData.SetConnection(newConn: TFDConnection);
begin
Connection := newConn;
end;
procedure TData.SetQuery(newQry: TFDQuery);
begin
Query := newQry;
end;
I expect to be able to set the Connection using that property however it gives me the access violation with any code that uses the property write:
TData.Conn.LoginPrompt := False;
TData.Conn.Connected := True;
var
TData: frmData.TData;
LoginForm: TLoginForm;
ErrorCount : integer;
implementation
{$R *.fmx}
procedure TLoginForm.ExitAppButtonClick(Sender: TObject);
begin
TData.ExitApp;
end;
procedure TLoginForm.LoginButtonClick(Sender: TObject);
var
companyPath : string;
nurseID : integer;
begin
if(UsernameInput.Text = '') or (PasswordInput.Text = '') or (PincodeInput.Text = '') then
begin
ShowMessage('Please enter your login details.');
Exit;
end;
try
TData.Conn := TFDConnection.Create(nil);
TData.Conn.Params.DriverID := 'MSAcc';
TData.Conn.Params.Database := 'D:\PulseDB\AlfaPersonnel\Pulse.mdb';
TData.Conn.LoginPrompt := False;
TData.Conn.Connected := True;
if(TData.Conn.Connected <> True) then
begin
ShowMessage('Could not connect, try again');
Exit;
end
else //When Connection
begin
TData.Qry := TFDQuery.Create(TData.Conn);
try
TData.Qry.Connection := TData.Conn;
TData.Qry.SQL.Text := 'SELECT * FROM NurseLogin WHERE Username=:uname AND Password=:pword AND PinCode=:pin;';
TData.Qry.Params.ParamByName('uname').AsString := UsernameInput.Text;
TData.Qry.Params.ParamByName('pword').AsString := PasswordInput.Text;
TData.Qry.Params.ParamByName('pin').AsString := PincodeInput.Text;
TData.Qry.Active := True;
if TData.Qry.RecordCount = 0 then ShowMessage('Details not recognised.')
else if TData.Qry.RecordCount = 1 then
begin
if TData.Qry.FieldByName('IsActive').AsBoolean then //If the user is active
begin
try
//Connect to the path
companyPath := TData.Qry.FieldByName('CompanyName').AsString;
TData.Conn.Params.Database := 'D\PulseDB\' + companyPath + '\Pulse.mdb';
TData.Conn.Connected := True;
ShowMessage('Connected to ' + companyPath);
finally
end;
end;
end;
finally
end;
end;
finally
end;
end;
You don't ever create an instance of your TData class. At some point you need to write:
TData := frmData.TData.Create;
Which is how you instantiate an instance. And you need to destroy it when you are finished also. Like this:
TData.Free;
That you did not instantiate an instance is the explanation for your access violation.
Some other issues:
Use the T prefix for types. Your variable should be named Data rather than TData.
Don't use global variables if at all possible.

Using Firedac to run SQL stored procedure

I'm trying to figure out how to run a stored procedure using firedac
unit DataLayer.OilCommanderConnection;
interface
uses
FireDAC.Phys.FB,
Generics.Collections,
Model.Sample,
Model.Batch,
FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Error,
FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def, FireDAC.Stan.Pool,
FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Phys.MySQL, Data.DB,
FireDAC.Comp.Client, FireDAC.Phys.MSSQL,
FireDAC.DApt,
FireDAC.Comp.UI
;
type
TOilCommanderConnection = class
strict private
public
Connection : TFDConnection;
function GetSampleTypesForBatch(Batch : TBatch) : Boolean;
function Connect:Boolean;
constructor Create;
destructor Destroy; override;
end;
implementation
uses
SysUtils
;
function TOilCommanderConnection.Connect:Boolean;
var
OK : Boolean;
begin
OK := true;
Connection := TFDConnection.Create(nil);
try
Connection.Params.LoadFromFile('MSSQL.ini');
finally
Result := OK;
end;
end;
function TOilCommanderConnection.GetSampleTypesForBatch(Batch : TBatch) : Boolean;
var
StoredProc : TFDStoredProc;
begin
Connect;
StoredProc := TFDStoredProc.Create(nil);
try
StoredProc.Connection := Connection;
StoredProc.StoredProcName := 'GetSampleTypesForBatch';
StoredProc.Prepare;
StoredProc.FetchOptions.Items := StoredProc.FetchOptions.Items - [fiMeta];
with StoredProc.Params do
begin
Clear;
with Add do
begin
Name := 'BatchNo';
ParamType := ptInput;
DataType := ftString;
Size := 6;
end;
end;
StoredProc.StoredProcName := 'GetSampleTypesForBatch';
StoredProc.Prepare;
StoredProc.Params[0].Value := Batch.RackNo;
StoredProc.ExecProc;
while not StoredProc.Eof do
begin
//StoredProc.FieldByName('').AsS
StoredProc.Next;
end;
finally
FreeAndNil(StoredProc);
end;
Result := true;
end;
constructor TOilCommanderConnection.Create;
begin
inherited;
Connection := TFDConnection.Create(nil);
end;
destructor TOilCommanderConnection.Destroy;
begin
if Assigned(Connection) then FreeAndNil(Connection);
inherited;
end;
end.
I get an error message a the first occurrence of the line
StoredProc.Prepare;
Here is the message
--------------------------- Debugger Exception Notification
Project RefractiveIndexTests.exe raised exception class Exception with message 'Object factory for class
{3E9B315B-F456-4175-A864-B2573C4A2201} is missing. To register it, you
can drop component [TFDGUIxWaitCursor] into your project'.
I've called the function using
OilCommanderConnection.GetSampleTypesForBatch(batch);
from a test project.
the tutorial I read didn't explain what to do about this situation.
I've tried adding TFDGUIxWaitCursor into my project as the error message suggests but this has not made any difference. I wonder if this problem is related to me keeping the Database connection logic in a separate unit to my Main Form. I would like to be able to separate my user interface from my Data Layer.
Depending on the type of your application, include one of the following units into any one "uses" clause:
FireDAC.VCLUI.Wait - for VCL applications;
FireDAC.FMXUI.Wait - for FireMonkey applications;
FireDAC.ConsoleUI.Wait - for console / non-visual applications.