Was trying to migrate app to FireDAC usage on Delphi 10.2 and stuck only with this function:
Source on github
procedure TMainForm.ExecuteScript(script: string; memo: TMemo);
var
Log: TStringList;
FN: string;
begin
ShowHourGlassCursor;
ZSQLProcessor.Script.Text := script;
try
ZSQLProcessor.Connection.StartTransaction;
ZSQLProcessor.Execute;
ZSQLProcessor.Connection.Commit;
except
on E:Exception do
begin
ZSQLProcessor.Connection.Rollback;
memo.Text := E.Message;
Exit;
end;
end;
Stuck with line and was not able to get along, any help would be good:
ZSQLProcessor.Script.Text := script;
reference:
ZSqlProcessor.pas
Converted function without last part looks so:
procedure TMainForm.ExecuteScript(script: string; memo: TMemo);
var
Log: TStringList;
FN: string;
begin
ShowHourGlassCursor;
//ZSQLProcessor.Script.Text := script;
try
MyTrinityConnection.StartTransaction;
FDScript1.ValidateAll;
FDScript1.ExecuteAll;
MyTrinityConnection.Commit;
except
on E:Exception do
begin
MyTrinityConnection.Rollback;
memo.Text := E.Message;
Exit;
end;
end;
To assign single SQL script to the TFDScript object you can simply Add one TFDSQLScript item to the TFDSQLScripts collection and set its SQL string list collection text to the SQL command of your choice, for example:
FDScript1.SQLScripts.Add.SQL.Text := script; { ← this adds one TFDSQLScript item to the script collection and to this just added item assigns a SQL script }
Of course, this assumes the TFDSQLScripts collection is clear, if not call Clear before.
Related
I have ported an application from ADO to FireDAC applying several RegExp replaces on the source code to convert the ADOQuery, ADOTables, ADOCommands, ADOStoredProcs, etc. ... to the corresponding FireDAC components.
It has worked fine, but now when running that application plenty of forms raise errors because of the type of the persistent fields being different than the type expected (the one defined from ADO when the persistent field was created).
I'm trying to make a list of those errors, creating an instance of all my forms and opening their datasets with persistent fields, and logging the errors. I can get the list of forms from the project source code, but when I try to use FindClass to create each form I get an error telling that the class has not been found.
Is there any other way to create a Form/DataModule from its class name ?.
This is my current code:
class procedure TfrmCheckFormularis.CheckDatasets(ProjecteFile: string);
var frmCheckFormularis: TfrmCheckFormularis;
Projecte: string;
rm: TMatch;
cc: TComponentClass;
c: TComponent;
i: integer;
Dataset: TFDQuery;
begin
Projecte := TFile.ReadAllText(ProjecteFile);
frmCheckFormularis := TfrmCheckFormularis.Create(Application);
try
with frmCheckFormularis do begin
Show;
qryForms.CreateDataSet;
qryErrors.CreateDataSet;
// I get a list of all the forms and datamodules on my project
for rm in TRegEx.Matches(Projecte, '^(?:.* in '')(?<File>.*)(?:'' {)(?<Class>.*)(?:},)', [roMultiline]) do begin
qryForms.AppendRecord([rm.Groups['File'].Value, rm.Groups['Class'].Value]);
end;
// Check every form and datamodule
qryForms.First;
while not qryForms.Eof do begin
cc := TComponentClass(FindClass(qryFormsClass.Value));
c := cc.Create(frmCheckFormularis);
try
for i := 0 to c.ComponentCount - 1 do begin
if c.Components[i] is TFDQuery then begin
Dataset := c.Components[i] as TFDQuery;
// When the Dataset has persistent fields, I open it to check if the persistent fields are correct
if Dataset.FieldDefs.Count > 1 then begin
try
Dataset.Open;
except
on E: Exception do qryErrors.AppendRecord([c.Name, Dataset.Name, E.Message]);
end;
end;
end;
end;
finally
c.Free;
end;
qryForms.Next;
end;
end;
finally
frmCheckFormularis.Free;
end;
end;
Thank you.
Using the "new" RTTI in Delphi is quite easy. The following code will (hopefully*) create one instance of each form in your application:
procedure TForm1.Button1Click(Sender: TObject);
var
Context: TRttiContext;
&Type: TRttiType;
InstanceType: TRttiInstanceType;
begin
Context := TRttiContext.Create;
for &Type in Context.GetTypes do
begin
if (&Type.TypeKind = tkClass) and &Type.IsInstance then
begin
InstanceType := TRttiInstanceType(&Type);
if InstanceType.MetaclassType.InheritsFrom(TForm) and (InstanceType.MetaclassType <> TForm) then
TFormClass(InstanceType.MetaclassType).Create(Application){.Show}; // optionally show it
end;
end;
end;
* Technically, it will create one instance of each proper descendant class of TForm.
There's an overloaded version of the Execute function of the TDBXCallback calls in Data.DBXJSon that looks like this
function Execute(Arg: TObject): TObject; overload; virtual; abstract;
Which in my Datasnap client, I've implemented like this:
type
ServerChannelCallBack = class(TDBXCallback)
public
function Execute(const Arg: TJSONValue): TJSONValue; overload; override; // this works!
function Execute(Arg: TObject): TObject; overload; override; // this doesn't
end;
function ServerChannelCallBack.Execute(Arg: TObject): TObject;
var
i: Integer;
begin
Result := TObject.Create; // is this correct?
try
if Arg is TStringList then
begin
FormClient.QueueLogMsg('ServerChannel', 'Got TStringList');
for i := 0 to TStrings(Arg).Count - 1 do
FormClient.QueueLogMsg('ServerChannel', TStringList(Arg)[i]);
end;
finally
end;
end;
This is called from the Datasnap server like this:
procedure TFormServer.Button2Click(Sender: TObject);
var
sr: TStringList;
begin
sr := TStringList.Create;
try
sr.Add('one');
sr.Add('two');
ServerContainer2.DSServer1.BroadcastObject('SERVERCHANNEL', sr);
finally
// sr
end;
end;
This is following on from an example in the video presented by Matt DeLong
Heavyweight Callbacks with DataSnap - Part 1: Thick Client
The callback works perfectly, but only exactly once! On the second call from the server (Button2Click), I get an AV in the client. It might be a bug in the DBX code. I don't know. I can't trace in there. Or perhaps I have initialized the Result from the ServerChannelCallBack.Execute incorrectly. Any assistance is appreciated.
UPDATE
The callback is registered on the client like this:
TFormClient = class(TForm)
CMServerChannel: TDSClientCallbackChannelManager;
...
private
ServerChannelCBID: string;
...
procedure TFormClient.FormCreate(Sender: TObject);
begin
ServerChannelCBID := DateTimeToStr(now);
CMServerChannel.RegisterCallback(
ServerChannelCBID,
ServerChannelCallback.Create
);
...
I'm basing this answer on the DataSnap Server + Client projects which can be downloaded from inside Delphi Seattle using `File | Open from version control'
https://radstudiodemos.svn.sourceforge.net/svnroot/radstudiodemos/branches/RadStudio_XE/Delphi/DataSnap/CallbackChannels
that's mentioned here: http://edn.embarcadero.com/article/41374.
The forms in both the server and client require a slight correction to get them to compile, name to add JSon to their Uses list.
On the server form, I've added the following:
procedure TForm3.Button1Click(Sender: TObject);
var
sr: TStringList;
begin
Inc(CallbackCount); // A form variable
sr := TStringList.Create;
try
sr.Add('Callback: ' + IntToStr(CallbackCount));
sr.Add('two');
ServerContainer1.DSServer1.BroadcastObject('ChannelOne', sr);
finally
// No need for sr.free
end;
end;
(I'm using ChannelOne for consistency with the client)
and on the client I have:
function TCallbackClient.Execute(Arg: TObject): TObject;
var
i: Integer;
begin
// Result := TObject.Create; // is this correct?
Result := TJSONTrue.Create;
try
if Arg is TStringList then
begin
QueueLogValue('Server: Got TStringList');
for i := 0 to TStrings(Arg).Count - 1 do
QueueLogValue('Server:' + TStringList(Arg)[i]);
end;
finally
end;
end;
With those variations from the code you've shown in your q, the server and client run fine, and I can click the server button as many times as I like and neither the server nor any of the clients get "stuck". So I think your problem must be specific to something in the code you are using, but at least the linked project gives you something to work from and compare with.
Btw, I changed the TCallbackClient.Execute return type to TJSONTrue.Create (same as the other override) because that's what it says in Marco Cantu's Delphi 2010 Handbook says it should return, admittedly in the context of a "lightweight" callback while a ServerMethod is executing: returning TJSONFalse tells the server to cancel the executing ServerMethod. However, the callbacks from the server work equally well with the TObject.Create you used.
I've been working with Word2010.pas for the past week and everything went well, until I found out that if you open a document manually, edit it (but don't save), press Alt+F4, a prompt will show up saying if you want to save your document or not, leave it like that. Go into code and try to access that document, all calls will result in EOleException: Call was rejected by callee. Once you cancel that Word save prompt, everything works fine.
I came across this while writing code that periodically checks if a document is open. Here is the function that checks if the document is open: (function runs in a timer every 2 seconds)
function IsWordDocumentOpen(FileName: string): Boolean;
var
WordApp: TWordApplication;
I: Integer;
begin
Result := False;
try
WordApp := TWordApplication.Create(nil);
try
WordApp.Connect;
for I := 1 to WordApp.Documents.Count do
begin
try
if WordApp.Documents.Item(I).FullName = FileName then
begin
Result := True;
System.Break;
end;
except
on E: EOleException do
// I always end up here while the document has the prompt
end;
end;
finally
FreeAndNil(WordApp);
end;
finally
//
end;
end;
Does anyone have any experience with this? Is there some sort of a lock that I'm not aware of?
UPDATE #1: So far the only solution I could find was to implement IOleMessageFilter, this way I do not receive any exceptions but the program stops and waits on the line WordApp.Documents.Item(I).FullName, but that is not what I want. Implementation of IOleMessageFilter goes like this:
type
IOleMessageFilter = class(TInterfacedObject, IMessageFilter)
public
function HandleInComingCall(dwCallType: Longint; htaskCaller: HTask;
dwTickCount: Longint; lpInterfaceInfo: PInterfaceInfo): Longint;stdcall;
function RetryRejectedCall(htaskCallee: HTask; dwTickCount: Longint;
dwRejectType: Longint): Longint;stdcall;
function MessagePending(htaskCallee: HTask; dwTickCount: Longint;
dwPendingType: Longint): Longint;stdcall;
procedure RegisterFilter();
procedure RevokeFilter();
end;
implementation
function IOleMessageFilter.HandleInComingCall(dwCallType: Integer; htaskCaller: HTask; dwTickCount: Integer; lpInterfaceInfo: PInterfaceInfo): Longint;
begin
Result := 0;
end;
function IOleMessageFilter.MessagePending(htaskCallee: HTask; dwTickCount, dwPendingType: Integer): Longint;
begin
Result := 2 //PENDINGMSG_WAITDEFPROCESS
end;
procedure IOleMessageFilter.RegisterFilter;
var
OldFilter: IMessageFilter;
NewFilter: IMessageFilter;
begin
OldFilter := nil;
NewFilter := IOleMessageFilter.Create;
CoRegisterMessageFilter(NewFilter,OldFilter);
end;
function IOleMessageFilter.RetryRejectedCall(htaskCallee: HTask; dwTickCount, dwRejectType: Integer): Longint;
begin
Result := -1;
if dwRejectType = 2 then
Result := 99;
end;
procedure IOleMessageFilter.RevokeFilter;
var
OldFilter: IMessageFilter;
NewFilter: IMessageFilter;
begin
OldFilter := nil;
NewFilter := nil;
CoRegisterMessageFilter(NewFilter,OldFilter);
end;
end;
BEST SOLUTION SO FAR: I used IOleMessageFilter implementation like this: (remember this will stop and wait on the line where I previously got an exception)
function IsWordDocumentOpen(FileName: string): Boolean;
var
OleMessageFilter: IOleMessageFilter;
WordApp: TWordApplication;
I: Integer;
begin
Result := False;
try
OleMessageFilter := IOleMessageFilter.Create;
OleMessageFilter.RegisterFilter;
WordApp := TWordApplication.Create(nil);
try
WordApp.Connect;
for I := 1 to WordApp.Documents.Count do
begin
if WordApp.Documents.Item(I).FullName = FileName then
begin
Result := True;
System.Break;
end;
end;
finally
OleMessageFilter.RevokeFilter;
FreeAndNil(WordApp);
FreeAndNil(OleMessageFilter);
end;
finally
//
end;
end;
Actually, I think that the problem is simply that Word is busy doing a modal dialog and so can't respond to external COM calls. This trivial code produces the same error:
procedure TForm1.Button1Click(Sender: TObject);
begin
Caption := MSWord.ActiveDocument.Name;
end;
Probably the simplest way to avoid this problem is to head it off before if happens. If you are using the TWordApplication server that comes with Delphi (on the Servers components tab), you can attach an event handler to its OnDocumentBeforeClose and use that to present your own "Save Y/N?" dialog and set the event's Cancel param to True to prevent Word's dialog from appearing.
Update: If you try experimenting with this code while the Save dialog is popped up
procedure TForm1.Button1Click(Sender: TObject);
var
vWin,
vDoc,
vApp : OleVariant;
begin
vWin := MSWord.ActiveWindow;
Caption := vWin.Caption;
vDoc := vWin.Document;
vApp := vDoc.Application; // Attempt to read Word Document property
Caption := vDoc.Path + '\';
Caption := Caption + vDoc.Name;
end;
I think you'll find that any attempt to read from the vDoc object will result in the "Call was rejected ..." message, so I am beginning to think that this behaviour is by design - it's telling you that the object is not in a state that it can be interacted with.
Interestingly, it is possible to read the Caption property of the vWin Window object, which will tell you the filename of the file but not the file's path.
Realistically, I still think your best option is to try and get the OnDocumentBeforeClose event working. I don't have Word 2010 installed on this machine by Word 2007 works fine with the Word server objects derived from Word2000.Pas so you might try those instead of Word2010.Pas, just to see.
Another possibility is simply to catch the "Call was rejected ..." exception, maybe return "Unavailable" as the document FullName, and try again later.
If you're not using TWordApplication and don't know how to catch the OnDocumentBeforeClose for the method your using to access Word, let me know how you are accessing it and I'll see if I can dig out some code to do it.
I vaguely recall there's a way of detecting that Word is busy with a modal dialog - I'll see if I can find where I saw that a bit later if you still need it. Your IOleMessageFilter looks more promising than anything I've found as yet, though.
I have the following issue, When ever I run this code in the procedure, getting a SQL from my SQL COMPACT DATABASE(sdf), it gives me an error "Object Already Open". How can I fix this. Below is my code for the procedure
Function GetSQL(sName: String; Var App: TApplication): String;
Var
Q: TADOQuery;
Begin
Q := TADOQuery.Create(App);
Q.ConnectionString := GetConnectionStringFromRegistry;
Q.Close;
Q.SQL.Text := 'SELECT * FROM SQLs WHERE Name = :sname';
Q.Parameters.ParamByName('sname').Value := sName;
Try
Q.Open;
If Q.RecordCount >= 1 Then
Begin
Q.First;
Result := Q['Query'];
Q.Close;
End;
Finally
Q.Free;
End;
End;
[This is what the error looks like]
[This is what the code looks like when I press Break]
The only thing I see that could be a problem is that your code leaves the query open if there are no rows returned:
Q.Open;
Try
If Q.RecordCount >= 1 Then
Begin
Q.First;
Result := Q['Query'];
Q.Close; // If Q.RecordCount = 0 above, this line never executes
End;
Finally
Q.Free;
End;
Move the Q.Close inside your finally instead, so it will always be called:
Q.Open;
Try
If Q.RecordCount >= 1 Then
Begin
Q.First;
Result := Q['Query'];
End;
Finally
Q.Close; // This will always run, even if no rows are returned
Q.Free; // or if an exception occurs.
End;
As an aside, you should use parameterized queries instead of concatenating the text, especially if you're running the same query multiple times with the only change being the value of sName. The server is smart enough to cache the compiled query and only replace the parameter value, which means your code executes faster and with less load on the server.
Function GetSQL(sName: String; Var App: TApplication): String;
Var
Q: TADOQuery;
Begin
Q := TADOQuery.Create(App);
Q.ConnectionString := GetConnectionStringFromRegistry;
// I've even tried closing it first
Q.Close;
Q.SQL.Text := 'SELECT Query FROM SQLs WHERE Name = :sname';
Q.ParamByName('sname').AsString := sName;
Try
// Error occurs here
Q.Open;
//Q.Active := True;
If Q.RecordCount >= 1 Then
Begin
Q.First;
Result := Q['Query'];
End;
Finally
Q.Close;
Q.Free;
End;
End;
Thanks to #user582118 for reminding this one...
This is actually a bug in the OleDB provider for SQL CE. If you have nvarchar fields greater than 127 characters in a table and you do a select query on that table, you will receive the DB_E_OBJECTOPEN error.
Original thread : https://stackoverflow.com/a/14222561/800214
I have Midas project that uses a TDataSetProvider in one of RemoteDataModules in the Server
Currently I am making use of the following events
BeforeApplyUpdates - to create an Object
BeforeUpdateRecord - to use the object
AfterApplyUpdates - to destory the object
Question:
Will ‘ AfterApplyUpdates’ always be called even if the is an update error ?
If you look at the sourcecode:
function TCustomProvider.DoApplyUpdates(const Delta: OleVariant; MaxErrors: Integer;
out ErrorCount: Integer; var OwnerData: OleVariant): OleVariant;
begin
SetActiveUpdateException(nil);
try
try
if Assigned(FOnValidate) then
FOnValidate(Delta);
DoBeforeApplyUpdates(OwnerData);
Self.OwnerData := OwnerData;
try
Result := InternalApplyUpdates(Delta, MaxErrors, ErrorCount);
finally
OwnerData := Self.OwnerData;
Self.OwnerData := unassigned;
end;
except
on E: Exception do
begin
SetActiveUpdateException(E);
raise;
end;
end;
finally
try
DoAfterApplyUpdates(OwnerData);
finally
SetActiveUpdateException(nil);
end;
end;
end;
Yoy see that DoAfterApplyUpdates is called in the finally block. This means it is always called regardles of any exception.