I am working on a legacy code which contains some TQuery components. I was trying to create a function which convert the TQuery Parameters into TParameters so that i can assign them into the Parameters property of an ADO Component (Like ADOQuery or ADODataSet).
I tried the following which i got from internet.
function ConvertToADOParms(Owner: TADODataset; aParams: TParams): TParameters;
var i: integer;
begin
// Convert a standard TParams object to an ADO-specific TParameters object
Result :=nil;
try
if aParams = nil then exit;
Result :=TParameters.create( Owner, TParameter);
for i:=0 to aParams.count - 1 do
begin
if aParams[i] = nil then continue;
with Result.AddParameter do
begin
Name := aParams[i].Name;
Datatype :=aParams[i].DataType;
Direction :=TParameterDirection(aParams[i].ParamType);
Size :=aParams[i].size;
Value :=aParams[i].value;
end;
end;
except
on e:exception do
begin
Result :=nil;
showmessage('Could not convert standard parameter object to ADO parameter object: '+e.message);
end;
end;
end;
But i am getting Invalid Class Typecast Error. When i debug the code i found that the error occurs at this function in ADODB unit
function TParameters.GetCommand: TADOCommand;
begin
Result := GetOwner as TADOCommand;
end;
Help Please. I am Using Delphi 5
I don't make much sense of the function prototype. It requests an owner for the collection that is returned by the function and as such should IMHO be independent.
I would simply get rid of that and operate directly with the passed ADO object. For example:
procedure FillParamsADO(Params: TParams; Dataset: TADODataset);
var
i: Integer;
begin
Dataset.Parameters.Clear;
for i := 0 to Params.Count-1 do
begin
with Dataset.Parameters.AddParameter do
begin
Name := Params[i].Name;
DataType := Params[i].DataType;
Direction := TParameterDirection(Params[i].ParamType);
Size := Params[i].Size;
Value := Params[i].Value;
end;
end;
end;
Related
The code below is from the JSonMarshall project in chapter 7 of Marco Cantu's Delphi 2010 Handbook. The source code is available from here http://cc.embarcadero.com/item/27600. I have made two changes to it:
Add JSon to the implementation Uses clause to get it to compile.
Added the line
theName := 'XXX'; // added by me
to the TDataWithList.Create constructor to assist debugging
I am running the code in Delphi Seattle (without update 1)
The purpose of the project is to demo a custom converter and reverter for the TDataWithList declared type. The custom converter seems to work fine, judging by the result output to Memo1.
However, attempting to run the reverter results in a "Read of address 00000000" AV on the line
sList.Add (Args[I]);
in btnUnmarshalReverterClick. The immediate cause of this is that contrary to what
the author evidently intended, when the above line executes, sList is Nil.
My question is simply why is sList Nil and how to fix this problem?
I have tried, not entirely successfully, to trace through the DBXJSONReflect source
to find out why.
After
Obj := ObjectInstance(FRTTICtx, objType);
in function TJSONUnMarshal.CreateObject, TDataWithList(obj).theName is 'XXX'
as I'd expect and TDataWithList(obj).theLList is an initialized, but empty,
TStringList.
However, by the time the anonymous method in btnUnmarshalReverterClick is called, TDataWithList(Data).theList is Nil.
Update: The reason that TDataWithList(Data).theList (incorrectly, imo) becomes Nil is that it is set to Nil in TJSONPopulationCustomizer.PrePopulate by a call to PrePopulateObjField. So I suppose the question is, why does PrePopulate allow an object's field which has been initialized in its constructor to be overwritten as if it knows better that the object's constructor.
Update2:
There may be an additional problem, in that as far as I can tell, in
TInternalJSONPopulationCustomizer.PrePopulateObjField, the assignment which overwrites TListWithData.theList with Nil, namely
rttiField.SetValue(Data, TValue.Empty);
does not seem to result in the TStringlist destructor being called.
Btw, I get the same error running the project in XE4, which is the earliest version I have which includes JSonUnMarshal.
Code:
type
[...]
TDataWithList = class
private
theName: String;
theList: TStringList;
public
constructor Create (const aName: string); overload;
constructor Create; overload;
function ToString: string; override;
destructor Destroy; override;
end;
[...]
procedure TFormJson.btnMarshalConverterClick(Sender: TObject);
var
theData: TDataWithList;
jMarshal: TJSONMarshal;
jValue: TJSONValue;
begin
theData := TDataWithList.Create('john');
try
jMarshal := TJSONMarshal.Create(
TJSONConverter.Create); // converter is owned
try
jMarshal.RegisterConverter(TDataWithList, 'theList',
function (Data: TObject; Field: string): TListOfStrings
var
I: Integer;
sList: TStringList;
begin
sList := TDataWithList(Data).theList;
SetLength(Result, sList.Count);
for I := 0 to sList.Count - 1 do
Result[I] := sList[I];
end);
jValue := jMarshal.Marshal(theData);
try
Memo1.Lines.Text := jValue.ToString;
finally
jValue.Free;
end;
finally
jMarshal.Free;
end;
finally
theData.Free;
end;
end;
procedure TFormJson.btnUnmarshalReverterClick(Sender: TObject);
var
jUnmarshal: TJSONUnMarshal;
jValue: TJSONValue;
anObject: TObject;
begin
jValue := TJSONObject.ParseJSONValue(
TEncoding.ASCII.GetBytes (Memo1.Lines.Text), 0);
try
jUnmarshal := TJSONUnMarshal.Create;
try
jUnmarshal.RegisterReverter(TDataWithList, 'theList',
procedure (Data: TObject; Field: string; Args: TListOfStrings)
var
I: Integer;
sList: TStringList;
begin
sList := TDataWithList(Data).theList;
for I := 0 to Length(Args) - 1 do
sList.Add (Args[I]);
end);
anObject := jUnmarshal.Unmarshal(jValue);
try
ShowMessage ('Class: ' + anObject.ClassName +
sLineBreak + anObject.ToString);
finally
anObject.Free;
end;
finally
jUnmarshal.Free;
end;
finally
jValue.Free;
end;
end;
function TMyData.ToString: string;
begin
Result := theName + ':' + IntToStr (theValue);
end;
{ TDataWithList }
constructor TDataWithList.Create(const aName: string);
var
I: Integer;
begin
theName := aName;
theList := TStringList.Create;
for I := 0 to 9 do
theList.Add(IntToStr (Random (1000)));
end;
constructor TDataWithList.Create;
begin
// core initialization, used for default construction
theName := 'XXX'; // added by me
theList := TStringList.Create;
end;
destructor TDataWithList.Destroy;
begin
theList.Free;
inherited;
end;
function TDataWithList.ToString: string;
begin
Result := theName + sLineBreak + theList.Text;
end;
rttiField.SetValue(Data, TValue.Empty); simply overrides the field value because as the name implies it's a field, not a property with get / set methods. The destructor of TStringList is not called due to simple pointer assignment.
The solution here is to declare a property:
TDataWithList = class
...
strict private
theList: TStringList;
...
public
property Data: TStringList read ... write SetData
...
end;
TDataWithList.SetData(TStringList aValue);
begin
theList.Assign(aValue);
end;
I wonder how caught a row of a listview and transform object.
I carry an .xml file and play in a listview , after loading this file you need to double-click in a row, take all of the data line and throw in a LabelEdit , as shown in the code below .
procedure TForm1.LstbxDadosDblClick(Sender: TObject);
begin
if Assigned(TMensagem(LstbxDados.Items.Objects[LstbxDados.ItemIndex])) then
begin
with TMensagem(LstbxDados.Items.Objects[LstbxDados.ItemIndex]) do
begin
EdtPara.Text := Para;
EdtDe.Text := De;
EdtCabecalho.Text := Cabecalho;
EdtCorpo.Text := Corpo;
end;
end;
end;
TMensagem = class
private
FCorpo: String;
FCabecalho: String;
FPara: String;
FDe: String;
public
property Para : String read FPara write FPara;
property De : String read FDe write FDe;
property Cabecalho: String read FCabecalho write FCabecalho;
property Corpo : String read FCorpo write FCorpo;
end;
Many ways to edit an object where the current object can change at any time (like with a double click). Here is one of the easiest: save when the current object changes and save at the very end. Here is a quick and dirty solution.
Add a member to the form or global in the implementation section
FLastMensagem: TMensagem;
May want to initialize to nil on create or initialization (left to you). Now in the event save data when the TMensagem object changes
procedure TForm1.LstbxDadosDblClick(Sender: TObject);
var
LNewMensagem: TMensagem;
begin
LNewMensagem := TMensagem(LstbxDados.Items.Objects[LstbxDados.ItemIndex]));
if Assigned(LNewMensagem) then
begin
// When we switch, capture the dialog before updating it
if Assigned(FMensagem) and (LNewMensagem <> FLastMensagem) then
begin
FLastMensagem.Para := EdtPara.Text;
FLastMensagem.De := EdtDe.Text;
FLastMensagem.Cabecalho := EdtCabecalho.Text;
FLastMensagem.Corpo := EdtCorpo.Text;
end;
EdtPara.Text := LNewMensagem.Para;
EdtDe.Text := LNewMensagem.De;
EdtCabecalho.Text := LNewMensagem.Cabecalho;
EdtCorpo.Text := LNewMensagem.Corpo;
//Set the last dblclicked
FLastMensagem := LNewMensagem
end;
end;
Of course the very last edit needs to be saved, that you can do in say a form close (not sure what your full design is). For example
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Assigned(FLastMensagem) then
begin
FLastMensagem.Para := EdtPara.Text;
FLastMensagem.De := EdtDe.Text;
FLastMensagem.Cabecalho := EdtCabecalho.Text;
FLastMensagem.Corpo := EdtCorpo.Text;
end;
end;
How can I convert a fieldtype from ftFloat to ftBCD;
I tried
for i := 0 to FDataSet.FieldCount - 1 do begin
if FDataSet.Fields.Fields[i].DataType = ftFloat then begin
FDataSet.Fields.Fields[i].DataType := ftBCD;
end;
end;
But I get the error
[DCC Error] E2129 Cannot assign to a read-only property
Is there a way I can convert all dataset field that ftFloat to ftBCD ?
DataType is readonly Property of the Tfield created for a DataType.
This is done from Fielddefs using DefaultFieldClasses: array[TFieldType] of TFieldClass from DB.
If you need to change the DataType you will have to Free the Field and create anotherone fittinig your needs.
Below is shown an exmaple how this could be done.
type
TMyFieldInfo = Record
FieldName: String;
Size: Integer;
DataType: TFieldType;
FieldKind: TFieldKind;
end;
type
TFA= Array of TMyFieldInfo;
Procedure GetFields(DS:Tdataset;var FA:TFA);
var
I: Integer;
begin
SetLength(FA, DS.FieldCount);
for I := 0 to DS.FieldCount - 1 do
begin
FA[I].FieldName := DS.Fields[I].FieldName;
FA[I].DataType := DS.Fields[I].DataType;
FA[I].Size := DS.Fields[I].Size;
FA[I].FieldKind := fkdata;
end;
end;
Procedure SetFields(DS:Tdataset;var FA:TFA);
var
I: Integer;
F:TField;
begin
DS.Fields.Clear;
for I := Low(FA) to High(FA) do
begin
F := DefaultFieldClasses[FA[I].DataType].Create(DS);
With F do
begin
FieldName := FA[I].FieldName;
FieldKind := FA[I].FieldKind;
Size := FA[I].Size;
DataSet := DS;
end;
end;
end;
procedure TForm6.Button1Click(Sender: TObject);
var
L_FA: TFA;
I:Integer;
begin
MyDS.Open; // open to get the Fielddefs.
GetFields(MyDS,L_FA);
MyDS.Close; // close to be able to change the fields
for I := Low(L_FA) to High(L_FA) do
begin
if L_FA[i].DataType = ftFloat then
L_FA[i].DataType := ftBCD;
end;
SetFields(MyDS,L_FA);
MyDS.Open;
end;
Here is another way:
First, you need to dump the table into a file like this
ADOQuery.SaveToFile('C:\1.xml');
then find your field description in it, let's say it will be like this:
<s:datatype dt:type='float' dt:maxLength='8' rs:fixedlength='true' rs:maybenull='true'/>
and replace it with the other type description, like this:
<s:datatype dt:type='number' rs:dbtype='currency' dt:maxLength='25' rs:precision='25' rs:fixedlength='true' rs:maybenull='true'/>
now you need to load this file back, like this:
ADOQuery.LoadFromFile('C:\1.xml');
NO! Once you creates a Datafield you can not change it! It is because assigning a Filedtype is much more than just changeing an enum type property. Each field type is a specific class:
TintegerField etc...
So you can not change the FieldType for the same reason the can not make an TList in to a string
Excatly what are you trying to to ?
Jens Borrisholt
This is just a very simple question to which i can't find a good clear answer to. I don't quite have the time to read all the documentation for this since i'm in a time crunch.
But here it is.
I have made a new class on top of my TForm class like so:
Bucket = Class
glass: Integer;
steel: Integer;
End;
I then create a couple of objects in a method which belongs to TForm1
procedure TForm1.getMarbles;
var
objPlastic: Bucket;
objAlu: Bucket;
begin
// Initialize objects
objPlastic := Bucket.Create;
objAlu := Bucket.Create;
// Get Values from edtBox
val(Edit1.Text, objPlastic.steel, code);
val(Edit2.Text, objAlu.steel, code);
val(Edit3.Text, objPlastic.glass, code);
val(Edit4.Text, objAlu.glass, code);
end;
My problem is that I don't know how to use these objects in other methods. I tried defining them in every way i know so far in the other methods I want to use them in, but I can't get it to work.
Here is the method and what I have it currently set to (which returns 0 all the time):
procedure TForm1.marbleDrop(kind: string);
var
objPlastic: Bucket;
I: Integer;
begin
objPlastic := Bucket.Create;
if kind= 'plastic' then // the function is receiving this parameter
begin
for I := 0 to objPlastic.glass do
begin
showmessage(inttostr(objPlastic.glass)); //returns 0
end;
end;
end;
Sorry for this kind of question, but i couldn't find a better way.
BTW, this is a simplified version of the code I am using. I did my best to get out any typos since it's a translation of what I am actually using, but it's mainly about the idea. I don't have typos in my code in delphi.
In other to access the objects across methods, you have to either:
declare the objects as members of the Form class:
type
TForm1 = class(TForm);
...
private
objPlastic: Bucket;
objAlu: Bucket;
...
end;
procedure TForm1.getMarbles;
begin
// Initialize objects
if objPlastic = nil then objPlastic := Bucket.Create;
if objAlu = nil then objAlu := Bucket.Create;
// Get Values from edtBox
objPlastic.steel := StrToIntDef(Edit1.Text, 0);
objAlu.steel := StrToIntDef(Edit2.Text, 0);
objPlastic.glass := StrToIntDef(Edit3.Text, 0);
objAlu.glass := StrToIntDef(Edit4.Text, 0);
end;
procedure TForm1.marbleDrop(kind: string);
begin
if (kind = 'plastic') and (objPlastic <> nil) then
begin
ShowMessage(IntToStr(objPlastic.glass));
end;
end;
pass them as parameters of the methods themselves:
procedure TForm1.getMarbles(objPlastic, objAlu: Bucket);
begin
// Get Values from edtBox
if objPlastic <> nil then
begin
objPlastic.steel := StrToIntDef(Edit1.Text, 0);
objPlastic.glass := StrToIntDef(Edit3.Text, 0);
end;
if objAlu <> nil then
begin
objAlu.steel := StrToIntDef(Edit2.Text, 0);
objAlu.glass := StrToIntDef(Edit4.Text, 0);
end;
end;
procedure TForm1.marbleDrop(objWhichKind: Bucket);
begin
if objWhichKind <> nil then
begin
ShowMessage(IntToStr(objWhichKind.glass));
end;
end;
procedure TForm1.someMethod();
var
objPlastic: Bucket;
begin
objPlastic := Bucket.Create;
getMarbles(objPlastic, nil);
marbleDrop(objPlastic);
objPlastic.Free;
end;
Of course it returns zero. It is another object. You should pass it as you pass any other parameter variable. What you made is similar to
procedure TForm1.Drop1(kind: string);
begin
marbleDrop(); // here kind = "staal"
end;
procedure TForm1.marbleDrop();
var
kind: string;
begin
if kind = 'plastic' then // it is not !!! why ???
begin
....
end;
end;
You also has another problem - Memory leak
val(Edit4.Text, objAlu.glass, code);
end;
You just created two objects - and allocated Heap memory for them.
But you did not freed them. That is garbage left and it will grow and grow and grow - until the program would exhaust all Windows memory and be killed.
If you want to use memory without any accuracy and without "wasting" your time on thinking and learning - you'd better user some managed language running in virtual machine, like PHP, Python, Java and other JVM-based, C# and other .NEt-based.
To make good Delphi code you should have at least some understanding what you CPU does and why.
Specifically in your code you'd better
use records instead of classes
pass them as const- or var-parameters to avoid redundant copying.
Like that:
type TBucket = Record glass, steel: Integer; End;
type TForm1 = class (TForm)
.....
private
var objPlastic, objAlu: TBucket;
(* making variables more global: now they are form-local not function-local *)
......
procedure TForm1.getMarbles;
begin
objPlastic.steel := StrToIntDef(Edit1.Text, 0);
objAlu.steel := ...
Self.objPlastic.glass ... (* adding Self - just for clarity where those variable are taken from *)
Self.objAlu.glass ....
end;
procedure TForm1.marbleDrop(kind: string);
var
I: Integer;
begin
if kind = 'plastic' then // the function is receiving this parameter
begin
for I := 0 to Self.objPlastic.glass do
begin
showmessage(inttostr(objPlastic.glass));
//getting via common parent context - TForm1 object, referenced as Self pseudo-variable
marbleTell(objPlastic); // passing as parameter
end;
end;
end;
procedure TForm1.marbleTell(const arg: TBucket);
// do not forget to use const to pass variable by-reference not by-value
begin
showmessage(inttostr(arg.glass)); // getting via argument
end;
I am working a custom class to xml converter and one of the requirements is the ability to stream TObjectList<T> fields.
I am trying to invoke the ToArray() method to get hold of the TObjectlist's objects, but I get 'Invalid class typecast' because the types obviously don't match.
take this class for example:
type
TSite = class
Name : String;
Address : String;
end;
TSites = class
Sites : TObjecList<TSite>;
end;
I just need to get the Site Objects from the Sites TObjectList.
Please keep in mind that I am using RTTI, so I don't know the ObjectType in TObjectList, so Typecasting won't work. This is what I have but it seems a dead end (Obj is TobjectList<TSite> here):
function TXmlPersister.ObjectListToXml(Obj : TObject; Indent: String): String;
var
TypInfo: TRttiType;
meth: TRttiMethod;
Arr : TArray<TObject>;
begin
Result := '';
TypInfo := ctx.GetType(Obj.ClassInfo);
Meth := TypInfo.GetMethod('ToArray');
if Assigned(Meth) then
begin
Arr := Invoke(Obj, []).AsType<TArray<TObject>>; // invalid class typecast error
if Length(Arr) > 0 then
begin
// get objects from array and stream them
...
end;
end;
Any way to get the objects out of the TObjectList via RTTI is good for me.
For some odd reason I don't see the GetItem/SetItem methods in TypInfo
EDIT
Thanks to David I have my solution:
function TXmlPersister.ObjectListToXml(Obj : TObject; Indent: String): String;
var
TypInfo: TRttiType;
meth: TRttiMethod;
Value: TValue;
Count : Integer;
begin
Result := '';
TypInfo := ctx.GetType(Obj.ClassInfo);
Meth := TypInfo.GetMethod('ToArray');
if Assigned(Meth) then
begin
Value := Meth.Invoke(Obj, []);
Assert(Value.IsArray);
Count := Value.GetArrayLength;
while Count > 0 do
begin
Dec(Count);
Result := Result + ObjectToXml(Value.GetArrayElement(Count).AsObject, Indent);
end;
end;
end;
I am open for suggestions, maybe there are more 'clever' ways to achieve this goal...
Your code fails because a dynamic array is not a TObject.
You can do it like this:
Value := Meth.Invoke(Obj, []);
Assert(Value.IsArray);
SetLength(Arr, Value.GetArrayLength);
for i := 0 to Length(Arr)-1 do
Arr[i] := Value.GetArrayElement(i).AsObject;