i have an ole Object created with (simple verion)
obj := CreateOleObject('foo.bar');
obj.OnResult := DoOnResult;
procedure TMyDM.DoOnResult(Res: olevariant);
which all works, the res variable has a function String[] GetAns()
which im calling like this
var
ans: array of string;
begin
ans := Res.GetAns;
end;
which again works.. except sometimes no array is returned, and then an exception is thrown.
as a temporary solution i have wrapped it in a empty try except block, which i know is bad. I have tried VarIsArray(Res.GetAns) but it still donst work if the result is null
What is the correct way check for the right result?
ps I have no control over the ole Object
Christopher try using the VarIsNull function
procedure TMyDM.DoOnResult(Res: olevariant);
var
ans: array of string;
begin
if not VarIsNull(Res) then
if not VarIsNull(Res.GetAns) then
begin
ans := Res.GetAns;
//do your stuff
end;
end;
Related
I'm adding strings with objects (also strings) to a TComboBox, but getting corrupted strings when trying to retrieve them later.
This is how I'm adding them:
var
i: Integer;
sl: TStringList;
c: Integer;
s: PChar;
begin
for i := 1 to tblCalls.FieldCount do
if tblCalls.Fields[i - 1].Tag = 1 then
ListBox1.Items.Append(tblCalls.Fields[i - 1].FieldName);
sl := TStringList.Create;
try
LoadStyles(TStrings(sl));
for c := 0 to sl.Count - 1 do
begin
s := PChar(sl.Values[sl.Names[c]]);
ComboBox1.Items.AddObject(sl.Names[c], TObject(s));
end;
finally
sl.Free;
end;
end;
procedure LoadStyles(var AStylesList: TStrings);
var
f, n: String;
filelist: TStringDynArray;
begin
f := ExtractFilePath(ParamStr(0)) + 'Styles';
if (not DirectoryExists(f)) then
Exit;
filelist := TDirectory.GetFiles(f);
for f in filelist do
begin
n := ChangeFileExt(ExtractFileName(f), EmptyStr);
AStylesList.Add(n + '=' + f);
end;
end;
..and this is where I'm trying to retrieve a string object:
procedure TfrmOptions.ComboBox1Change(Sender: TObject);
var
si: TStyleInfo;
i: Integer;
s: String;
begin
i := TComboBox(Sender).ItemIndex;
s := PChar(TComboBox(Sender).Items.Objects[i]);
Showmessage(s); // --> Mostly shows a corrupted string (gibberish chars)
if (TStyleManager.IsValidStyle(s, si)) then
begin
if (not MatchStr(s, TStyleManager.StyleNames)) then
TStyleManager.LoadFromFile(s);
TStyleManager.TrySetStyle(si.Name);
end;
end;
I suspect that its something with the way I'm adding them. Perhaps I need to allocate memory at:
s := PChar(sl.Values[sl.Names[c]]);
Not sure. Looking at the help on StrNew, NewStr and StrAlloc, it says that those functions are deprecated. Can you help point out whats wrong?
There's nothing to keep the string alive. When you write:
s := PChar(sl.Values[sl.Names[c]]);
an implicit local variable of type string is created to hold whatever sl.Values[sl.Names[c]] evaluates to. That local variable goes out of scope, as far as the compiler is aware, nothing references it, and the string object is destroyed.
In fact, it's even worse than that. Because the assignment above happens in a loop, there is only one implicit local variable. Each time round the loop, the string that you asked the combo box to remember is destroyed.
You need to find a way to extend the lifetime of the string. You could do it like this:
var
StrPtr: ^string;
....
for c := 0 to sl.Count - 1 do
begin
New(StrPtr);
StrPtr^ := sl.Values[sl.Names[c]];
ComboBox1.Items.AddObject(sl.Names[c], TObject(StrPtr));
end;
Then when you need to access the string you can do so like this:
var
StrPtr: ^string;
....
TObject(StrPtr) := TComboBox(Sender).Items.Objects[i];
// do something with StrPtr^
When you clear the combo box you must also run through each item and call Dispose on the pointer.
Having said that, it's going to be much easier not to do it that way. Stop trying to force strings into the TObject data associated with each item. Instead keep a parallel string list containing these strings. When you need to look up a name look it up in that list rather than in the combo box.
I know this is an old question but I came across this problem again and rather than use the separate string list I used an object with a string value (I think someone suggested it in a comment) as follows:
Declare a type as TObject with a string value:
TStringObject = class(TObject)
StringValue : string;
end;
Then when adding your items declare a local var of TStringObject and create a new instance for each item:
var
strObj : TStringObject
begin
...
for c := 0 to sl.Count - 1 do
begin
strObj := TStringObject.Create;
strObj.StringValue := sl.Values[sl.Names[c]];
ComboBox1.Items.AddObject(sl.Names[c], strObj);
end;
And when retrieving the values:
s := TStringObject(TComboBox(Sender).Items.Objects[i]).StringValue;
As #Dejan Dozet mentions in the comments - you should always free the data objects before freeing the TStringList!
the following line of code fails :
...
ProcessStringLIst(ChecklistBox_CheckedStrings(MyCheckListBox));
....
// support functions
function ProcessStringLIst (alst : TStringlist);
begin
/// .... process the stringlist
end;
function ChecklistBox_CheckedStrings(aCheckListBox: TCheckListBox): TStringList;
var
i: Integer;
begin
result.Clear;
for i := 0 to aCheckListBox.Items.Count - 1 do
if aCheckListBox.Checked[i] then
result.Add(aCheckListBox.Items[i])
end;
because inside ChecklistBox_CheckedStrings the result is not yet assignd with data . Can I avoid the 4 line version as below :
templist := TStringlist.Create;
temList := ChecklistBox_CheckedStrings(MyCheckListBox);
ProcessStringLIst(templist);
templist.free;
In your code the function return value is not initialized, and then your first line of code does:
result.Clear;
Because you have not initialized result, anything can happen. If you enable compiler warnings then the compiler will tell you this.
You need to make up your mind whether or not you want the function to return a newly created string list object, or to work with one created by the caller. Let's assume you opt for the latter. Then your function becomes a procedure like this:
procedure GetChecklistBox_CheckedStrings(aCheckListBox: TCheckListBox;
aStringList: TStringList);
var
i: Integer;
begin
aStringList.Clear;
for i := 0 to aCheckListBox.Items.Count - 1 do
if aCheckListBox.Checked[i] then
aStringList.Add(aCheckListBox.Items[i])
end;
The calling code then becomes:
templist := TStringlist.Create;
try
GetChecklistBox_CheckedStrings(MyCheckListBox, templist);
ProcessStringList(templist);
finally
templist.free;
end;
You must use try/finally if you want to protect your program against memory leaks.
And the other way looks like this:
function CreateCheckListBox_CheckedStrings(aCheckListBox: TCheckListBox): TStringList;
var
i: Integer;
begin
Result := TStringList.Create;
try
for i := 0 to aCheckListBox.Items.Count - 1 do
if aCheckListBox.Checked[i] then
Result.Add(aCheckListBox.Items[i])
except
Result.Free;
raise;
end;
end;
.....
templist := CreateCheckListBox_CheckedStrings(MyCheckListBox);
try
ProcessStringList(templist);
finally
templist.free;
end;
Again, it's easy to put either of these methods into a class helper to make the calling syntax look more clear.
My most important pieces of advice:
Enable warnings and hints and make sure your code never has any.
Use try/finally correctly.
When I try to pass tmemorystream as a var or pointer to a procedure it comes back corrupted. What is the proper way to do this?
For example:
function tform1.downloadmemupdate(url, desc: string; var data: tmemorystream; var msg: string): boolean;
begin
filelabel.Caption:=desc;
downloadmemthread:=tdownloadmemthread.create(url);
dlcancelbtn.Enabled:=true;
downloadmemthread.dlstart;
waitforsingleobject(downloadmemthread.Handle, INFINITE);
downloadmemthread.data.SaveToStream(data); //corrupted
downloadmemthread.data.SaveToFile('data.zip'); //works
dlcancelbtn.Enabled:=false;
result:=not (downloadmemthread.canceled and downloadmemthread.success);
dlcanceled:=downloadmemthread.canceled;
msg:=downloadmemthread.msg;
downloadthread.Free;
end;
You don't create data within this method. As it is a var (byref) parameter, I would expect it to be created within tform1.downloadmemupdate, i.e.:
data := TMemoryStream.Create;
Note that if you create an object like this, you will need to free it somewhere else, probably in the calling code.
e.g.
Data := nil;
try
downloadmemupdate(url, desc, data, msg);
// do something with data
finally
Data.Free;
end;
An alternative (and the idiomatic method in Delphi) is to pass objects by value (without the var). and leave it to the calling code to create and destroy them. This is mainly because Delphi doesn't have garbage collection, so it forces the person writing the calling code to think about "ownership".
This would be
function tform1.downloadmemupdate(url, desc: string; data: TStream; var msg: string): boolean;
begin
filelabel.Caption:=desc;
downloadmemthread:=tdownloadmemthread.create(url);
try
...
downloadmemthread.data.SaveToStream(data); //corrupted
downloadmemthread.data.SaveToFile('data.zip'); //works
finally
downloadmemthread.Free;
end;
end;
calling code:
Data := TMemoryStream.Create;
try
downloadmemupdate(url, desc, data, msg);
// do something with data
finally
Data.Free;
end;
I know what changed. I know why. But..
TComplicatedCallMaker = record
Param1: TRecordType;
Param2: TRecordType;
{...}
Param15: TRecordType;
procedure Call;
end;
function ComplicatedCall: TComplicatedCallMaker;
begin
{ Fill default param values }
end;
procedure DoingSomeWorkHere;
begin
with ComplicatedCall do begin
Param7 := Value7;
Param12 := Value12;
Call;
end;
end;
This has perfectly worked before Delphi 2010. An extremely useful technique for making calls which accept a load of parameters but usually only need two or three. Never the same ones though.
And now it gives... guess what?
E2064: Left side cannot be assigned to.
Can't this helpful new behavior be disabled somehow? Any ideas on how to modify the pattern so it works?
Because seriously, losing such a handy technique (and rewriting a bunch of code) for no apparent reason...
I find it a little surprising that this ever worked but since you say it did I'm sure you are right. I'd guess the change was made without consideration for record methods. Without the ability to call methods then this construct would be rather pointless.
Anyway, the compiler isn't going to let you off the hook on this one so you'll have to do this:
type
TRecordType = record end;
TComplicatedCallMaker = record
Param1: TRecordType;
procedure Call;
end;
function ComplicatedCall: TComplicatedCallMaker;
begin
{ Fill default param values }
end;
procedure DoingSomeWorkHere(const Value: TRecordType);
var
CallMaker: TComplicatedCallMaker;
begin
CallMaker := ComplicatedCall;
with CallMaker do begin
Param1 := Value;
Call;
end;
end;
I... think I did it
I hope Delphi developers see what they make their programmers do!
type
PCallMaker = ^TCallMaker;
TCallMaker = record
Param1: integer;
Param2: integer;
function This: PCallMaker; inline;
procedure Call; inline;
end;
function TCallMaker.This: PCallMaker;
begin
Result := #Self;
{ Record functions HAVE to have correct self-pointer,
or they wouldn’t be able to modify data. }
end;
procedure TCallMaker.Call;
begin
writeln(Param1, ' ', Param2);
end;
function CallMaker: TCallMaker; inline
begin
Result.Param1 := 0;
Result.Param2 := 0;
end;
procedure DoingSomeWorkHere;
var cm: TCallMaker;
begin
{Test the assumption that cm is consistent}
cm := CallMaker;
if cm.This <> #cm then
raise Exception.Create('This wasn''t our lucky day.');
{Make a call}
with CallMaker.This^ do begin
Param1 := 100;
Param2 := 500;
Call;
end;
end;
This works, preserves all the good points of the old version (speed, simplicity, small call overhead) but aren't there any hidden problems with this approach?
I'd like to set the length of a dynamic array, as suggested in this post. I have two classes TMyClass and the related TChildClass defined as
TChildClass = class
private
FField1: string;
FField2: string;
end;
TMyClass = class
private
FField1: TChildClass;
FField2: Array of TChildClass;
end;
The array augmentation is implemented as
var
RContext: TRttiContext;
RType: TRttiType;
Val: TValue; // Contains the TMyClass instance
RField: TRttiField; // A field in the TMyClass instance
RElementType: TRttiType; // The kind of elements in the dyn array
DynArr: TRttiDynamicArrayType;
Value: TValue; // Holding an instance as referenced by an array element
ArrPointer: Pointer;
ArrValue: TValue;
ArrLength: LongInt;
i: integer;
begin
RContext := TRTTIContext.Create;
try
RType := RContext.GetType(TMyClass.ClassInfo);
Val := RType.GetMethod('Create').Invoke(RType.AsInstance.MetaclassType, []);
RField := RType.GetField('FField2');
if (RField.FieldType is TRttiDynamicArrayType) then begin
DynArr := (RField.FieldType as TRttiDynamicArrayType);
RElementType := DynArr.ElementType;
// Set the new length of the array
ArrValue := RField.GetValue(Val.AsObject);
ArrLength := 3; // Three seems like a nice number
ArrPointer := ArrValue.GetReferenceToRawData;
DynArraySetLength(ArrPointer, ArrValue.TypeInfo, 1, #ArrLength);
{ TODO : Fix 'Index out of bounds' }
WriteLn(ArrValue.IsArray, ' ', ArrValue.GetArrayLength);
if RElementType.IsInstance then begin
for i := 0 to ArrLength - 1 do begin
Value := RElementType.GetMethod('Create').Invoke(RElementType.AsInstance.MetaclassType, []);
ArrValue.SetArrayElement(i, Value);
// This is just a test, so let's clean up immediatly
Value.Free;
end;
end;
end;
ReadLn;
Val.AsObject.Free;
finally
RContext.Free;
end;
end.
Being new to D2010 RTTI, I suspected the error could depend on getting ArrValue from the class instance, but the subsequent WriteLn prints "TRUE", so I've ruled that out. Disappointingly, however, the same WriteLn reports that the size of ArrValue is 0, which is confirmed by the "Index out of bounds"-exception I get when trying to set any of the elements in the array (through ArrValue.SetArrayElement(i, Value);). Do anyone know what I'm doing wrong here? (Or perhaps there is a better way to do this?) TIA!
Dynamic arrays are kind of tricky to work with. They're reference counted, and the following comment inside DynArraySetLength should shed some light on the problem:
// If the heap object isn't shared (ref count = 1), just resize it. Otherwise, we make a copy
Your object is holding one reference to it, and so is the TValue. Also, GetReferenceToRawData gives you a pointer to the array. You need to say PPointer(GetReferenceToRawData)^ to get the actual array to pass to DynArraySetLength.
Once you've got that, you can resize it, but you're left with a copy. Then you have to set it back onto the original array.
TValue.Make(#ArrPointer, dynArr.Handle, ArrValue);
RField.SetValue(val.AsObject, arrValue);
All in all, it's probably a lot simpler to just use a list instead of an array. With D2010 you've got Generics.Collections available, which means you can make a TList<TChildClass> or TObjectList<TChildClass> and have all the benefits of a list class without losing type safety.
I think you should define the array as a separate type:
TMyArray = array of TMyClass;
and use that.
From an old RTTI based XML serializer I know the general method that you use should work (D7..2009 tested):
procedure TXMLImpl.ReadArray(const Name: string; TypeInfo: TArrayInformation; Data: Pointer; IO: TParameterInputOutput);
var
P: PChar;
L, D: Integer;
BT: TTypeInformation;
begin
FArrayType := '';
FArraySize := -1;
ComplexTypePrefix(Name, '');
try
// Get the element type info.
BT := TypeInfo.BaseType;
if not Assigned(BT) then RaiseSerializationReadError; // Not a supported datatype!
// Typecheck the array specifier.
if (FArrayType <> '') and (FArrayType <> GetTypeName(BT)) then RaiseSerializationReadError;
// Do we have a fixed size array or a dynamically sized array?
L := FArraySize;
if L >= 0 then begin
// Set the array
DynArraySetLength(PPointer(Data)^,TypeInfo.TypeInformation,1,#L);
// And restore he elements
D := TypeInfo.ElementSize;
P := PPointer(Data)^;
while L > 0 do begin
ReadElement(''{ArrayItemName},BT,P,IO); // we allow any array item name.
Inc(P,D);
Dec(L);
end;
end else begin
RaiseNotSupported;
end;
finally
ComplexTypePostfix;
end;
end;
Hope this helps..