i implemented the bwlow function to set INTERNET_OPTION_RECEIVE_TIMEOUT prior submitting to receive omething to avoid the timeout... this is working pretty well.
This function is implemented in a second form, i call from my main form with a menu.
When i close the second form, everything is ok. But when i close the main form, i get an error: Exception. Invalid Pointer...
if i dont call the function, i dont get the error... am stuck... anybody there to help me ?
function SetTimeout(const HTTPReqResp: THTTPReqResp; Data: Pointer; NumSecs : integer) : boolean;
var
TimeOut: Integer;
begin
// Sets the receive timeout. i.e. how long to wait to 'receive' the response
TimeOut := (NumSecs * 1000);
try
InternetSetOption(Data, INTERNET_OPTION_RECEIVE_TIMEOUT, Pointer(#TimeOut), SizeOf(TimeOut));
InternetSetOption(Data, INTERNET_OPTION_SEND_TIMEOUT, Pointer(#TimeOut), SizeOf(TimeOut));
except on E:Exception do
raise Exception.Create(Format('Unhandled Exception:[%s] while setting timeout to [%d] - ',[E.ClassName, TimeOut, e.Message]));
end;
end;
procedure TFmTestv2.HTTPRIO1HTTPWebNode1BeforePost(
const HTTPReqResp: THTTPReqResp; Data: Pointer);
begin
SetTimeout(HTTPReqResp, Data, 5 * 60);
end;
like described in this post
How do set the timeout on a wcf service caller in Delphi?
best regards
Holger
The most plausible explanation for an error relating to the code shown is that you are passing an invalid HINTERNET parameter. That's the first parameter you pass to the API function. My guess is that it's just something other than an HINTERNET. The fact that it is typed Pointer is a concern. According to the documentation this parameter must be either a valid HINTERNET or NULL. Make sure that it is. I see no evidence at all that the value of the Data parameter of the HTTPRIO1HTTPWebNode1BeforePost event handler is an HINTERNET.
I also suggest that you check for errors correctly. Start by reading the documentation for each API call you make, and following the instructions for error checking. You certainly fail to check for errors in the code shown. You've copied somebody else's code that does it wrongly. That's a risk when you copy code. In this case the code you have copied ignores return values which are how errors are signaled, and instead traps exceptions that are never raised.
Related
I'm trying to handle the ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED error using the following function:
function CallInternetErrorDialog(AInetOpenRequest: HINTERNET; ALastError: DWORD): DWORD;
var
P: Pointer;
begin
Result := InternetErrorDlg(GetDesktopWindow()
,AInetOpenRequest
,ALastError
,FLAGS_ERROR_UI_FILTER_FOR_ERRORS or FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS or FLAGS_ERROR_UI_FLAGS_GENERATE_DATA
,P);
// Only to check result (this is not important right now)
case Result of
ERROR_SUCCESS: OutputDebugString('ERROR_SUCCESS');
ERROR_CANCELLED: OutputDebugString('ERROR_CANCELLED');
ERROR_INTERNET_FORCE_RETRY: OutputDebugString('ERROR_INTERNET_FORCE_RETRY');
ERROR_INVALID_HANDLE: OutputDebugString('ERROR_INVALID_HANDLE');
end;
if ALastError = ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED then
Result := ERROR_INTERNET_FORCE_RETRY;
end;
This is merely a helper function built around the InternetErrorDlg function and it's very simple with two parameters. The first one is the Open Request Handle, returned by HttpOpenRequest funcion. The second one is the result of GetLastError function.
On my implementation, when GetLastError returns ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED, i call that function like this (example):
CallInternetErrorDialog(OpenRequestHandle,ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED)
The behaviour I expected was the System's Select Certificate default dialog being shown to the user select some certificate:
However, the internal call to InternetErrorDlg only returns zero (ERROR_SUCCESS) imediatelly, without show anything.
For those claiming the full source code here goes the roadmap. I'll not put the entire code because it is very extense. The full unit has more than 800 lines of code:
InternetOpenHandle := InternetOpen(...);
InternetConnectHandle := InternetConnect(InternetOpenHandle,...);
HttpOpenRequestHandle := HttpOpenRequest(InternetConnectHandle,...);
HttpSendRequestResult := HttpSendRequest(HttpOpenRequestHandle,...);
GetLastError = ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED
CallInternetErrorDialog(ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED,HttpOpenRequestHandle);
Repeat from step 4;
GetLastError = ERROR_INTERNET_SECURITY_CHANNEL_ERROR
End
The step 6 call my function that simply call the InternetErrorDlg, with the following (already replaced) parameters:
InternetErrorDlg(GetDesktopWindow()
,HttpOpenRequestHandle
,ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED
,FLAGS_ERROR_UI_FILTER_FOR_ERRORS or FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS or FLAGS_ERROR_UI_FLAGS_GENERATE_DATA
,P);
With these parameters, the InternetErrorDlg function returns ERROR_SUCCESS immediatelly, without show anything to the user, so, what kind of tratament was done for the ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED error?
The error at step eight is absolutely natural, because after the server send the ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED it wait that the next attempt (HttpSendRequest) already be loaded with a valid certificate. This proofs that the InternetErrorDlg function, despite your successful result, is not doing what it should
Please see the CallInternetErrorDialog again for more information.
I'm using Delphi 10.1 Berlin Update 2 Enterprise and the DataSnap client/server REST framework.
If I run the app without debugging and invoke a method the user isn't authorized to invoke, the code runs without any exception and the method returns a null response.
When interactively debugging a call on the client to a DataSnap server method, I get two popup exceptions regarding "unauthorized".
The first bubbles up and is replaced by the second.
The second exception gets "eaten" and the session/connection simply closed and then the method returns a blank result (e.g. a zero if the return type is integer, and an empty string for a string return type).
This is happening in the following section of code near the end of the ExecuteRequest method in the Datasnap.DSClientRest unit:
except
on E: TDSRestProtocolException do
LSessionExpired;
end;
Why are these exceptions (e.g. TDSRestProtocolException) not reaching my code?
I kind of think this is new to Update 2, and I remember seeing those exceptions bubble up to my code prior to Update 2.
Attached is a skeleton example (standard example generated by Delphi wizards) that demonstrates the issue - click the button and you get "" instead of "4321" because the user isn't authorized - but no runtime exception.
I'm new to DataSnap, so bear with me :-)
Thanks in advance for helpful responses =)
This is happening due to DSAuthenticationManager1 component added to webmodule of the server and client side is failing to authenticate.
Please go through this to check how to work with authentication
Adding Authentication and Authorization
Well..I'm not sure but try providing username and password to DSRestConnection1 component before the instance of server methods gets created
procedure TClientModule1.TestCon(aUsername, aPassword: string);
var
lServerMethodsClient : TServerMethodsClient;
begin
DSRestConnection1.UserName := aUsername;
DSRestConnection1.Password := aPassword;
lServerMethodsClient:=TServerMethodsClient.Create(DSRestConnection1);
end;
and try to call this functn from ur clientform
procedure TF_ClientForm.Button1Click(Sender: TObject);
begin
ClientModule1.TestCon(EdtUsername.Text, EdtPassword.Text);
end;
Maybe a little late but this morning I've had a deep dive into this because, after upgrading from Delphi XE6 to Tokyo 10.2, applications where I used the TDSRestConnection component got broken. Although I supplied the correct username and password, they did not appear in the TDSAuthenticationManager.OnUserAuthenticate event.
The 'problem' has to do with the new System.Net.HttpClient implementation.
To make a long story short (or a little bit less long):
The client component does not send the credentials until the receiving server demands one by sending a 401 response. After receiving this (properly formatted) response the client looks at de TDSConnection credentials en tries again. At the client side a complete list of urls with credential requirements is maintaned so repetitive calls to the same url go 'smoother'.
I added this code to the server's WebModule (where the TDSRESTWebDispatcher resides) which solved my problems:
procedure TwbmMain.WebModuleBeforeDispatch(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
LAuthorization: string;
begin
inherited;
if Request.PathInfo.StartsWith('/datasnap/') then
begin
LAuthorization := TNetEncoding.Base64.Decode(Request.Authorization.Replace('Basic ', ''));
if LAuthorization.IsEmpty then
begin
Response.StatusCode := 401;
Response.WWWAuthenticate := 'Basic';
Handled := True;
end;
end;
end;
Because my applications provides some downloadable items like a logo etc., I limited the check to just those URLs that have anything to do with datasnap.
Hope this is useful to others!
I have a procedure to call a function named [main()] from a DLL , this is the Caller procedure :
procedure call_dll(path:string);
var
lib: HMODULE;
mainfn: procedure(); stdcall;
begin
if FileExists(path) then
begin
try
lib := LoadLibrary(PAnsiChar(path));
Win32Check(lib <> 0);
try
#mainfn := GetProcAddress(lib, 'main');
Win32Check(Assigned(mainfn));
mainfn();
finally
FreeLibrary(lib);
end;
except
end;
end;
end;
Until yet every thing is working fine , I mean after writing the correct path of the DLL everything work without a problem but if I write a wrong path (other file path) in the path parameter it show me a popup error that this is is not a Win32 DLL but I don't want to bother the user with this type of errors , so I need a function to check the DLL and if it's not then it will automatically ask for another file again without showing the popup error ?
It is your code that is raising the exception. Your code makes an explicit choice to handle errors by raising exceptions. The exception is raised by your code here:
Win32Check(lib <> 0);
If you don't want to raise an exception, don't use Win32Check. Instead check the value of lib and handle any errors by whatever means you see fit.
The same issue is present for your other use of Win32Check.
Of course you are swallowing all exceptions with your catch all exception handler. A catch all exception handler is usually a bad idea. I don't understand why you have included that. I think you should remove it.
So if you are seeing dialogs when running outside the debugger it follows that the system is producing the dialogs. You should be disabling the system's error message dialogs by calling SetErrorMode on startup passing SEM_FAILCRITICALERRORS.
var
Mode: DWORD;
....
Mode := SetErrorMode(SEM_FAILCRITICALERRORS);
SetErrorMode(Mode or SEM_FAILCRITICALERRORS);
The somewhat clunky double call is explained here: http://blogs.msdn.com/b/oldnewthing/archive/2004/07/27/198410.aspx
Prompted by a q here yesterday, I'm trying to re-familiarise myself with TGeckoBrowser
from here: http://sourceforge.net/p/d-gecko/wiki/Home.
(Nb: requires the Mozilla XulRunner package to be installed)
Things seem to have moved backwards a bit since I last tried in the WinXP era, in that
with a minimal D7 project to navigate to a URL, I'm getting errors that I don't recall
seeing before. I've included my code below. These are the errors which I've run into
navigating to sites like www.google.com, news.bbc.co.uk, and here, of course.
The first exception - "Exception in Safecall method" - occurs as my form first displays, before naviagting anywhere at all. I have a work-around in the form of a TApplication.OnException handler.
My q is: a) Does anyone know how to avoid it in the first place or b) is there a tidier way of catching it than setting up a TApplication.Exception handler, which always feels to me like a bit of
an admission of defeat (I mean having one to avoid the user seeing an exception, not having an application-wide handler at all).
This exception occurs in this code:
procedure TCustomGeckoBrowser.Paint;
var
rc: TRect;
baseWin: nsIBaseWindow;
begin
if csDesigning in ComponentState then
begin
rc := ClientRect;
Canvas.FillRect(rc);
end else
begin
baseWin := FWebBrowser as nsIBaseWindow;
baseWin.Repaint(True);
end;
inherited;
end;
in the call to baseWin.Repaint, so presumably it's
presumably coming from the other side of the interface. I only get it the first
time .Paint is called. I noticed that at that point, the baseWin returns False for GetVisibility,
hence the experimental code in my TForm1.Loaded, to see if that would avoid it.
It does not.
2.a After calling GeckoBrowser1.LoadURI, I get "Invalid floating point operation"
once or more depending on the URL being loaded.
2.b Again, depending on the URL, I get: "Access violation at address 556318B3 in module js3250.dll. Read of address 00000008." or similar. On some pages it occurs every few seconds (thanks I imagine to some JS timer code in the page).
2a & 2b are avoided by the call to Set8087CW in TForm1.OnCreate below but I'm
mentioning them mainly in case anyone recognises them and 1 together as symptomatic
of a systemic problem of some sort, but also so google will find this q
for others who run into those symptoms.
Reverting to my q 1b), the "Exception in Safecall method" occurs from StdWndProc->
TWinControl.MainWndProc->[...]->TCustomGeckoBrowser.Paint. Instead of using an
TApplication.OnException handler, is there a way of catching the exception further
up the call-chain, so as to avoid modifying the code of TCustomGeckoBrowser.Paint by
putting a handler in there?
Update: A comment drew my attention to this documentation relating to SafeCall:
ESafecallException is raised when the safecall error handler has not been set up and a safecall routine returns a non-0 HResult, or if the safecall error handler does not raise an exception. If this exception occurs, the Comobj unit is probably missing from the application's uses list (Delphi) or not included in the project source file (C++). You may want to consider removing the safecall calling convention from the routine that gave rise to the exception.
The GeckoBrowser source comes with a unit, BrowserSupports, which looks like a type library import unit, except that it seems to have been manually prepared. It contains an interface which includes the Repaint method which is producing the SafeCall exception.
nsIBaseWindow = interface(nsISupports)
['{046bc8a0-8015-11d3-af70-00a024ffc08c}']
procedure InitWindow(parentNativeWindow: nativeWindow; parentWidget: nsIWidget; x: PRInt32; y: PRInt32; cx: PRInt32; cy: PRInt32); safecall;
procedure Create(); safecall;
procedure Destroy(); safecall;
[...]
procedure Repaint(force: PRBool); safecall;
[...]
end;
Following the suggestion in the quoyed documentation, I changed th "safecall" to StdCall on the Repaint member (but only that member) and, presto!, the exception stopped occurring. If it doesn't reappear in the next couple of days, I'll post that as an answer, unless anyone comes up with a better one.
My project code:
uses
BrowserSupports;
procedure TForm1.FormCreate(Sender: TObject);
begin
Set8087CW($133F);
Application.OnException := HandleException;
end;
procedure TForm1.HandleException(Sender: TObject; E: Exception);
begin
Inc(Errors);
Caption := Format('Errors %d, msg: %s', [Errors, E.Message]);
Screen.Cursor := crDefault;
end;
type
TMyGeckoBrowser = class(TGeckoBrowser);
procedure TForm1.Loaded;
begin
inherited;
GeckoBrowser1.HandleNeeded;
(TMyGeckoBrowser(GeckoBrowser1).WebBrowser as nsIBaseWindow).SetVisibility(True);
end;
procedure TForm1.btnLoadUrlClick(Sender: TObject);
begin
try
GeckoBrowser1.LoadURI(edUrl.Text);
except
end;
end;
Looking at the headers, the prototype for Repaint is effectively as follows:
HRESULT __stdcall Repaint(PRBool force);
and that means that
procedure Repaint(force: PRBool); safecall;
is a reasonable declaration. Remember that safecall performs parameter re-writing to convert COM error codes into exceptions.
This does mean that if the call to Repaint returns a value that indicates failure, then the safecall mechanism will surface that as an exception. If you wish to ignore this particular exception then it is cleaner to do so at source:
try
baseWin.Repaint(True);
except
on EOleException do
; // ignore
end;
If you wish to avoid dealing with exceptions then you could switch to stdcall, but you must remember to undo the parameter re-writing.
function Repaint(force: PRBool): HRESULT; stdcall;
Now you can write it like this:
if Failed(baseWin.Repaint(True)) then
; // handle the error if you really wish to, or just ignore it
Note that Failed is defined in the ActiveX unit.
If you want to troubleshoot the error further then you can look at the error code:
var
hres: HRESULT;
....
hres := baseWin.Repaint(True);
// examine hres
Or if you are going to leave the function as safecall then you can retrieve the error code from the EOleException instance's ErrorCode property.
I'm using AllocateHWnd in a class I'm writing to receive system messages with a TWndMethod and the messages I'm receiving need to handle a 4-byte WPARAM, which specifically references a pointer. But I'm only getting 2 bytes in return. How do I set up things so I can correctly receive these messages within the class?
Edit: Specific code. I'm setting a message event up using SHChangeNotifyRegister, based on a Microsoft sample I downloaded. The proc works enough to pull back events (in lEvent) that I can buy off on, but the code Microsoft used defines WParam to be Thandle and LParam to be DWord. The specific problem I have is that when the function IsItemNotificationEvent is true, SHGetPathFromIDList is AVing or pulling back garbage. I kept looking this over and am not really seeing a problem other than what the docs I have indicate in that WParam is a Word (probably old) and that GetLastError at the point I put in the code returns "The handle is invalid".
function IsItemNotificationevent(lEvent: Longint): boolean;
var
flagval: Longint;
begin
flagval := (lEvent and (SCHNE_UPDATEIMAGE or SHCNE_ASSOCCHANGED
or SHCNE_EXTENDED_EVENT or SHCNE_FREESPACE
or SHCNE_DRIVEADDGUI or SHCNE_SERVERDISCONNECT));
Result := (flagval > 0);
end;
procedure TShellNotifyHandler.WindowProc(Var msg: TMessage);
var
hNotifyLock: THandle;
lEvent: Longint;
pgpidl: PitemIDList;
psi1: array[1..MAX_PATH] of Char;
begin
if Msg.Msg = FShellMsg then
begin
hNotifyLock := SHChangeNotification_Lock(THandle(Msg.WParam),DWord(Msg.LParam),
pgpidl, lEvent);
writeln(SysErrorMessage(GetLastError));
if (hNotifyLock > 0) then
begin
if IsItemNotificationEvent(lEvent) then
// this limits events for this to what Microsoft defined in their example
begin
if (pgpidl <> nil) then
SHGetPathFromIDList(pgpidl, #psi1);
Writeln('Path #1: ', String(psi1));
end;
SHChangeNotification_Unlock(hNotifyLock);
end;
if Assigned(FOnShellNotify) then
FOnShellNotify(Self, LEvent);
end
else
FWndProc(Msg);
end;
The main thing that I see wrong with this code, and I've only really studied the call to SHChangeNotification_Lock, is that you are unconditionally calling GetLastError.
The documentation for that API function is inadequate because it does not specify how errors are signalled. However, I would strongly expect that errors to be signalled by the function returning NULL. Since the documentation does not say anything about calling GetLastError it is entirely possible that the API function does not set the last error value. No matter, even if you can be sure that GetLastError can be called, you should only do so after a failure, ie. if the call to SHChangeNotification_Lock returns NULL. If you call GetLastError after a successful API call you will get the error code for the most recent failed API call, which is unrelated to the current call.
The bottom line is that I'm sure WParam is carrying all 4 bytes and that your problem is not with that part of the process.
The upshot of all this is the I strongly believe that SHChangeNotification_Lock is succeeding, but the call to SHGetPathFromIDList is failing. You don't check the return value for that. I bet it returns FALSE.
Take a look at the C++ declarations for the two functions.
SHChangeNotification_Lock returns the ID list in a parameter typed liked this:
PIDLIST_ABSOLUTE **pppidl
SHGetPathFromIDList receives the ID list in a parameter typed liked this:
PCIDLIST_ABSOLUTE pidl
I don't know what your declaration of SHChangeNotification_Lock looks like, but the one supplied in my version of Delphi (XE2) looks plain wrong. It has this parameter declared like this:
out pppidl: array of PItemIDList
I honestly can't see how a Windows API function can return a Delphi open array as an out parameter. I think it should be declared so:
out pppidl: PPItemIDList
and you may need to declare PPItemIDList to be ^PItemIDList.
Now, pppidl is an array. It points to the first element of an array of PItemIDList. So you would obtain the path of the first element by calling:
SHGetPathFromIDList(pppidl^, #psi1);
This, I believe, is the real problem you have.
Finally I can't understand why you would test for success with hNotifyLock > 0. The correct test is hNotifyLock <> 0. Now, I know that some of the Delphi types have changed in recent versions, but if THandle was a signed value in your version of Delphi then you code would be wrong. No matter what, the correct logical test is <>0.
Okay, I got this answered. A number of problems all over the board, actually:
1) I had things wrong when it comes to IsItemNotificationEvent. To have valid PIDLs, I needed to make sure that the event WASN'T one of those, because no PIDL is valid to process against those.
if IsItemNotificationEvent(lEvent) then
2) "out" was necessary in the definition to SHChangeNotification_Lock and not "var" or a simple pointer reference. I don't have anything that indicates what "out" does specifically, so if anyone can help, please do. The fixed definition is below.
function SHChangeNotification_Lock(hChangeNotification: THandle; dwProcessID: DWord;
out pppidl: PSHNotifyStruct; out plEvent: Longint): THandle; stdcall;
3) In my documentation (including the source samples), it indicates that multiple pidls are possible for some event types. Which makes the suggested correction invalid in the QC report. The problem with using the original definition is probably as suggested. It's not quite right. Reference the definition above, and you'll see a different type. That definition is below. No events have more than two parms, so it would suffice.
TSHNotifyStruct = packed record
dw1: PItemIDList;
dw2: PItemIDList;
end;
PSHNotifyStruct = ^TSHNotifyStruct;
Got it working as I expect it to now. I just need to find a valid list of two parm events and code in to make it a little cleaner (i.e. not reference the second pitemid if known to be invalid). Some samples of output from my test program are below to illustrate:
Event received: $00001000 Parm 1: (C:) Local Disk // update directory
Event received: $00000008 Parm 1: ChangeNotifyWatcher // make directory
Event received: $00000002 Parm 1: ChangeNotifyWatcher // create file
Event received: $00000010 Parm 1: ChangeNotifyWatcher Parm 2: RECYCLER // remove directory
Thanks all for your help!