また山に行きたくなる。山の記録を楽しく共有できる。

Yamareco

HOME > ヤマノート > GPXファイルの日時シフトツール(Windows PC用)
更新日:2020年05月07日 訪問者数:420
ジャンル共通 IT
GPXファイルの日時シフトツール(Windows PC用)
kfd01567
GPXファイルの日時シフトツール(Windows PC用)
ルートファイル(GPXファイル)の日時を過去の日時や未来の日時に変更するVBスクリプトです。例えば「登山開始(2019/01/08 08:30)〜登山終了(2019/01/08 15:00)」というGPXファイルを元に「登山開始(2020/02/20 09:00)〜登山終了(2020/02/20 15:30)」といったGPXファイルを生成することができます。
利用シーンとして今回の登山ではGPSログを取っていないが過去に同じコースを概ね同じペースで登ったことがあり、その際のGPXファイルを元に写真の自動配置などを行う場合などです。
カシミールにも同様の機能がありますが、カシミールで編集を行うとGPXファイルに含まれる拡張情報(ケイデンスなど)が保持されない、差分の"秒"を指定する必要がある、など私にとっては少し使い辛かったためスクリプト化しました。

なおスクリプトは本ページの「'---------スクリプト 〜」の行から「Call Main」の行までです。内容を元に拡張子vbsのスクリプトファイルを作成してください。その後スクリプトに含まれている全角の<を半角の<にすべて置き換えてください(6か所あります)。
スクリプトにGPXファイルを与えて起動しますと、変更前の登山開始日時(例:2019/01/08 08:30)が表示されますので、変更後の登山開始日時(例:2020/02/20 09:00)に書き換えてください。するとxxxx_Change.gpxという新たなファイルが生成されます。

今回のスクリプト化にあたっては「guchi999」さんのVBスクリプトを参考にさせて頂きました。この場をお借りしてお礼申し上げます。m(__)m
スクリプトファイルの詳細な作成方法、起動方法などは「guchi999」さんのヤマノートを参考にして頂ければと思います(本ページ末尾にリンク記載しています)。
起動方法
スクリプト
'-----------スクリプト GPXファイルの時間シフト 2020/04/19 v1.0 --------------------------

Option Explicit
Const strTitl = "GPX時間シフト"
Const intTC = -9 '標準時間係数 グリニッジ標準時は-9, 日本ローカル時間は0

Function getFormatNum(inOrg)
If inOrg < 10 Then
getFormatNum = "0" & CStr(inOrg)
Else
getFormatNum = CStr(inOrg)
End If
End Function

Sub checkErr()
If Err.Number = 0 Then Exit Sub
MsgBox "エラーが発生しました。処理を中止します。(" & Err.Description & ")", , strTitl
WScript.Quit '終了
End Sub

Sub Main()
Dim strScriptPath, objFSO, strArg, objDrpFile, strBuf
Dim intI, intJ

If WScript.Arguments.Count = 0 Then
MsgBox "GPXファイルをドロップしてください。", , strTitl
WScript.Quit
End If

'スクリプトのあるフォルダを作業フォルダにしてFileSystemObjectの取得
strScriptPath = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
strArg = WScript.Arguments(0)
If Not objFSO.FileExists(strArg) Then
MsgBox "ドロップされたのはファイルではありません。", , strTitl
WScript.Quit '終了
End If

'入力ファイルを全行読み込みバッファに格納
On Error Resume Next
Set objDrpFile = CreateObject("ADODB.Stream")
checkErr()
With objDrpFile
.Type = 2
.Charset = "UTF-8"
.Open
.LoadFromFile strArg
checkErr()
'改行コードがLf(Stravaなど)またはCrLf(カシミールなど)のいずれにも対応
'するため全行読み込む
strBuf = .ReadText(-1)
checkErr()
.Close
End With
On Error GoTo 0

'先頭から開始日時<time>を探す
intJ = 0
intI = InStr(strBuf, "<trkseg")
If intI > 0 Then
intJ = InStr(intI, strBuf, "<time>") 'trksegの直後のtimeが開始日時
End If
If intJ = 0 Then
MsgBox "ドロップされたのはGPXファイルではありません。", , strTitl
WScript.Quit '終了
End If

