To detect and prevent shutdown the computer I use very simple program. It has only one form and one private procedure like below:
TForm3 = class(TForm)
private
procedure WMQueryEndSession(var Msg : TWMQueryEndSession) ;
message WM_QueryEndSession;
end;
and the implementation
procedure TForm3.WMQueryEndSession(var Msg: TWMQueryEndSession);
begin
Msg.Result := 0; //so I don't want to shutdown while my program is running
end;
I compiled it Delphi 5 and Delphi 2010. Both of them detect shutdown. But when I compiled in Delphi 2010; after preventing shutdown my program closes. (PC doesn't shutdown)
How do I get the same result from both of them?
EDIT: changed to intercept WM_ENDSESSION instead of WM_QUERYENDSESSION.
As you cannot directly change the behaviour of TApplication, you can install a TApplication message hook instead that neutralizes the WM_ENDSESSION message.
Installing such a hook is quite simple, you only have to add a method similar to the following to your mainform and register the hook in FormCreate.
function TForm25.HookEndSession(var Message: TMessage): Boolean;
begin
result := false;
if Message.Msg = WM_ENDSESSION then begin
Message.Result := 0;
result := true;
end;
end;
procedure TForm25.FormCreate(Sender: TObject);
begin
Application.HookMainWindow(HookEndSession);
end;
I usually run "shutdown -a" command. You can do the same from your code to interrupt Windows from shutdown.
Regards
This looks like a bug in Delphi. I suggest you to post this on Quality Central.
Edit: Here's an approach that doesn't work. Thanks
Procedure TMyForm.FormClose(Sender: TObject; Var Action: TCloseAction);
Begin
Action := caNone; //The form is not allowed to close, so nothing happens.
End; // Note: the OP says he tried this, doesn't help. See the comments.
Are you testing on the same OS? There are some application shutdown changes in Vista. Read this: Application Shutdown Changes in Windows Vista
If you are testing on the same OS, maybe Delphi 2010 handles WM_ENDSESSION messages in a different way. In Delphi 7, WM_ENDSESSION message are handled in Application.WndProc.
In all versions should you not be using the FormCloseQuery event?
procedure TForm3.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
Canclose := Not StillDoingImportantStuff;
end;
Oops - just read comments to "this does not work" :( Is win 7 different?
In all my apps this gets called if windows is trying to shut down...
ShutdownGuard is built with Delphi and it's open source, you can download it tweak it for your needs
Related
This is my first post here so please forgive me if I am not doing it right.
I am using Delphi 7 on my Windows 10 machine. When I use the TOpenDialog I get garbage in the filename property on close. This is what I get back þƒ‡uÔÁ™ßðæRw. I created a simple form with a button and a edit box to show the problem here. Could someone please assist me.
The code is below.
procedure TForm1.Button1Click(Sender: TObject);
begin
opendialog1.Execute();
end;
procedure TForm1.OpenDialog1Close(Sender: TObject);
begin
edit1.Text := opendialog1.FileName;
end;
Don't use the OnClose event of the dialog. That is invoked after the underlying dialog object, which owns the file name data, has been destroyed.
Instead respond to the dialog when Execute returns.
procedure TForm1.Button1Click(Sender: TObject);
begin
if opendialog1.Execute() then
edit1.Text := opendialog1.FileName;
end;
Note that you must also test the return value of Execute to handle the user cancelling the dialog.
My Delphi application has a form that uses the Acrobat Reader ActiveX control for viewing pdfs. When I use the control's functions (LoadFile, gotoNextPage, gotoPreviousPage, gotoFirstPage, gotoLastPage), then close the form, I get the following error: "Access violation at address 6AF5703C. Read of address 6AF5703C". When I run the app, but do not use the control's functions, and then close the form, the app will exit without error.
Anyone know of a fix or workaround for this issue?
My app is written using Delphi 5 (legacy app). I have Adobe Acrobat Reader DC v15.016.20045 installed.
As I said in a comment to Zam, with the current version downloaded today of Acrobat Reader DC , I get the exact same error as you.
Please try this code and let us know whether it avoids the error for you, because it certainly works for me and there is no AV, either in the FormClose or afterwards.
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
Ref : Integer;
begin
Ref := AcroPdf1.ControlInterface._AddRef;
AcroPdf1.Src := '';
AcroPdf1.Free;
AcroPdf1 := Nil;
end;
This is my FormCreate, which contains my only other code.
procedure TForm1.FormCreate(Sender: TObject);
begin
AFileName := 'd:\aaad7\pdf\printed.pdf';
AcroPdf1.src := AFileName;
AcroPdf1.setZoom(200); // <- this line is to exercise the
// ControlInterface to provoke the AV on shutdown
end;
I have absolutely no idea why my FormClose avoids the AV problem, and before anybody else says so, yes, it looks mad to me, too! Hardly something that deserves the name "solution", but maybe it will suggest a proper solution to someone who knows more about COM and Ole controls than I do.
I originally included the Ref := AcroPdf1._AddRef just as an experiment. I noticed that after it, Ref's value was 9. After AcroPdf1.Src := '', calling AcroPdf1._Release in the debugger evaluator returned a value of 4. I was about to see if the AV was avoided by forcing the RefCount down by repeatedly calling _Release but then Presto!, there was no AV after my first trace into FormClose exited.
Update: I have not tested the following exhaustively, but this simplified FormClose also avoids the AV, on my system at any rate:
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
Ref : Integer;
begin
Ref := AcroPdf1.ControlInterface._AddRef;
end;
Obviously, omitting the assignment to Ref shouldn't make any difference.
I'm using Delphi 10 Seattle on 64-bit Win10, btw.
The better solution is to edit the TPDF Object in "AcroPDFLib_Tlb.pas"
Just add the proper destructor to the Code to free the OLE Object:
Declaration
Type
TAcroPDF = class(TOleControl)
...
public
destructor Destroy; override; // <- New Line
...
end;
Implementation
destructor TAcroPDF.Destroy;
begin
FIntf := NIL;
inherited;
end;
I wrote a program using IdHTTP and IdFTP but I have a problem. I wrote it on windows XP 32 bit (using Delphi XE4) and the exe file (Project1.exe) works fine. When I try to open it on windows 7 64 bit, the computer gives me an error.
Picture:
It means "You cannot acces to the path or the specified file. Maybe you don't have enough permissions". I've never seen this error before. Here you can see a picture of the folder with source code.
How can I solve my problem?
Here's the code:
function downloadSrc(var aUrl:ansiString):ansiString;
begin
with tIdHttp.create(nil) do begin //Create Indy http object
request.userAgent:=INET_USERAGENT; //Custom user agent string
redirectMaximum:=INET_REDIRECT_MAX; //Maximum redirects
handleRedirects:=INET_REDIRECT_MAX<>0; //Handle redirects
readTimeOut:=INET_TIMEOUT_SECS*1000; //Read timeout msec
try //Catch errors
result:=get(aUrl); //Do the request
if url.port='80' then url.port:=''; //Remove port 80 from final URL
aUrl:=url.getFullURI //Return final URL
except result:='error' end; //Return an error message if failed
free //Free the http object
end
end;
procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
if not(DirectoryExists('C:\mk7vrlist')) then
begin
CreateDir('C:\mk7vrlist');
end;
ComboBox1.Items.BeginUpdate;
for i := 0 to 59 do
begin
ComboBox1.AddItem(IntToStr(40000+i*1000), nil);
end;
ComboBox1.AddItem('99999', nil);
ComboBox1.Items.EndUpdate;
end;
procedure TForm1.Label5Click(Sender: TObject);
begin
ShellExecute(self.WindowHandle,'open',PChar('http://www.mk7vrlist.altervista.org'),nil,nil,SW_SHOWNORMAL);
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
var s:ansiString;
begin
IdFTP1.Host:= 'mk7vrlist.altervista.org';
IdFTP1.Username:='mk7vrlist';
IdFTP1.Password:=pass;
IdFTP1.Connect;
s:='http://www.mk7vrlist.altervista.org/databases/test.txt';
Memo1.Lines.Add(Edit1.Text+':'+ComboBox1.Text+':'+Edit2.Text);
Memo1.Lines.Add(downloadSrc(s));
Memo1.Lines.SaveToFile('C:\mk7vrlist\test.txt');
IdFTP1.ChangeDir('databases/');
IdFTP1.Put('C:\mk7vrlist\test.txt');
IdFTP1.Quit;
IdFTP1.Disconnect;
Label10.Visible:=True;
Beep;
end;
Assuming your account has administrative rights, right click on your program's icon, and invoke 'run as administrator' - you will get prompted/warned - click yes.
I don't believe the problem is 32->64 bit, but going from XP to Win 7, which by default is more particular about access.
You can set up a shortcut configured always to run it as admin, to avoid the right click step, but you will still get prompted/warned.
CreateDir('C:\mk7vrlist)
Normal users do not have that kind of access to c:\
Do something like this instead (pseudo code):
CreateDir('%temp%\mk7vrlist)
I have some inherited code for opening IE, this is short version :
procedure OpenIE(URL: OleVariant; FieldValues: string = '');
var ie : IWebBrowser2;
begin
ie := CreateOleObject('InternetExplorer.Application') as IWebBrowser2;
ie.Navigate2(URL, Flags, TargetFrameName, PostData, Headers);
ShowWindow(ie.HWND, SW_SHOWMAXIMIZED);
ie.Visible := true;
...
end;
Since CreateOleObject takes a long time to execute I would like to have one "prepared" IE for the first run.
For example in Main FormCreate to call CreateOleObject, then for 1st call of OpenIE to use "IE" object already created.
For 2nd, 3rd ... call of OpenIE - just usual call
ie := CreateOleObject
When I try to code it, I get some threads and marshaling errors, I am newbie in this area. What would be proper way to do this (some small code example would be great) ?
Thanks in advance.
Perhaps you are creating the browser instance in a different thread from which you then issue subsequent calls. The following trivial code works exactly as expected:
type
TMainForm = class(TForm)
ShowBrowser: TButton;
procedure FormCreate(Sender: TObject);
procedure ShowBrowserClick(Sender: TObject);
private
FBrowser: Variant;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
FBrowser := CreateOleObject('InternetExplorer.Application');
end;
procedure TMainForm.ShowBrowserClick(Sender: TObject);
begin
FBrowser.Navigate('http://stackoverflow.com');
ShowWindow(FBrowser.HWND, SW_SHOWMAXIMIZED);
FBrowser.Visible := True;
end;
I'm not using IWebBrowser2 because I don't have the import unit handy. But that won't change anything – your problems will not be related to early/late binding.
Obviously FormCreate runs in the GUI thread. And ShowBrowserClick is a button OnClick event handler. And so it runs in the main GUI thread.
If you are calling your OpenIE function from a thread other than the GUI thread, that would explain your errors. If you access the browser on a thread other than the one on which it was created, you will receive an EOleSysError with message The application called an interface that was marshalled for a different thread.
Finally, a word of advice when asking questions. If you receive an error message, make sure you include that exact error message in your question. Doing so makes it much more likely we can provide good answers.
I've built a few services in Delphi 7 and did not have this problem. Now that I started a new service app in XE2, it won't stop properly. I don't know if it's something I'm doing wrong or if it might be a bug in the XE2 services.
The execute procedure looks like this:
procedure TMySvc.ServiceExecute(Sender: TService);
begin
try
CoInitialize(nil);
Startup;
try
while not Terminated do begin
DoSomething; //Problem persists even when nothing's here
end;
finally
Cleanup;
CoUninitialize;
end;
except
on e: exception do begin
PostLog('EXCEPTION in Execute: '+e.Message);
end;
end;
end;
I never have an exception, as you can see I log any exception. PostLog saves to an INI file, which works fine. Now I do use ADO components, so I use CoInitialize() and CoUninitialize. It does connect to the DB and do its job properly. The problem only happens when I stop this service. Windows gives me the following message:
Then the service continues. I have to stop it a second time. The second time it does stop, but with the following message:
The log file indicates that the service did successfully free (OnDestroy event was logged) but it never successfully stopped (OnStop was never logged).
In my above code, I have two procedures Startup and Cleanup. These simply create/destroy and initialize/uninitialize my necessary things...
procedure TMySvc.Startup;
begin
FUpdateThread:= TMyUpdateThread.Create;
FUpdateThread.OnLog:= LogUpdate;
FUpdateThread.Resume;
end;
procedure TMySvc.Cleanup;
begin
FUpdateThread.Terminate;
end;
As you can see, I have a secondary thread running. This service actually has numerous threads running like this, and the main service thread is only logging the events from each thread. Each thread has different responsibilities. The threads are reporting properly, and they are also being terminated properly.
What could be causing this stop failure? If my posted code doesn't expose anything, then I can post more code later - just have to 'convert' it because of internal naming, etc.
EDIT
I just started NEW service project in Delphi XE2, and have the same issue. This is all my code below:
unit JDSvc;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, JDSvcMgr;
type
TJDService = class(TService)
procedure ServiceExecute(Sender: TService);
private
FAfterInstall: TServiceEvent;
public
function GetServiceController: TServiceController; override;
end;
var
JDService: TJDService;
implementation
{$R *.DFM}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
JDService.Controller(CtrlCode);
end;
function TJDService.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TJDService.ServiceExecute(Sender: TService);
begin
while not Terminated do begin
end;
end;
end.
look at the source code for the Execute method:
procedure TServiceThread.Execute;
var
msg: TMsg;
Started: Boolean;
begin
PeekMessage(msg, 0, WM_USER, WM_USER, PM_NOREMOVE); { Create message queue }
try
// Allow initialization of the Application object after
// StartServiceCtrlDispatcher to prevent conflicts under
// Windows 2003 Server when registering a class object with OLE.
if Application.DelayInitialize then
Application.Initialize;
FService.Status := csStartPending;
Started := True;
if Assigned(FService.OnStart) then FService.OnStart(FService, Started);
if not Started then Exit;
try
FService.Status := csRunning;
if Assigned(FService.OnExecute) then
FService.OnExecute(FService)
else
ProcessRequests(True);
ProcessRequests(False);
except
on E: Exception do
FService.LogMessage(Format(SServiceFailed,[SExecute, E.Message]));
end;
except
on E: Exception do
FService.LogMessage(Format(SServiceFailed,[SStart, E.Message]));
end;
end;
as you can see if you don't assign a OnExecute method, Delphi will process SCM requests (Service Start, Stop, ...) until the service is stopped.
When you make an loop in the Service.Execute you must to process SCM requests yourself by calling ProcessRequests(False). A good habit is not to use Service.execute and start your workerthread in the Service.OnStart event and terminating/freeing it in the Service.OnStop event.
As told in the comments, another problem lies in the FUpdateThread.Terminate part.
David Heffernan was spot on with the Free/WaitFor comment.
Make sure you end your thread in correct fashion using synchronisation objects.