Option Explicit
'
' ConvertImg2Rus.vbs
' 2006.04.04 hm
' 2006.04.15 hm: munka alkönyvtárak automatikus létrehozása
' 2006.04.21 hm: GC-pontokat tartalmazó gpx fájlból rus térkép készítés
'
' EZ a szkript turistaurak.hu-ról letöltött img file-kat konvertál Russa program alatti használatr
'
'

Dim oFS, strMainPath, oMainFolder, arrPar (3), oSubFolder, iNum
Set oFS = CreateObject ("Scripting.FileSystemObject")
strMainPath = oFS.GetAbsolutePathName (WScript.ScriptFullName + "\..\")
Set oMainFolder = oFS.GetFolder (strMainPath)

LetSubFolder oMainFolder, "0"
LetSubFolder oMainFolder, "1"
LetSubFolder oMainFolder, "2"
LetSubFolder oMainFolder, "4"
LetSubFolder oMainFolder, "9"
LetSubFolder oMainFolder, "rus"

GetNumOfFiles oFS, strMainPath, "", "img", iNum
If iNum>0 Then
   ConvertImg2Mp oFS, strMainPath, oMainFolder
End If

ConvertMp0 oFS, strMainPath, oMainFolder
ConvertMp1 oFS, strMainPath, oMainFolder
ConvertMp2 oFS, strMainPath, oMainFolder
ConvertMp4 oFS, strMainPath, oMainFolder
ConvertMp9 oFS, strMainPath, oMainFolder

GetNumOfFiles oFS, strMainPath & "\0", "0-", "mp", iNum
If iNum > 0 Then
   ConvertMp2Rus oFS, strMainPath, oMainFolder, "0"
End If
GetNumOfFiles oFS, strMainPath & "\1", "0-", "mp", iNum
If iNum > 0 Then
   ConvertMp2Rus oFS, strMainPath, oMainFolder, "1"
End If
GetNumOfFiles oFS, strMainPath & "\2", "0-", "mp", iNum
If iNum > 0 Then
   ConvertMp2Rus oFS, strMainPath, oMainFolder, "2"
End If
GetNumOfFiles oFS, strMainPath & "\4", "0-", "mp", iNum
If iNum > 0 Then
   ConvertMp2Rus oFS, strMainPath, oMainFolder, "4"
End If
GetNumOfFiles oFS, strMainPath & "\9", "0-", "mp", iNum
If iNum > 0 Then
   ConvertMp2Rus oFS, strMainPath, oMainFolder, "9"
End If

GetNumOfFiles oFS, strMainPath & "", "", "gpx", iNum
If iNum > 0 Then
   LetSubFolder oMainFolder, "GC"
   ConvertGpx2Mp oFS, strMainPath, oMainFolder
   GetNumOfFiles oFS, strMainPath & "\GC", "0-", "mp", iNum
   If iNum > 0 Then
      ConvertMp2Rus oFS, strMainPath, oMainFolder, "GC"
   End If
End If

'-----------------------------------------------
Sub ConvertGpx2Mp(oFS, strMainPath, oMainFolder)
'-----------------------------------------------
' Gpx formatumú útpont-fájlból Polish formátumú fájl készítése
'
Dim oInFile, oInTextStream, strExt, strInFileName, strOutFile, oOutFile
Dim iSzam, arrParagraph(), bNemkell, arrGpxParagraph(), arrZipCodes()

iSzam = 0

For Each oInFile In oMainFolder.Files
    strExt = LCase(oFS.GetExtensionName(oInFile.Path))
    If strExt = "gpx" Then
	  iSzam = iSzam+1
	  Set oInTextStream = oInFile.OpenAsTextStream
        strInFileName = oFS.GetBaseName(oInFile.Path)
        strOutFile = strMainPath + "\GC\" + strInFileName + ".gpx"
        Set oOutFile = oFS.CreateTextFile(strOutFile)

	  ConvertGpx2z oInTextStream, oOutFile, arrZipCodes
	  oOutFile.Close
	  oInTextStream.Close

	  Set oInTextStream = oFS.OpenTextFile(strOutFile)
        strOutFile = strMainPath + "\GC\0-" + strInFileName + ".mp"
        Set oOutFile = oFS.CreateTextFile(strOutFile)

	  LoadMpHeader arrParagraph
	  WriteParagraph oOutFile, arrParagraph

'	  LoadZipCodes arrParagraph, arrZipCodes
'	  WriteParagraph oOutFile, arrParagraph
        Do
		ReadGpxParagraph oInTextStream, arrGpxParagraph
		If UBound( arrGpxParagraph ) > 1 Then
		   GpxArr2MpArr arrGpxParagraph, arrParagraph
		   WriteParagraph oOutFile, arrParagraph
		End If
        Loop Until oInTextStream.AtEndOfStream

        oOutFile.Close
	  oInTextStream.Close
        oFS.DeleteFile strMainPath & "\" & strInFileName & ".gpx"
	  oFS.DeleteFile strMainPath + "\GC\" + strInFileName + ".gpx"
    End If
Next

If iSzam>0 Then
   MsgBox iSzam & " (GC) gpx file átalakítva mp formátumra!"
End If

End Sub


'****************-------------------------------------
Sub ConvertGpx2z(oInTextStream, oOutFile, arrZipCodes)
'****************-------------------------------------
' gpx-ből szűkített változat készítése, és ZipCode szótár összeállítása
Dim arrPar(), idx, strDesc, iPos
ReDim arrZipCodes(1)
arrZipCodes(1)=""

Do
   ReadGpxParagraph oInTextStream, arrPar
   If UBound( arrPar ) > 1 Then
	If Left( arrPar(4), 5) = "<zip>" Then
	   strDesc = Mid( arrPar(4), 6, InStr(6, arrPar(4), "<", 1)-6)
	   If idx=0 Then
		iPos = 0
	   Else	   
		FindInArray arrZipCodes, strDesc, iPos
	   End If
	   If iPos=0 Then
		idx = idx+1
		ReDim Preserve arrZipCodes(idx)
		arrZipCodes(idx) = strDesc
		arrPar(4) = "<zipidx>" & idx  & "</zipidx>"
	   Else
		arrPar(4) = "<zipidx>" & iPos & "</zipidx>"
	   End If
	End If
      WriteParagraph oOutFile, arrPar
   End If
Loop Until oInTextStream.AtEndOfStream

End Sub 

'-----------------------------------
Sub FindInArray(arrIn, strTxt, iPos)
'-----------------------------------
Dim ind
iPos=0

For ind=1 To UBound(arrIn)
    If UCase(arrIn(ind))=UCase(strTxt) Then
	 iPos=ind
	 Exit For
    End If
Next 'ind
End Sub

'-----------------------------------------------
Sub ConvertImg2Mp(oFS, strMainPath, oMainFolder)
'-----------------------------------------------
Dim aMapEdit, iSzam, oInFile, strExt, strOutFile

Set aMapEdit = CreateObject ("GPSMapEdit.Application.1")
aMapEdit.MinimizeWindow

Dim strFileName, strSubDir

iSzam = 0
For Each oInFile In oMainFolder.Files
	strExt = LCase (oFS.GetExtensionName (oInFile.Path))
	If strExt = "img" Then
		iSzam = iSzam+1
		aMapEdit.Open oInFile.Path, False
		strFileName = oFS.GetBaseName(oInFile.Path)
		strSubDir = "\"
		If Right(strFileName,1)="0" Then
			strSubDir = "\0\"
		End If
		If Right(strFileName,1)="1" Then
			strSubDir = "\1\"
		End If
		If Right(strFileName,1)="2" Then
			strSubDir = "\2\"
		End If
		If Right(strFileName,1)="4" Then
			strSubDir = "\4\"
		End If
		If Right(strFileName,1)="9" Then
			strSubDir = "\9\"
		End If
		strOutFile = strMainPath + strSubDir + oFS.GetBaseName(oInFile.Path) + ".mp"
		aMapEdit.SaveAs strOutFile, "Polish"
		oFS.DeleteFile strFileName & ".img"
	End if
Next

aMapEdit.Exit

MsgBox iSzam & " img file-ból mp generálva!"
End Sub


'--------------------------------------------
Sub ConvertMp0(oFS, strMainPath, oMainFolder)
'--------------------------------------------
' Polish formatumú utak-ból felesleges objektumok eltávolítása:
'	- Háttér eltávolítása
'	- Országhatár nem kell, megvan külön
'
'
Dim oInFile, oInTextStream, strExt, strInFileName, strOutFile, oOutFile, oActFolder
Dim iSzam, arrParagraph(), bNemkell

iSzam = 0

Set oActFolder = oFS.GetFolder (strMainPath+ "\0")

For Each oInFile In oActFolder.Files
    strExt = LCase(oFS.GetExtensionName(oInFile.Path))
    If Left(oFS.GetBaseName(oInFile.Path),2)<>"0-" And strExt = "mp" Then
	  iSzam = iSzam+1
	  Set oInTextStream = oInFile.OpenAsTextStream
        strInFileName = oFS.GetBaseName(oInFile.Path)
        strOutFile = oFS.GetParentFolderName(oInFile.Path) + "\0-" + UCase(Left(strInFileName,1)) + Right(strInFileName, Len(strInFileName)-1) + ".mp"
        Set oOutFile = oFS.CreateTextFile(strOutFile)

        Do
		bNemkell = 0
		ReadParagraph oInTextStream, arrParagraph
		If UBound( arrParagraph ) < 2 Then bNemkell = 1
		If bNemkell = 0 Then
			If arrParagraph(1)="[POLYGON]" And (arrParagraph(2) = "Type=0x4b" Or arrParagraph(2) = "Type=0x1e") Then
			' háttér vagy országhatár
				bNemkell = 1
			End If
		End If
		If bNemkell = 0 Then
			WriteParagraph oOutFile, arrParagraph
		End If
        Loop Until oInTextStream.AtEndOfStream
        oOutFile.Close
	  oInTextStream.Close
        oFS.DeleteFile strMainPath & "\0\" & strInFileName & ".mp"
    End If
Next

If iSzam>0 Then
   MsgBox iSzam & " (utak) mp file-ból a felesleges objektumok kiszűrve!"
End If

End Sub


'----------------
Sub ConvertMp1(oFS, strMainPath, oMainFolder)
'----------------
' Polish formátumú felülelet-ből felesleges objektumok eltávolítása:
'	- Háttér eltávolítása
'	- industrial complex, small urban area, large urban area -> reservation
'
'
Dim oInFile, oInTextStream, strExt, strInFileName, strOutFile, oOutFile, oActFolder
Dim iSzam, arrParagraph(), bNemkell

iSzam = 0
Set oActFolder = oFS.GetFolder (strMainPath+ "\1")

For Each oInFile In oActFolder.Files
    strExt = LCase(oFS.GetExtensionName(oInFile.Path))
    If Left(oFS.GetBaseName(oInFile.Path),2)<>"0-" And strExt = "mp" Then
	  iSzam = iSzam+1
	  Set oInTextStream = oInFile.OpenAsTextStream
        strInFileName = oFS.GetBaseName(oInFile.Path)
        strOutFile = oFS.GetParentFolderName(oInFile.Path) + "\0-" + UCase(Left(strInFileName,1)) + Right(strInFileName, Len(strInFileName)-1) + ".mp"
        Set oOutFile = oFS.CreateTextFile(strOutFile)

        Do
		bNemkell = 0
		ReadParagraph oInTextStream, arrParagraph
		If UBound( arrParagraph ) < 2 Then bNemkell = 1
		If bNemkell = 0 Then
			If arrParagraph(1)="[POLYGON]" And (arrParagraph(2) = "Type=0x4b" Or arrParagraph(2) = "Type=0x1e") Then
			' háttér vagy országhatár
				bNemkell = 1
			ElseIf arrParagraph(1)="[POLYGON]" And (arrParagraph(2) = "Type=0xc" Or arrParagraph(2) = "Type=0x1" Or arrParagraph(2) = "Type=0x2") Then
				arrParagraph(2) = "Type=0xd"
			End If
		End If
		If bNemkell = 0 Then
			WriteParagraph oOutFile, arrParagraph
		End If
        Loop Until oInTextStream.AtEndOfStream
        oOutFile.Close
	  oInTextStream.Close
        oFS.DeleteFile strMainPath & "\1\" & strInFileName & ".mp"
    End If
Next

If iSzam>0 Then
   MsgBox iSzam & " (felület) mp file-ból a felesleges objektumok kiszürve!"
End If
End Sub


'----------------
Sub ConvertMp2(oFS, strMainPath, oMainFolder)
'----------------
' Polish formatumú szintvonalak-hoz egy dummy pont hozzárakása, hogy majd a Russa meg tudja jeleníteni a térképet:
'
Dim oInFile, oInTextStream, strExt, strInFileName, strOutFile, oOutFile, oActFolder
Dim iSzam, arrParagraph(), bVanpont, strLine, strKoord, iPos1, iPos2, bNemkell

iSzam = 0
Set oActFolder = oFS.GetFolder (strMainPath+ "\2")

For Each oInFile In oActFolder.Files
    strExt = LCase(oFS.GetExtensionName(oInFile.Path))
    If Left(oFS.GetBaseName(oInFile.Path),2)<>"0-" And strExt = "mp" Then
	  iSzam = iSzam+1
	  Set oInTextStream = oInFile.OpenAsTextStream
        strInFileName = oFS.GetBaseName(oInFile.Path)
        strOutFile = oFS.GetParentFolderName(oInFile.Path) + "\0-" + UCase(Left(strInFileName,1)) + Right(strInFileName, Len(strInFileName)-1) + ".mp"
        Set oOutFile = oFS.CreateTextFile(strOutFile)
	  bVanpont = 0
	  strKoord = ""
        Do
		bNemkell = 0
		ReadParagraph oInTextStream, arrParagraph
		If UBound( arrParagraph ) > 2 Then
			If arrParagraph(1)="[POLYGON]" And (arrParagraph(2) = "Type=0x4b" Or arrParagraph(2) = "Type=0x1e") Then
			   ' háttér vagy országhatár
			   bNemkell = 1
			End If
		End If
		If bVanpont=0 And UBound( arrParagraph ) > 4 Then
		   If arrParagraph(1) = "[POLYLINE]" Then
			strLine = arrParagraph(4)
			If Left(strLine, 4) = "Data" Then
			   iPos1 = InStr(6, strLine, "(", 1)
			   If iPos1>0 Then
				iPos2 = InStr(iPos1, strLine, ")", 1)
				If iPos2>0 Then
				   strKoord = Mid(strLine, iPos1, iPos2-iPos1+1)
				   ' Dummy pont beszúrása
				   oOutFile.WriteLine "[POI]"
				   oOutFile.WriteLine "Type=0x6200"
				   oOutFile.WriteLine "Label=""B"" "
				   oOutFile.WriteLine "Data4=" & strKoord
				   oOutFile.WriteLine "[END]"
				   oOutFile.WriteLine ""
				   bVanpont = 1
				End If
			   End If
			End If
		   End If
		End If
		If bNemkell=0 Then
		   WriteParagraph oOutFile, arrParagraph
		End If
        Loop Until oInTextStream.AtEndOfStream
        oOutFile.Close
	  oInTextStream.Close
    	  oFS.DeleteFile strMainPath & "\2\" & strInFileName & ".mp"
    End If
Next

If iSzam>0 Then
   MsgBox iSzam & " (szintvonal) mp file-ba dummy pont beszúrva!"
End If
End Sub


'--------------------------------------------
Sub ConvertMp4(oFS, strMainPath, oMainFolder)
'--------------------------------------------
' Polish formátumú utak+felületek-ből felesleges objektumok eltávolítása:
'	- Háttér eltávolítása
'	- Országhatár nem kell, megvan külön
'	- industrial complex, small urban area, large urban area -> reservation
'
Dim oInFile, oInTextStream, strExt, strInFileName, strOutFile, oOutFile, oActFolder
Dim iSzam, arrParagraph(), bNemkell

iSzam = 0

Set oActFolder = oFS.GetFolder (strMainPath+ "\4")

For Each oInFile In oActFolder.Files
    strExt = LCase(oFS.GetExtensionName(oInFile.Path))
    If Left(oFS.GetBaseName(oInFile.Path),2)<>"0-" And strExt = "mp" Then
	  iSzam = iSzam+1
	  Set oInTextStream = oInFile.OpenAsTextStream
        strInFileName = oFS.GetBaseName(oInFile.Path)
        strOutFile = oFS.GetParentFolderName(oInFile.Path) + "\0-" + UCase(Left(strInFileName,1)) + Right(strInFileName, Len(strInFileName)-1) + ".mp"
        Set oOutFile = oFS.CreateTextFile(strOutFile)

        Do
		bNemkell = 0
		ReadParagraph oInTextStream, arrParagraph
		If UBound( arrParagraph ) < 2 Then bNemkell = 1
		If bNemkell = 0 Then
		   If arrParagraph(1)="[POLYGON]" And (arrParagraph(2) = "Type=0x4b" Or arrParagraph(2) = "Type=0x1e") Then
			' háttér vagy országhatár
			bNemkell = 1
		   ElseIf arrParagraph(1)="[POLYGON]" And (arrParagraph(2) = "Type=0xc" Or arrParagraph(2) = "Type=0x1" Or arrParagraph(2) = "Type=0x2") Then
			arrParagraph(2) = "Type=0xd"
		   End If
		End If
		If bNemkell = 0 Then
		   WriteParagraph oOutFile, arrParagraph
		End If
        Loop Until oInTextStream.AtEndOfStream
        oOutFile.Close
	  oInTextStream.Close
        oFS.DeleteFile strMainPath & "\4\" & strInFileName & ".mp"
    End If
Next

If iSzam>0 Then
   MsgBox iSzam & " (utak+felületek) mp file-ból a felesleges objektumok kiszürve!"
End If
End Sub


'--------------------------------------------
Sub ConvertMp9(oFS, strMainPath, oMainFolder)
'--------------------------------------------
' Polish formátumú szintvonalak+utak+felületek-bol felesleges objektumok eltávolítása:
'	- Háttér eltávolítása
'	- Országhatár nem kell, megvan külön
'	- industrial complex, small urban area, large urban area -> reservation
'
Dim oInFile, oInTextStream, strExt, strInFileName, strOutFile, oOutFile, oActFolder
Dim iSzam, arrParagraph(), bNemkell

iSzam = 0

Set oActFolder = oFS.GetFolder (strMainPath+ "\9")

For Each oInFile In oActFolder.Files
    strExt = LCase(oFS.GetExtensionName(oInFile.Path))
    If Left(oFS.GetBaseName(oInFile.Path),2)<>"0-" And strExt = "mp" Then
	  iSzam = iSzam+1
	  Set oInTextStream = oInFile.OpenAsTextStream
        strInFileName = oFS.GetBaseName(oInFile.Path)
        strOutFile = oFS.GetParentFolderName(oInFile.Path) + "\0-" + UCase(Left(strInFileName,1)) + Right(strInFileName, Len(strInFileName)-1) + ".mp"
        Set oOutFile = oFS.CreateTextFile(strOutFile)

        Do
		bNemkell = 0
		ReadParagraph oInTextStream, arrParagraph
		If UBound( arrParagraph ) < 2 Then bNemkell = 1
		If bNemkell = 0 Then
		   If arrParagraph(1)="[POLYGON]" And (arrParagraph(2) = "Type=0x4b" Or arrParagraph(2) = "Type=0x1e") Then
			' háttér vagy országhatár
			bNemkell = 1
		   ElseIf arrParagraph(1)="[POLYGON]" And (arrParagraph(2) = "Type=0xc" Or arrParagraph(2) = "Type=0x1" Or arrParagraph(2) = "Type=0x2") Then
			arrParagraph(2) = "Type=0xd"
		   End If
		End If
		If bNemkell = 0 Then
		   WriteParagraph oOutFile, arrParagraph
		End If
        Loop Until oInTextStream.AtEndOfStream
        oOutFile.Close
	  oInTextStream.Close
        oFS.DeleteFile strMainPath & "\9\" & strInFileName & ".mp"
    End If
Next

If iSzam>0 Then
   MsgBox iSzam & " (szintvonalak+utak+felületek) mp file-ból a felesleges objektumok kiszürve!"
End If
End Sub

'----------------
Sub ConvertMp2Rus( oFS, strMainPath, oMainFolder, kvtar)
'----------------
' ConvertToRus.vbs
'
' This script uses GPSMapEdit to convert multiple maps from Polish to RUS format.
'
'
Dim app, iSzam
Set app = CreateObject ("GPSMapEdit.Application.1")
app.MinimizeWindow

iSzam = 0
Dim pFile, strExt, strOutFile, aktFolder
Set aktFolder = oFS.GetFolder (strMainPath+ "\" + kvtar)
For Each pFile In aktFolder.Files
	strExt = LCase (oFS.GetExtensionName (pFile.Path))
	If Left(oFS.GetBaseName(pFile.Path),2)="0-" And strExt = "mp" Then
	   iSzam = iSzam+1
	   app.Open pFile.Path, False
	   strOutFile = oMainFolder + "\rus\" + Right(oFS.GetBaseName(pFile.Path),Len(oFS.GetBaseName(pFile.Path))-2) + ".rus"
	   app.SaveAs strOutFile, "russa-rus"
	   oFS.DeleteFile aktFolder & "\" & oFS.GetBaseName(pFile.Path) & ".mp"
	End if
Next
app.Exit

If iSzam > 0 Then
   MsgBox kvtar & ": " & iSzam & " mp file-ból rus generálás megtörtént!"
End If
End Sub

'**********************************
Sub GetNumOfFiles(oFS, strPath, strPrefix, strExt, iSzam)
'**********************************
Dim pFile, aktFolder, iLenPref
iLenPref = Len(strPrefix)
iSzam = 0
Set aktFolder = oFS.GetFolder (strPath)
For Each pFile In aktFolder.Files
    If iLenPref = 0 Then
	 If LCase (oFS.GetExtensionName (pFile.Path)) = strExt Then
	    iSzam = iSzam+1
	 End If
    Else
	 If LCase (oFS.GetExtensionName (pFile.Path)) = strExt And Left(oFS.GetBaseName(pFile.Path),iLenPref)=strPrefix Then
	    iSzam = iSzam+1
	 End If
    End if
Next

End Sub

'*******************
Sub ReadParagraph( oTextStream, arrPar )
'*******************
' Egy [...], [END...] pár által határolt bekezdés kiolvasása, elhelyezése egy tömbben.
ReDim arrPar(1)
arrPar(1)=""

Dim strLine, bMehet, iLines
bMehet = 0
iLines = 0

Do
   strLine = oTextStream.ReadLine
   If Left(strLine, 1) = "[" Then	' paragrafus kezdet	
	bMehet = 1
	Exit Do
   End If
Loop Until oTextStream.AtEndOfStream

If (bMehet=1) Then	' innentől az első [END-ig minden mehet a paragrafus tömmbe
   Do
	iLines = iLines+1
	ReDim Preserve arrPar(iLines)
	arrPar(iLines) = strLine
	If Left(strLine, 4) = "[END" Then
	   Exit Do
	End If
	strLine = oTextStream.ReadLine
   Loop Until oTextStream.AtEndOfStream
End If

End Sub


'*******************
Sub ReadGpxParagraph( oTextStream, arrGpxPar )
'*******************
' Egy <wpt, </wpt> pár által határolt bekezdés kiolvasása, elhelyezése egy tömbben.
ReDim arrGpxPar(1)
arrGpxPar(1)=""

Dim strLine, bMehet, iLines, strDesc
bMehet = 0
iLines = 0

Do
   strLine = oTextStream.ReadLine
   If Left(strLine, 4) = "<wpt" Then	' paragrafus kezdet	
	bMehet = 1
	Exit Do
   End If
Loop Until oTextStream.AtEndOfStream

If (bMehet=1) Then	' innentol az elso </wpt>-ig minden mehet a paragrafus tömmbe
   Do
	If Left(strLine,4)="<wpt" Or Left(strLine,5)="</wpt" Or Left(strLine,4)="<ele" Then
	   strLine = strLine
	ElseIf Left(strLine,5)="<name" Or Left(strLine,4)="<sym" Or Left(strLine,5)="<type" Then
	   strLine = strLine
	ElseIf Left(strLine,5)="<desc" Then
	   strDesc = Mid( strLine, 15, InStr(15, strLine, "]", 1)-14)
	   If strDesc="[]" Or strDesc="[ ]" Then
		strLine = ""
	   Else
	   	strLine = "<zip>" & strDesc & "</zip>"
	   End If
	ElseIf Left(strLine,8)="<zipidx>" Then
	   strLine = strLine
	Else
	   strLine = ""
	End If
	If strLine <> "" Then
	   iLines = iLines+1
	   ReDim Preserve arrGpxPar(iLines)
	   arrGpxPar(iLines) = strLine

	   If Left(strLine, 6) = "</wpt>" Then
	      Exit Do
	   End If
	End If
	strLine = oTextStream.ReadLine
   Loop Until oTextStream.AtEndOfStream
End If

End Sub


'********************
Sub WriteParagraph( oOutFile, arrPar )
'********************
' Egy teljes bekezdés kiírása tömbből
Dim iNum 

For iNum = 1 To UBound( arrPar )
    If arrPar(iNum)<>"" Then
	 oOutFile.WriteLine arrPar(iNum)
    End If
Next
oOutFile.WriteLine ""

End Sub


'****************---------------
Sub LoadMpHeader( arrParagraph )
'****************---------------
' GC-pontokat tartalmazó mp formátumú térkép header adatainak előkészítése
ReDim arrParagraph(1)
arrParagraph(1)=""
ReDim arrParagraph(23)
arrParagraph( 1) = "[IMG ID]"
arrParagraph( 2) = "ID="
arrParagraph( 3) = "Name=GC-pontok"
arrParagraph( 4) = "Preprocess=F"
arrParagraph( 5) = "CodePage=1250"
arrParagraph( 6) = "LblCoding=9"
arrParagraph( 7) = "TreSize=511"
arrParagraph( 8) = "TreMargin=0.00000"
arrParagraph( 9) = "RgnLimit=127"
arrParagraph(10) = "POIIndex=N"
arrParagraph(11) = "Copyright="
arrParagraph(12) = "Levels=5"
arrParagraph(13) = "Level0=24"
arrParagraph(14) = "Level1=22"
arrParagraph(15) = "Level1=21"
arrParagraph(16) = "Level1=20"
arrParagraph(17) = "Level1=19"
arrParagraph(18) = "Zoom0=0"
arrParagraph(19) = "Zoom1=1"
arrParagraph(20) = "Zoom2=2"
arrParagraph(21) = "Zoom3=3"
arrParagraph(22) = "Zoom4=4"
arrParagraph(23) = "[END-IMG ID]"

End Sub

'****************--------------------
Sub LoadZipCodes(arrPar, arrZipCodes)
'****************--------------------
' [ZipCodes] fejezet feltöltő
Dim iNum

Redim arrPar(1)
arrPar(1)="[ZipCodes]"

For iNum=1 To UBound(arrZipCodes)
    ReDim Preserve arrPar(1+iNum)
    arrPar(1+iNUm) = "ZipCode" & iNum & "=" & arrZipCodes(iNum)
Next 'iNUm
ReDim Preserve arrPar(2+UBound(arrZipCodes))
arrPar(2+UBound(arrZipCodes)) = "[END-ZipCodes]"

End Sub


'****************-------------------------------
Sub LetSubFolder( poMainFolder, pstrFolderName )
'****************-------------------------------
' Alkönyvtár létezését levizsgáló, szükség szerint létrehozó fv.
Dim bVan
Dim strFN, ofc, ofol
Set ofc = oMainFolder.SubFolders
bVan = False
For Each ofol in ofc
    strFN = ofol.Name 
    If ofol.Name = pstrFolderName Then
	 bVan = True
	 Exit For
    End If
Next
If Not bVan Then
   ofc.Add pstrFolderName
End If

End Sub

'****************--------------------------
Sub GpxArr2MpArr( arrGpxPar, arrPar )
'****************--------------------------
' gpx formátumú útpontot tartalmazó tömbből készít mp formátumú POI-t tartalmazó tömböt
ReDim arrPar(1)
arrPar(1)=""
ReDim arrPar(7)

arrPar(1) = "[POI]"
arrPar(2) = "Type="
arrPar(3) = "Label="
arrPar(4) = ""
arrPar(5) = "Data0="
arrPar(6) = "EndLevel=2"
arrPar(7) = "[END]"

Dim iNum, strSor, strSymbol, codSymbol, strKoord1, strKoord2, ipos1, ipos2
For iNum = 1 To UBound( arrGpxPar )
    strSor = arrGpxPar( iNum )
    If	Left(strSor, 4) = "<wpt" 	Then
		strKoord1 = Mid( strSor, 11, InStr(11, strSor, """")-11)
		ipos1 = InStr(19, strSor, "=")+2
		ipos2 = InStr(ipos1, strSor, """")-1
		strKoord2 = Mid( strSor, ipos1, ipos2-ipos1+1)
		arrPar(5) = arrPar(5) & "(" & strKoord1 & ", " & strKoord2 & ")"
    ElseIf  Left(strSor, 5) = "<ele>"	Then
    ElseIf  Left(strSor, 6) = "<name>"	Then
		strSymbol = Mid( strSor, 7, InStr(7, strSor, "<", 1)-7)
		arrPar(3) = arrPar(3) & strSymbol
    ElseIf  Left(strSor, 8) = "<zipidx>"	Then
'		strSymbol = Mid( strSor, 9, InStr(9, strSor, "<", 1)-9)
'		arrPar(4) = "ZipIdx=" & strSymbol
    ElseIf  Left(strSor, 5) = "<sym>"	Then
	 	strSymbol = Mid( strSor, 6, InStr(6, strSor, "<", 1)-6)
		If	 strSymbol = "Information"	Then
			 codSymbol = "0x4c00"
		ElseIf strSymbol = "Crossing"		Then
			 codSymbol = "0x6406"
		ElseIf strSymbol = "Geocache"		Then
			 codSymbol = "0x2c00"
		ElseIf strSymbol = "Museum"		Then
			 codSymbol = "0x2c02"
		ElseIf strSymbol = "Shower"		Then
			 codSymbol = "0x4f00"
		ElseIf strSymbol = "Parking Area"	Then
			 codSymbol = "0x2600"
		Else
			 codSymbol = "0x1c06"
		End If
		arrPar(2) = arrPar(2) & codSymbol
    End If
Next

End Sub