Using TFPHttpClient I can download some images via https and not
others?
lazarus / 38-Networking and Web Programming

----------------------------------------------------------------------
vonskie · 2017-02-17 02:29

The uncommented sights work but the one that is // commented out does
not... get can not connect error.

If I paste it in a browser it comes up just fine.

Any ideas?

Openssl 1.0.2 is installed




procedure tform1.mainp;

var

  Source: string;
  PersonalPath: array[0..MaxPathLen] of char; //Allocate memory
  filepath: string;
begin

  with TFPHttpClient.Create(nil) do
    try
      try
        if radiobuttonearth.Checked = True then
          Source := 'http://www.goes.noaa.gov/FULLDISK/GEVS.JPG'
        else
          //Source :=
'https://sdo.gsfc.nasa.gov/assets/img/latest/latest_1024_0193.jpg';
            source:='https://sohowww.nascom.nasa.gov/data/realtime/eit
_284/1024/latest.jpg';
        if memolog.Lines.Count > 50 then
          memolog.Lines.Delete(0);

        memolog.Lines.Add(trim(FormatDateTime('h:nn:ss AM/PM', now) +
          ' ' + FormatDateTime('MM/DD/YYYY', now)) + ' GET: ' +
Source);


        PersonalPath := '';
      SHGetSpecialFolderPath(0, PersonalPath, CSIDL_PERSONAL, False);

      filepath := PersonalPath + '\Spacegetti\';
      if not directoryexists(filepath) then
        createdir(filepath);

        get(Source,filepath + 'source.jpg');
        setdesktop(filepath + 'source.jpg');

      finally
        Free;
      end;




    except
      on E: Exception do
        DumpExceptionCallStack(E, 'log');

    end;

end;

----------------------------------------------------------------------
Thaddy · 2017-02-17 02:41

Both the second and third URL don't work and generate Not Found
The second also generates a 404.
So both links are invalid (by now).

Your code looks correct, but Nasa probably throws away such images
after a certain time.

----------------------------------------------------------------------
molly · 2017-02-17 02:54

That's strange...

A simple test example using fpc only showed me that i was able to
receive all 3 urls without any problems.

----------------------------------------------------------------------
Thaddy · 2017-02-17 03:51

If you click on the URL's it does  not work. I am sorry. The url's in
the posting itself are malformed.
This little test downloads all three, indeed.
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i program
untitled;{$ifdef fpc}{$mode delphi}{$H+}{$endif}uses
sysutils,fphttpclient;var source:string;begin  with
TFPHttpClient.Create(nil) do    try      try           Source :=
'http://www.goes.noaa.gov/FULLDISK/GEVS.JPG';         
 get(Source,'img1.jpg');           Source :=
'https://sdo.gsfc.nasa.gov/assets/img/latest/latest_1024_0193.jpg';  
       get(Source,'img2.jpg');           Source:='https://sohowww.nasc
om.nasa.gov/data/realtime/eit_284/1024/latest.jpg';         
 get(Source,'img3.jpg');      finally        Free;      end;   
except      on E: Exception do        writeln(e.message);    end; end.

----------------------------------------------------------------------
molly · 2017-02-17 04:57

np Thaddy, as i ran into that myself as well.

I guess that's what you get when people don't put their code between
code tags.

