Skip to content
Permalink
Browse files

Prevent file read issues: THttpDownload.SendRequest() now stores the …

…response in a string variable if the passed file name is empty.
  • Loading branch information...
ansgarbecker committed Aug 26, 2019
1 parent e8ba05a commit 7666496177da29d10d12ea2472bb4683a5d39598
Showing with 16 additions and 9 deletions.
  1. +11 −2 source/apphelpers.pas
  2. +5 −7 source/main.pas
@@ -69,6 +69,7 @@ THttpDownload = class(TObject)
private
FOwner: TComponent;
FURL: String;
FLastContent: String;
FBytesRead: Integer;
FContentLength: Integer;
FTimeOut: Cardinal;
@@ -81,6 +82,7 @@ THttpDownload = class(TObject)
property TimeOut: Cardinal read FTimeOut write FTimeOut;
property BytesRead: Integer read FBytesRead;
property ContentLength: Integer read FContentLength;
property LastContent: String read FLastContent;
end;

// Threading stuff
@@ -3219,6 +3221,7 @@ procedure THttpDownload.SendRequest(Filename: String);
DoStore: Boolean;
UserAgent, OS: String;
HttpStatus: Integer;
ContentChunk: String;
begin
DoStore := False;
if MainForm.IsWine then
@@ -3233,6 +3236,7 @@ procedure THttpDownload.SendRequest(Filename: String);
InternetSetOption(NetHandle, INTERNET_OPTION_CONNECT_TIMEOUT, @TimeOutSeconds, SizeOf(TimeOutSeconds));

UrlHandle := nil;
FLastContent := '';
try
UrlHandle := InternetOpenURL(NetHandle, PChar(FURL), nil, 0, INTERNET_FLAG_RELOAD, 0);
if not Assigned(UrlHandle) then
@@ -3265,8 +3269,13 @@ procedure THttpDownload.SendRequest(Filename: String);
// Stream contents
while true do begin
InternetReadFile(UrlHandle, @Buffer, SizeOf(Buffer), BytesInChunk);
if DoStore then
BlockWrite(LocalFile, Buffer, BytesInChunk);
// Either store as file or in memory variable
if DoStore then begin
BlockWrite(LocalFile, Buffer, BytesInChunk)
end else begin
SetString(ContentChunk, PChar(@Buffer[1]), BytesInChunk);
FLastContent := FLastContent + ContentChunk;
end;
Inc(FBytesRead, BytesInChunk);
if Assigned(FOnProgress) then
FOnProgress(Self);
@@ -12820,7 +12820,7 @@ procedure TMainForm.TaskDialogHyperLinkClicked(Sender: TObject);

function TMainForm.HasDonated(ForceCheck: Boolean): TThreeStateBoolean;
var
Email, TempFileName, CheckResult: String;
Email, CheckResult: String;
rx: TRegExpr;
CheckWebpage: THttpDownload;
begin
@@ -12840,20 +12840,18 @@ function TMainForm.HasDonated(ForceCheck: Boolean): TThreeStateBoolean;
CheckWebpage := THttpDownload.Create(MainForm);
CheckWebpage.URL := APPDOMAIN + 'hasdonated.php?email='+EncodeURLParam(Email);
CheckWebpage.TimeOut := 3;
TempFileName := GetTempDir + '\' + APPNAME + '_hasdonated_check.tmp';
try
try
CheckWebpage.SendRequest(TempFileName);
CheckWebpage.SendRequest('');
except
on E:Exception do begin
// Try again without SSL. See issue #65
MainForm.LogSQL(E.Message, lcError);
CheckWebpage.URL := ReplaceRegExpr('^https:', CheckWebpage.URL, 'http:');
CheckWebpage.SendRequest(TempFileName);
CheckWebpage.SendRequest('');
end;
end;
CheckResult := ReadTextFile(TempFileName, TEncoding.Default);
SysUtils.DeleteFile(TempFileName);
CheckResult := CheckWebpage.LastContent;
rx.Expression := '^\d+$';
if rx.Exec(CheckResult) then begin
if CheckResult = '0' then
@@ -12863,7 +12861,7 @@ function TMainForm.HasDonated(ForceCheck: Boolean): TThreeStateBoolean;
end;
except
on E:Exception do begin
MainForm.LogSQL(E.Message, lcError);
MainForm.LogSQL(E.Message + sLineBreak + 'Check response: "'+CheckResult+'"', lcError);
FHasDonatedDatabaseCheck := nbUnset; // Could have been set before, when ForceCheck=true
end;
end;

0 comments on commit 7666496

Please sign in to comment.
You can’t perform that action at this time.