I have an app that makes intensively uses of Wininet functions to get some data from internet. I am getting a very odd handle related error messages sometimes:
Internal error in ConnectToHost when trying to create a session
ERROR_INTERNET_OUT_OF_HANDLES: No more handles could be generated at this time. Wininet error code = 12001;
When this occured i noticed that my application had more than 5000 handles created. I ran a resource profile and I found out that some handles created by wininet were not being freed.
So, I created a small application to reproduce the issue. The code is simple and does nothing but allocate some wininet handles and then free them. That is the code:
procedure request(const AUrl : AnsiString);
var
sMethod : AnsiString;
pSession : HINTERNET;
pConnection : HINTERNET;
pRequest : HINTERNET;
port : Integer;
flags : DWord;
begin
pSession := InternetOpen(nil, INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
if Assigned(pSession) then
try
Port := INTERNET_DEFAULT_HTTP_PORT;
pConnection := InternetConnectA(pSession, PAnsiChar(AUrl), port, nil, nil, INTERNET_SERVICE_HTTP, 0, 0);
if Assigned(pConnection) then
try
sMethod := 'GET';
flags := INTERNET_SERVICE_HTTP;
pRequest := HTTPOpenRequestA(pConnection, PAnsiChar(sMethod), PAnsiChar(AUrl), nil, nil, nil, flags, 0);
try
if Assigned(pRequest) then
ShowMessage('ok');
finally
InternetCloseHandle(pRequest);
end;
finally
InternetCloseHandle(pConnection);
end;
finally
InternetCloseHandle(pSession);
end;
end;
Running this sample on my profiler, I get the same handle related issues.
I think that InternetCloseHandle is not freeing the handle as it should be because my resource profile tells me that I have 3 live handles when I close the application. Those are the handles that are not being freed:
pRequest
pConnection
pSession
Does anyone know how to get rid of this?
EDIT
The function InternetCloseHandle is working fine, the return value is true.
EDIT
I have searched a lot on the internet, but i was not able to find anybody complaining about that. But it is happening. I would like to know if anybody reproduced the issue or if it is just me.
It turned out to be a AQtime problem. I downloaded another profiler and I also took a look at Task Manager and it seems that the handles are being released. But I still get the no more handles error sometimes and I have no idea why. But I will open another question, since this one was just to see why those handles were not being released.
Thanks for all help I got.
The Http protocol has some limits and the Wininet is using them.
Check at WinInet limits connections per server:
WinInet limits connections to a single HTTP 1.0 server to four simultaneous connections. Connections to a single HTTP 1.1 server are limited to two simultaneous connections. The HTTP 1.1 specification (RFC2616) mandates the two-connection limit. The four-connection limit for HTTP 1.0 is a self-imposed restriction that coincides with the standard that is used by a number of popular Web browsers.
Maybe you should wait until connections are closed before attemping a new connection
Related
I deploy my application in environments heavily stricken with firewalls. Frequently I find myself using Telnet to check if a port is open and accessible in the network.
Now I would like to implement an equivalent functionality of the command, Telnet [domainname or ip] [port], in Delphi.
Is it adequate that I just attempt to open and close a TCP/IP socket without sending or receiving any data?
Is there any risk that I might crash the arbitrary application/service listening on the other end?
Here's my code:
function IsPortActive(AHost : string; APort : Word):boolean;
var IdTCPClient : TIdTCPClient;
begin
IdTCPClient := TIdTCPClient.Create(nil);
try
try
IdTCPClient.Host := AHost;
IdTCPClient.Port := APort;
IdTCPClient.Connect;
except
//Igonre exceptions
end;
finally
result := IdTCPClient.Connected;
IdTCPClient.Disconnect;
FreeAndNil(IdTCPClient);
end;
end;
If you just want to check whether the port is open, then you can use this:
function IsPortActive(AHost : string; APort : Word): boolean;
var
IdTCPClient : TIdTCPClient;
begin
Result := False;
try
IdTCPClient := TIdTCPClient.Create(nil);
try
IdTCPClient.Host := AHost;
IdTCPClient.Port := APort;
IdTCPClient.Connect;
Result := True;
finally
IdTCPClient.Free;
end;
except
//Ignore exceptions
end;
end;
But that only tells you if any server app has opened the port. If you want to make sure that YOUR server app opened the port, then you will have to actually communicate with the server and make sure its responses are what you are expecting. For this reason, many common server protocols provide an initial greeting so clients can identify the type of server they are connected to. You might consider adding a similar greeting to your server, if you are at liberty to make changes to your communication protocol.
Simply opening a connection to the server does not impose any risk of crashing the server, all it does is momentarily occupy a slot in the server's client list. However, if you actually send data to the server, and the server app you are connected to is not your app, then you do run a small risk if the server cannot handle arbitrary data that does not conform it its expected protocol. But that is pretty rare. Sending a small command is not uncommon and usually pretty safe, you will either get back a reply (which may be in a format that does not conform to your protocol, so just assume failure), or you may not get any reply at all (like if the server is waiting for more data, or simply is not designed to return a reply) in which case you can simply time out the reading and assume failure.
I have somethin like that:
function DDE_Read(Service, Topic, Items: string): string;
var
DDE: TDDEClientConv;
begin
try
DDE := TDDEClientConv.Create(nil);
DDE.SetLink(Service, Topic);
DDE.OpenLink;
Result:=DDE.RequestData(Items);
finally
DDE.Free;
end;
end;
I connect to DDE server and get data. Sometimes I can get data and sometimes I receive empty string. Can you tell me is this code ok? How often I can connect to dde server to get data?
Have you maybe some *dll or your own code?
//EDIT
Im beginer and I dont now always what you mean :) I am very grateful that you're helping me. So my code should be smth like that?
function DDE_Read(Service, Topic, Items: string): string;
var
DDE: TDDEClientConv;
temp:PAnsiCHar;
begin
DDE := TDDEClientConv.Create(nil);
DDE.SetLink(Service, Topic);
DDE.OpenLink;
try
temp:=DDE.RequestData(Items);
Result:=temp;
SysUtils.StrDispose(temp);
finally
DDE.Free;
end;
end;
IIRC, there are sometimes problems using DDE when a lot of connections are opened and closed in a short time interval. I'm unsure if this is still a problem with modern Windows systems. On the other hand, the pure need for you to use DDE suggests that you are not working in a modern environment.
You can try to keep the TDDEClientConv instance for a specific Service or a combination of Service and Topic alive for a longer time. This might at least reduce your problem.
I have a windows service created with Delphi 7, with StartType = stSystem.
Now I need to launch an application to make some things for me.
This application has a MainForm and other GDI resources.
The parameter passed to the application assigns values for some controls (like edits and memos) and then click at a button....
I'm trying this:
var
token: cardinal;
si: TStartupInfo;
pi: TProcessInformation;
begin
if not LogonUser('admintest', '', 'secret123', LOGON32_LOGON_INTERACTIVE, LOGON32_PROVIDER_DEFAULT, token) then
RaiseLastOSError;
try
if not ImpersonateLoggedOnUser(token) then
RaiseLastOSError;
fillchar(si, sizeof(si), 0);
si.cb := sizeof(si);
si.lpDesktop := PChar('winsta0\default');
if not CreateProcessAsUser(token, nil, '"c:\...\myapp.exe" -doCrazyThings', nil, nil, false, NORMAL_PRIORITY_CLASS or CREATE_NEW_CONSOLE, nil, nil, si, pi) then
RaiseLastOSError;
CloseHandle(pi.hThread);
waitForSingleObject(pi.hProcess, INFINITE);
CloseHandle(pi.hProcess);
finally
CLoseHandle(token);
end;
end;
When I run my service executable as a normal application (-noservice), it starts as a Forms.Application and creates a MainForm with a button "Start".
*The button runs the same code that service run, but it doesn't works and it's rasing the eror code 1314 at createprocessasuser.*
Why? What is the diference between SYSTEM service and a normal application launched by a administrator?
My environment is a Windows 7 Pro x64
What am I doing wrong?
How can I solve this?
Can someone post an example?
Error 1314 is ERROR_PRIVILEGE_NOT_HELD, which means your calling thread is missing a required privilege to run CreateProcessAsUser(). You don't need to, nor should you be, impersonating the user token in order to launch a new process in the user's desktop. You should be letting the thread use the service's credentials, not the user's credentials, when calling CreateProcessAsUser(). It will make sure the new process is run inside the user's account and desktop for you, so get rid of the call to ImpersonateLoggedOnUser() and see if CreateProcessAsUser() starts working.
Update: read the documentation:
Typically, the process that calls the CreateProcessAsUser function must have the SE_INCREASE_QUOTA_NAME privilege and may require the SE_ASSIGNPRIMARYTOKEN_NAME privilege if the token is not assignable. If this function fails with ERROR_PRIVILEGE_NOT_HELD (1314), use the CreateProcessWithLogonW function instead. CreateProcessWithLogonW requires no special privileges, but the specified user account must be allowed to log on interactively. Generally, it is best to use CreateProcessWithLogonW to create a process with alternate credentials.
On Vista and later, windows services run in session 0. Interactive users exist in session 1 and up. This means that windows services cannot show user interface and indeed cannot easily start processes in the interactive session.
Now, there are ways to launch interactive processes from a service. If you are dead set on launching an interactive process from your service, then that article tells you all your need to know. But such techniques are very tricky and absolutely not to be recommended. The recommendation is that you find a different way to communicate between your service and the interactive desktop.
The normal approach is to run a standard desktop app, perhaps started using HKLM\Software\Microsoft\Windows\CurrentVersion\Run. And use some form of IPC to communicate between the desktop app and the service.
You should be creating the service to do the background work, and the GUI application should only call the service. IE you always have a service running.
Consider using the DataSnap stuff for the back end. An MVC approach is not pure in Delphi like it is in some other languages. The controller goes wherever it is convenient. Datasets are mostly a compromise, and the only really fast way to do data is with DBexpress and a whack of components on the client to keep it all happy. But it works and it is worth learning.
Services cant have gui controls. No TForm descendents allowed. TService only. New project under Delphi Projects / Service Application. You get a project with a unit / form that is pretty much the same as a data module. ie, no visual controls allowed. Reasons are pretty obvious. You need to learn records, object design etc. to use services. Datasnap is your best bet for that. It does most of the hard work for you.
Dr. Bob has a pretty good book on it for XE2/3. If you are new to object oriented design you need to learn that thoroughly first.
Here is the code i use to do this kind of thing
procedure CreateNewProcess;
var
CmdLine: AnsiString;
ErrorCode: Cardinal;
ConnSessID: Cardinal;
Token: Cardinal;
App: AnsiString;
FProcessInfo: _PROCESS_INFORMATION;
FStartupInfo: _STARTUPINFOA;
begin
ZeroMemory(#FStartupInfo, SizeOf(FStartupInfo));
FStartupInfo.cb := SizeOf(FStartupInfo);
FStartupInfo.lpDesktop := nil;
ConnSessID := WTSGetActiveConsoleSessionId;
if WTSQueryUserToken(ConnSessID, Token) then
begin
if CreateProcessAsUser(Token, PAnsiChar(App), PAnsiChar(CmdLine),
nil, nil, false, 0, nil, nil, FStartupInfo, FProcessInfo) = False
then
begin
ErrorCode := GetLastError;
try
RaiseLastOSError(ErrorCode);
except on E: Exception do
EventLog.LogError(e.ClassName +': '+ e.Message);
end;
end;
end;
end;
Hope this helps
if you want the service to wait for the new process to terminate before continuing add this
if CreateProcessAsUser(Token, PAnsiChar(App), PAnsiChar(CmdLine),
nil, nil, false, 0, nil, nil, FStartupInfo, FProcessInfo) = False
then
begin
ErrorCode := GetLastError;
try
RaiseLastOSError(ErrorCode);
except on E: Exception do
EventLog.LogError(e.ClassName +': '+ e.Message);
end;
end
else
WaitForSingleObject(FProcessInfo.hProcess, INFINITE);
although and infinite wait is probably not advisable.
Related to a post of mine ( How to retrieve a file from Internet via HTTP? ) about how to easily and robustly download a file from Internet, I have found a possible solution - however is not working as it was supposed to work.
According to MS documentation, the code below is supposed to time-out at 500ms after I disconnect myself from internet. However, it looks like it totally ignores the 'INTERNET_OPTION_RECEIVE_TIMEOUT' setting. The application freezes during download. It takes about 20-30 to this function to realize that there the Internet connection is down and to give the control back to the GUI.
Anybody knows why?
function GetBinFileHTTP (const aUrl: string; const pStream: TStream; wTimeOut: Word= 500; wSleep: Word= 500; wAttempts: Word= 10): Integer;
CONST
BufferSize = 1024;
VAR
hSession, hService: HINTERNET;
Buffer : array[0..BufferSize-1] of Char;
dwBytesRead, dwBytesAvail: DWORD;
lSucc : LongBool;
lRetries, dwTimeOut: Integer;
begin
Result:= 0;
if NOT IsConnectedToInternet then
begin
Result:= -1;
EXIT;
end;
hSession := InternetOpen(PChar(ExtractFileName(Application.ExeName)), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0); { The INTERNET_OPEN_TYPE_PRECONFIG flag specifies that if the user has configured Internet Explorer to use a proxy server, WinInet will use it as well. }
if NOT Assigned(hSession) then
begin
Result:= -4;
EXIT;
end;
TRY
hService := InternetOpenUrl(hSession, PChar(aUrl), nil, 0, INTERNET_FLAG_RELOAD, 0);
if NOT Assigned(hService) then Exit;
TRY
FillChar(Buffer, SizeOf(Buffer), 0);
{ Set time out }
dwTimeOut:= wTimeOut;
InternetSetOption(hService, INTERNET_OPTION_RECEIVE_TIMEOUT, #dwTimeOut, SizeOf(dwTimeOut)); { use INTERNET_FLAG_RELOAD instead of NIL to redownload the file instead of using the cache }
InternetSetOption(hService, INTERNET_OPTION_CONNECT_TIMEOUT, #dwTimeOut, SizeOf(dwTimeOut));
REPEAT
lRetries := 0;
REPEAT
lSucc:= InternetQueryDataAvailable( hService, dwBytesAvail, 0, 0);
if NOT lSucc
then Sleep( wSleep );
if lRetries > wAttempts
then Result:= -2;
UNTIL lSucc OR (Result= -2);
if NOT InternetReadFile(hService, #Buffer, BufferSize, dwBytesRead) then
begin
Result:= -3; { Error: File not found/File cannot be downloaded }
EXIT;
end;
if dwBytesRead = 0
then Break;
pStream.WriteBuffer(Buffer[0], dwBytesRead);
UNTIL False;
FINALLY
InternetCloseHandle(hService);
end;
FINALLY
InternetCloseHandle(hSession);
end;
Result:= 1;
end;
Here is the documentation:
{
INTERNET_OPTION_CONNECT_TIMEOUT Sets or retrieves an unsigned long integer value that contains the time-out value to use for Internet connection requests. If a connection request takes longer than this time-out value, the request is canceled. When attempting to connect to multiple IP addresses for a single host (a multihome host), the timeout limit is cumulative for all of the IP addresses. This option can be used on any HINTERNET handle, including a NULL handle. It is used by InternetQueryOption and InternetSetOption.
INTERNET_OPTION_RECEIVE_TIMEOUT Sets or retrieves an unsigned long integer value that contains the time-out value to receive a response to a request. If the response takes longer than this time-out value, the request is canceled. This option can be used on any HINTERNET handle, including a NULL handle. It is used by InternetQueryOption and InternetSetOption. For using WinInet synchronously, only the default value for this flag can be changed by calling InternetSetOption and passing NULL in the hInternet parameter.
INTERNET_OPTION_CONTROL_RECEIVE_TIMEOUT - Identical to INTERNET_OPTION_RECEIVE_TIMEOUT. This is used by InternetQueryOption and InternetSetOption.
}
Edit:
I disconnect the Internet by unplugging the cable or (for wireless) from software AFTER the application starts the download (I chose to download large file). It simulates the web site going offline.
The connect timeout obviously isn't applicable in your test because by the time you start your test (i.e., pull the plug), the connection has already been established. Indeed, the connection is already established before you even get around to setting the timeout option.
The validity of the receive timeout is also suspect, because you've already begun receiving the response, too.
The most promising-looking timeout is the disconnect timeout, but MSDN says that's not implemented yet.
It seems to me that the way to go is to use asynchronous operations. Use InternetReadFileEx and use the irf_Async and irf_No_Wait flags. If too much time passes without receiving any data, close the connection. Another option is to stick with your synchronous calls, but then call InternetCloseHandle from another thread if the download takes too long.
There is a documented bug in MS IE code. Can only be solved by using the code in a thread and re-implementing the time out mechanism.
Details:
"This acticle shows a workaround to the InternetSetOption API bug on setting timeout values by creating a second thread.
InternetSetOption Does Not Set Timeout Values"
http://support.microsoft.com/default.aspx?scid=kb;en-us;Q224318
(Link was reported broken. Blame MS not me)
Maybe somebody can help with implementing this bug fix also in Delphi. I personally don't have experience with C. Even the backbone in pseudo-Pascal will be nice.
IMO, you should run this in a thread. Threading does not have to mean looping - it can be a "one and done" thread. Run it that way, and your GUI remains responsive until the thread finishes. I realize that this does not actually answer your question, but it will make your code better.
Also, if you disconnect the internet during the first loop where you're checking for data, I think it will retry 10 times. You should detect, and then quit right away.
Lastly, I don't think you should use EXIT when you've got handles and stuff open. Break instead, so that you still run through the disconnects. I would expect your code to tie up the socket. I saw this recently during a code review when there was an EXIT intead of a BREAK, and it's causing a memory leak because objects are created and never freed. I'd use the same rule here.
Are you sure that you aren't hitting the INTERNET_OPTION_CONNECT_TIMEOUT? It will try to connect first, then receive.
In order to test the connect timeout, it must resolve, but never connect. In order to test the read timeout, it must connect, but never receive any data.
I generally set my connect timeout to 10 seconds, and the read timeout to 30 seconds. Anything longer than that, I consider down anyway.
I haven't programmed in Delphi for a while and frankly didn't think I'll ever have to but...
Here I am, desperately trying to find some information on the matter and it's so scarce nowadays, I can't find anything. So maybe you guys could help me out.
Currently my application uses Synapse library to make HTTP calls, but it doesn't allow for setting a timeout. Usually, that's not a big problem, but now I absolutely must to have a timeout to handle any connectivity issues nicely.
What I'm looking for, is a library (synchronous or not) that will allow making HTTP requests absolutely transparent for the user with no visible or hidden delays. I can't immediately kill a thread right now, and with possibility of many frequent requests to the server that is not responding, it's no good.
EDIT: Thanks everybody for your answers!
You will always have to take delays and timeouts into account when doing network communication. The closest you can get IMHO is to put network communication in a thread. Then you can check if the thread finishes in the desired time and if not just let it finish, but ignore the result (there's no safe way to abort a thread). This has an additional advantage: you can now just use synchronous network calls which are a lot easier to read.
In synapse, the timeout is available from the TSynaClient object, which THttpSend decends from. So all you have to do to adjust for timeout (assuming your using the standard functions) is to copy the function your using, add a new parameter and set the Timeout to what you need. For example:
function HttpGetTextTimeout(const URL: string;
const Response: TStrings;
const Timeout:integer): Boolean;
var
HTTP: THTTPSend;
begin
HTTP := THTTPSend.Create;
try
HTTP.Timeout := Timeout;
Result := HTTP.HTTPMethod('GET', URL);
if Result then
Response.LoadFromStream(HTTP.Document);
finally
HTTP.Free;
end;
end;
Synapse defaults to a timeout of 5000 and does timeout if you wait long enough. Since its tightly contained, synapse runs perfectly fine in threads.
[Known to work on D2010 only]
You can use MSXML to send client requests (add msxml and ole2 to your uses clause). The trick is to use IServerXMLHTTPRequest rather than IXMLHTTPRequest, as the former allows timeouts to be specified. The code below shows the Execute() method of a thread:
procedure TClientSendThread.Execute;
const
LResolveTimeoutMilliseconds = 2000;
LConnectTimeoutMilliseconds = 5000;
LSendTimeoutMilliseconds = 5000;
LReceiveTimeoutMilliseconds = 10000;
var
LHTTPServer: IServerXMLHTTPRequest;
LDataStream: TMemoryStream;
LData: OleVariant;
begin
{Needed because this is inside a thread.}
CoInitialize(nil);
LDataStream := TMemoryStream.Create;
try
{Populate ....LDataStream...}
LData := MemoryStreamToOleVariant(LDataStream);
LHTTPServer := CreateOleObject('MSXML2.ServerXMLHTTP.3.0') as IServerXMLHTTPRequest;
LHTTPServer.setTimeouts(
LResolveTimeoutMilliseconds,
LConnectTimeoutMilliseconds,
LSendTimeoutMilliseconds,
LReceiveTimeoutMilliseconds
);
LHTTPServer.open('POST', URL, False, 0, 0);
LHTTPServer.send(LData);
FAnswer := LHTTPServer.responseText;
finally
FreeAndNil(LDataStream);
CoUninitialize;
end;
end;
I recently discovered an extremely annoying behavior of this MSXML technique in which GET requests will not be re-sent if the URL remains unchanged for subsequent sendings; in other words, the client is caching GET requests. This does not happen with POST.
Obviously, once the timeouts occur, the Execute method completes and the thread is cleaned up.
Synapse can be configured to raise an Exception when network errors occur.
RaiseExcept
Check http://synapse.ararat.cz/doc/help/blcksock.TBlockSocket.html#RaiseExcept:
If True, winsock errors raises
exception. Otherwise is setted
LastError value only and you must
check it from your program! Default
value is False.