Option Explicit
'
' TuhuKNy.vbs
' 23:13 2006.11.16. hm (alias Mikulás)
'
' Ez a szkript turistaurak.hu-ról letöltött img file-kat konvertál Russa program alatti használatr
' Outputként két, önállóan használható, útvonaltervezős rus formátumú file-t készít,
' egy NY.rus file-t, Magyarország nyugati részéről, illetve egy K.rus file-t a keleti részéről.
' A két országrészt a Duna vonala választja el 
' Az eredeti Garmin térképen szereplo ládákat (GC... POI-k) meghagyja
'
Dim oFS, strMainPath, oMainFolder, arrPar (3), oSubFolder, iNum
Set oFS = CreateObject ("Scripting.FileSystemObject")
strMainPath = oFS.GetAbsolutePathName (WScript.ScriptFullName + "\..\")
Set oMainFolder = oFS.GetFolder (strMainPath)

UniteMaps oFS, strMainPath, oMainFolder, "K"
UniteMaps oFS, strMainPath, oMainFolder, "NY"

ConvertMp oFS, strMainPath, oMainFolder

ConvertMp2Rus oFS, strMainPath, oMainFolder, ""

MsgBox "V É G E"

'-------------------------------------------------
Sub UniteMaps(oFS, strMainPath, oMainFolder, pNYK)
'-------------------------------------------------
Dim aMapEdit, oInFile, strExt, strFileName, NYK, strOutFile, ssz

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

For Each oInFile In oMainFolder.Files
	strExt = LCase (oFS.GetExtensionName (oInFile.Path))
	If strExt = "img" Then
		strFileName = oFS.GetBaseName(oInFile.Path)
		If strFileName = "96900199" Or strFileName = "96900599" Then
			NYK = "K"
		ElseIf strFileName = "96900899" Or strFileName = "96901199" Then
			NYK = "K"
		ElseIf strFileName = "96901499" Or strFileName = "96902299" Then
			NYK = "K"
		ElseIf strFileName = "96902999" Or strFileName = "96905299" Then
			NYK = "K"
		ElseIf strFileName = "96905399" Then
			NYK = "K"
		Else
			If Left(strFileName, 3)="969" And Right(strFileName, 2)="99" Then
				NYK = "NY"
			Else
				NYK = "--"
			End If
		End If

		If NYK = pNYK Then
			ssz = ssz+1
			If ssz=1 Then
				aMapEdit.Open oInFile.Path, False
			Else
				aMapEdit.Open oInFile.Path, True
			End If
		End If
	End If
Next
strOutFile = strMainPath + "\" + pNYK + ".mp"
aMapEdit.SaveAs strOutFile, "Polish"
aMapEdit.Exit

End Sub


'--------------------------------------------
Sub ConvertMp(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
'	- Geoláda felesleges
'	- ZipCodes, Countries, Regions, Cities felesleges
'
Dim oInFile, oInTextStream, strExt, strInFileName, strOutFile, oOutFile, oActFolder
Dim iSzam, arrParagraph(), bNemkell

iSzam = 0

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

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=0x4a" Or 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
		   'If arrParagraph(1)="[POI]" And Left(arrParagraph(2),11)="Type=0x2c04" And Left(arrParagraph(3),8)="Label=GC" Then
			' Geoláda
			'bNemkell = 1
		   'End If
		   If arrParagraph(1)="[ZipCodes]" Then
			bNemkell = 1
		   End If
		   If arrParagraph(1)="[Countries]" Then
			bNemkell = 1
		   End If
		   If arrParagraph(1)="[Regions]" Then
			bNemkell = 1
		   End If
		   If arrParagraph(1)="[Cities]" Then
			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 & "\" & strInFileName & ".mp"
    End If
Next

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

	   'app.Edit.RemoveDuplicates
	   'app.Edit.GeneralizeNodesOfPolylinesAndPolygons
	   'app.Edit.GenerateRoutingNodes
	   
	   strOutFile = oMainFolder + "\" + 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

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 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 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