I have a base class TBuilder that inherits from TObjectList. TBuilder can do ADO related operations and populate its internal structure with the results. In addition to this, the same operation can be done over the web, via HTTP calls. The results returned is also parsed and the internal structure updated.
From here on I generate pas files from a database table to mimic its structure. Say I have a table called Company, I programmatically generate a TCompany object that also inherits from TBuilder which can then choose what it needs to be. At the moment I construct TCompany with a type that says I want it to do ADO operations or I want it to do HTTP operations. TBuilder would then typically have a load procedure and, based on the type, it will then generate SQL and load from the database (or http) and populate itself internally with the results.
Now what I'm trying to do now is to split TBuilder up so that one unit knows how to query the database via ADO and the other via HTTP. I was thinking to inherit these two classes from TBuilder as well. But I'm challanged with TCompany because it needs to inherit from either TBuilder, or TADOBuilder or TDSBuilder ( the latter two being the new units). If I inherit from TADOBuilder it can only represent the one type of object. I'm trying to make it so that TCompany can be either of the two at any time. I saw that you can only implement multiple inheritance with Interfaces, but I'm new to this and haven't been able to figure out how I can redesign it so that my TCompany can be both types of objects.
Any ideas how I can approach this? For the time being I'm stuck in Delphi 6 doing this.
This is how it looks:
TCompany = class(TBuilder) //I generate this programatically. This represents a table in the database
private
fUser: TSecurityUser;
function GetCompanyName: TBuilderField;
function GetCompanyAbbreviation: TBuilderField;
function GetCompanyID: TBuilderField;
function GetDateCreated: TBuilderField;
function GetDeleted: TBuilderField;
public
Property CompanyID:TBuilderField read GetCompanyID;
Property CompanyName:TBuilderField read GetCompanyName;
Property Abbreviation:TBuilderField read GetCompanyAbbreviation;
property DateCreated:TBuilderField read GetDateCreated;
property Deleted:TBuilderField read GetDeleted;
property User:TSecurityUser read fUser Write fUser;
constructor NewObject(psCompanyName,psAbbreviation:string);
constructor Create(conType:TConnectionType = conTypeSQLServer);override;
This is how the Load procedure looks like, at the moment that I'm trying to split out into seperate units, in a smarter way:
function TBuilder.Load(psSQL:string = ''; poLoadOptions:TLoadOptions = []; poConnectionType:TConnectionType = conNone): Boolean;
var
LoQuery:TADOQuery;
LoSQL:string;
LoConnectionType:TConnectionType;
begin
Result := True;
LoConnectionType := fConnectionType;
if poConnectionType <> conNone then
LoConnectionType := poConnectionType;
if LoConnectionType = conTypeSQLServer then
begin
LoQuery := TADOQuery.Create(nil);
Try
try
LoQuery.Connection := uBuilder.ADOConnection;
LoSQL := psSQL;
if LoSQL = '' then
LoSQL := BuildSelectSQL;
LoQuery.SQL.Text := LoSQL;
LoQuery.Open;
LoadFromDataset(LoQuery);
except on E:exception do
begin
Error := E.Message;
Result := False;
end;
end;
Finally
FreeAndNil(LoQuery);
end;
end else
if fConnectionType = conTypeDatasnap then
begin
fWebCallType := sqlSelect;
try
if Assigned(fParent) then
if fParent.Error <> '' then
Exit;
if Assigned(OnBusyLoadingHook) then
OnBusyLoadingHook('Busy loading...');
{Reset the msg}
if Assigned(OnDisplayVisualError) then
OnDisplayVisualError(imtRed,'');
if (poLoadOptions <> LoadOptions) then
LoadOptions := LoadOptions + poLoadOptions;
Result := InternalLoad(loFullyRecursiveLoad in LoadOptions);
finally
{ We're done loading }
if Assigned(OnBusyLoadingHook) then
OnBusyLoadingHook('');
end;
end;
end;
Then I'd use the object in this way:
var
LoCompany:TCompany;
begin
LoCompany := TCompany.Create(conTypeDatasnap);
LoCompany.CompanyName.Value := 'Test';
LoCompany.Load; //This will then generate the appropriate JSON and pass it via idhttp component to the server and the results will be parsed into its structure.
end;
If I change the type it will query the database directly.
Option 1)
Do not inherit TCompany from TBuilder. Add an FBuilder: TBuilder field/property to TCompany and set this to either a TADOBuilder or TDSBuilder instance. And then add the required methods to TCompany and those methods would need to call the required method on FBuilder. Of course the methods needed has to be declared as virtual on TBuilder and TADOBuilder would need to override those.
Option2)
Separate your business object (TCompany) from the persistence code (TBuilder, TADOBuilder). Hard to give concrete advice without knowing the details but the idea is that your TCompany should be independent from the persistence code. In general you add all the required business properties to TCompany (e.g. Name, Address) and use a separate class which loads data into a TCompany using a TBuilder or TADOBuilder etc.
EDIT
Here is how it would look like with Option1.
TBuilder = abstract class
procedure Load; virtual;
end;
TADOBuilder = class(TBuilder)
procedure Load; override;
end;
TDSBuilder = class(TBuilder)
procedure Load; override;
end;
TCompany = class
private
FBuilder: TBuilder;
public
constructor Create(aBuilder: TBuilder);
procedure Load;
end;
{ TCompany }
constructor TCompany.Create(aBuilder: TBuilder);
begin
inherited;
FBuilder := aBuilder;
end;
procedure TCompany.Load;
begin
FBuilder.Load;
end;
....
EDIT example for Option 2
TCompany = class
private
FId: Integer;
FName: string;
...
public
property Id: Integer read FId write FId;
property Name: string read FName write FName;
end;
TADOPerssiter = class
public
constructor Create(const aConnectionString: string);
// Creates and loads TCompany from ADO
function LoadCompany(aId: Integer): TCompany;
procedure SaveCompany(aCompany: TCompany);
end;
Add similar class for DS
Related
Suppose if I had the following Employee struct:
mutable struct Employee
_id::Int64
_first_name::String
_last_name::String
function Employee(_id::Int64,_first_name::String,_last_name::String)
# validation left out.
new(_id,_first_name,_last_name)
end
end
If I wanted to implement my own setproperty!() I can do:
function setproperty!(value::Employee,name::Symbol,x)
if name == :_id
if !isa(x,Int64)
throw(ErrorException("ID type is invalid"))
end
setfield!(value,:_id,x)
end
if name == :_first_name
if is_white_space(x)
throw(ErrorException("First Name cannot be blank!"))
end
setfield!(value,:_first_name,x)
end
if name == :_last_name
if is_white_space(x)
throw(ErrorException("Last Name cannot be blank!"))
end
setfield!(value,:_last_name,x)
end
end
Have I implemented setproperty!() correctly?
The reason why I use setfield!() for _first_name and _last_name, is because if I do:
if name == :_first_name
setproperty!(value,:_first_name,x) # or value._first_name = x
end
it causes a StackOverflowError because it's recursively using setproperty!().
I don't really like the use of setproperty!(), because as the number of parameters grows, so would setproperty!().
It also brings to mind using Enum and if statements (only we've switched Enum with Symbol).
One workaround I like, is to document that the fields are meant to be private and use the provided setter to set the field:
function set_first_name(obj::Employee,first_name::AbstractString)
# Validate first_name before assigning it.
obj._first_name = first_name
end
The function is smaller and has a single purpose.
Of course this doesn't prevent someone from using setproperty!(), setfield!() or value._field_name = x, but if you're going to circumvent the provided setter then you'll have the handle the consequences for doing it.
Of course this doesn't prevent someone from using setproperty!(), setfield!() or value._field_name = x, but if you're going to circumvent the provided setter then you'll have the handle the consequences for doing it.
I would recommend you to do this, defining getter,setter functions, instead of overloading getproperty/setproperty!. on the wild, the main use i saw on overloading getproperty/setproperty! is when fields can be calculated from the data. for a getter/setter pattern, i recommend you to use the ! convention:
getter:
function first_name(value::Employee)
return value._first_name
end
setter:
function first_name!(value::Employee,text::String)
#validate here
value._first_name = text
return value._first_name
end
if your struct is mutable, it could be that some fields are uninitialized. you could add a getter with default, by adding a method:
function first_name(value::Employee,default::String)
value_stored = value._first_name
if is_initialized(value_stored) #define is_initialized function
return value_stored
else
return default
end
end
with a setter/getter with default, the only difference between first_name(val,text) and first_name!(val,text) would be the mutability of val, but the result is the same. useful if you are doing mutable vs immutable functions. as you said it, the getproperty/setproperty! is cumbersome in comparison. If you want to disallow accessing the fields, you could do:
Base.getproperty(val::Employee,key::Symbol) = throw(error("use the getter functions instead!")
Base.setproperty!(val::Employee,key::Symbol,x) = throw(error("use the setter functions instead!")
Disallowing the syntax sugar of val.key and val.key = x. (if someone really want raw access, there is still getfield/setfield!, but they were warned.)
Finally, i found this recomendation in the julia docs, that recommends getter/setter methods over direct field access
https://docs.julialang.org/en/v1/manual/style-guide/#Prefer-exported-methods-over-direct-field-access
In my test code below, I am trying to modify a variable by passing it as system.address to another procedure.
with Ada.Text_IO;
with System;
with System.Storage_Elements;
procedure Main is
procedure Modify ( Var : in out System.Address) is
use System.Storage_Elements;
begin
Var := Var + 10;
end Modify;
My_Var : Integer := 10;
begin
-- Insert code here.
Modify (My_Var'Address);
Ada.Text_IO.Put_Line("My_Var is:" & Integer(My_Var)'Image );
end Main;
Compiler is returning an error as below,
17:17 actual for "Var" must be a variable
I could not understand the reason as My_Var(actual for Var) is clearly a variable. What should I change to modify My_Var with system.address?
Note: The context of this trail is that I am trying to understand an interface module in an existing legacy project. While there could be better ways to achieve what I need, I want to understand if it is possible to modify a variable with above method.
It would be helpful if you could show the relevant part of the legacy interface module -- it would help us understand what you need and want to do.
That said, first note that passing a parameter by reference is not usually done in Ada by explicitly passing the 'Address of the actual variable. As you say, there are other and better ways.
If you pass a System.Address value, and then want to read or write whatever data resides at that address, you have to do the read/write through a variable that you force to have that address, or through an access value (the Ada equivalent of "pointer") that you force to point at that addressed location. In both cases, you are responsible for ensuring that the type of the variable, or of the access value, matches the actual type of the data that you want to read or write.
To create an access value that points to memory at a given address, you should use the predefined package System.Address_To_Access_Conversions. That requires some understanding of access values and generics, so I won't show an example here.
To force a variable to have a given address, you declare the variable with the Address aspect set to the given address. The code below shows how that can be done for this example. Note the declaration of the local variable Modify.Var (and note that I changed the name of the parameter from Var to Var_Addr).
with Ada.Text_IO;
with System;
procedure Mod_By_Addr is
procedure Modify (Var_Addr : in System.Address) is
Var : Integer with Address => Var_Addr;
begin
Var := Var + 10;
end Modify;
My_Var : aliased Integer := 10;
begin
Modify (My_Var'Address);
Ada.Text_IO.Put_Line("My_Var is:" & Integer(My_Var)'Image );
end Mod_By_Addr;
Since the Var_Addr parameter is not modified in the Modify procedure, it can be declared with the "in" mode, and so the actual parameter can be an expression (My_Var'Address).
HTH
You modify the address and not the variable. Try to change parameter to Addr : in System.Address and declare Var : Integer with Address => Addr in Modify.
Another way of modifying the variable I have understood using address_to_Access_Conversions is shown below,
with Ada.Text_IO;
with System.Address_To_Access_Conversions;
with System.Storage_Elements;
procedure Main is
procedure Modify ( Var : in System.Address) is
use System.Storage_Elements;
package Convert is new System.Address_To_Access_Conversions (Integer);
begin
Ada.Text_IO.Put_Line(Convert.To_Pointer (Var).all'Img);
end Modify;
My_Var : Integer := 10;
begin
Modify (My_Var'Address);
Ada.Text_IO.Put_Line("My_Var is:" & Integer(My_Var)'Image );
end Main;
I'm kinda new with Ada and recently got an error that I don't seem to know how to solve.
I have the following code:
data.ads
with Text_IO; use text_io;
with ada.Integer_Text_IO; use ada.Integer_Text_IO;
package data is
type file is private;
type file_set is array (Integer range <>) of file;
procedure file_Print (T : in out file); --Not used
private
type file is record
start, deadline : integer;
end record;
end data;
Main.adb
with ada.Integer_Text_IO; use ada.Integer_Text_IO;
procedure Main is
Num_files: integer:=3;
Files:file_set(1..Num_files);
begin
Files(1):=(2,10); -- Expected private type "file" defined at data.ads
for i in 1..Num_Files loop
Put(integer'Image(i));
New_Line;
data.File_Print(Files(i));
But I'm getting this error Expected private type "file" defined at data.ads
How can I access the file type and declare a new array of values in main?
That's right - you don't get to see or manipulate what's inside a private type. That would be breaking encapsulation. Bugs and security risks follow.
You can only interact with a private type via its methods : functions and procedures declared in the package where it's declared.
Now file_set is NOT a private type (you might consider making it private later, for better encapsulation, but for now ....) you can index it to access a file within it (using one of those procedures).
Files(1):=(2,10);
As you want to create a file here, you need a method to create a file ... a bit similar to a constructor in C++, but really more like the Object Factory design pattern. Add this to the package:
function new_file(start, deadline : integer) return file;
And implement it in the package body:
package body data is
function new_file(start, deadline : integer) return file is
begin
-- check these values are valid so we can guarantee a proper file
-- I have NO idea what start, deadline mean, so write your own checks!
-- also there are better ways, using preconditions in Ada-2012
-- without writing explicit checks, but this illustrates the idea
if deadline < NOW or start < 0 then
raise Program_Error;
end if;
return (start => start, deadline => deadline);
end new_file;
procedure file_Print (T : in out file) is ...
end package body;
and that gives the users of your package permission to write
Files(1):= new_file(2,10);
Files(2):= new_file(start => 3, deadline => 15);
but if they attempt to create garbage to exploit your system
Files(3):= new_file(-99,-10); -- Oh no you don't!
this is the ONLY way to create a file, so they can't bypass your checks.
I am migrating some code from Delphi 5 to a modern platform. Currently I have the compiled code (which works in my environment) and the source code (which cannot be compiled in my environment). This means I can't really experiment with the code by changing it or inserting breakpoints or dumping values. In looking at one particular passage of code, I see that one Procedure (ProcedureA) is calling another (ProcedureB) and passing in parameters that must be by reference, since otherwise ProcedureB would have no effect. It's my understanding that a var prefix must be added to parameters in a Procedure's parameter list in order for them to be passed by reference, but this is not being done here. One of the parameters, though, is of type TList, which I know to be essentially an array of pointers. My question is: are parameters of type TList (as well as others having to do with pointers) implicitly passed by reference?
Here's the code:
Procedure ProcedureB(PartyHeaderInformationPtr : PartyHeaderInformationPointer;
PartyHeaderTable : TTable;
_PrisonCode : String;
_FineType : TFineTypes;
PartyHeaderInformationList : TList);
begin
with PartyHeaderInformationPtr^, PartyHeaderTable do
begin
AssessmentYear := FieldByName('TaxRollYr').Text;
PartyType := FieldByName('PartyType').Text;
PartyNumber := FieldByName('PartyNo').AsInteger;
PrisonCode := _PrisonCode;
FineType := _FineType;
end; {with PartyHeaderInformationPtr^ ...}
PartyHeaderInformationList.Add(PartyHeaderInformationPtr);
end; {AddPartyHeaderPointerInformation}
{=================================================================}
Procedure ProcedureA(PartyHeaderTable : TTable;
PartyDetailTable : TTable;
PartyHeaderInformationList : TList);
var
Done, FirstTimeThrough : Boolean;
PrisonPartyFound, JunglePartyFound : Boolean;
PrisonPartyYear, PrisonCode, PartyType : String;
PartyHeaderInformationPtr : PartyHeaderInformationPointer;
begin
PartyHeaderTable.Last;
PrisonPartyYear := '';
PrisonPartyFound := False;
JunglePartyFound := False;
Done := False;
FirstTimeThrough := True;
repeat
If FirstTimeThrough
then FirstTimeThrough := False
else PartyHeaderTable.Prior;
If PartyHeaderTable.BOF
then Done := True;
If not Done
then
begin
PartyType := PartyHeaderTable.FieldByName('PartyType').Text;
If ((not JunglePartyFound) and
((PartyType = 'MU') or
(PartyType = 'TO')))
then
begin
JunglePartyFound := True;
New(PartyHeaderInformationPtr);
AddPartyHeaderPointerInformation(PartyHeaderInformationPtr,
PartyHeaderTable,
'', ltPlace,
PartyHeaderInformationList);
end; {If ((not JunglePartyFound) and ...}
end; {If not Done}
until Done;
end; {FillPartyHeaderInformationList}
Yes.
In Delphi, classes are reference types.
Every variable of type TBitmap, TList, TButton, TStringList, TForm etc. is nothing but a pointer to the object, so an object is always passed "by reference". It is only this address, this native-sized integer, that is given to the called routine.
Consequently, even without var, the called routine can alter the object since it, like the caller, has the address to it. But the pointer itself is passed by value, so if the called routine alters the parameter pointer to point to a different object, the caller will not see that; only the called routine's copy of the address is changed. With var, the pointer itself is passed by reference, so the called routine can change that too: it can change the original object, and it can make the caller's variable point to a different object, if it wants to.
On the other hand, value types like integers, booleans, sets, static arrays, and records are passed by value, so -- without any parameter decoration such as var -- the called routine gets a copy, and any changes made are only made to that copy. The caller will not see its variable being modified. If you use a var parameter, however, the variable will be passed by reference.
So, in your case, it has nothing to do with TList being a "list" or being something that "contains pointers". It's about TList being a class.
Can anyone tell me what ControlGetHandle() does behind the scenes? What Windows API function does it invoke? How can I see it? (logs/debug mode).
It sometimes succeeds and sometimes fails and I don't understand why. I looked all over the place, including AutoIT .au3 include files, but I couldn't find any information.
So, I discovered this amazing tool called "API Monitor". It shows you API calls made to the OS. You can filter etc. When running AutoIT with "ControlGetHandle" you can see that it actually calls two functions:
EnumWindows
EnumChildWindows
With the relevant parameters to get the handle you wish.
Thanks!
I believe it uses GetDlgCtrlID among other things. If you are having trouble getting it to return a handle sometimes changing the controlID parameter will fix it. Also, make sure you are waiting for the control to load first. If the control exists and you are using the right controlID parameters AutoIt will be able to get a controls handle 99.9999% of the time.
The first thing that comes to mind, the function finds the window with matching caption, lists the controls, finds the control with suitable criteria( class name and text), and returns his HWnd. This is done using the API EnumWindows/GetWindowTextLength/GetWindowText,GetWindowClassName.
Here, I wrote a small example, but it is in Pascal ( Excuse me. later rewritten in AutoIt. ;) ;) ;)
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
fhw:hwnd;
cls,txt:string;
wind:hwnd;
implementation
{$R *.dfm}
function GetText(wnd:hwnd):string;
var
len:integer;
begin
len:=GetWindowTextLength(wnd)+1;
SetLength(result,len);
SetLength(Result,GetWindowText(wnd,pchar(result),len));
end;
function GetClsName(wnd:hwnd):string;
begin
SetLength(result,5000);
SetLength(result,GetClassName(wnd,pchar(result),5000));
end;
function EnumChildProc(wnd:HWnd; param:Integer):bool;stdcall;
var
wintext,wincls:string;
ccmp,tcmp:boolean;
begin
wintext:=gettext(wnd);
wincls:=getclsname(wnd);
if cls <> '' then
ccmp:=(comparetext(cls,wincls)=0)
else
ccmp:=true;
if txt <> '' then
tcmp:=(comparetext(txt,wintext)=0)
else
tcmp:=true;
result:=not (tcmp and ccmp);
if not result then
wind:=wnd;
end;
procedure GetControlHandle(title:string; wtext:string; clsname:string);
var
hw:hwnd;
begin
wind:=0;
hw:=findwindow(nil,pchar(title));
if hw <> 0 then
begin
cls:=clsname;
txt:=wtext;
EnumChildWindows(hw,#EnumChildProc,integer(pointer(result)));
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
w:hwnd;
begin
getcontrolhandle('New Project','','Button');
w:=wind;
CloseWindow(w);
end;
end.