GPSログ(GPXファイル)を接続するツール(スクリプト)です。必要なのはWindowsの標準テキストエディタであるメモ帳だけ、他の特別なソフトは不要です。
このスクリプトは2つのGPXファイルのトラックポイントを時間で並べ替えており、前後にルート(トラック)を接続するだけでなく”中抜け”のルートを挿入することもできます。
使い方は、2つのGPXファイルをスクリプトのアイコンにドラッグ&ドロップするだけです。ドロップした元ファイルはそのままで、新たに接続したファイルを作ります。
このスクリプトは2つのGPXファイルのトラックポイントを時間で並べ替えており、前後にルート(トラック)を接続するだけでなく”中抜け”のルートを挿入することもできます。
使い方は、2つのGPXファイルをスクリプトのアイコンにドラッグ&ドロップするだけです。ドロップした元ファイルはそのままで、新たに接続したファイルを作ります。
ヤマノート「手書きGPXファイルの時間変更 & GPSログの欠落補完」(http://www.yamareco.com/modules/yamanote/detail.php?nid=1808) に書いたテキストエディタによるGPXファイルの接続/補完は、膨大な行数を扱うし、補完する場合トラックポイントの場所を探すのが厄介です。そこで、スクリプトで自動的に処理するようにしたものです。
ヤマレコのルート登録では複数のPGXファイルが登録できるのでGPSログが1つでなくても特に問題はありませんが、1つにまとめたい場合もあるかと思います。そんな時にも使えます。
大抵のGPXファイルに使えますが中に使えないものあります。トラックポイント(<trkptから</trkpt>まで)毎に改行されていないGPXファイルでは動きません。
スクリプトはWindowsに標準で搭載されているVBScriptで書いており、WindowsXP、7、8、10のいずれでも動くと思います。PCによってはVBScriptが動かない場合もあるかも知れません。その場合はWindows Script Hostをマイクロソフトのサイトからインストールする必要があります。
ヤマレコのルート登録では複数のPGXファイルが登録できるのでGPSログが1つでなくても特に問題はありませんが、1つにまとめたい場合もあるかと思います。そんな時にも使えます。
大抵のGPXファイルに使えますが中に使えないものあります。トラックポイント(<trkptから</trkpt>まで)毎に改行されていないGPXファイルでは動きません。
スクリプトはWindowsに標準で搭載されているVBScriptで書いており、WindowsXP、7、8、10のいずれでも動くと思います。PCによってはVBScriptが動かない場合もあるかも知れません。その場合はWindows Script Hostをマイクロソフトのサイトからインストールする必要があります。
1.準備(vbsスクリプトの作成)
作成したvbsスクリプトは繰り返し使えますので、この作業は1回だけです。
メモ帳(別なテキストエディタを使っている場合は、それを使って)を開き、'---------スクリプト・・・-------以下の全てをコピペします。(最初が 「'」で始まっている行はコメントなので省いても大丈夫です。)
次にメモ帳のコマンド「編集(E)」「置換(R)」で「<」を全て「<」に置き換えてください。
(全角から半角に変更します。半角のままでノートに書くと、タグと判断されてスクリプトが正常に表示されない部分があるので全角にしているためです。)
適当に名前をつけて(半角英数を推奨します)、文字ードをANSIかUTF16-LEで保存し、ファイルの拡張子を「.txt」から「.vbs」に代えるとアイコンが画像2のようになります。拡張子を変更しようとすると「ファイルが使えなくなる可能性がある」というメッセージが出ますが、気にせずに変更してOKです。
作成した ***.vbs のアイコンをダブルクリックして「GPXファイルをドロップしてください。」というメッセージが出れば準備は完了です。
もしエラーメッセージが出た場合は、拡張子を「.txt」に戻し、下記の語句を、それぞれ半角英数字で()内の例のような英語表記か適当なローマ字に置き換えて再度保存し、やり直してみてください。この場合はメモ帳のデフォルトであるUTF-8保存しても大丈夫だと思いますが、ANSIかUTF16-LEで保存した方が無難です。
GPXファイル接続 (GPX file nesting)
GPXファイルをドロップしてください (Drop the GPX file.)
ファイルが一つです (Only One file.)
ファイル以外がドロップされました (Non-file dropped.)
GPXファイル以外がドロップされました (Not GPX file was dropped.)
どちらのファイルのヘッダーを使いますか? (Which files header?)
同名のファイルがあります。上書きしますか? (Same name file is existing. Overwrite?)
終了しました (Finished)
メモ帳でない他のエディタを使っていて、ファイル保存時に文字コードの指定がある場合は、SJISI(Shift-JIS)かANSIで保存してください。
* WSH(Windows Script Host)のVBSは古いシステムであるため、2バイト文字コードでエラーになる場合があります。Windows 10 Ver.1903のアップデート時に、メモ帳のデフォルト文字コードがANSIからUTF-8に変更され、それ以後スクリプトがエラーになる現象が発生している考えられるので、記述を変更しました。【2020/05/28】
メモ帳(別なテキストエディタを使っている場合は、それを使って)を開き、'---------スクリプト・・・-------以下の全てをコピペします。(最初が 「'」で始まっている行はコメントなので省いても大丈夫です。)
次にメモ帳のコマンド「編集(E)」「置換(R)」で「<」を全て「<」に置き換えてください。
(全角から半角に変更します。半角のままでノートに書くと、タグと判断されてスクリプトが正常に表示されない部分があるので全角にしているためです。)
適当に名前をつけて(半角英数を推奨します)、文字ードをANSIかUTF16-LEで保存し、ファイルの拡張子を「.txt」から「.vbs」に代えるとアイコンが画像2のようになります。拡張子を変更しようとすると「ファイルが使えなくなる可能性がある」というメッセージが出ますが、気にせずに変更してOKです。
作成した ***.vbs のアイコンをダブルクリックして「GPXファイルをドロップしてください。」というメッセージが出れば準備は完了です。
もしエラーメッセージが出た場合は、拡張子を「.txt」に戻し、下記の語句を、それぞれ半角英数字で()内の例のような英語表記か適当なローマ字に置き換えて再度保存し、やり直してみてください。この場合はメモ帳のデフォルトであるUTF-8保存しても大丈夫だと思いますが、ANSIかUTF16-LEで保存した方が無難です。
GPXファイル接続 (GPX file nesting)
GPXファイルをドロップしてください (Drop the GPX file.)
ファイルが一つです (Only One file.)
ファイル以外がドロップされました (Non-file dropped.)
GPXファイル以外がドロップされました (Not GPX file was dropped.)
どちらのファイルのヘッダーを使いますか? (Which files header?)
同名のファイルがあります。上書きしますか? (Same name file is existing. Overwrite?)
終了しました (Finished)
メモ帳でない他のエディタを使っていて、ファイル保存時に文字コードの指定がある場合は、SJISI(Shift-JIS)かANSIで保存してください。
* WSH(Windows Script Host)のVBSは古いシステムであるため、2バイト文字コードでエラーになる場合があります。Windows 10 Ver.1903のアップデート時に、メモ帳のデフォルト文字コードがANSIからUTF-8に変更され、それ以後スクリプトがエラーになる現象が発生している考えられるので、記述を変更しました。【2020/05/28】
拡張子が表示されない設定になっている場合は、保存したファイルのアイコンを右クリックしてプロパティを表示すれば、そこで拡張子を変更できます。アイコンが変化しない場合はWindows Script Hostがインストールされていない可能性が高いです。
2.使い方
使い方と言っても、2つのファイルをスクリプトのアイコンにドラッグ&ドロップするだけです。
ファイルを2つ選択するには1つ目のファイルで左クリックしたら「ctrl」キーを押しながら2つ目のファイルを左クリックします。ファイルが並んでいるいる場合は、どちらかのファイルのアイコンの横でマウスの右ボタンを押して、そのままマウスを2つ目のファイルのアイコンに移動すれば選択できます。
選択したファイルをスクリプトのアイコンに持って行きドロップすると、どちらのファイルのヘッダーを使うか聞いてきますので、1か2を選択します。(2以外の文字を入れると自動的に1が選択されます)
終了のメッセージが出ればスクリプトの置いてあるフォルダに2つのファイル名が繋がったファイルが出来ています。
GPXファイルが大きいと、少し時間がかかる事もありますが、長くても数秒〜数十秒で終わると思います。もし、ずっと終わらないようであれば、GPXファイルのフォーマット違いやエラー等でスクリプトが動作停止している可能性があります。
そのような時はWindowsのタスクマネージャーを立ち上げて、図2のようなマークのついたタスク(Microsoft ®Windows Based Script Host)を選択し、「タスクの終了(E)」を押してスクリプトを止めて下さい。
(タスクマネージャーは、ツールバーの上で右クリックして出てくるコマンドリストの中にあります)
2つ以上のGPXファイルを接続したい場合は、2つのGPXファイルを接続して、そのファイルと更に接続したいGPXファイルを接続してください。
ファイルを2つ選択するには1つ目のファイルで左クリックしたら「ctrl」キーを押しながら2つ目のファイルを左クリックします。ファイルが並んでいるいる場合は、どちらかのファイルのアイコンの横でマウスの右ボタンを押して、そのままマウスを2つ目のファイルのアイコンに移動すれば選択できます。
選択したファイルをスクリプトのアイコンに持って行きドロップすると、どちらのファイルのヘッダーを使うか聞いてきますので、1か2を選択します。(2以外の文字を入れると自動的に1が選択されます)
終了のメッセージが出ればスクリプトの置いてあるフォルダに2つのファイル名が繋がったファイルが出来ています。
GPXファイルが大きいと、少し時間がかかる事もありますが、長くても数秒〜数十秒で終わると思います。もし、ずっと終わらないようであれば、GPXファイルのフォーマット違いやエラー等でスクリプトが動作停止している可能性があります。
そのような時はWindowsのタスクマネージャーを立ち上げて、図2のようなマークのついたタスク(Microsoft ®Windows Based Script Host)を選択し、「タスクの終了(E)」を押してスクリプトを止めて下さい。
(タスクマネージャーは、ツールバーの上で右クリックして出てくるコマンドリストの中にあります)
2つ以上のGPXファイルを接続したい場合は、2つのGPXファイルを接続して、そのファイルと更に接続したいGPXファイルを接続してください。
3.接続したGPXファイルの確認
メモ帳等のテキストエディタで接続後のGPXファイルを開き、最初の1行目が「<?xml」で始まっていたら、そのままファイルを閉じて終了、次回からこの確認は不要です。
もし「・ソ<?xml」のように、他の文字で始まっていたら「・ソ」を削除して上書き保存します。「・ソ」以外の文字がある場合も同じで、この作業は毎回必要になります。
*「<?xml」の前の文字はBOMコードといって、Windowsのファイル識別の為の物です。ヤマレコのシステムではBOMが入っていると正常なGPXファイルとして認識されません。
もし「・ソ<?xml」のように、他の文字で始まっていたら「・ソ」を削除して上書き保存します。「・ソ」以外の文字がある場合も同じで、この作業は毎回必要になります。
*「<?xml」の前の文字はBOMコードといって、Windowsのファイル識別の為の物です。ヤマレコのシステムではBOMが入っていると正常なGPXファイルとして認識されません。
4.スクリプト
'---------スクリプト GPXファイルの接続 V1.1 2016-12-03 ---------
Option explicit
Const strTitl = "GPXファイル接続"
Select Case WScript.Arguments.Count
Case 0
MsgBox "GPXファイルをドロップしてください",,strTitl
WScript.Quit
Case 1
MsgBox "ファイルが一つです",,strTitl
WScript.Quit
Case Else
strArg1 = WScript.Arguments(0)
strArg2 = WScript.Arguments(1)
End Select
'スクリプトのあるフォルダを作業フォルダにしてFileSystemObjectの取得
Dim strScriptPath, objFSO, objDrpFile1, objDrpFile2, strArg1, strArg2
strScriptPath = Replace( Wscript.ScriptFullName, Wscript.ScriptName, "")
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strArg1) And objFSO.FileExists(strArg2) Then
On Error Resume Next
Set objDrpFile1 = objFSO.GetFile(strArg1)
Set objDrpFile2 = objFSO.GetFile(strArg2)
If Err.Number <> 0 Then
Set objDrpFile1 = Nothing
Set objDrpFile2 = Nothing
End If
On Error Goto 0
Else
Set objDrpFile1 = Nothing
Set objDrpFile2 = Nothing
End If
If (objDrpFile1 Is Nothing) or (objDrpFile2 Is Nothing) Then
MsgBox "ファイル以外がドロップされました",,strTitl
WScript.Quit '終了
End If
Dim objInFile1, objInFile2, objOutFile, strInFilePath, strOutFilePath
Set objInFile1 = objFSO.OpenTextFile(objDrpFile1.Path, 1)
Set objInFile2 = objFSO.OpenTextFile(objDrpFile2.Path, 1)
Dim strFilName1, strFilName2, intFID
Dim intI, intJ, intK, strBuf0, strBuf1, strBuf2
intI = 0: intJ = 0: intK = 0
For intI = 1 to 3
strBuf1 = objInFile1.ReadLine
strBuf2 = objInFile2.ReadLine
If InStr(strBuf1, "gpx") <> 0 Then intJ = 1
If InStr(strBuf2, "gpx") <> 0 Then intK = 1
Next
objInFile1.Close
objInFile2.Close
If (intJ <> 1) Or (intK <> 1) Then
MsgBox "GPXファイル以外がドロップされました",,strTitl
WScript.Quit '終了
End if
'出力ファイル準備
strFilName1 = objFSO.GetBaseName(objDrpFile1.Name) & "." & objFSO.GetExtensionName(objDrpFile1)
strFilName2 = objFSO.GetBaseName(objDrpFile2.Name) & "." & objFSO.GetExtensionName(objDrpFile2)
On Error Resume next
intFID = InputBox("どちらのファイルのヘッダーを使いますか?" &vbCrLf&vbCrLf& " 1 = "&strFilName1 &vbCrLf&vbCrLf& " 2 = "&strFilName2 ,strTitl, "1")
If intFID = 1 Then
Set objInFile1 = objFSO.OpenTextFile(objDrpFile1.Path, 1)
Set objInFile2 = objFSO.OpenTextFile(objDrpFile2.Path, 1)
strOutFilePath = strScriptPath & objFSO.GetBaseName(objDrpFile1.Name) &"-"& objFSO.GetBaseName(objDrpFile2.Name) &".gpx"
Else
Set objInFile1 = objFSO.OpenTextFile(objDrpFile2.Path, 1)
Set objInFile2 = objFSO.OpenTextFile(objDrpFile1.Path, 1)
strOutFilePath = strScriptPath & objFSO.GetBaseName(objDrpFile2.Name) &"-"& objFSO.GetBaseName(objDrpFile1.Name) &".gpx"
End If
On Error Goto 0
If objFSO.FileExists(strOutFilePath) Then '同名ファイルがあったら抹消
If MsgBox ("同名のファイルがあります。上書きしますか?", vbYESNO,strTitl) = vbNO Then
objInFile1.Close
objInFile2.Close
Wscript.Quit
End If
objFSO.DeleteFile(strOutFilePath)
End If
Set objOutFile = objFSO.OpenTextFile(strOutFilePath, 8, True, 0)
'========= File marge Start ========
Dim intTimbgn, intTimEnd, strTim1, strTim2
Dim strTrkEnd1, strTrkEnd2
'ヘッダを出力ファイルにコピーして最初のtrkptを読み込む
Do
strBuf1 = ObjInFile1.ReadLine
'UTF-8文字化け対策(End Ifまで3行) V1.1 2016-12-03
If InStr(strBuf1, "<name>") And InStr(strBuf1, "</name>") = 0 Then
strBuf1 = Replace(strBuf1, "/name", "</name")
End If
objOutFile.WriteLine strBuf1
Loop Until InStr(strBuf1, "<trkseg>")
Do
strBuf2 = ObjInFile2.ReadLine
Loop Until InStr(strBuf2, "<trkseg>")
strBuf1 = ObjInFile1.ReadLine : strBuf2 = ObjInFile2.ReadLine
'<trkptから</trkpt>までが分割されていたら1行にする
If InStr(strBuf1, "</trkpt>") = 0 Then
Do
strBuf1 = strBuf1 & ObjInFile1.ReadLine
Loop Until InStr(strBuf1, "</trkpt>")
End If
If InStr(strBuf2, "</trkpt>") = 0 Then
Do
strBuf2 = strBuf2 & ObjInFile2.ReadLine
Loop Until InStr(strBuf2, "</trkpt>")
End If
'trktp毎に時間を比較して早い方を出力するループ
Do
intTimbgn = InStr(strBuf1, "<time>"): intTimEnd = InStr(strBuf1, "</time>")
strTim1 = Mid(strBuf1, intTimbgn + 6, intTimEnd - intTimbgn - 6)
intTimbgn = InStr(strBuf2, "<time>"): intTimEnd = InStr(strBuf2, "</time>")
strTim2 = Mid(strBuf2, intTimbgn + 6, intTimEnd - intTimbgn - 6)
strTim1 = Replace(strTim1, "T", " "): strTim2 = Replace(strTim2, "T", " "):
strTim1 = Replace(strTim1, "Z", ""): strTim2 = Replace(strTim2, "Z", ""):
If DateDiff("s", strTim1, strTim2) < 1 Then
Call File2_WandR
Else
Call File1_WandR
End If
Loop Until InStr(strTrkEnd1, "</trkseg>") Or InStr(strTrkEnd2, "</trkseg>")
'どちらかのファイルが</trkseg>に達していれば、もう一方を最後まで出力する
If InStr(strTrkEnd1, "</trkseg>") and InStr(strTrkEnd2, "</trkseg>")=0 Then
Do
Call File2_WandR
Loop Until InStr(strTrkEnd2, "</trkseg>")
End If
If InStr(strTrkEnd2, "</trkseg>") and InStr(strTrkEnd1, "</trkseg>")=0 Then
Do
Call File1_WandR
Loop Until InStr(strTrkEnd1, "</trkseg>")
End If
'フッターを出力
objOutFile.WriteLine "</trkseg></trk>"
objOutFile.WriteLine "</gpx>"
objOutFile.Close
objInFile1.Close
objInFile2.Close
MsgBox "終了しました",,strTitl
WScript.Quit '終了
'==================== Subroutine ==========================
'strBufを書き出して、次のtrkptを読む、<trkptから</trkpt>までが分割されていれば1行にする
Sub File1_WandR
objOutFile.WriteLine strBuf1
strBuf0 = ObjInFile1.ReadLine
If InStr(strBuf0,"</trkseg>") Then
strTrkEnd1 = strBuf0
Else
If InStr(strBuf0,"<trkpt") Then
strBuf1 = strBuf0
If InStr(strBuf1, "</trkpt>") = 0 Then
Do
strBuf1 = strBuf1 & ObjInFile1.ReadLine
Loop Until InStr(strBuf1, "</trkpt>")
End If
End If
End If
End Sub
Sub File2_WandR
objOutFile.WriteLine strBuf2
strBuf0 = ObjInFile2.ReadLine
If InStr(strBuf0,"</trkseg>") Then
strTrkEnd2 = strBuf0
Else
If InStr(strBuf0,"<trkpt") Then
strBuf2 = strBuf0
If InStr(strBuf2, "</trkpt>") = 0 Then
Do
strBuf2 = strBuf2 & ObjInFile2.ReadLine
Loop Until InStr(strBuf2, "</trkpt>")
End If
End If
End If
End Sub
Option explicit
Const strTitl = "GPXファイル接続"
Select Case WScript.Arguments.Count
Case 0
MsgBox "GPXファイルをドロップしてください",,strTitl
WScript.Quit
Case 1
MsgBox "ファイルが一つです",,strTitl
WScript.Quit
Case Else
strArg1 = WScript.Arguments(0)
strArg2 = WScript.Arguments(1)
End Select
'スクリプトのあるフォルダを作業フォルダにしてFileSystemObjectの取得
Dim strScriptPath, objFSO, objDrpFile1, objDrpFile2, strArg1, strArg2
strScriptPath = Replace( Wscript.ScriptFullName, Wscript.ScriptName, "")
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strArg1) And objFSO.FileExists(strArg2) Then
On Error Resume Next
Set objDrpFile1 = objFSO.GetFile(strArg1)
Set objDrpFile2 = objFSO.GetFile(strArg2)
If Err.Number <> 0 Then
Set objDrpFile1 = Nothing
Set objDrpFile2 = Nothing
End If
On Error Goto 0
Else
Set objDrpFile1 = Nothing
Set objDrpFile2 = Nothing
End If
If (objDrpFile1 Is Nothing) or (objDrpFile2 Is Nothing) Then
MsgBox "ファイル以外がドロップされました",,strTitl
WScript.Quit '終了
End If
Dim objInFile1, objInFile2, objOutFile, strInFilePath, strOutFilePath
Set objInFile1 = objFSO.OpenTextFile(objDrpFile1.Path, 1)
Set objInFile2 = objFSO.OpenTextFile(objDrpFile2.Path, 1)
Dim strFilName1, strFilName2, intFID
Dim intI, intJ, intK, strBuf0, strBuf1, strBuf2
intI = 0: intJ = 0: intK = 0
For intI = 1 to 3
strBuf1 = objInFile1.ReadLine
strBuf2 = objInFile2.ReadLine
If InStr(strBuf1, "gpx") <> 0 Then intJ = 1
If InStr(strBuf2, "gpx") <> 0 Then intK = 1
Next
objInFile1.Close
objInFile2.Close
If (intJ <> 1) Or (intK <> 1) Then
MsgBox "GPXファイル以外がドロップされました",,strTitl
WScript.Quit '終了
End if
'出力ファイル準備
strFilName1 = objFSO.GetBaseName(objDrpFile1.Name) & "." & objFSO.GetExtensionName(objDrpFile1)
strFilName2 = objFSO.GetBaseName(objDrpFile2.Name) & "." & objFSO.GetExtensionName(objDrpFile2)
On Error Resume next
intFID = InputBox("どちらのファイルのヘッダーを使いますか?" &vbCrLf&vbCrLf& " 1 = "&strFilName1 &vbCrLf&vbCrLf& " 2 = "&strFilName2 ,strTitl, "1")
If intFID = 1 Then
Set objInFile1 = objFSO.OpenTextFile(objDrpFile1.Path, 1)
Set objInFile2 = objFSO.OpenTextFile(objDrpFile2.Path, 1)
strOutFilePath = strScriptPath & objFSO.GetBaseName(objDrpFile1.Name) &"-"& objFSO.GetBaseName(objDrpFile2.Name) &".gpx"
Else
Set objInFile1 = objFSO.OpenTextFile(objDrpFile2.Path, 1)
Set objInFile2 = objFSO.OpenTextFile(objDrpFile1.Path, 1)
strOutFilePath = strScriptPath & objFSO.GetBaseName(objDrpFile2.Name) &"-"& objFSO.GetBaseName(objDrpFile1.Name) &".gpx"
End If
On Error Goto 0
If objFSO.FileExists(strOutFilePath) Then '同名ファイルがあったら抹消
If MsgBox ("同名のファイルがあります。上書きしますか?", vbYESNO,strTitl) = vbNO Then
objInFile1.Close
objInFile2.Close
Wscript.Quit
End If
objFSO.DeleteFile(strOutFilePath)
End If
Set objOutFile = objFSO.OpenTextFile(strOutFilePath, 8, True, 0)
'========= File marge Start ========
Dim intTimbgn, intTimEnd, strTim1, strTim2
Dim strTrkEnd1, strTrkEnd2
'ヘッダを出力ファイルにコピーして最初のtrkptを読み込む
Do
strBuf1 = ObjInFile1.ReadLine
'UTF-8文字化け対策(End Ifまで3行) V1.1 2016-12-03
If InStr(strBuf1, "<name>") And InStr(strBuf1, "</name>") = 0 Then
strBuf1 = Replace(strBuf1, "/name", "</name")
End If
objOutFile.WriteLine strBuf1
Loop Until InStr(strBuf1, "<trkseg>")
Do
strBuf2 = ObjInFile2.ReadLine
Loop Until InStr(strBuf2, "<trkseg>")
strBuf1 = ObjInFile1.ReadLine : strBuf2 = ObjInFile2.ReadLine
'<trkptから</trkpt>までが分割されていたら1行にする
If InStr(strBuf1, "</trkpt>") = 0 Then
Do
strBuf1 = strBuf1 & ObjInFile1.ReadLine
Loop Until InStr(strBuf1, "</trkpt>")
End If
If InStr(strBuf2, "</trkpt>") = 0 Then
Do
strBuf2 = strBuf2 & ObjInFile2.ReadLine
Loop Until InStr(strBuf2, "</trkpt>")
End If
'trktp毎に時間を比較して早い方を出力するループ
Do
intTimbgn = InStr(strBuf1, "<time>"): intTimEnd = InStr(strBuf1, "</time>")
strTim1 = Mid(strBuf1, intTimbgn + 6, intTimEnd - intTimbgn - 6)
intTimbgn = InStr(strBuf2, "<time>"): intTimEnd = InStr(strBuf2, "</time>")
strTim2 = Mid(strBuf2, intTimbgn + 6, intTimEnd - intTimbgn - 6)
strTim1 = Replace(strTim1, "T", " "): strTim2 = Replace(strTim2, "T", " "):
strTim1 = Replace(strTim1, "Z", ""): strTim2 = Replace(strTim2, "Z", ""):
If DateDiff("s", strTim1, strTim2) < 1 Then
Call File2_WandR
Else
Call File1_WandR
End If
Loop Until InStr(strTrkEnd1, "</trkseg>") Or InStr(strTrkEnd2, "</trkseg>")
'どちらかのファイルが</trkseg>に達していれば、もう一方を最後まで出力する
If InStr(strTrkEnd1, "</trkseg>") and InStr(strTrkEnd2, "</trkseg>")=0 Then
Do
Call File2_WandR
Loop Until InStr(strTrkEnd2, "</trkseg>")
End If
If InStr(strTrkEnd2, "</trkseg>") and InStr(strTrkEnd1, "</trkseg>")=0 Then
Do
Call File1_WandR
Loop Until InStr(strTrkEnd1, "</trkseg>")
End If
'フッターを出力
objOutFile.WriteLine "</trkseg></trk>"
objOutFile.WriteLine "</gpx>"
objOutFile.Close
objInFile1.Close
objInFile2.Close
MsgBox "終了しました",,strTitl
WScript.Quit '終了
'==================== Subroutine ==========================
'strBufを書き出して、次のtrkptを読む、<trkptから</trkpt>までが分割されていれば1行にする
Sub File1_WandR
objOutFile.WriteLine strBuf1
strBuf0 = ObjInFile1.ReadLine
If InStr(strBuf0,"</trkseg>") Then
strTrkEnd1 = strBuf0
Else
If InStr(strBuf0,"<trkpt") Then
strBuf1 = strBuf0
If InStr(strBuf1, "</trkpt>") = 0 Then
Do
strBuf1 = strBuf1 & ObjInFile1.ReadLine
Loop Until InStr(strBuf1, "</trkpt>")
End If
End If
End If
End Sub
Sub File2_WandR
objOutFile.WriteLine strBuf2
strBuf0 = ObjInFile2.ReadLine
If InStr(strBuf0,"</trkseg>") Then
strTrkEnd2 = strBuf0
Else
If InStr(strBuf0,"<trkpt") Then
strBuf2 = strBuf0
If InStr(strBuf2, "</trkpt>") = 0 Then
Do
strBuf2 = strBuf2 & ObjInFile2.ReadLine
Loop Until InStr(strBuf2, "</trkpt>")
End If
End If
End If
End Sub
お気に入りした人
人
拍手で応援
拍手した人
拍手
guchi999さんの記事一覧
- 国土地理院地図の登山道や道路をGPXファイルにする 33 更新日:2024年03月12日
- 地理院地図の等倍印刷 59 更新日:2023年05月09日
- Google マップの活用(ログの3D表示、計画ルート作成) 31 更新日:2023年04月06日
※この記事はヤマレコの「ヤマノート」機能を利用して作られています。
どなたでも、山に関する知識や技術などのノウハウを簡単に残して共有できます。
ぜひご協力ください!
コメントを編集
いいねした人
コメントを書く
ヤマレコにユーザー登録いただき、ログインしていただくことによって、コメントが書けるようになります。ヤマレコにユーザ登録する