A slightly more complicated version which is a bit more in line with
what OP is attempting to accomplish:
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i program
nasa; {$MODE OBJFPC}{$H+} uses  Classes, SysUtils,
fphttpclient; procedure DumpExceptionCallStack(E: Exception);var  I:
Integer;  Frames: PPointer;  Report: string;begin  Report := 'Program
exception! ' + LineEnding + 'Stacktrace:' + LineEnding + LineEnding; 
if E <> nil then   begin    Report := Report + 'Exception class: ' +
E.ClassName + LineEnding + 'Message: ' + E.Message + LineEnding; 
end;  Report := Report + BackTraceStrFunc(ExceptAddr);  Frames :=
ExceptFrames;  for I := 0 to ExceptFrameCount - 1     do Report :=
Report + LineEnding + BackTraceStrFunc(Frames[I]);  WriteLn(Report); 
Halt;end; function GetUrlAs(Url: String; AsName: String):
Boolean;begin  Result := False;   with TFPHttpClient.Create(nil) do 
try    if (ExtractFilePath(AsName) <> '') then      if not
DirectoryExists(ExtractFilePath(AsName)) then        if not
ForceDirectories(ExtractFilePath(AsName)) then Exit;    try     
WriteLn(trim(FormatDateTime('h:nn:ss AM/PM MM/DD/YYYY', now)) + ' GET:
' + Url);      get(Url, AsName);      Result := True;    finally     
Free;    end;  except    on E: Exception do
DumpExceptionCallStack(E);  end;end; procedure ReportStatus(Success:
Boolean); inline;begin  if Success then WriteLn('Succes') else
WriteLn('Failure');end;  const  URL1 =
'http://www.goes.noaa.gov/FULLDISK/GEVS.JPG';  URL2 =
'https://sdo.gsfc.nasa.gov/assets/img/latest/latest_1024_0193.jpg'; 
URL3 = 'https://sohowww.nascom.nasa.gov/data/realtime/eit_284/1024/lat
est.jpg';var  TargetDir : String;  SomeDirectory : String; 
SomeFolderName : String;  RetVal : boolean;begin  SomeDirectory :=
IncludeTrailingPathDelimiter(GetCurrentDir);  SomeFolderName :=
'pictures3';  TargetDir := IncludeTrailingPathDelimiter(SomeDirectory
+ SomeFolderName);   WriteLn('Attempting to download URL''s into
directory ', TargetDir);   RetVal := GetUrlAs(URL1, TargetDir +
'pic1.jpg');  ReportStatus(RetVal);   Sleep(1000);   Retval :=
GetUrlAs(URL2, TargetDir + 'pic2.jpg');  ReportStatus(RetVal);  
Sleep(1000);   RetVal := GetUrlAs(URL3, TargetDir + 'pic3.jpg'); 
ReportStatus(RetVal);    WriteLn('Done!');end. 
I'll refrain from putting up the images so you'll just have to trust
my word for it.

There are various reasons (including those mentioned by Thaddy) of why
a connection might fail. Sometimes its the server, other times its
your provider and/or poor network.

Simply never expect a single request to always work. In that regards
my example is too simple as well as it doesn't attempt multiple tries
in case of failure.

A question for OP: why the trim ?

----------------------------------------------------------------------
balazsszekely · 2017-02-17 05:35

Function "get" calls procedure "HTTPMethod" internally, with 200 as
allowed response codes. The secret is that sometimes(not always, but
quite often), HTTPMethod will throw an exception, even when the
operation was successful. So the following code, won't work:
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i //...try 
WriteLn(trim(FormatDateTime('h:nn:ss AM/PM MM/DD/YYYY', now)) + ' GET:
' + Url);  get(Url, AsName); //<--exception here, function result will
be false  Result := True;finally  Free;end;I use this instead. In my
experience always works, unless the webpage is down of course):
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i //...  try 
WriteLn(trim(FormatDateTime('h:nn:ss AM/PM MM/DD/YYYY', now)) + ' GET:
' + Url);  AllowRedirect := True; //most webpage will use some kind of
redirect  try    get(Url, AsName); //<--exception here, the result can
be true though  except  end;  if ResponseStatusCode = 200 then  begin 
  //success, do other things if needed     Result := True; 
end;finally  Free;end;

----------------------------------------------------------------------
vonskie · 2017-02-17 14:46

Thank you everyone for your assistance..

I downloaded the following

https://slproweb.com/download/Win32OpenSSL_Light-1_0_2k.exe

and it started working.

Guess I had a old version of OpenSSL installed.

----------------------------------------------------------------------
molly · 2017-02-17 19:29

Quote from: GetMem on February 17, 2017, 06:35:39 amFunction "get"
calls procedure "HTTPMethod" internally, with 200 as allowed response
codes. The secret is that sometimes(not always, but quite often),
HTTPMethod will throw an exception, even when the operation was
successful.
Thank you GetMem.

You are correct, and i was naive in my code with assuming that would
always be the case. Because indeed it isn't, as there are many other
things that could cause an exception.

Besides that, a bit of a obvious memory leak was in my code as well.
Following code based on GetMem's suggestion should be a bit nicer.
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i program
nasa_getmem; {$MODE OBJFPC}{$H+} uses  Classes, SysUtils,
fphttpclient; function GetUrlAs(Url: String; AsName: String):
Boolean;begin  Result := False;   with TFPHttpClient.Create(nil) do 
try    AllowRedirect := true;     try      if (ExtractFilePath(AsName)
<> '') then        if not DirectoryExists(ExtractFilePath(AsName))
then          if not ForceDirectories(ExtractFilePath(AsName)) then  
         raise exception.create('Unable to create directory ' +      
       ExtractFilePath(AsName)) at get_caller_addr(get_frame),
get_caller_frame(get_frame);       
WriteLn(trim(FormatDateTime('h:nn:ss AM/PM MM/DD/YYYY', now)) + ' GET:
' + Url);      get(Url, AsName);    except      on E: Exception do
WriteLn('Exception: ' + E.Message); //    
 DumpExceptionCallStack(E);    end;     if (ResponseStatusCode = 200)
then    begin      if FileExists(AsName) then Result := True;   
end;   finally    Free;  end;end; procedure ReportStatus(Success:
Boolean); inline;begin  if Success then WriteLn('Success') else
WriteLn('Failure');end;  const  URL1 =
'http://www.goes.noaa.gov/FULLDISK/GEVS.JPG';  URL2 =
'https://sdo.gsfc.nasa.gov/assets/img/latest/latest_1024_0193.jpg'; 
URL3 = 'https://sohowww.nascom.nasa.gov/data/realtime/eit_284/1024/lat
est.jpg';var  TargetDir : String;  SomeDirectory : String; 
SomeFolderName : String;  RetVal : boolean;begin  SomeDirectory :=
IncludeTrailingPathDelimiter(GetCurrentDir);  SomeFolderName :=
'Spacegetti';  TargetDir := IncludeTrailingPathDelimiter(SomeDirectory
+ SomeFolderName);   WriteLn('Attempting to download URL''s into
directory ', TargetDir);   RetVal := GetUrlAs(URL1, TargetDir +
'pic1.jpg');  ReportStatus(RetVal);   Sleep(1000);   Retval :=
GetUrlAs(URL2, TargetDir + 'pic2.jpg');  ReportStatus(RetVal);  
Sleep(1000);   RetVal := GetUrlAs(URL3, TargetDir + 'pic3.jpg'); 
ReportStatus(RetVal);    WriteLn('Done!');end. As you can see it would
be better to dump the rather intrusive stackdump routine and use a bit
more silent silent exception handling. That way you still get informed
about what goes wrong without directly halting your program. That
allows you to check the result and act accordingly.