| |
| |
Ermittlung von Entfernungen und Geh-/Fahrzeiten- #24464 in section [744294] |
| Sec: |
(1) Allgemeines |
| Von: |
Ulf Neugebauer |
| An: |
Cyprian Kuschka |
| Am/Um: |
20.11.2025 11:27:14 gelesen |
Hallo Cyprian,
nur so als Anregung:
*******************************************************
* routing.prg
* Einfache Routing-Hilfsfunktionen für VFP
* nutzt OSRM (öffentlich oder lokal)
*******************************************************
*------------------------------------------------------
* Zentrale Wrapper-Funktion
* tnFromLat, tnFromLon : Startkoordinaten
* tnToLat, tnToLon : Zielkoordinaten
* tcMode: "CAR" / "FOOT" (case-insensitive)
*
* Rückgabe: Objekt mit Eigenschaften:
* .Success (l)
* .Mode (c)
* .Provider (c)
* .DistanceKm (n)
* .DurationMin (n)
* .RawJson (c)
* .ErrorMessage (c)
*------------------------------------------------------
FUNCTION Route_Get(tnFromLat, tnFromLon, tnToLat, tnToLon, tcMode)
LOCAL loResult, lcMode
loResult = CREATEOBJECT("Empty")
ADDPROPERTY(loResult, "Success", .F.)
ADDPROPERTY(loResult, "Mode", "")
ADDPROPERTY(loResult, "Provider", "OSRM")
ADDPROPERTY(loResult, "DistanceKm", -1)
ADDPROPERTY(loResult, "DurationMin", -1)
ADDPROPERTY(loResult, "RawJson", "")
ADDPROPERTY(loResult, "ErrorMessage", "")
IF VARTYPE(tcMode) <> "C"
tcMode = "CAR"
ENDIF
lcMode = UPPER(ALLTRIM(tcMode))
LOCAL lcProfile
DO CASE
CASE lcMode == "CAR"
lcProfile = "driving"
CASE lcMode == "FOOT"
* je nach OSRM-Setup evtl. "foot" oder "walking"
lcProfile = "foot"
OTHERWISE
loResult.ErrorMessage = "Unbekannter Modus: " + tcMode + " (erwartet: CAR oder FOOT)"
RETURN loResult
ENDCASE
* tatsächlicher Aufruf von OSRM
LOCAL loOsrm
loOsrm = GetRoute_OSRM(lcProfile, tnFromLat, tnFromLon, tnToLat, tnToLon)
loResult.RawJson = loOsrm.RawJson
loResult.DistanceKm = loOsrm.DistanceKm
loResult.DurationMin = loOsrm.DurationMin
IF loOsrm.DistanceKm >= 0 AND loOsrm.DurationMin >= 0
loResult.Success = .T.
loResult.Mode = lcMode
ELSE
loResult.Success = .F.
IF EMPTY(loOsrm.ErrorMessage)
loResult.ErrorMessage = "Route konnte nicht berechnet werden."
ELSE
loResult.ErrorMessage = loOsrm.ErrorMessage
ENDIF
ENDIF
RETURN loResult
ENDFUNC
*------------------------------------------------------
* OSRM-Routing (Basisfunktion)
* tnFromLat, tnFromLon, tnToLat, tnToLon: Koordinaten
* tcProfile: "driving", "foot", "cycling" etc.
*
* Rückgabe: Objekt mit:
* .DistanceKm
* .DurationMin
* .RawJson
* .ErrorMessage
*------------------------------------------------------
FUNCTION GetRoute_OSRM(tcProfile, tnFromLat, tnFromLon, tnToLat, tnToLon)
LOCAL loResult
loResult = CREATEOBJECT("Empty")
ADDPROPERTY(loResult, "DistanceKm", -1)
ADDPROPERTY(loResult, "DurationMin", -1)
ADDPROPERTY(loResult, "RawJson", "")
ADDPROPERTY(loResult, "ErrorMessage", "")
IF EMPTY(tcProfile)
tcProfile = "driving"
ENDIF
*--------------------------------------------------
* Basis-URL:
* öffentlich: http://router.project-osrm.org
* lokal: http://localhost:5000
*--------------------------------------------------
LOCAL lcBaseHost, lcBaseUrl, lcUrl
lcBaseHost = "http://router.project-osrm.org" && hier ggf. auf lokalen Server umstellen
lcBaseUrl = lcBaseHost + "/route/v1/" + tcProfile + "/"
* OSRM erwartet "lon,lat"
lcUrl = lcBaseUrl + ;
TRANSFORM(tnFromLon) + "," + TRANSFORM(tnFromLat) + ";" + ;
TRANSFORM(tnToLon) + "," + TRANSFORM(tnToLat) + ;
"?overview=false"
LOCAL lcJson
lcJson = HttpGet(lcUrl)
loResult.RawJson = lcJson
IF EMPTY(lcJson)
loResult.ErrorMessage = "Keine Antwort vom OSRM-Server."
RETURN loResult
ENDIF
*---------------------------------------------
* Quick & Dirty: "distance" und "duration" aus JSON lesen
*---------------------------------------------
LOCAL lnPos, lnPos2, lnDistance, lnDuration
* distance (Meter), erstes Vorkommen in "routes":[{"distance":...,
lnPos = AT('"distance":', lcJson)
IF lnPos > 0
lnPos = lnPos + LEN('"distance":')
lnPos2 = AT(",", SUBSTR(lcJson, lnPos))
IF lnPos2 > 0
lnDistance = VAL(SUBSTR(lcJson, lnPos, lnPos2-1))
ELSE
lnDistance = -1
ENDIF
ELSE
lnDistance = -1
ENDIF
* duration (Sekunden)
lnPos = AT('"duration":', lcJson)
IF lnPos > 0
lnPos = lnPos + LEN('"duration":')
lnPos2 = AT(",", SUBSTR(lcJson, lnPos))
IF lnPos2 > 0
lnDuration = VAL(SUBSTR(lcJson, lnPos, lnPos2-1))
ELSE
lnDuration = -1
ENDIF
ELSE
lnDuration = -1
ENDIF
IF lnDistance >= 0
loResult.DistanceKm = lnDistance / 1000.0
ENDIF
IF lnDuration >= 0
loResult.DurationMin = lnDuration / 60.0
ENDIF
RETURN loResult
ENDFUNC
*------------------------------------------------------
* HTTP GET-Helfer
*------------------------------------------------------
FUNCTION HttpGet(tcUrl, tcContentType)
LOCAL loHttp, lcResp
lcResp = ""
IF VARTYPE(tcContentType) <> "C" OR EMPTY(tcContentType)
tcContentType = "application/json"
ENDIF
loHttp = CREATEOBJECT("WinHttp.WinHttpRequest.5.1")
loHttp.Open("GET", tcUrl, .F.)
loHttp.SetRequestHeader("Content-Type", tcContentType)
TRY
loHttp.Send()
IF loHttp.Status = 200
lcResp = loHttp.ResponseText
ELSE
* hier könnte man loHttp.Status loggen
* MESSAGEBOX("HTTP-Fehler: " + TRANSFORM(loHttp.Status))
ENDIF
CATCH
* Fehler beim HTTP-Aufruf – lcResp bleibt leer
ENDTRY
RETURN lcResp
ENDFUNC
*--------------------------------------------------------------------
* Beispiel Leipzig -> Berlin, PKW
LOCAL loRoute
loRoute = Route_Get( ;
51.3397, 12.3731, ; && Start
52.5200, 13.4050, ; && Ziel
"CAR" && oder "FOOT"
)
IF loRoute.Success
? "Entfernung (km): " + TRANSFORM(loRoute.DistanceKm, "999,999.99")
? "Dauer (min): " + TRANSFORM(loRoute.DurationMin, "999,999.99")
ELSE
? "Fehler: " + loRoute.ErrorMessage
ENDIF
Beste Grüße
Fox on The Run (The Sweet)
|
|
|
|
