I've got a problem when people who tries to install my file has connection problems. It appears a message and you cannot retry nor wait until you solve the problem. It just has an accept button and the setup closes. So I would like to have a message saying "No connection, check it." or something similar and allow you to fix the problem and continue. The error is given by this line: WinHttpRequest.Send;
Thanks in advanced.
function DownloadFile(const AURL: string; var AResponse: string): Boolean;
var
WinHttpRequest: Variant;
begin
Result := True;
try
WinHttpRequest := CreateOleObject('WinHttp.WinHttpRequest.5.1');
WinHttpRequest.Open('GET', AURL, False);
WinHttpRequest.Send;
AResponse := WinHttpRequest.ResponseText;
except
Result := False;
AResponse := GetExceptionMessage;
end;
end;
Related
I would like to check if a file to download exists or not.
I searched for a specific command but I have not found it so I thought to use the DownloadTemporaryFileSize command that throws an exception if something goes wrong.
Suppose that the file doesn't exist, I expected that the catching the exception error it will be hidden, but why it is not?
procedure InitializeWizard;
begin
try
FileSizeRetrieved := DownloadTemporaryFileSize('https://example.com/my_picture.jpg')
except
if....
//do something
//SuppressibleMsgBox(AddPeriod(GetExceptionMessage), mbCriticalError, MB_OK, IDOK);
end;
end;
MsgBox(IntToStr(FileSizeRetrieved), mbInformation, MB_OK);
end;
It's hard to tell what you are actually doing, as the code you have posted won't even compile. The following compilable version of your code proves that in general your approach is correct. The code won't show any message box, even if the download does not exist.
function DownloadExists(Url: string): Boolean;
var
Size: Int64;
begin
try
Size := DownloadTemporaryFileSize(Url)
Log(Format('Size of %s download is %d', [Url, Size]));
Result := True;
except
Log(Format('Download %s does not exist: %s', [Url, GetExceptionMessage]));
Result := False;
end;
end;
Note that you still get an exception, when debugging the code in IDE. But it won't happen when executed normally.
While using android app developed using java or android studio I discovered that the message dialog prompt stay execution of the next line until the dialog prompt is answered. I have been trying to do this using TDialogService.MessageDialog(AMessage, ADialogType, AButtons, ADefaultButton, 0, procedurexyz). While the prompt is on display, the next line is executed making the prompt useless as the user was suppose to decide the next action. I need help from anyone to get an active block message dialog prompt.
Embarcadero documentation says, that on Android platform you can use only non-blocking calls for ShowMessage, MessageDialog, myForm.ShowModal and etc.
To get "blocking" mode you can use workaround, like this:
function myMessageDialog(const AMessage: string; const ADialogType: TMsgDlgType;
const AButtons: TMsgDlgButtons; const ADefaultButton: TMsgDlgBtn): Integer;
var
mr: TModalResult;
begin
mr:=mrNone;
// standart call with callback anonimous method
TDialogService.MessageDialog(AMessage, ADialogType, AButtons,
ADefaultButton, 0,
procedure (const AResult: TModalResult)
begin
mr:=AResult
end);
while mr = mrNone do // wait for modal result
Application.ProcessMessages;
Result:=mr;
end;
After your suggestion #Kami I came up with this and its working very well for me, though am open to suggestions or additions.
function MsgBox(const AMessage: string; const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons;
const ADefaultButton: TMsgDlgBtn ): Integer;
var
myAns: Integer;
IsDisplayed: Boolean;
begin
myAns := -1;
IsDisplayed := False;
While myAns = -1 do
Begin
if IsDisplayed = False then
TDialogService.MessageDialog(AMessage, ADialogType, AButtons, ADefaultButton, 0,
procedure (const AResult: TModalResult)
begin
myAns := AResult;
IsDisplayed := True;
end);
IsDisplayed := True;
Application.ProcessMessages;
End;
Result := myAns;
end;
I'm learning about Inno Setup to make a simple installer. I need to download a file from a website during the installation, so it's important check if there is Internet connection. How can I check or take some alert to connect Internet during the process of the installation?
Thanks!
The best check is to try to actually download the file.
"Internet" is hardly a real thing that you can connect to. So it's hard to test, if you are connected to "Internet". You actually do not need a connection to "Internet", you need a connection to your server. So test that.
See also
How to check if internet connection is present in java?
What is the best way to check for Internet connectivity using .NET?
An equivalent implementation in Inno Setup would be like:
function InitializeSetup(): Boolean;
var
WinHttpReq: Variant;
Connected: Boolean;
begin
Connected := False;
repeat
Log('Checking connection to the server');
try
WinHttpReq := CreateOleObject('WinHttp.WinHttpRequest.5.1');
{ Use your real server host name }
WinHttpReq.Open('GET', 'https://www.example.com/', False);
WinHttpReq.Send('');
Log('Connected to the server; status: ' + IntToStr(WinHttpReq.Status) + ' ' +
WinHttpReq.StatusText);
Connected := True;
except
Log('Error connecting to the server: ' + GetExceptionMessage);
if WizardSilent then
begin
Log('Connection to the server is not available, aborting silent installation');
Result := False;
Exit;
end
else
if MsgBox('Cannot reach server. Please check your Internet connection.',
mbError, MB_RETRYCANCEL) = IDRETRY then
begin
Log('Retrying');
end
else
begin
Log('Aborting');
Result := False;
Exit;
end;
end;
until Connected;
Result := True;
end;
I´m having a few problems trying to download a file with 14mb using a TThread.
When I put the download code into the TDataModule, the download is ok, but after a refactoring and move the code to TThread.Execute, on DownloadUrl.ExecuteTarget I receive the error message on the Title.
The code in the TThread:
procedure TThreadDownload.Execute;
var
DownloadFile: TDownloadUrl;
begin
try
DownloadFile := TDownLoadURL.Create(nil);
DownloadFile.URL := 'http://.....';
DownloadFile.Filename := 'c:\';
DownloadFile.OnDownloadProgress := URL_OnDownloadProgress; //Procedure created to update the progressbar.
DownloadFile.ExecuteTarget(nil);
DownloadFile.Free;
except
on E: Exception do
begin
MessageDlg('Error'+#13+#10+E.Message,
mtInformation, [mbOK], 0);
end;
end;
end;
Any idea about what is wrong?
Thanks.
I solved the problem:
after read the code of DownloadUrl, I made little changes in the code, and now it´s working fine.
Code OK:
procedure TThreadDownload.AtualizarTela;
begin
with _Form do
begin
TcxProgressBar(_Form.FindComponent(_ProgressBar.Name)).Properties.Max := _TotalDownload;
TcxProgressBar(_Form.FindComponent(_ProgressBar.Name)).Position := _StatusDownload;
end;
end;
constructor TThreadDownload.Create(CreateSuspended: Boolean; AForm: TFrmMyFormWithProgress; AProgress: TcxProgressBar; PathUrl, PathLocal: String);
begin
inherited Create(CreateSuspended);
_Form := AForm;
_ProgressBar := AProgress;
_PathUrl := PathUrl;
_PathLocal := PathLocal;
FreeOnTerminate := True;
end;
procedure TThreadDownload.Execute;
var
DownloadFile: TDownloadUrl;
begin
try
DownloadFile := TDownloadUrl.Create(nil);
DownloadFile.URL := _PathUrl;
DownloadFile.Filename := _PathLocal;
DownloadFile.OnDownloadProgress := URL_OnDownloadProgress;
DownloadFile.ExecuteTarget(_Form);
DownloadFile.Free;
except
on E: Exception do
begin
MessageDlg('Error Message'+#13+#10+E.Message, mtInformation, [mbOK], 0);
end;
end;
end;
procedure TThreadDownload.URL_OnDownloadProgress(Sender: TDownLoadURL; Progress,
ProgressMax: Cardinal; StatusCode: TURLDownloadStatus; StatusText: String;
var Cancel: Boolean);
begin
_TotalDownload := ProgressMax;
_StatusDownload := Progress;
Synchronize(AtualizarTela);
end;
Do not do it, because TDownloadUrl would not work properly. If you would create 2 or more objects base on TDownloadUrl class and make them download simultaneously they would not return results, each thread will remain frozen. Even if you will free the objects after this collision has happened (I freed them from main thread), it would take exactly 5 minutes for the system to resolve it, but even after all the objects will be freed all other will be created "harmed" (meaning they will freeze straight away).
Here is my unit for Delphi-7 that may be used to reproduce this situation, if someone would like to check my statement.
This is my first post here - so be gentle :-)
I want to build a client/server application that uses datasnap for data transport.
This is a fairly simple task - and there are lots of examples to learn from.
BUT - Having a Datasnap server (build from Delphi XE wizard) I find myself running into a problem, and I hope someone can guide me into the right direction.
Server and Client run on same PC (that is the design for now).
Server is running Session lifecycle.
Server and Client shares a class (posted below)..
The Server provides a simple method - GetServerObject which uses the GetNewObject method.
The Server itself is a VCL application - main form is fmServer.
OnCreate instatiates the Servers FormObject property (FormObject := TMyDataObject.Create);
function TServerMethods2.GetNewObject: TMyDataObject;
begin
Result := TMyDataObject.Create;
end;
function TServerMethods2.GetServerObject: TMyDataObject;
begin
Result := GetNewObject;
if not Result.Assign(fmServer.FormObject) then
raise Exception.Create('Server error : Assign failed!');
end;
All this is pretty trivial - and my problem only appears if I twist my Client application into a multithreaded monster :-) (read - more than 1 thread).
So here is the Thread code for the client.
TDataThread = class(TThread)
private
DSConn: TSQLConnection;
protected
procedure Execute; override;
public
constructor Create(aConn: TSQLConnection); overload;
end;
constructor TDataThread.Create(aConn: TSQLConnection);
begin
inherited Create(False);
DSConn := aConn.CloneConnection;
FreeOnTerminate := true;
end;
procedure TDataThread.Execute;
var
DSMethod: TServerMethods2Client;
aDataObject : TMyDataObject;
begin
NameThreadForDebugging('Data');
{ Place thread code here }
DSMethod := nil;
try
while not terminated do
begin
sleep(10);
if DSConn.Connected then
begin
try
if DSMethod = nil then
DSMethod := TServerMethods2Client.Create(DSConn.DBXConnection,false);
if DSMethod <> nil then
try
aDataObject := DSMethod.GetserverObject;
finally
freeandnil(aDataObject);
end;
except
freeandnil(DSMethod);
DSConn.Connected := False;
end
end
else
begin
// connect
try
sleep(100);
DSConn.Open;
except
;
end;
end;
end;
finally
freeandnil(DSMethod);
DSConn.Close;
freeandnil(DSConn);
end;
When I create more than 1 of these threads - eventually I will get an error (being "cannot instatiate ... " or some "remote dbx error ..." .. and so on.
I simply cannot get this to work - so that I can spawn hundreds of threads/connections to a datasnap server.
I know this question is tricky - but my hope is that someone is smarter than me :-)
If I try the same client thread code - but accessing a more simple server method (lets say echostring from sample) then I can run it with hundreds of threads.
Perhaps Im answering myself here - but Im too blind to realize it :-)
unit uDataObject;
interface
uses
SysUtils;
Type
TMyDataObject = class(TObject)
private
fString: String;
fInteger: Integer;
public
constructor Create; virtual;
destructor Destroy; override;
function Assign(aSource: TMyDataObject): boolean;
property aString: String read fString write fString;
property aInteger: Integer read fInteger write fInteger;
end;
implementation
{ TMyDataObject }
function TMyDataObject.Assign(aSource: TMyDataObject): boolean;
begin
if aSource <> nil then
begin
try
fString := aSource.aString;
fInteger := aSource.aInteger;
Result := True;
except
Result := false;
end;
end
else
Result := false;
end;
constructor TMyDataObject.Create;
begin
inherited;
Randomize;
fString := 'The time of creation is : ' + FormatDateTime('ddmmyyyy hh:nn:ss:zzz', Now);
fInteger := Random(100);
end;
destructor TMyDataObject.Destroy;
begin
inherited;
end;
end.
All help is appreciated
This has mostly been answered in the comments and the bug report, but... The problem you are seeing is caused by a multithreading issue in XE's marshaller code. If two threads (or two clients) call a server server method which takes in or return user defined types (any type which will use the marshaller/unmarshaller) at the same time, then an exception could happen.
I am unaware of a perfect workaround for XE, but if it is possible to not use user-defined types, then you shouldn't see multithreading issues.
Mat
When the simple server method is working, i think your problem has to be found i somethin the "real" code is doing or using.
It could be in the connection (try changing your simpler code to use the connection)
Your problem can also be then CloneConnection. The Cloned connection is freed, when the connection it is cloned from is freed. See
http://docwiki.embarcadero.com/VCL/en/SqlExpr.TSQLConnection.CloneConnection