In theory connection attempt should terminate after 5 seconds. However in practice I still get infinite timeout. Is there any way to terminate connection from outside. For example I could use timer and then execute proper function to abort. Another nasty workaround would be fire thread and kill it with TerminateThread function.
function DownloadFile(URL, {User, Pass,} FileName: string): Boolean;
const
BufferSize = 1024;
var
hSession, hURL: HInternet;
Buffer: array[1..BufferSize] of Byte;
BufferLen,Connect_timeout: DWORD;
F: File;
User,Pass:string;
begin
User:='';
Pass:='';
Result := False;
hSession := InternetOpen('', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0) ;
Connect_timeout := 5000 ;
InternetSetOption(hSession, INTERNET_OPTION_CONNECT_TIMEOUT, Pointer(#Connect_timeout), sizeof(Connect_timeout));
// Establish the secure connection
InternetConnect (
hSession,
PChar(URL),
INTERNET_DEFAULT_HTTPS_PORT,
PChar(User),
PChar(Pass),
INTERNET_SERVICE_HTTP,
0,
0
);
try
hURL := InternetOpenURL(hSession, PChar(URL), nil, 0, 0, 0) ;
try
AssignFile(f, FileName);
Rewrite(f,1);
try
repeat
InternetReadFile(hURL, #Buffer, SizeOf(Buffer), BufferLen) ;
BlockWrite(f, Buffer, BufferLen)
until BufferLen = 0;
finally
CloseFile(f) ;
Result := True;
end;
finally
InternetCloseHandle(hURL)
end
finally
InternetCloseHandle(hSession)
end;
end;
Related
This question already has answers here:
WinAPI: InternetCloseHandle function closes the handle but not the connection
(2 answers)
Closed 3 years ago.
I use this code to get some data from a URL:
function GetUrlContent(const Url: string): string;
var
NetHandle: HINTERNET;
UrlHandle: HINTERNET;
Buffer: array[0..1024] of AnsiChar;
BytesRead: DWORD;
Size: Integer;
begin
Result := '';
NetHandle := InternetOpen('App', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
if not Assigned(NetHandle) then Exit;
try
UrlHandle := InternetOpenUrl(NetHandle, PChar(Url), nil, 0, INTERNET_FLAG_RELOAD, 0);
if not Assigned(UrlHandle) then Exit;
try
{ Proceed with download }
Size := 0;
repeat
if not InternetReadFile(UrlHandle, #Buffer, SizeOf(Buffer), BytesRead) then Break;
if BytesRead = 0 then Break;
SetLength(Result, Size + BytesRead);
Move(Buffer, Result[Size + 1], BytesRead);
Inc(Size, BytesRead);
until False;
finally
InternetCloseHandle(UrlHandle);
end;
finally
InternetCloseHandle(NetHandle);
end;
end;
The problem is that it seems like the connection is still established after I get the data, like if InternetCloseHandle() crashs or is buggy.
I want to close the active connection of the function after the result is returned.
Thanks for all problem resolved
InternetCloseHandle(hInternet);
InternetSetOption(NULL, INTERNET_OPTION_SETTINGS_CHANGED, NULL, 0);
I got answer heer thanks a lot
WinAPI: InternetCloseHandle function closes the handle but not the connection
I use the WinINet library to connect to a website.
Using the Internet Explorer (Win10) it works and shows me the message to select the certificate to use.
This is the delphi code I call:
FUNCTION TRAD.lastOrganization(): Integer;
VAR
js:TlkJSONobject;
ws: TlkJSONstring;
url, resp: String;
count,statusCodeLen, bodyCodeLen: Cardinal;
header,tmp: String;
buffer, body: String;
statusCode: ARRAY [0 .. 1024] OF Char;
bodyCode: ARRAY [0 .. 1024] OF Char;
UrlHandle: HINTERNET;
BEGIN
buffer := '00000000000000000000';
url := contextUrl + '/rest/organization/count';
UrlHandle := InternetOpenUrl(NetHandle, PChar(url), nil, 0, INTERNET_FLAG_RELOAD, 0);
IF NOT ASSIGNED(UrlHandle) THEN
SHOWMESSAGE('Unable to read the amount of Organization using the URL ' + url + ': ' + SysErrorMessage(GetLastError));
statusCodeLen := Length(statusCode);
bodyCodeLen := Length(bodyCode);
count := 0;
IF HttpQueryInfo(UrlHandle, HTTP_QUERY_STATUS_CODE, #statusCode[0], statusCodeLen, count) THEN
BEGIN
buffer := statusCode;
IF buffer <> '200' THEN
BEGIN
ShowMessage('While read amount of Organization I got a status code ' + buffer + ' but 200 was expected.');
EXIT;
END;
END;
count := 0;
body := '';
REPEAT
FillChar(bodyCode, bodyCodeLen, 0);
IF NOT InternetReadFile(UrlHandle, #bodyCode[0], bodyCodeLen, count) THEN
BEGIN
ShowMessage('Problem on reading from response stream while read the amount of Organization using the URL ' + url + '.');
EXIT;
END;
IF count > 0 THEN
BEGIN
tmp := bodyCode;
body := body + LeftStr(tmp, count);
END;
UNTIL count = 0;
InternetCloseHandle(UrlHandle);
Result := strtoint(body);
END;
If I call the method, I get this message:
Buuut, using the Edge-Browser I have to specify a certificate, and it works just great.
Question
How to specify the certificate?
Edit (new informations):
If I change the code to
FUNCTION TRAD.lastOrganization(): Integer;
VAR
js:TlkJSONobject;
ws: TlkJSONstring;
url, resp: String;
count,statusCodeLen, bodyCodeLen: Cardinal;
header,tmp: String;
buffer, body: String;
statusCode: ARRAY [0 .. 1024] OF Char;
bodyCode: ARRAY [0 .. 1024] OF Char;
UrlHandle: HINTERNET;
BEGIN
buffer := '00000000000000000000';
url := contextUrl + '/rest/organization/count';
UrlHandle := InternetOpenUrl(NetHandle, PChar(url), nil, 0, INTERNET_FLAG_RELOAD, 0);
IF NOT ASSIGNED(UrlHandle) THEN
raiseLastOSError();
It shows:
Consider the use of InternetErrorDlg
Code example:
function WebSiteConnect(const UserAgent: string; const Server: string; const Resource: string;): string;
var
hInet: HINTERNET;
hConn: HINTERNET;
hReq: HINTERNET;
dwLastError:DWORD;
nilptr:Pointer;
dwRetVal:DWORD;
bLoop: boolean;
port:Integer;
begin
hInet := InternetOpen(PChar(UserAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
if hInet = nil then exit;
hConn := InternetConnect(hInet, PChar(Server), INTERNET_DEFAULT_HTTPS_PORT, nil, nil, INTERNET_SERVICE_HTTP, 0, 0);
if hConn = nil then
begin
InternetCloseHandle(hInet);
exit;
end;
hReq := HttpOpenRequest(hConn, 'GET', PChar(Resource), 'HTTP/1.0', nil, nil, INTERNET_FLAG_SECURE, 0);
if hReq = nil then
Begin
InternetCloseHandle(hConn);
InternetCloseHandle(hInet);
exit;
end;
bLoop := true;
while bLoop do
begin
if HttpSendRequest(hReq, nil, 0, nil, 0) then
dwLastError := ERROR_SUCCESS
else
dwLastError:= GetLastError();
if dwLastError = ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED then
begin
dwRetVal:= InternetErrorDlg(application.handle, hReq, dwLastError,
FLAGS_ERROR_UI_FILTER_FOR_ERRORS or
FLAGS_ERROR_UI_FLAGS_GENERATE_DATA or
FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS,
nilptr );
if dwRetVal = ERROR_INTERNET_FORCE_RETRY then
continue
else // CANCEL button
begin
InternetCloseHandle(hReq);
InternetCloseHandle(hConn);
InternetCloseHandle(hInet);
exit;
end;
end
else
bLoop := false;
end;
Result:= ...
end;
Using WinHTTP (You can do the same with WinInetHTTP) you can set the certificate like this via ActiveX :
// Instantiate a WinHttpRequest object.
var HttpReq = new ActiveXObject("WinHttp.WinHttpRequest.5.1");
// Open an HTTP connection.
HttpReq.Open("GET", "https://www.fabrikam.com/", false);
// Select a client certificate.
HttpReq.SetClientCertificate(
"LOCAL_MACHINE\\Personal\\My Middle-Tier Certificate");
// Send the HTTP Request.
HttpReq.Send();
So that easy with ActiveX but it's not really what you want (i gave you the example as illustration). So with the windows API, WinHTTP enables you to select and send a certificate from a local certificate store. The following code example shows how to open a certificate store and locate a certificate based on subject name after the ERROR_WINHTTP_CLIENT_AUTH_CERT_NEEDED error has been returned.
if( !WinHttpReceiveResponse( hRequest, NULL ) )
{
if( GetLastError( ) == ERROR_WINHTTP_CLIENT_AUTH_CERT_NEEDED )
{
//MY is the store the certificate is in.
hMyStore = CertOpenSystemStore( 0, TEXT("MY") );
if( hMyStore )
{
pCertContext = CertFindCertificateInStore( hMyStore,
X509_ASN_ENCODING | PKCS_7_ASN_ENCODING,
0,
CERT_FIND_SUBJECT_STR,
(LPVOID) szCertName, //Subject string in the certificate.
NULL );
if( pCertContext )
{
WinHttpSetOption( hRequest,
WINHTTP_OPTION_CLIENT_CERT_CONTEXT,
(LPVOID) pCertContext,
sizeof(CERT_CONTEXT) );
CertFreeCertificateContext( pCertContext );
}
CertCloseStore( hMyStore, 0 );
// NOTE: Application should now resend the request.
}
}
}
According to Microsoft-Support: How To Handle Proxy Authorization with WinInet
and other Delphi examples (http://forum.codecall.net/topic/51366-internetopen-tthreads-maxconnectionsperserver/, https://pastebin.com/f1ea3a752), I wrote following test code to try out the proper way to access a https page through an authenticated proxy server:
program Project35;
{$APPTYPE CONSOLE}
uses
SysUtils, WinInet, Windows, Classes;
Function sslGet(Const AServer, AUrl : string): AnsiString;
var
aBuffer : Array[0..4096] of Char;
BufStream : TMemoryStream;
sMethod : AnsiString;
BytesRead : Cardinal;
pSession : HINTERNET;
pConnection : HINTERNET;
pRequest : HINTERNET;
LUsername: string;
LPassword: string;
LProxy, LBypass: string;
LAgent: string;
LStatusCode, LStatusLen, LIndex : DWORD;
begin
Result := '';
LUsername := 'User-002' ;
LPassword := 'test2';
LProxy := 'myproxyserver:808';//https=https://
LBypass := '<local>';
LAgent := 'Bo-Test';
//pSession := InternetOpen(PChar(LAgent), INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0);
pSession := InternetOpen(PChar(LAgent), INTERNET_OPEN_TYPE_PROXY , PChar(LProxy), PChar(LBypass), 0);
//pSession := InternetOpen(PChar(LAgent), INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY , nil, nil, 0);
if Assigned(pSession) then
try
// pConnection := InternetConnect(pSession, PChar(AServer), INTERNET_DEFAULT_HTTPS_PORT, PChar(LUsername), PChar(LPassword), INTERNET_SERVICE_HTTP, 0, 0);
pConnection := InternetConnect(pSession, PChar(AServer), INTERNET_DEFAULT_HTTPS_PORT, nil, nil, INTERNET_SERVICE_HTTP, 0, 0);
if Assigned(pConnection) then
try
sMethod := 'GET';
pRequest := HTTPOpenRequest(pConnection, PChar(sMethod), PChar(AURL), nil, nil, nil,
INTERNET_FLAG_SECURE or
INTERNET_FLAG_KEEP_CONNECTION or
INTERNET_FLAG_NO_CACHE_WRITE or
INTERNET_FLAG_PRAGMA_NOCACHE or
INTERNET_FLAG_NO_AUTH or
INTERNET_FLAG_IGNORE_CERT_CN_INVALID or
INTERNET_FLAG_IGNORE_CERT_DATE_INVALID or
INTERNET_FLAG_NO_UI or
INTERNET_FLAG_IGNORE_REDIRECT_TO_HTTPS or
SECURITY_FLAG_IGNORE_UNKNOWN_CA, 0); //or INTERNET_FLAG_NO_AUTH
if Assigned(pRequest) then
try
if HTTPSendRequest(pRequest, nil, 0, nil, 0) then
begin
LStatusLen := SizeOf(LStatusCode);
LIndex := 0;
// expecting a 407 returned
HttpQueryInfo(pRequest, HTTP_QUERY_STATUS_CODE or HTTP_QUERY_FLAG_NUMBER,
#LStatusCode, LStatusLen, LIndex);
Write('Status code=');
writeln(LStatusCode);
// resend after 407
InternetSetOption(pRequest, INTERNET_OPTION_PROXY_USERNAME, PChar(LUsername) , length(LUsername));
InternetSetOption(pRequest, INTERNET_OPTION_PROXY_PASSWORD, PChar(LPassword), length(LPassword));
HTTPSendRequest(pRequest, nil, 0, nil, 0);
HttpQueryInfo(pRequest, HTTP_QUERY_STATUS_CODE or HTTP_QUERY_FLAG_NUMBER,
#LStatusCode, LStatusLen, LIndex);
Write('Resend status code=');
writeln(LStatusCode);
BufStream := TMemoryStream.Create;
try
while InternetReadFile(pRequest, #aBuffer, SizeOf(aBuffer), BytesRead) do
begin
if (BytesRead = 0) then Break;
BufStream.Write(aBuffer, BytesRead);
end;
aBuffer[0] := #0;
BufStream.Write(aBuffer, 1);
Result := PChar(BufStream.Memory);
finally
FreeAndNil(BufStream);
end;
end
else begin
Writeln(GetLastError());
end;
finally
InternetCloseHandle(pRequest);
end;
finally
InternetCloseHandle(pConnection);
end;
finally
InternetCloseHandle(pSession);
end;
end;
var
StopEnter: string;
begin
try
// the wsdl is only available with ssl, i.e., https://services.staging.referralnet.com.au/services/Referral_Service_51?wsdl
// it is invalid for http://services.staging.referralnet.com.au/services/Referral_Service_51?wsdl
Writeln(sslGet('services.staging.referralnet.com.au', '/services/Referral_Service_51?wsdl'));
Write('Press Enter to stop ...');
Readln(StopEnter);
except
on E:Exception do
Writeln(E.Classname, ': ', E.Message);
end;
end.
I am using CCProxy as the proxy server for this testing.
I tried with two machines, one modified the hosts file so that the server of the wsdl page is pointing to 127.0.0.1, another one modified its firewall, so all the traffic to the server is blocked.
Both testings returned two 407 code, i.e., original and resend request both failed with 407.
What could be wrong? Or somebody can point me to an working example?
Take a look at how the THttpRIo component handles this. Just follow the proxy property usage in the code.
How to avoid app freeze in memory execute function?
After I send resource to memory and when I run this code, my exe in memory runs successfully, but UI form will freeze until process close.
Here's my code:
unit pe;
interface
uses Windows;
//type
// TByteArray = array of Byte;
Function MemoryExecute(Buffer :Pointer;Parameters: String; Visible: Boolean): TProcessInformation;
implementation
Function MemoryExecute(Buffer :Pointer;Parameters: String; Visible: Boolean): TProcessInformation;
type
HANDLE = THandle;
PVOID = Pointer;
LPVOID = Pointer;
SIZE_T = Cardinal;
ULONG_PTR = Cardinal;
NTSTATUS = LongInt;
LONG_PTR = Integer;
PImageSectionHeaders = ^TImageSectionHeaders;
TImageSectionHeaders = Array [0..95] Of TImageSectionHeader;
Var
ZwUnmapViewOfSection :Function(ProcessHandle: THANDLE; BaseAddress: Pointer): LongInt; stdcall;
ProcessInfo :TProcessInformation;
StartupInfo :TStartupInfo;
Context :TContext;
BaseAddress :Pointer;
BytesRead :DWORD;
BytesWritten :DWORD;
I :ULONG;
OldProtect :ULONG;
NTHeaders :PImageNTHeaders;
Sections :PImageSectionHeaders;
Success :Boolean;
ProcessName :string;
Function ImageFirstSection(NTHeader: PImageNTHeaders): PImageSectionHeader;
Begin
Result := PImageSectionheader( ULONG_PTR(#NTheader.OptionalHeader) +
NTHeader.FileHeader.SizeOfOptionalHeader);
End;
Function Protect(Characteristics: ULONG): ULONG;
Const
Mapping :Array[0..7] Of ULONG = (
PAGE_NOACCESS,
PAGE_EXECUTE,
PAGE_READONLY,
PAGE_EXECUTE_READ,
PAGE_READWRITE,
PAGE_EXECUTE_READWRITE,
PAGE_READWRITE,
PAGE_EXECUTE_READWRITE );
Begin
Result := Mapping[ Characteristics SHR 29 ];
End;
Begin
#ZwUnmapViewOfSection := GetProcAddress(LoadLibrary('ntdll.dll'), 'ZwUnmapViewOfSection');
ProcessName := ParamStr(0);
FillChar(ProcessInfo, SizeOf(TProcessInformation), 0);
FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
StartupInfo.cb := SizeOf(TStartupInfo);
StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
if Visible Then
StartupInfo.wShowWindow := SW_NORMAL
else
StartupInfo.wShowWindow := SW_Hide;
If (CreateProcess(PChar(ProcessName), PChar(Parameters), NIL, NIL,
False, CREATE_SUSPENDED, NIL, NIL, StartupInfo, ProcessInfo)) Then
Begin
Success := True;
Result := ProcessInfo;
Try
Context.ContextFlags := CONTEXT_INTEGER;
If (GetThreadContext(ProcessInfo.hThread, Context) And
(ReadProcessMemory(ProcessInfo.hProcess, Pointer(Context.Ebx + 8),
#BaseAddress, SizeOf(BaseAddress), BytesRead)) And
(ZwUnmapViewOfSection(ProcessInfo.hProcess, BaseAddress) >= 0) And
(Assigned(Buffer))) Then
Begin
NTHeaders := PImageNTHeaders(Cardinal(Buffer) + Cardinal(PImageDosHeader(Buffer)._lfanew));
BaseAddress := VirtualAllocEx(ProcessInfo.hProcess,
Pointer(NTHeaders.OptionalHeader.ImageBase),
NTHeaders.OptionalHeader.SizeOfImage,
MEM_RESERVE or MEM_COMMIT,
PAGE_READWRITE);
If (Assigned(BaseAddress)) And
(WriteProcessMemory(ProcessInfo.hProcess, BaseAddress, Buffer,
NTHeaders.OptionalHeader.SizeOfHeaders,
BytesWritten)) Then
Begin
Sections := PImageSectionHeaders(ImageFirstSection(NTHeaders));
For I := 0 To NTHeaders.FileHeader.NumberOfSections -1 Do
If (WriteProcessMemory(ProcessInfo.hProcess,
Pointer(Cardinal(BaseAddress) +
Sections[I].VirtualAddress),
Pointer(Cardinal(Buffer) +
Sections[I].PointerToRawData),
Sections[I].SizeOfRawData, BytesWritten)) Then
VirtualProtectEx(ProcessInfo.hProcess,
Pointer(Cardinal(BaseAddress) +
Sections[I].VirtualAddress),
Sections[I].Misc.VirtualSize,
Protect(Sections[I].Characteristics),
OldProtect);
If (WriteProcessMemory(ProcessInfo.hProcess,
Pointer(Context.Ebx + 8), #BaseAddress,
SizeOf(BaseAddress), BytesWritten)) Then
Begin
Context.EAX := ULONG(BaseAddress) +
NTHeaders.OptionalHeader.AddressOfEntryPoint;
Success := SetThreadContext(ProcessInfo.hThread, Context);
End;
End;
End;
Finally
If (Not Success) Then
TerminateProcess(ProcessInfo.hProcess, 0)
else
ResumeThread(ProcessInfo.hThread);
WaitForSingleObject(ProcessInfo.hProcess,INFINITE) ;
// GetExitCodeProcess(ProcessInfo.hProcess, Result);
End;
End;
End;
end.
Your code freezes because it is calling WaitForSingleObject() to wait for the spawned process to exit, and while it is waiting it is not pumping the calling thread's message queue for new messages. To avoid that, you have three choices:
stop waiting altogether.
stop calling this code in your main thread. Move it to a worker thread.
call WaitForSingleObject() with a non-INFINITE timeout in a loop that pumps the message queue periodically. If you replace WaitForSingleObject() with MsgWaitForMultipleObjects(), it can tell you when new messages are waiting, so you don't need to pump the queue when there is nothing to process.
Personally, I would opt for #1, especially since the function returns a TProcessInformation describing the spawned process, so let the caller decide what to do with the process. If the caller wants to wait, it will have the process's handles to do so. If the caller does not want to wait, it does not have to.
i need a file downloader component for Delphi . may you help me ?
Use the high-level URLDownloadToFile function:
uses UrlMon;
...
URLDownloadToFile(nil, 'http://www.rejbrand.se/', 'C:\Users\Andreas Rejbrand\Desktop\index.html', 0, nil);
Or, you could very easily write your own downloader function using the WinInet functions, something like
uses WinInet;
...
hInet := InternetOpen(PChar(UserAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
try
hURL := InternetOpenUrl(hInet, PChar('http://' + Server + Resource), nil, 0, 0, 0);
try
repeat
InternetReadFile(hURL, #Buffer, SizeOf(Buffer), BufferLen);
...
There is a lot of sample code here at SO. Use the search box above.
Update
I wrote a small sample. You might want to execute this code in its own thread and let it ping back every 10 kB or so, so that you can provide the user with some progress bar, for instance.
function DownloadFile(const UserAgent, URL, FileName: string): boolean;
const
BUF_SIZE = 4096;
var
hInet, hURL: HINTERNET;
f: file;
buf: PByte;
amtc: cardinal;
amti: integer;
begin
result := false;
hInet := InternetOpen(PChar(UserAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
try
hURL := InternetOpenUrl(hInet, PChar(URL), nil, 0, 0, 0);
try
GetMem(buf, BUF_SIZE);
try
FileMode := fmOpenWrite;
AssignFile(f, FileName);
try
Rewrite(f, 1);
repeat
InternetReadFile(hURL, buf, BUF_SIZE, amtc);
BlockWrite(f, buf^, amtc, amti);
until amtc = 0;
result := true;
finally
CloseFile(f);
end;
finally
FreeMem(buf);
end;
finally
InternetCloseHandle(hURL);
end;
finally
InternetCloseHandle(hInet);
end;
end;
You can also make this with Indy :
procedure DownloadHTTP(const AUrl : string; DestStream: TStream);
begin
with TIdHTTP.Create(Application) do
try
try
Get(AUrl,DestStream);
except
On e : Exception do
MessageDlg(Format('Erreur : %s',[e.Message]), mtInformation, [mbOK], 0);
end;
finally
Free;
end;
end;
If you want quick download, you can also use Clever Internet Suite