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;
Related
I'm implementing the Exec method of TWebBrowser based on this answer. This method is triggered whenever a script error occurs. Now I need to get error information.
I first get hold of the event object of the TWebBrowser.
var
Doc: IHTMLDocument2;
HTMLWindow: IHTMLWindow2;
Event: IHTMLEventObj;
MethodName: String;
MethodResult: OleVariant;
DispatchId: Integer;
Param: array of OleVariant;
begin
//Avoid non-error calls
if nCmdID != OLECMDID_SHOWSCRIPTERROR then
Exit;
//Get hold of the event object
Doc := MapForm.WebBrowser.Document as IHTMLDocument2;
if not Assigned(Doc) then
Exit;
HTMLWindow := Doc.parentWindow;
if not Assigned(HTMLWindow) then
Exit;
//Get the current event
Event := HTMLWindow.event;
And then I'm trying to get the information I need (as demonstrated in this link) using GetIDsOfNames and Invoke functions of the interface. A working Delphi code for using these methods are in this documentation link.
Here is how I use these functions on the Event object.
MethodName := 'errorMessage';
Result := Event.GetIDsOfNames(GUID_NULL, #MethodName, 1, SysLocale.DefaultLCID, #DispatchId);
Result := Event.Invoke(DispatchId, GUID_NULL, SysLocale.DefaultLCID, DISPATCH_METHOD, Param, #MethodResult, nil, nil);
The GetIDsOfNames fuGetIDsOfNames function executes properly, outputs an acceptable integer to DispatchId and returns S_OK.
But the Invoke function just fails. It returns some negative integer as HRESULT and doesn't output anything to MethodResult.
How can I work around this?
The error values you are trying to access are not object methods, they are properties, so Invoke() is going to fail due to your use of DISPATCH_METHOD. Use DISPATCH_PROPERTYGET instead.
However, OleVariant (and Variant) has built-in support for IDispatch.Invoke(), so you don't need to mess with it manually at all. You can call object methods and read/write object properties normally, and the compiler will produce the necessary IDispatch calls for you.
Try something more like this:
function TWebBrowser.Exec(CmdGroup: PGUID; nCmdID, nCmdexecopt: DWORD;
const vaIn: OleVariant; var vaOut: OleVariant): HRESULT; stdcall;
var
Event: OleVariant;
ErrorLine: Integer;
ErrorChar: Char;
ErrorCode: Integer;
ErrorMsg: String;
ErrorUrl: String;
begin
if (CmdGroup = nil) or not IsEqualGUID(CmdGroup^, CGID_DocHostCommandHandler) then
begin
Result := OLECMDERR_E_UNKNOWNGROUP;
Exit;
end;
if nCmdID <> OLECMDID_SHOWSCRIPTERROR then
begin
Result := OLECMDERR_E_NOTSUPPORTED;
Exit;
end;
Event := (IUnknown(vaIn) as IHTMLDocument2).parentWindow.event;
ErrorLine := Event.errorLine;
ErrorChar := Event.errorCharacter;
ErrorCode := Event.errorCode;
ErrorMsg := Event.errorMessage;
ErrorUrl := Event.errorUrl;
...
if (should continue running scripts) then
begin
vaOut := True;
end else
begin
vaOut := False;
end;
Result := S_OK;
end;
Sorry if there's the same question with mine.
In Delphi i make function like this:
function TModuleDatabase.LoadCountryList():TDictionary<integer, String>;
var
UQ: TUniQuery;
UC: TUniConnection;
CountryList: TDictionary<integer, String>;
begin
CountryList := TDictionary<integer, String>.Create;
UC := UniConnection2;
UQ := TUniQuery.Create(nil);
try
UQ.Connection := UC;
try
UQ.SQL.Clear;
UQ.SQL.Add('SELECT ID,NAME FROM COUNTRY ORDER BY NAME ASC');
UQ.Open;
while not UQ.Eof do
begin
CountryList.Add(UQ.Fields.FieldByName('ID').AsInteger,UQ.Fields.FieldByName('NAME').AsString);
UQ.Next;
end;
Result := CountryList;
except
on E:Exception do
ModuleMsgDialog.WarningMsg(E.Message);
end;
finally
UQ.Close;
UQ.Free;
CountryList.Free;
end;
end;
I separate the function to other DataModule to make me not repeat this function every time in each form. But when i call this funtion from a form:
procedure TCompanyDetailsForm.FormCreate(Sender: TObject);
var
i: Integer;
sItem: String;
CountryList: TDictionary<integer, String>;
begin
PageControl1.ActivePage := AddressTab;
CountryList := ModuleDatabase.LoadCountryList();
for i in CountryList.Keys do
begin
LocationCbbx.Items.AddObject(CountryList.Items[i],TObject(i));
end;
end;
The Problem is at CountryList.Free;. All item in dictionary already freed before use.
If i don't do free, there will make memory leaks.
How the best ways to transfer data before doing free. Or how to free value at other form or unit after call.
Thank you for your help.
You have two main options.
Option 1 – Caller provides an instantiated object
Here you let the caller take responsibility for lifetime. The caller passes in an instantiated object, the callee populates it.
procedure PopulateCountryDict(Countries: TDictionary<Integer, string>);
begin
// populate Countries here
end;
Option 2 – Caller returns a newly instantiated object, which is also populated
This is viable, but the caller has to assume responsibility for the lifetime once the callee returns. It looks like this:
function CreateAndPopulateCountryDict: TDictionary<Integer, string>;
begin
Result := TDictionary<Integer, string>.Create;
try
// populate Result here
except
Result.Free; // until this function returns, we are responsible for lifetime
raise;
end;
end;
The calling code looks like this:
var
Countries: TDictionary<Integer, string>
....
Countries := CreateAndPopulateCountryDict;
try
// do stuff with Countries
finally
Countries.Free;
end;
As an extension to David's answer there is another option using a callback
procedure LoadCountryList( ACallback : TProc<TDictionary<integer,string>> );
var
LCountryList : TDictionary<integer,string>;
begin
// create the instance
LCountryList := TDictionary<integer,string>.Create;
try
// fill the dictionary
// execute the callback
ACallback( LCountryList );
finally
// free the instance
LCountryList.Free;
end;
end;
and then use this in your code
procedure TCompanyDetailsForm.FormCreate(Sender: TObject);
begin
PageControl1.ActivePage := AddressTab;
LoadCountryList(
procedure ( CountryList : TDictionary<integer,string> )
var
i: Integer;
begin
for i in CountryList.Keys do
begin
LocationCbbx.Items.AddObject(CountryList.Items[i],TObject(i));
end;
end );
end;
You should create dictinary in FormCreate method, and destroy or clear where do you need. Not in LoadCountryList function.
Whats wrong with my code? I try to save and then load again an object to a blob field in a database, but get nothing back.
Records are saved, but I can't say if the data was written correctly because I cant read the data back.
Here is the object type:
TMyObject = class
Name: string;
end;
And here I try to save:
procedure TForm1.btnSaveObjectClick(Sender: TObject);
var
myObject: TmyObject;
aMemoryStream: TMemoryStream;
begin
myObject:= TMyObject.Create;
myObject.Name:=edtName.Text;
aMemoryStream:= TMemoryStream.Create;
aMemoryStream.Write(myObject, myObject.InstanceSize);
aMemoryStream.Position:=0;
with TSQLQuery.Create(nil) do
begin
DataBase:=Conn;
SQL.Text:='INSERT INTO testtable (data) VALUES (:data)';
try
ParamByName('data').LoadFromStream(aMemoryStream, ftBlob);
ExecSQL;
TX.CommitRetaining;
finally
aMemoryStream.Free;
myObject.Free;
Free;
end;
end;
end;
Trying to read the data back up again:
procedure TForm1.btnLoadObjectClick(Sender: TObject);
var
myObject: TMyObject;
BlobStream : TStream;
begin
with TSQLQuery.Create(nil) do
begin
DataBase:=Conn;
SQL.Text:='SELECT data FROM testtable';
myObject:= TmyObject.Create;
try
Open;
Last;
BlobStream:= CreateBlobStream(FieldByName('data'), bmread);
BlobStream.Position:=0;
BlobStream.Read(myObject, BlobStream.Size);
ShowMessage('Stored Name: ' +myObject.Name);
finally
myObject.Free;
Free;
end;
end;
end;
Also, should BlobStream be free'd?
The correct way for storing your objects into files, streams or blob fields is to first extend your object with additional methods for loading and saving data from your objects fields (objects internal variables) into single memory block.
You do this by saving one field after another.
If your objects are dynamically sized (containing dynamic arrays or strings) don't forget to store the size of these separately so you will know how much data belongs to them when loading your objects later on.
Also if your objects contain some other objects you also need them to have similar methods for storing and loading their data.
The implementation depends heavily on your object's class design. Here a code example for a string field:
type
TMyObject = class
public
Name: string;
procedure SaveToStream(AStream: TStream);
procedure LoadFromStream(AStream: TStream);
end;
procedure TMyObject.SaveToStream(AStream: TStream);
var
Len: Integer;
begin
Len := Length(Name);
AStream.Write(Len, SizeOf(Len));
AStream.Write(PChar(Name)^, Len);
end;
procedure TMyObject.LoadFromStream(AStream: TStream);
var
Len: Integer;
begin
AStream.Read(Len, SizeOf(Len));
SetString(Name, PChar(nil), Len);
AStream.Read(PChar(Name)^, Len);
end;
With this, it is possible to use the stream that CreateBlobStream returns and just save myObject to the blobfield:
BlobField := FieldByName('data') as TBlobField;
Stream := CreateBlobStream(BlobField, bmWrite);
myObject.SaveToStream(Stream);
..or load it from the stream:
Stream:= CreateBlobStream(FieldByName('data'), bmread);
myObject.LoadFromStream(Stream);
Delphi XE6 - I have a Unit (EMAIL1.pas) which does related processing. This is meant to be a standalone unit I can incorporate into multiple programs. My initial procedure is called GetDetailsFromEmailAddress. It has two parameters, an email address which I lookup and a "group of data" which will get updated, currently defined as a var. This can be a record or a class, I don't really care. It is just a group of related strings (firstname, last name, city, etc). Let's call this EmpRec.
My challenge is that this procedure creates an instance of a class (JEDI VCL HTMLParser) which uses a method pointer to call a method (TableKeyFound). This routine needs to update EmpRec. I do not want to change this code (HTMLPArser routine) to add additional parameters. There are several other procedures that my UNIT creates. All of them need to read/update EmpRec. How do I do this?
I need a way to "promote" the variable EmpRec which is passed in this one routine (GetDetailsFromEmailAddress) to be GLOBAL within this UNIT so that all the routines can access or change the various elements. How do I go about this? I do NOT really want to have to define this as a GLOBAL / Application wide variable.
Code sample below. So.. How does the routine TableKeyFoundEx get access to the EmpRec variable?
procedure GetDetailsFromEmailAddress(Email: string; var EmpRec: TEmpRec);
begin
...
// Now create the HTML Parser...
JvHtmlParser1 := TJvHTMLParser.Create(nil);
// On event KeyFoundEx, call Parsehandlers.TableKeyFoundEx;
JvHtmlParser1.OnKeyFoundEx := ParseHandlers.TableKeyFoundEx;
...
end.
procedure TParseHandlers.TableKeyFoundEx(Sender: TObject; Key, Results, OriginalLine: String; TagInfo: TTagInfo;
Attributes: TStrings);
begin
..
// NEED ACCESS to EmpRec here, but can't change procedure definition
end;
There are two different ways I would approach this:
use the parser's Tag property:
procedure GetDetailsFromEmailAddress(Email: string; var EmpRec: TEmpRec);
begin
...
JvHtmlParser1 := TJvHTMLParser.Create(nil);
JvHtmlParser1.OnKeyFoundEx := ParseHandlers.TableKeyFoundEx;
JvHtmlParser1.Tag := NativeInt(#EmpRec);
...
end;
procedure TParseHandlers.TableKeyFoundEx(Sender: TObject; Key, Results, OriginalLine: String; TagInfo: TTagInfo; Attributes: TStrings);
var
EmpRec: PEmpRec; // assuming PEmpRec = ^TEmpRec
begin
EmpRec := PEmpRec(TJvHTMLParser(Sender).Tag);
...
end;
use a little TMethod hack to pass the record DIRECTLY to the event handler:
// Note: this is declared as a STANDALONE procedure instead of a class method.
// The extra DATA parameter is where a method would normally pass its 'Self' pointer...
procedure TableKeyFoundEx(Data: Pointer: Sender: TObject; Key, Results, OriginalLine: String; TagInfo: TTagInfo; Attributes: TStrings);
var
EmpRec: PEmpRec; // assuming PEmpRec = ^TEmpRec
begin
EmpRec := PEmpRec(Data);
...
end;
procedure GetDetailsFromEmailAddress(Email: string; var EmpRec: TEmpRec);
var
M: TMethod;
begin
...
JvHtmlParser1 := TJvHTMLParser.Create(nil);
M.Code := #TableKeyFoundEx;
M.Data := #EmpRec;
JvHtmlParser1.OnKeyFoundEx := TJvKeyFoundExEvent(M);
...
end;
In addition to the two options that Remy offers, you could derive a sub-class of TJvHTMLParser.
type
PEmpRec = ^TEmpRec;
TMyJvHTMLParser = class(TJvHTMLParser)
private
FEmpRec: PEmpRec;
public
constructor Create(EmpRec: PEmpRec);
end;
....
constructor TMyJvHTMLParser.Create(EmpRec: PEmpRec);
begin
inherited Create(nil);
FEmpRec := EmpRec;
end;
When you create the parser, do so like this:
procedure GetDetailsFromEmailAddress(Email: string; var EmpRec: TEmpRec);
var
Parser: TMyJvHTMLParser;
begin
Parser := TMyJvHTMLParser.Create(#EmpRec);
try
Parser.OnKeyFoundEx := ParseHandlers.TableKeyFoundEx;
....
finally
Parser.Free;
end;
end.
And in your OnKeyFoundEx you cast Sender back to the parser type to gain access to the record:
procedure TParseHandlers.TableKeyFoundEx(Sender: TObject; ...);
var
EmpRec: PEmpRec;
begin
EmpRec := (Sender as TMyJvHTMLParser).FEmpRec;
....
end;
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;