Using TFPHttpClient I can download some images via https and not others?

[vonskie]

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]

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]

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]

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][+][-]

1. program untitled;
2. {$ifdef fpc}{$mode delphi}{$H+}{$endif}
3. uses sysutils,fphttpclient;
4. var source:string;
5. begin
6.  with TFPHttpClient.Create(nil) do
7.     try
8.       try
9.            Source := 'http://www.goes.noaa.gov/FULLDISK/GEVS.JPG';
10.            get(Source,'img1.jpg');
11.            Source := 'https://sdo.gsfc.nasa.gov/assets/img/latest/latest_1024_0193.jpg';
12.            get(Source,'img2.jpg');
13.            Source:='https://sohowww.nascom.nasa.gov/data/realtime/eit_284/1024/latest.jpg';
14.            get(Source,'img3.jpg');
15.       finally
16.         Free;
17.       end;
18.     except
19.       on E: Exception do
20.         writeln(e.message);
21.     end;
22.  end.

[molly]

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][+][-]

1. program nasa;
2.  
3. {$MODE OBJFPC}{$H+}
4.  
5. uses
6.   Classes, SysUtils, fphttpclient;
7.  
8. procedure DumpExceptionCallStack(E: Exception);
9. var
10.   I: Integer;
11.   Frames: PPointer;
12.   Report: string;
13. begin
14.   Report := 'Program exception! ' + LineEnding + 'Stacktrace:' + LineEnding + LineEnding;
15.   if E <> nil then
16.   begin
17.     Report := Report + 'Exception class: ' + E.ClassName + LineEnding + 'Message: ' + E.Message + LineEnding;
18.   end;
19.   Report := Report + BackTraceStrFunc(ExceptAddr);
20.   Frames := ExceptFrames;
21.   for I := 0 to ExceptFrameCount - 1
22.     do Report := Report + LineEnding + BackTraceStrFunc(Frames[I]);
23.   WriteLn(Report);
24.   Halt;
25. end;
26.  
27. function GetUrlAs(Url: String; AsName: String): Boolean;
28. begin
29.   Result := False;
30.  
31.   with TFPHttpClient.Create(nil) do
32.   try
33.     if (ExtractFilePath(AsName) <> '') then
34.       if not DirectoryExists(ExtractFilePath(AsName)) then
35.         if not ForceDirectories(ExtractFilePath(AsName)) then Exit;
36.     try
37.       WriteLn(trim(FormatDateTime('h:nn:ss AM/PM MM/DD/YYYY', now)) + ' GET: ' + Url);
38.       get(Url, AsName);
39.       Result := True;
40.     finally
41.       Free;
42.     end;
43.   except
44.     on E: Exception do DumpExceptionCallStack(E);
45.   end;
46. end;
47.  
48. procedure ReportStatus(Success: Boolean); inline;
49. begin
50.   if Success then WriteLn('Succes') else WriteLn('Failure');
51. end;
52.  
53.  
54. const
55.   URL1 = 'http://www.goes.noaa.gov/FULLDISK/GEVS.JPG';
56.   URL2 = 'https://sdo.gsfc.nasa.gov/assets/img/latest/latest_1024_0193.jpg';
57.   URL3 = 'https://sohowww.nascom.nasa.gov/data/realtime/eit_284/1024/latest.jpg';
58. var
59.   TargetDir : String;
60.   SomeDirectory : String;
61.   SomeFolderName : String;
62.   RetVal : boolean;
63. begin
64.   SomeDirectory := IncludeTrailingPathDelimiter(GetCurrentDir);
65.   SomeFolderName := 'pictures3';
66.   TargetDir := IncludeTrailingPathDelimiter(SomeDirectory + SomeFolderName);
67.  
68.   WriteLn('Attempting to download URL''s into directory ', TargetDir);
69.  
70.   RetVal := GetUrlAs(URL1, TargetDir + 'pic1.jpg');
71.   ReportStatus(RetVal);
72.  
73.   Sleep(1000);
74.  
75.   Retval := GetUrlAs(URL2, TargetDir + 'pic2.jpg');
76.   ReportStatus(RetVal);
77.  
78.   Sleep(1000);
79.  
80.   RetVal := GetUrlAs(URL3, TargetDir + 'pic3.jpg');
81.   ReportStatus(RetVal);
82.  
83.   WriteLn('Done!');
84. end.
85.  

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]

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][+][-]

