I'm porting an old application from delphi7 to delphi xe8
and from intraweb 8 to intraweb XIV
My app was subdivided in a main program and a number of child packages
and it worked perfectly with the old components.
With theese new components, I now get an exception trying to generate and return a page to the server controller, creating such a page from a child package.
If instead I generate the page from the main app, it works.
In the procedure TIWServerController.IWServerControllerBaseGetMainForm
I call a procedure of a my component (packman) that tries to obtain a main window from a child package.
this is the servercontroller function
procedure TIWServerController.IWServerControllerBaseGetMainForm(var vMainForm : TIWBaseForm);
begin
VMainForm := PackMan.MainLoginForm(webApplication);
end;
and this is the packman function:
function tPackMan.MainLoginForm (aOwner:tComponent) : tIwAppForm;
var Proc : tGetMainFormProc;
begin
#Proc := GetProcAddress (LoginPkg,'MainForm');
Result := Proc(aOwner);
end;
this is the definition of the procedural type:
tGetMainFormProc = function (aOwner:tComponent): tIwAppForm;
and this is the MainForm procedure, in the child package (packlogin).
Initially I tried to create the original form, full of components,
after that I've removed all components from original form, without success,
and finally I tried to construct an empty form, as shown in this sample:
function MainForm (aOwner:tComponent): tIWAppForm;
begin
Result := tIWAppForm.Create(aOwner);
end;
exports MainForm;
I've traced the program behaviour using several Outputdebugstring messages (here not shown) and I've come to the following conclusion:
1) the Mainform procedure, in the package, seems to return a valid tIwAppform
2) this Object is correctly returned to the IWServerControllerBaseGetMainForm procedure
and the variable VMainForm is correctly assigned.
3) if I inspect the classname property of this variable, I see it has the value "tIWAppform".
The exception seems to be generated at the procedure return.
I've interceped it in the procedure IWServerControllerBaseException
with the following code :
procedure TIWServerController.IWServerControllerBaseException(
AApplication: TIWApplication; AException: Exception;
var Handled: Boolean);
begin
Dump ('UNEXPECTED EXCEPTION ' + AException.message);
Handled := true;
end;
What am I missing ?
Any suggestion ?
Regards.
Maurizio.
Related
We use a Delphi TADOQuery with an explicit connection for inserts.
Summary:
When the connection is lost while the query is in State dsInsert, the query seems to enter an inconsistent state with respect to the underlying ADO recordset. As a result, the query cannot be used anymore, even if the connection has been reestablished.
Details:
Assume the following simplified steps:
quTest.Connection:= ADOConnection1;
quTest.Open;
quTest.Insert;
//Simulate lost connection
ADOConnection1.Close;
try
//quTest.State is still dsInsert
quTest.Post; //Throws 'Operation is not allowed when the object is closed'. This is the expected beavior.
except
//Reconnect (simplified algorithm)
ADOConnection1.Connected:= true;
end;
//quTest.State is still dsInsert
//So far, so good.
//Now let's close or abort or somehow reset quTest so that we can use it again. How?
quTest.Close //throws 'Operation is not allowed when the object is closed'
The problem is that at the end of the code sample above quTest is still in State dsInsert, but the underlying ADO recordset is disconnected.
Any attempt to close or somehow reset quTest fails with an exception 'Operation is not allowed when the object is closed'.
Please note that our goal is not to continue the initial insert operation. We just want to bring the query back to a state where we can open and use it again.
Is this possible?
Since quTest is part of a datamodule with design-time field bindings, we cannot easily free the broken query and create a new query instance.
Edit:
Of course, the simulation of the disconnect is not too realistic.
However, comparing the stack traces of the production error and the test sample, we see that the test is good enough.
Production stack trace:
================================================================================
Exception class : EOleException
Exception message: Operation is not allowed when the object is closed
EOleException.ErrorCode : -2146824584
================================================================================
[008B9BD7] Data.Win.ADODB.TCustomADODataSet.InternalGotoBookmark + $17
(0000E290) [0040F290]
[008B9BD7] Data.Win.ADODB.TCustomADODataSet.InternalGotoBookmark + $17
[008B9BF4] Data.Win.ADODB.TCustomADODataSet.InternalSetToRecord + $14
[0081EEBE] Data.DB.TDataSet.InternalSetToRecord + $2
[0081D576] Data.DB.TDataSet.SetCurrentRecord + $62
[0081D9A4] Data.DB.TDataSet.UpdateCursorPos + $10
[0081E378] Data.DB.TDataSet.Cancel + $68
[0081AA49] Data.DB.TDataSet.SetActive + $AD
[0081A841] Data.DB.TDataSet.Close + $9
Test case stack trace:
Data.Win.ADODB.TCustomADODataSet.InternalFirst
Data.DB.TDataSet.SetCurrentRecord(0)
Data.DB.TDataSet.UpdateCursorPos
Data.DB.TDataSet.Cancel
Data.DB.TDataSet.SetActive(???)
Data.DB.TDataSet.Close
In fact, since the query state is still dsInsert, an attempt to .Cancel is made, resulting in subsequent calls to the ADO recordset which fail.
procedure TDataSet.SetActive(Value: Boolean);
begin
...
if State in dsEditModes then Cancel;
...
end;
Edit 2:
The problem is not easy to reproduce, since it seems to be data dependent.
That's why I created a console test program.
Please run the test program twice and change the test case in the main block.
The output of the tests at my machine is shown below.
Console test program:
program Project2;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
Data.DB,
Data.Win.ADODB,
ActiveX;
procedure Setup(aConnection: TADOConnection; aEmpty: Boolean);
var
query: TADOQuery;
begin
query:= TADOQuery.Create(nil);
try
query.Connection:= aConnection;
//Create test table
try
query.SQL.Add('create table test3 (a int)');
query.ExecSQL;
WriteLn('Table created.');
except
on e: Exception do
Writeln(e.Message);
end;
//Clear test table
query.SQL.Clear;
query.SQL.Add('delete test3');
query.ExecSQL;
if not aEmpty then begin
//Create a row
query.SQL.Clear;
query.SQL.Add('insert into test3 values (0)');
query.ExecSQL;
end;
finally
query.Free;
end;
end;
var
con: TADOConnection;
query: TADOQuery;
begin
CoInitialize(nil);
try
con:= TADOConnection.Create(nil);
query:= TADOQuery.Create(nil);
try
con.ConnectionString:= 'Provider=SQLOLEDB.1;Persist Security Info=False;Integrated Security=SSPI;Data Source=10.0.0.11,1433;Initial Catalog=TestDB';
con.Connected:= true;
//Test case 1: With data
Setup(con, false);
//Test case 2: No data
//Setup(con, true);
query.Connection:= con;
query.SQL.Add('select * from test3');
query.Open;
query.Insert;
con.Close;
WriteLn('query.Active: ' + BoolToStr(query.Active));
WriteLn('query.State: ' + IntToStr(Ord(query.State)));
query.Close;
WriteLn('Test ran without exception.');
except
on E: Exception do
Writeln('Exception: ' + E.ClassName, ': ', E.Message);
end;
finally
ReadLn;
query.Free;
con.Free;
end;
end.
Test-Environment:
Delphi 10 Seattle Version 23.0.21418.4207
Console test program platform: Win32
Microsoft SQL Server 2008 R2 (SP1) - 10.50.2550.0 (X64)
Tested on:
Windows 8.1 Pro in IDE
Windows 8.1 Pro
Windows Server 2008 R2 Standard, 6.1.7601 SP1 Build 7601
Windows Server 2008 R2 Standard
Output of test case 1:
There is already an object named 'test3' in the database
query.Active: 0
query.State: 0
Test ran without exception.
Output of test case 2:
There is already an object named 'test3' in the database
query.Active: -1
query.State: 3
Exception: EOleException: Operation is not allowed when the object is closed
I don't like posting an answer which doesn't actually answer the question, but
in this case I think I should because I simply cannot reproduce what you've said in
your comments regarding the state of your quTest. Perhaps the divergence
between my results and yours is due to some part of your code or object properties
that are not included in your question.
Please try this (I've tested it in D7 and Seattle):
Start a new project and drop a TAdoConnection and TAdoQuery on your form.
Make only the property changes shown in the DFM extract below;
Set up the event handlers shown in the code extract shown below.
Put breakpoints inside the BeforeClose and BeforeCancel handlers, and one on
quTest.Post
then compile, run and click Button1.
What I get is as follows:
The BP on BeforeClose trips.
The BP on BeforeCancel trip.
The BP on quTest.Post trips.
At step 3, the state of quTest is dsInactive and its Active property is False.
Those values and the fact that the Before ... events are called beforehand are
precisely what I would expect, given that calling AdoConnection.Close closes
the dataset(s) using it as their Connection.
So, I think that if you get different results with your app, you need to explain
why because I think I've shown that a test project does not exhibit the
behaviour you've reported.
Update 2
At the request of the OP, I added an int column 'a' to the table, and a corresponding Parameter to quTest and added
quTest.Parameters.ParamByName('a').Value:= 0;
before both my calls to quTest.Open. This makes no difference to the State and Active properties of quTest when the BP on quTest.Post trips: they are still dsInactive and False, respectively.
As the OP has said he just want to be able to carry on using quTest after the aborted Insert, I replaced quTest.Post; in the except block by quTest.Open;. After that, once the Inssert exception has occurred, I can carry on using quTest without any apparent problem - I can do Deletes, Inserts and Edits manually and these are correctly passed back to the server, so that when the app is re-run, these changes have persisted.
Update 3. The OP seems to be in some doubt that calling AdoConnection1.Close results in quTest being closed. It does. To verify this put a watch on Form1.quTest.RecordSetState and run the appl as far as AdoConnection1.Close. Then, trace into that call. You will find that TCustomConnection.SetConnected calls DoDisconnect
which calls ConnectionObject.Close. That sets quTest.RecordSetState to stClosed so that when TAdoConnection.Disconnect executes
for I := 0 to DataSetCount - 1 do
with DataSets[I] do
if stClosed in RecordsetState then Close;
quTest is closed.
Sample code
TForm1 = class(TForm)
ADOConnection1: TADOConnection;
quTest: TADOQuery;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure quTestBeforeCancel(DataSet: TDataSet);
procedure quTestBeforeClose(DataSet: TDataSet);
public
{ Public declarations }
procedure TestReconnect;
end;
[...]
procedure TForm1.FormCreate(Sender: TObject);
begin
quTest.Open;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
TestReconnect;
end;
procedure TForm1.quTestBeforeCancel(DataSet: TDataSet);
begin
Caption := 'Before Cancel';
end;
procedure TForm1.quTestBeforeClose(DataSet: TDataSet);
begin
Caption := 'Before close';
end;
procedure TForm1.TestReconnect;
begin
quTest.Connection:= ADOConnection1;
quTest.Open;
quTest.Insert;
//quTest.FieldByName('Name').AsString := 'yyyy'; added by MA
//Simulate lost connection
ADOConnection1.Close;
try
quTest.Post; //Throws 'Operation is not allowed when the object is closed'
except
//Reconnect (simplified algorithm)
ADOConnection1.Connected:= true;
quTest.Post;
end;
end;
end.
Partial DFM
object ADOConnection1: TADOConnection
Connected = True
ConnectionString =
'Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initia' +
'l Catalog=MATest;Data Source=MAI7'
Provider = 'SQLOLEDB.1'
Left = 24
Top = 24
end
object quTest: TADOQuery
Connection = ADOConnection1
CursorType = ctStatic
BeforeClose = quTestBeforeClose
BeforeCancel = quTestBeforeCancel
Parameters = <>
SQL.Strings = (
'Select * from TestTable')
Left = 64
Top = 24
end
Update 1 The following code allows the completion of the pending insert
in the except block. Note the absence of a call to quTest.Post in the except block.
procedure TForm1.TestReconnect;
const
SaveFileName = 'C:\Temp\testdata.xml';
begin
quTest.Connection:= ADOConnection1;
quTest.Open;
quTest.Insert;
quTest.FieldByName('Name').AsString := 'yyyy';
quTest.SaveToFile(SaveFileName, pfXML);
//Simulate lost connection
ADOConnection1.Close;
try
quTest.Post; //Throws 'Operation is not allowed when the object is closed'
except
//Reconnect (simplified algorithm)
ADOConnection1.Connected:= true;
quTest.LoadFromFile(SaveFileName);
end;
end;
The reason for the observed behavior is a change in or before Delphi XE6, which I think is a bug.
https://quality.embarcadero.com/browse/RSP-15545
Summary:
The problem does not occur in Delphi 2007 and Delphi XE.
The problem occurs in Delphi 10.1
The problematic code change has been introduced in or before XE6 in TDataSet.SetActive, where a new call to Cancel has been added.
This call fails in the described scenario leading to the described effects.
In my application I want to copy all the text from a website into a string variable. Because of some issues with Indy, I want to use the webbrowser component.
The following code works perfectly for me:
procedure TForm1.Button1Click(Sender: TObject);
begin
WebBrowser1.Navigate('www.tribalwars.nl');
while WebBrowser1.Busy do
Application.ProcessMessages;
Memo1.Lines.Add((WebBrowser1.Document as IHTMLDocument2).body.innerText);
end;
However, in the example above I use a WebBrowser that has been manually created on my Form1.
Now I want to create it during runtime. I tried the following code:
procedure TForm1.Button2Click(Sender: TObject);
var Web: TWebBrowser;
begin
Web := TWebBrowser.Create(nil);
Web.Navigate('www.tribalwars.nl');
while Web.Busy do
Application.ProcessMessages;
Memo1.Lines.Add((Web.Document as IHTMLDocument2).body.innerText); //This line raises the error mentioned below
Web.Free;
end;
Unfortunately it keeps raising the following error:
Project Project1.exe raised exception class $C0000005 with message 'access violation at 0x005d9b4f: read of address 0x00000000'.
I guess I'm trying to use something that hasn't been created yet, or somewhere in that direction.
I hope someone can help me get this to work!
EDIT: whosrdaddy mentioned that I should make this component visible. How can I do that? I tried this, but it doesn't work:
procedure TForm1.Button2Click(Sender: TObject);
var Web: TWebBrowser;
begin
Web := TWebBrowser.Create(nil);
Web.Left := 50;
Web.Top := 50;
Web.Width := 50;
Web.Height := 50;
Web.Visible := True;
Application.ProcessMessages;
Web.Navigate('www.tribalwars.nl');
while Web.Busy do
Application.ProcessMessages;
Memo1.Lines.Add((Web.Document as IHTMLDocument2).body.innerText);
Web.Free;
end;
The problem is that when you create TWebBrowser dynamically and pass NIL as the owner, unfortunately the parent is also NIL. a non -NIL parent is needed to display anything.
Normally you would do this:
var
pnlBrowser : TPanel;
Web : TWebBrowser;
Web := TWebBrowser.Create(nil);
Web.Parent := pnlBrowser;
BUT, unfortunately, you cannot (directly) do this either (you get an error message "read-only property" if you try).
But luckily, there IS a way to circumvent the problem:
TWinControl(Web).Parent := pnlBrowser; // this works OK!
I have no idea WHY the parent property of the TWebBrowser class is read-only.
Reading the Delphi documentation, also
TControl(Web).Parent := pnlBrowser; // this should also work
as a side note:
If you have TmsMediaPlayer component (the ActiveX version of Microsoft Windows Media Player), setting parent using the Delphi's Parent property will stop any video playing, but setting it directly through a windows API call does not.
IF you want to use your TWebBrowser to play videos, changing the Parent property on the fly may also stop any video playing. If so it is worth trying to change the parent using windows API call directly instead to avoid stopping a video playing in the web browser.
1) try to change Your TWebBrowser component to TEmbeddedWB
- the parameters/events are the same + lots of extras You can use...
2) I think the problem is with the readystate of your created browser after navigation - its not loaded completely (+maybe it has not assigned parent)
try use the following code (replace Your TWebBrowser component name):
Web.Navigate('www.tribalwars.nl')
repeat application.processmessages; until web.readystate=4;
Memo1.Lines.Add((Web.Document as IHTMLDocument2).body.innerText);
I'm tidying up components used in a large legacy project, I've eliminated about 90 of 220 custom components, replacing them with standard Delphi controls. Some of the remaining components require a significant amount work to remove which I don't have available. I would like to prevent anyone from making additional use of some of these components and was wondering if there was a way of showing a message if the component is dropped on the form at design time - something like "Don't use this control, use x or y instead".
Another possibility would to hide the control on the component pallet (but still have the control correctly render on the form at design time).
There is protected dynamic method TComponent.PaletteCreated, which is called only in one case: when we add this component to a form from component palette.
Responds when the component is created from the component palette.
PaletteCreated is called automatically at design time when the component has just been created from the component palette. Component writers can override this method to perform adjustments that are required only when the component is created from the component palette.
As implemented in TComponent, PaletteCreated does nothing.
You can override this method to show warning, so it will alert the user just one time, when he tries to put it to form.
UPDATE
I couldn't make this procedure work in Delphi 7, XE2 and Delphi 10 Seattle (trial version), so it seems that call to PaletteCreated from IDE is not implemented.
I sent report to QC:http://qc.embarcadero.com/wc/qcmain.aspx?d=135152
maybe developers will make it work some day.
UPDATE 2
There are some funny workarounds, I've tried them all this time, works normally. Suppose that TOldBadButton is one of components that shouldn't be used. We override 'Loaded' procedure and WMPaint message handler:
TOldBadButton=class(TButton)
private
fNoNeedToShowWarning: Boolean; //false when created
//some other stuff
protected
procedure Loaded; override;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
//some other stuff
end;
and implementation:
procedure TBadOldButton.Loaded;
begin
inherited;
fNoNeedToShowWarning:=true;
end;
procedure TOldBadButton.WMPaint(var Message: TWMPAINT);
begin
inherited;
if (csDesigning in ComponentState) and not fNoNeedToShowWarning then begin
Application.MessageBox('Please, don''t use this component','OldBadButton');
fNoNeedToShowWarning:=true;
end;
end;
The problem is, this works only for visual components. If you have custom dialogs, imagelists etc, they never get WMPaint message. In that case we can add another property, so when it is shown in object inspector, it calls getter and here we display warning. Something like this:
TStupidOpenDialog = class(TOpenDialog)
private
fNoNeedToShowWarning: boolean;
function GetAawPlease: string;
procedure SetAawPlease(value: string);
//some other stuff
protected
procedure Loaded; override;
//some other stuff
published
//with name like this, probably will be on top in property list
property Aaw_please: string read GetAawPlease write SetAawPlease;
end;
implementation:
procedure TStupidOpenDialog.Loaded;
begin
inherited;
fNoNeedToShowWarning:=true; //won't show warning when loading form
end;
procedure TStupidOpenDialog.SetAawPlease(value: string);
begin
//nothing, we need this empty setter, otherwise property won't appear on object
//inspector
end;
function TStupidOpenDialog.GetAawPlease: string;
begin
Result:='Don''t use this component!';
if (csDesigning in ComponentState) and not fNoNeedToShowWarning then begin
Application.MessageBox('Please, don''t use this component','StupidOpenDialog');
fNoNeedToShowWarning:=true;
end;
end;
Older versions of Delphi always scroll object inspector to the top when new component is added from palette, so our Aaw_please property will surely work. Newer versions tend to start with some chosen place in property list, but non-visual components usually have quite a few properties, so it shouldn't be a problem.
To determine when the component is first created (dropped on the form)?
Override "CreateWnd" and use the following if statement in it:
if (csDesigning in ComponentState) and not (csLoading in ComponentState) then
// We have first create
More detail here >>
Link
We would like to share an ADOConnection across a DLL boundary (Delphi to Delphi at the moment, though could also be C# to Delphi in the near future).
As we would like the flexibility to call the DLL from c# in future, we were hoping to be able to define the DLL call using _Connection as a parameter. Something like:
procedure DoStuff (ADOConnection: _Connection)
var
InnerConnection: TADOConnection;
begin
InnerConnection := TADOConnection.create(nil);
try
InnerConnection.ConnectionObject := ADOConnection;
DoMoreStuff(InnerConnection);
finally
InnerConnection.free;
end;
end;
Unfortunately, the TADOConnection destructor code closes the connection passed into it, which is an unwanted side-effect. Adding
InnerConnection.ConnectionObject := nil
prior to the free doesn't do anything, as it's caught by
if Assigned(Value) = nil
in TADOConnection.SetConnectionObject, which results in the call not doing anything.
Is there a better way of achieving this? Passing the connection string is an alternative, but would mean that we would have to deal with username/password issues and encryption across the boundary. Passing the TADOConnection is another option, but that prevents calling from other languages.
Edit: For clarity, the Username/Password of the original TADOConnection object is set using the .Open routine, so these details aren't in the connection string (in fact, the wrong username is usually stored, as it's the name used to 'test connection' in the MS UDL editor)
You can try this way:
type TInit_StFattDLL = procedure( var DataBase:TAdoConnection);
var Init_StFattDLL:TInit_StFattDll;
The caller is:
Function ConnectDll():Boolean;
var
handleDll:THandle;
begin
handleDll := LoadLibrary('mydll.DLL');
#Init_StFattDLL := GetProcAddress(handleDll , 'myConnectFunction');
if #Init_StFattDLL <> nil then
begin
Init_StFattDLL(ADOConnection1);
result:=true;
end
else
result:=false;
end;
into the the dll put the following:
in the project file put the exports:
Exports myConnectFunction;
global section:
var Database:TAdoConnection;
the exported procedure is the following:
procedure myConnectFunction( var MyDataBase:TAdoConnection);export;
begin
Database:=MyDataBase;
end
I want to know how can I write a module to show something like clock or other thing on Borland Delphi 7 IDE status bar, because I know it's possible but I couldn't find how!
To insert a text in a StatusBar, you have to insert a panel first.
Just select your statusbar, find the property "Panels" (or perform double click over the statusbar) and click in "Add new".
After that, you can write what you want inside the panel in the property "Text" (you can insert one or more panels).
To do it programmatically, you can do something like this:
procedure TForm1.Timer1Timer(Sender: TObject);
begin
StatusBar1.Panels[0].Text := 'Today is: ' + FormatDateTime('dd/mm/yyyy hh:nn:ss', Now);
end;
Since OP didn't replied with more details, I'm going to post a little demonstration how to reach a status bar of Delphi's edit window. I had no success with adding new distinct status panel w/o disturbing layout, so I'm just changing the text of INS/OVR indicator panel.
Disclaimer: I still do not have access to the machine with Delphi 7 installed, so I've done that in BDS ("Galileo") IDE. However, differences should be minor. I believe what main difference lies in the way how we locate edit window.
Key strings are: 'TEditWindow' for edit window class name and 'StatusBar' for TStatusBar control name owned by edit window. These strings are consistent across versions.
{ helper func, see below }
function FindForm(const ClassName: string): TForm;
var
I: Integer;
begin
Result := nil;
for I := 0 to Screen.FormCount - 1 do
begin
if Screen.Forms[I].ClassName = ClassName then
begin
Result := Screen.Forms[I];
Break;
end;
end;
end;
procedure Init;
var
EditWindow: TForm;
StatusBar: TStatusBar;
StatusPanel: TStatusPanel;
begin
EditWindow := FindForm('TEditWindow');
Assert(Assigned(EditWindow), 'no edit window');
StatusBar := EditWindow.FindComponent('StatusBar') as TStatusBar;
(BorlandIDEServices as IOTAMessageServices).AddTitleMessage(Format('StatusBar.Panels.Count = %d', [StatusBar.Panels.Count]));
//StatusPanel := StatusBar.Panels.Add;
StatusPanel := StatusBar.Panels[2];
StatusPanel.Text := 'HAI!';
end;
initialization
Init;
finalization
// nothing to clean up yet
Another note: As you see, I use Open Tools API to output debug messages only, to interact with IDE I do use Native VCL classes. Therefore, this code must be in package.
The code above is a relevant part of the unit which should be contained in package. Do not forget to add ToolsAPI to uses clause as well as other appropriate referenced units (up to you).
Package should require rtl, vcl and designide (important!).
Since I run the testcase directly from initialization section, installing the package is enough for testcase to run and produce some result.