unit UnitIGNWebServices; // Interrogation du serveur d'altimétrie de l'IGN // pour les altitudes: Z = f(Latitude, Longitude) // Documentation (deprecated) // https://geoservices.ign.fr/documentation/services/api-et-services-ogc/calcul-altimetrique-rest // En GET: // https://wxs.ign.fr/essentiels/alti/rest/elevation.xml?lon=-0.02500000&lat=43.08600000&zonly=false // En POST // https://wxs.ign.fr/essentiels/alti/wps?service=WPS&version=1.0.0 // Nouvelle doc: // https://geoservices.ign.fr/documentation/services/services-geoplateforme/altimetrie#72673 {$INCLUDE CompilationParameters.inc} {$define IGN_DEBUG} interface uses StructuresDonnees, GHTopoGeneralFunctions, unitDatesUtils, unitGHTopoViseesUtils, unitColorsUtils, unitSolveEquationsPolynomes, Classes, SysUtils, Math, // anciennement Include UnitListesSimplesWithGeneriques, tgfclhttpclientbroker, JsonTools ; // Ne pas oublier les libs OpenSSL à télécharger sur https://indy.fulgan.com/SSL/openssl-1.0.2q-i386-win32.zip type { THTTPSClient } THTTPSClient = class private FHTTP : TFCLHTTPClient; procedure ClearAllHeaders(); procedure ClearAllRequestHeaders(); procedure AddAHeader(const H, V: string); procedure AddARequestHeader(const RH: string); function Post(const UseHTTPS: boolean; const MyUrl: string): string; procedure QAfficherMessageErreur(const msg: string); function Get(const UseHTTPS: boolean; const MyUrl: string): string; public constructor Create; destructor Destroy; end; type { TMyHTTSService } TMyHTTSService = class(THTTPSClient) private public function Initialiser(): boolean; procedure Finaliser(); function GetResponse(const UseHTTPS: boolean; const MyURL: string): string; end; //****************************************************************************** type TMyIGNWebService = class(THTTPSClient) private FStrPostResponse: string; FListePointsATraiter: TListePointsLatLonAltAcc; function GetPoint(const Idx: integer): TPointLatLonAltAcc; public function Initialiser(): boolean; procedure Finaliser(); function GetAltitudeByLatLon(const QLat, QLon: double; out QAltitude, QAccuracy: double): boolean; procedure AppendPointByLatLonAlt(const QLat, QLon: double; const QAlt: double; const QAcc: double = 0.00); overload; procedure AppendPoint(const P: TPointLatLonAltAcc); // Requete POST function POST_BeginListePoints(): boolean; function POST_Flush(): boolean; function POST_TraiterReponseIGN(): integer; function GetNbPointsExtraits(): integer; function GetPointTraite(const Idx: integer): TPointLatLonAltAcc; function getNbRequestHeaders(): integer; end; implementation uses DGCDummyUnit, Forms; const HTTP_ERR_OK = 200; HTTP_WWW_OPENGIS_NET = 'http://www.opengis.net'; HTTP_SCHEMAS_OPENGIS_NET = 'http://schemas.opengis.net'; HTTP_WWW_W3C_ORG = 'http://www.w3.org'; IGN_DATA_GEOPF_FR = 'data.geopf.fr'; IGN_ALTIMETRIE = 'altimetrie'; IGN_GEOPF_VERSION = '1.0'; IGN_CALCUL = 'calcul'; IGN_RESOURCE = 'ign_rge_alti_wld'; IGN_ALTI = 'alti'; IGN_REST = 'rest'; IGN_APPLICATION = 'json'; // xml ou json IGN_ELEVATION_JSON = 'elevation.json'; JSON_IGN_NODENAME_ELEVATIONS = 'elevations'; JSON_IGN_NODENAME_Lon = 'lon'; JSON_IGN_NODENAME_Lat = 'lat'; JSON_IGN_NODENAME_Alt = 'z'; ALTITUDE_ERROR = -9999.0; //HTTPS_PORT = 443; IGN_WXS = 'wxs.ign.fr'; IGN_KEY = 'essentiels'; IGN_WPS = 'wps'; IGN_WFS = 'wfs'; IGN_WCS = 'wcs'; IGN_GML = 'gml'; IGN_OWS = 'ows'; IGN_OGC = 'ogc'; IGN_XLINK = 'xlink'; OWS_Identifier = 'Identifier'; WPS_Input = 'Input'; WPS_Data = 'Data'; WPS_LiteralData = 'LiteralData'; WPS_DataInputs = 'DataInputs'; WPS_RawDataOutput = 'RawDataOutput'; WPS_ResponseForm = 'ResponseForm'; IGN_SERVICE = 'service=WPS'; IGN_VERSION = '1.0.0'; XMLNS = 'xmlns'; XML_IGN_SECTION_ELEVATIONS = 'elevations'; XML_IGN_ELEVATION_ITEM = 'elevation'; XML_IGN_LAT = 'lat'; XML_IGN_LON = 'lon'; XML_IGN_ALT = 'z'; XML_IGN_ACCURACY = 'acc'; { TMyHTTSService } function TMyHTTSService.Initialiser(): boolean; begin Result := false; AfficherMsgClass(self, 'Initialiser()'); { SSL initialization has to be done by hand here } try FHTTP.IOTimeout := 30000; self.ClearAllHeaders(); self.AddAHeader('User-Agent','Mozilla/5.0 (compatible; fpweb)'); //self.AddAHeader('Content-Type',Format('application/%s; charset=UTF-8', ['json'])); //self.AddAHeader('Accept', format('application/%s', ['json'])); //FHTTP.AllowRedirect := true; Result := True; except end; end; procedure TMyHTTSService.Finaliser(); begin try pass; // FPOSTFormData.Clear; // FListePointsATraiter.ClearListe(); // FStrPostResponse := ''; finally // FreeAndNil(FListePointsATraiter); // FreeAndNil(FPOSTFormData); //FreeAndNil(FHTTP); end; end; function TMyHTTSService.GetResponse(const UseHTTPS: boolean; const MyURL: string): string; var LastError: Integer; begin result := ''; LastError := 0; try result := self.Get(UseHTTPS, MyURL); /// < Segfault sous Linux --- if (trim(result) = '') then begin QAfficherMessageErreur(Format('Reponse vide: "%s"', [result])); exit(''); end; except on E: Exception do begin LastError := -1; raise; // Redéclenche l'exception pour affichage: dans ce cas, la cause de l'erreur est mise en évidence end; end; if (LastError <> 0) then exit(''); end; { THTTPSClient } procedure THTTPSClient.ClearAllHeaders; begin FHTTP.RequestHeaders.Clear; end; procedure THTTPSClient.ClearAllRequestHeaders; begin FHTTP.RequestHeaders.Clear; end; procedure THTTPSClient.AddAHeader(const H, V: string); begin FHTTP.AddHeader(H, V); end; procedure THTTPSClient.AddARequestHeader(const RH: string); begin FHTTP.RequestHeaders.Add(RH); end; function THTTPSClient.Get(const UseHTTPS: boolean; const MyUrl: string): string; var QUrl: String; begin QUrl := MyURL; result := ''; //if (UseHTTPS) then QUrl += format(':%d', [HTTPS_PORT]); AfficherMsgClass(self, 'Get(): %s', [QUrl]); try try result := FHTTP.Get(QUrl); except on E: exception do AfficherMessageErreur(E.Message); end; finally end; end; function THTTPSClient.Post(const UseHTTPS: boolean; const MyUrl: string): string; var QUrl: String; begin QUrl := MyURL; //https://wxs.ign.fr/essentiels/alti/rest/elevation.xml?lon=-0.02500000&lat=43.08600000&zonly=false AfficherMsgClass(self, 'POST(%s)', [QUrl]); result := ''; //if (UseHTTPS) then QUrl += format(':%d', [HTTPS_PORT]); try try result := FHTTP.Post(QUrl); except on E: exception do AfficherMessageErreur(E.Message); end; finally end; end; procedure THTTPSClient.QAfficherMessageErreur(const msg: string); begin {$ifdef IGN_DEBUG}AfficherMessageErreur('HTTPSService: ' + msg);{$endif} end; constructor THTTPSClient.Create; begin FHTTP := TFCLHTTPClient.Create(Application); end; destructor THTTPSClient.Destroy; begin try finally FreeAndNil(FHTTP); end; end; { TMyWebService } function TMyIGNWebService.Initialiser(): boolean; begin Result := false; AfficherMsgClass(self, 'Initialiser()'); { SSL initialization has to be done by hand here } //InitSSLEAInterface(false); FListePointsATraiter := TListePointsLatLonAltAcc.Create; try FListePointsATraiter.ClearListe(); // FPOSTFormData.Clear; self.ClearAllHeaders(); self.AddAHeader('User-Agent','Mozilla/5.0 (compatible; fpweb)'); self.AddAHeader('Content-Type',Format('application/%s; charset=UTF-8', [IGN_APPLICATION])); self.AddAHeader('Accept', format('application/%s', [IGN_APPLICATION])); FHTTP.AllowRedirect := true; Result := True; except end; end; function TMyIGNWebService.GetAltitudeByLatLon(const QLat, QLon: double; out QAltitude, QAccuracy: double): boolean; var MyURL, QResponse: String; LastError: integer; JSONRoot, NodeSection, NodePoint: TJsonNode; begin // TODO: Sous Linux, installer éventuellement la lib ssl: sudo apt install libssl-dev result := False; LastError := 0; QResponse := ''; QAltitude := ALTITUDE_ERROR; QAccuracy := 0.00; // Ancien format (* MyURL := Format('https://%s/%s/%s/%s/%s?lon=%.8f&lat=%.8f&zonly=%s', [IGN_WXS, IGN_KEY, IGN_ALTI, IGN_REST, IGN_ELEVATION_XML, QLon, QLat, BoolToStr(false, 'true', 'false')]); //*) // Nouveau format (Cà fonctionne) MyURL := Format('https://%s/%s/%s/%s/'+ '%s/%s/%s?%s=%.10f&%s=%.10f&resource=%s&indent=%s&measure=%s&zonly=%s', [IGN_DATA_GEOPF_FR, IGN_ALTIMETRIE, IGN_GEOPF_VERSION, IGN_CALCUL, IGN_ALTI, IGN_REST, IGN_ELEVATION_JSON, JSON_IGN_NODENAME_Lon, QLon, JSON_IGN_NODENAME_Lat, QLat, IGN_RESOURCE, BoolToStr(true , 'true', 'false'), // Indent: OUI BoolToStr(false, 'true', 'false'), // measure: false BoolToStr(false, 'true', 'false')]); // zonly : NON //++AfficherMessageErreur(MyURL); try QResponse := self.Get(True, MyURL); /// < Segfault sous Linux --- if (trim(QResponse) = '') then begin QAfficherMessageErreur(Format('Reponse vide: "%s"', [QResponse])); exit(false); end; except on E: Exception do begin LastError := -1; raise; // Redéclenche l'exception pour affichage: dans ce cas, la cause de l'erreur est mise en évidence end; end; //++ AfficherMessageErreur('Reponse GET: ' + QResponse); if (LastError <> 0) then exit(false); JSONRoot := TJsonNode.Create; try try JSONRoot.LoadFromString(QResponse); //++ AfficherMessageErreur('-- Chargement du JSON: %d sections', [JSONRoot.Count]); NodeSection := JSONRoot.Child(JSON_IGN_NODENAME_ELEVATIONS); if (NodeSection = nil) then raise Exception.CreateFmt('Section [%s] introuvable', [JSON_IGN_NODENAME_ELEVATIONS]); //++ AfficherMessageErreur(' Node: %s - %d children', [ NodeSection.Name, NodeSection.Count]); if (NodeSection.Count = 0) then raise Exception.CreateFmt('Section [%s] found, but void', [JSON_IGN_NODENAME_ELEVATIONS]); // On prend le premier point seulement NodePoint := NodeSection.Child(0); //MyPoint.Longitude := NodePoint.Child(JSON_IGN_NODENAME_Lon).AsNumber; //MyPoint.Latitude := NodePoint.Child(JSON_IGN_NODENAME_Lat).AsNumber; QAltitude := NodePoint.Child(JSON_IGN_NODENAME_Alt).AsNumber; QAccuracy := 0.00; //MyPoint.Accuracy := 0.00; //jSubItem.Items[3].AsFloat; except on E: Exception do begin AfficherMessageErreur('*** ' + E.Message); exit(false); end; end; Result := true; finally FreeAndNil(JSONRoot); end; end; procedure TMyIGNWebService.AppendPointByLatLonAlt(const QLat, QLon: double; const QAlt: double; const QAcc: double = 0.00); var P: TPointLatLonAltAcc; begin P.setFrom(QLat, QLon, QAlt, QAcc); FListePointsATraiter.AddElement(P); end; procedure TMyIGNWebService.AppendPoint(const P: TPointLatLonAltAcc); begin FListePointsATraiter.AddElement(P); end; // Nouvelle version - Utilisation provisoire de la méthode GET function TMyIGNWebService.POST_BeginListePoints(): boolean; begin result := false; FListePointsATraiter.ClearListe(); result := true; end; // utilisation provisoire de la méthode GET // // ** https://data.geopf.fr/altimetrie/1.0/calcul/alti/rest/elevation.json?lon=1.48|1.49&lat=43.54|43.55&resource=ign_rge_alti_wld&delimiter=|&indent=false&measures=false&zonly=false function TMyIGNWebService.POST_Flush(): boolean; const IGN_VALUE_DELIMITER = '|'; var i, Nb, LastError: Integer; MyURL, QArrayLon, QArrayLat: String; //NodeElevations, //NodeLongitudes, NodeLatitudes: TJsonNode; //NodeLon, NodeLat : TJsonNode; MyPoint: TPointLatLonAltAcc; begin result := false; LastError := 0; FStrPostResponse := ''; Nb := FListePointsATraiter.GetNbElements(); AfficherMsgErrClass(self, 'POST_Flush(): %d points', [Nb]); if (0 = Nb) then exit; QArrayLon := format('%s=', [JSON_IGN_NODENAME_Lon]); QArrayLat := format('%s=', [JSON_IGN_NODENAME_Lat]); for i := 0 to Nb-1 do begin MyPoint := self.GetPoint(i); QArrayLon += FormatterNombreWithDotDecimal(MyPoint.Longitude, 8) + BoolToStr(i = (Nb-1), '', IGN_VALUE_DELIMITER); QArrayLat += FormatterNombreWithDotDecimal(MyPoint.Latitude , 8) + BoolToStr(i = (Nb-1), '', IGN_VALUE_DELIMITER); end; MyURL := Format('https://%s/%s/%s/%s/'+ '%s/%s/%s?%s&%s&delimiter=%s&resource=%s&indent=%s&measures=%s&zonly=%s', // zonly=%s', [IGN_DATA_GEOPF_FR, IGN_ALTIMETRIE, IGN_GEOPF_VERSION, IGN_CALCUL, IGN_ALTI, IGN_REST, IGN_ELEVATION_JSON, QArrayLon, QArrayLat, IGN_VALUE_DELIMITER, IGN_RESOURCE, BoolToStr(true , 'true', 'false'), // indent: OUI BoolToStr(false, 'true', 'false'), // Measures: NON BoolToStr(false, 'true', 'false')]); // zonly : NON //++ AfficherMessageErreur(MyURL); try FStrPostResponse := self.Get(True, MyURL); /// < Segfault sous Linux --- if (trim(FStrPostResponse) = '') then begin QAfficherMessageErreur(Format('Reponse vide: "%s"', [FStrPostResponse])); exit(false); end; except on E: Exception do begin LastError := -1; raise; // Redéclenche l'exception pour affichage: dans ce cas, la cause de l'erreur est mise en évidence end; end; //++ AfficherMessageErreur('Reponse GET: ' + FStrPostResponse); result := True; end; // avec fpJSON function TMyIGNWebService.POST_TraiterReponseIGN(): integer; var i, j, NbSubItems, NbFields: Integer; MyPoint : TPointLatLonAltAcc; JSONRoot, NodeSection, NodePoint: TJsonNode; begin result := 0; AfficherMsgClass(self, 'POST_TraiterReponseIGN()'); // ici, on peut virer le contenu de la liste initiale // on la recréera lors du parsing de la réponse JSON FListePointsATraiter.ClearListe(); JSONRoot := TJsonNode.Create; try try JSONRoot.LoadFromString(FStrPostResponse); AfficherMessageErreur('-- Chargement du JSON: %d sections', [JSONRoot.Count]); NodeSection := JSONRoot.Child(JSON_IGN_NODENAME_ELEVATIONS); if (NodeSection = nil) then raise Exception.CreateFmt('Section [%s] introuvable', [JSON_IGN_NODENAME_ELEVATIONS]); AfficherMessageErreur(' Node: %s - %d children', [ NodeSection.Name, NodeSection.Count]); if (NodeSection.Count = 0) then raise Exception.CreateFmt('Section [%s] found, but void', [JSON_IGN_NODENAME_ELEVATIONS]); for i := 0 to NodeSection.Count - 1 do begin NodePoint := NodeSection.Child(i); MyPoint.Longitude := NodePoint.Child(JSON_IGN_NODENAME_Lon).AsNumber; MyPoint.Latitude := NodePoint.Child(JSON_IGN_NODENAME_Lat).AsNumber; MyPoint.Altitude := NodePoint.Child(JSON_IGN_NODENAME_Alt).AsNumber; MyPoint.Accuracy := 0.00; //jSubItem.Items[3].AsFloat; FListePointsATraiter.AddElement(MyPoint); end; except on E: Exception do begin AfficherMessageErreur('*** ' + E.Message); exit(0); end; end; finally FreeAndNil(JSONRoot); end; // contrôle (* AfficherMessageErreur('%d points valides', [FListePointsATraiter.GetNbElements()]); for i := 0 to FListePointsATraiter.GetNbElements() - 1 do begin MyPoint := self.GetPointTraite(i);//self.FListePointsATraiter.GetElement(i); AfficherMessageErreur('+++ %d: %s', [i, MyPoint.DebugString('')]); end; //*) result := FListePointsATraiter.GetNbElements(); end; function TMyIGNWebService.GetNbPointsExtraits(): integer; begin result := FListePointsATraiter.GetNbElements(); end; function TMyIGNWebService.GetPointTraite(const Idx: integer): TPointLatLonAltAcc; begin result := FListePointsATraiter.GetElement(idx); end; function TMyIGNWebService.getNbRequestHeaders(): integer; begin result := FHTTP.RequestHeaders.Count; end; function TMyIGNWebService.GetPoint(const Idx: integer): TPointLatLonAltAcc; begin result := FListePointsATraiter.GetElement(Idx); end; procedure TMyIGNWebService.Finaliser(); begin try //FPOSTFormData.Clear; FListePointsATraiter.ClearListe(); FStrPostResponse := ''; finally FreeAndNil(FListePointsATraiter); //FreeAndNil(FPOSTFormData); //FreeAndNil(FPOSTInputJSON); //FreeAndNil(FHTTP); end; //*) end; end.