1. //...
2. try
3.   WriteLn(trim(FormatDateTime('h:nn:ss AM/PM MM/DD/YYYY', now)) + ' GET: ' + Url);
4.   get(Url, AsName); //<--exception here, function result will be false
5.   Result := True;
6. finally
7.   Free;
8. end;

I use this instead. In my experience always works, unless the webpage is down of course):

Code: Pascal  [Select][+][-]

1. //...  
2. try
3.   WriteLn(trim(FormatDateTime('h:nn:ss AM/PM MM/DD/YYYY', now)) + ' GET: ' + Url);
4.   AllowRedirect := True; //most webpage will use some kind of redirect
5.   try
6.     get(Url, AsName); //<--exception here, the result can be true though
7.   except
8.   end;
9.   if ResponseStatusCode = 200 then
10.   begin
11.     //success, do other things if needed
12.     Result := True;
13.   end;
14. finally
15.   Free;
16. end;

[vonskie]

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]

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.

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][+][-]

1. program nasa_getmem;
2.  
3. {$MODE OBJFPC}{$H+}
4.  
5. uses
6.   Classes, SysUtils, fphttpclient;
7.  
8. function GetUrlAs(Url: String; AsName: String): Boolean;
9. begin
10.   Result := False;
11.  
12.   with TFPHttpClient.Create(nil) do
13.   try
14.     AllowRedirect := true;
15.  
16.     try
17.       if (ExtractFilePath(AsName) <> '') then
18.         if not DirectoryExists(ExtractFilePath(AsName)) then
19.           if not ForceDirectories(ExtractFilePath(AsName)) then
20.             raise exception.create('Unable to create directory ' +
21.               ExtractFilePath(AsName)) at get_caller_addr(get_frame), get_caller_frame(get_frame);
22.  
23.       WriteLn(trim(FormatDateTime('h:nn:ss AM/PM MM/DD/YYYY', now)) + ' GET: ' + Url);
24.       get(Url, AsName);
25.     except
26.       on E: Exception do WriteLn('Exception: ' + E.Message); //      DumpExceptionCallStack(E);
27.     end;
28.  
29.     if (ResponseStatusCode = 200) then
30.     begin
31.       if FileExists(AsName) then Result := True;
32.     end;
33.  
34.   finally
35.     Free;
36.   end;
37. end;
38.  
39. procedure ReportStatus(Success: Boolean); inline;
40. begin
41.   if Success then WriteLn('Success') else WriteLn('Failure');
42. end;
43.  
44.  
45. const
46.   URL1 = 'http://www.goes.noaa.gov/FULLDISK/GEVS.JPG';
47.   URL2 = 'https://sdo.gsfc.nasa.gov/assets/img/latest/latest_1024_0193.jpg';
48.   URL3 = 'https://sohowww.nascom.nasa.gov/data/realtime/eit_284/1024/latest.jpg';
49. var
50.   TargetDir : String;
51.   SomeDirectory : String;
52.   SomeFolderName : String;
53.   RetVal : boolean;
54. begin
55.   SomeDirectory := IncludeTrailingPathDelimiter(GetCurrentDir);
56.   SomeFolderName := 'Spacegetti';
57.   TargetDir := IncludeTrailingPathDelimiter(SomeDirectory + SomeFolderName);
58.  
59.   WriteLn('Attempting to download URL''s into directory ', TargetDir);
60.  
61.   RetVal := GetUrlAs(URL1, TargetDir + 'pic1.jpg');
62.   ReportStatus(RetVal);
63.  
64.   Sleep(1000);
65.  
66.   Retval := GetUrlAs(URL2, TargetDir + 'pic2.jpg');
67.   ReportStatus(RetVal);
68.  
69.   Sleep(1000);
70.  
71.   RetVal := GetUrlAs(URL3, TargetDir + 'pic3.jpg');
72.   ReportStatus(RetVal);
73.  
74.   WriteLn('Done!');
75. end.
76.  

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.