'修正後の日時の入力UI表示する 既定値には修正前の値を表示する
Dim strStrTimInit, longDiffSeconds
Dim strStrTim, strDate, dateValue, strNewDateTime, strNewBuf

strStrTimInit = Mid(strBuf, intJ + 6, 19)
strStrTimInit = Replace(strStrTimInit, "T", " ")
strStrTimInit = DateAdd("h", intTC * -1, strStrTimInit)

strDate = InputBox("修正後の出発日付を入力 (yyyy-mm-dd)", strTitl, Mid(strStrTimInit, 1, 10))
If IsEmpty(strDate) Then
WScript.Quit
End If
strStrTim = InputBox("修正後の出発時間を入力 (hh:mm:ss)", strTitl, Mid(strStrTimInit, 12, 8))
If IsEmpty(strStrTim) Then
WScript.Quit
End If
strStrTim = strDate & " " & strStrTim
If InStr(strStrTim, ":") = 0 Then strStrTim = strStrTim & " 00:00:00"
On Error Resume Next
longDiffSeconds = DateDiff("s", strStrTimInit, strStrTim)
checkErr()
On Error GoTo 0
If longDiffSeconds = 0 Then
MsgBox "修正前と修正後は異なる日時を指定してください。", , strTitl
WScript.Quit '終了
End If

'出力ファイル準備
Dim strOutFilePath
With objFSO
strOutFilePath = strScriptPath + .GetBaseName(strArg) + "_Change.gpx"
If .FileExists(strOutFilePath) Then
If MsgBox("同名のファイルがあります。上書きしますか?", vbYesNo, strTitl) = vbNo Then
WScript.Quit
End If
.DeleteFile (strOutFilePath)
End If
End With

'時間シフト処理
Dim iProcTime
iProcTime = Timer
intJ = InStr(strBuf, "<time>") 'ヘッダ部分のtimeも変更するため先頭から検索
strNewBuf = Left(strBuf, intJ + 5)
Do While True
strStrTim = Mid(strBuf, intJ + 6, 19)
strStrTim = Replace(strStrTim, "T", " ")
dateValue = DateAdd("s", longDiffSeconds, strStrTim)
strNewDateTime = DatePart("yyyy", dateValue) & "-" & getFormatNum(DatePart("m", dateValue)) & "-" & getFormatNum(DatePart("d", dateValue)) & "T" & getFormatNum(DatePart("h", dateValue)) & ":" & getFormatNum(DatePart("n", dateValue)) & ":" & getFormatNum(DatePart("s", dateValue)) & "Z"
strNewBuf = strNewBuf & strNewDateTime
intI = InStr(intJ + 26, strBuf, "<time>")
If intI = 0 Then
Exit Do
End If
strNewBuf = strNewBuf & Mid(strBuf, intJ + 26, intI - (intJ + 20))
intJ = intI
Loop
strNewBuf = strNewBuf & Mid(strBuf, intJ + 26)

'出力ファイル作成
Dim objOutFile
Set objOutFile = CreateObject("ADODB.Stream")
With objOutFile
.Type = 2
.Charset = "UTF-8"
.Open
.WriteText strNewBuf, 0

'出力ファイルのBOM除去
.Position = 0 '先頭にSeek
.Type = 1 'バイナリ形式に変更
.Position = 3 '位置を3バイト分移動
strNewBuf = .Read
.Position = 0
.Write strNewBuf
.SetEOS
.SaveToFile strOutFilePath, 2
.Close
End With
iProcTime = Timer - iProcTime
MsgBox "終了しました。[処理時間:" & iProcTime & "秒]", , strTitl
WScript.Quit
End Sub

Call Main
参考
お気に入り登録-
拍手した人-
訪問者数:420人

kfd01567さんの記事一覧

※この記事はヤマレコの「ヤマノート」機能を利用して作られています。
どなたでも、山に関する知識や技術などのノウハウを簡単に残して共有できます。 ぜひご協力ください!

詳しくはこちら

コメントを書く

ヤマレコにユーザー登録いただき、ログインしていただくことによって、コメントが書けるようになります。
ヤマレコにユーザ登録する

この記録へのコメント

まだコメントはありません
ページの先頭へ