If WScript.Arguments.Count > 0 Then
' //A felhasználói beállítások
' *********************************************************************************
' * A beállítás "True" értéke esetén a végeredményt a bemeneti fájl nevével, azt *
' * felülírva kapod meg. "False" érték esetén a végeredmény új HTML fájl, ami *
' * egy CLEAN előtagot kap. *
' *********************************************************************************
Const html_overw = True
' *********************************************************************************
' * A HTML-fájl kódlapjának beállítása. *
' * A beállítás "True" értéke esetén valódi Unicode kódólású HTML fájlt készít. *
' * Ha átírod "False"-re, akkor windows-1250 kódolású végeredményt kapsz. *
' *********************************************************************************
Const unicode_html = True
' *********************************************************************************
' * Készíthetsz magadnak saját címsor stílusokat definiáló *
' * felsorolást. Ha a pontos és teljes útvonalat megadod a szövegfájlhoz, *
' * akkor a végeredmény részébe azt a szkript be fogja másolni. *
' * A sor elejére írt "Rem"-el kikapcsolható ez a funkció. *
' *********************************************************************************
Rem Const style_file = "C:/E-Books/header_styles.txt"
' *********************************************************************************
' * A régebbi Word-HTML-ek még egy "./" alakú relatív mappajelzést használnak *
' * a képek 
hivatkozásainál, de az újabb MP Creator-ok ezt nem *
' * tudják használni. Ha szeretnéd ezeket automatikusan kiszedetni, akkor *
' * a konstans értékét állítsd "True"-ra. *
' *********************************************************************************
Const pict_path_corr = True
' *********************************************************************************
' * A Mobipocket PRC-ben a paraméterrel határozhatod meg a bekez- *
' * dések első sorának behúzását és
értékkel az első sor feletti *
' * sortávot. Ha "Rem"-el kikapcsolod a funkciót akkor az alapértelmezett *
' * szövegképet fogod a PRC-ben viszontlátni. *
' *********************************************************************************
Rem Const p_width = "0"
Rem Const p_height = "0"
' *********************************************************************************
' * tag-ek beszúrásával kijelölhető a szöveg tartalomjegyzékbe kerülő része. *
' * Ez a címsort-használó megoldás alternatívája. Ha tehát a szövegfelkészítés *
' * során speciális karakterekkel megjelölted a választott szövegrészek elejét *
' * végét, akkor itt adhatod meg, hogy az egyes karakterek , vagy *
' * tag-ekre cserélődjenek. A funkció "Rem"-ek beírásával kikapcsolható. *
' *********************************************************************************
Rem Const sign0_start = "¦"
Rem Const sign0_end = "†"
Const sign1_start = "¶"
Const sign1_end = "¬"
Const sign2_start = "‡"
Const sign2_end = "¤"
' *********************************************************************************
' * Ha valamilyen karakterrel megjelölted a szövegben a későbbi oldaltörések *
' * helyét, akkor itt megadhatod a keresendő karaktert a cseréhez. *
' * A szkript a megjelölt pontoknál szakaszokra fogja osztani a szöveget ezzel: *
' *
*
' *********************************************************************************
Rem Const sign_brake = "˛"
' *********************************************************************************
' * Hibakeresés céljából a művelet közben készült két temp fájlt megőrizheted. *
' * Ha nem akarod az átmeneti fájlokat automatikusan töröltetni, akkor *
' * a konstans értékét állítsd "True"-ra. *
' *********************************************************************************
Const save_temp = False
' //A felhasználói beállítások vége.
' //Ne írj át semmit a most következő részben, csak ha tudod, hogy mit csinálsz!
' //változók definiálása
Dim Row
Dim Begin
Dim TMP1
Dim TMP2
Dim FINAL
Dim Path
Dim FName
Dim meta_row
Dim img_src
Dim img_rpl
Dim brake_row
Dim pb
Dim p
Dim t
Dim a
Dim b
Dim c
' //információ kinyerése az argumentumból, útvonalak és fájlnevek beállítása
Set FS = CreateObject("Scripting.FileSystemObject")
Path = FS.GetParentFolderName(WScript.Arguments.Item(0))
FName = FS.GetFileName(WScript.Arguments.Item(0))
TMP1 = Path & "\tmp.tmp"
TMP2 = Path & "\tmp2.tmp"
If html_overw = True Then
FINAL = Path & "\" & FName
Else
FINAL = Path & "\CLEAN_" & FName
End If
' //felhasználói cserékhez szükséges szövegminták
If unicode_html Then
meta_row = "
"
Else
meta_row = "
"
End If
If pict_path_corr = True Then
img_src = "src=" & Chr(34) & "./"
img_rpl = "src=" & Chr(34)
End If
If sign_brake<>"" Then
brake_row = "
"
End If
' //tisztítás első fázisa
Set FIN = FS.OpenTextFile(WScript.Arguments.Item(0), 1, False)
Set FOUT = FS.CreateTextFile(TMP1, True)
FOUT.WriteLine ""
FOUT.WriteLine ""
' //a rész kitakarítása a
kivételével, a fájltípus meta-sorának visszaírása
Do
Row = FIN.ReadLine
If Left(Row, 6) = "<title" Then
FOUT.WriteLine row
FOUT.WriteLine meta_row
' //ha van megadva címsor-stílusokat tartalmazó külső fájl, akkor azt beszúrja a <head>-be
If style_file <> "" Then
Set SFIN = FS.OpenTextFile(style_file, 1, False)
Begin = False
Do While Not SFIN.AtEndOfStream
pb = SFIN.ReadLine
a = InStr(pb, "<style")
b = InStr(pb, "</style")
If a <> 0 Or Begin = True Then
Begin = True
FOUT.WriteLine pb
End If
If b <> 0 Then
Begin = False
End If
Loop
Begin = False
SFIN.Close
End If
End If
Loop Until Left(Row, 5) = "<body"
FOUT.WriteLine "</head>"
FOUT.WriteLine "<body>"
' //a <p>...</p> és <h>...</h> blokkok sorainak összevonása
Do While Not FIN.AtEndOfStream
Row = FIN.ReadLine
If Left(Row, 2) = "<p" Then
If InStr(Row, "</p>") Then
FOUT.WriteLine Row
Else
Begin = True
FOUT.Write Row & " "
End If
ElseIf Left (Row, 2) = "<h" Then
If InStr(Row, "</h") Then
FOUT.WriteLine Row
Else
Begin = True
FOUT.Write Row & " "
End If
ElseIf Begin = True And InStr(Row, "</p>") = 0 And InStr(Row, "</h") = 0 Then
FOUT.Write Row & " "
Else
FOUT.WriteLine Row
Begin = False
End If
Loop
FIN.Close
FOUT.Close
' //tisztítás második fázisa, a <p> és <h> tag-ek kitakarítása
Set FIN = FS.OpenTextFile(TMP1, 1, False)
Set FOUT = FS.CreateTextFile(TMP2, True)
Do While Not FIN.AtEndOfStream
Row = FIN.ReadLine
Row = Replace(Row, "<![if !supportEmptyParas]>", "")
Row = Replace(Row, "<![endif]>", "")
Row = Replace(Row, "<o:p></o:p>", "")
' //az oldaltörés jelek becserélése <div> szakaszokra
If sign_brake <> "" Then
If Left(Row, 2) = "<p" And InStr(Row, sign_brake) Then
Row = brake_row
End If
End If
' //a <p> tag-ek kipucolása
If Left(Row, 2) = "<p" And Left(Row, 4) <> "<pre" Then
pb = "<p"
' //a width és height paraméterek beírása a <p> tag-be
If p_width <> "" Then
pb = pb & " width=" & Chr(34) & p_width & Chr(34)
End If
If p_height <> "" Then
pb = pb & " height=" & Chr(34) & p_height & Chr(34)
End If
' //a paragrafus igazítások megőrzése
p = InStr(Row, "align=")
If p <> 0 Then
align_text = Mid(Row, p, 15)
a = InStr(align_text, "left")
If a <> 0 Then
pb = pb & " align=" & Chr(34) & "left" & Chr(34)
Else
b = InStr(align_text, "center")
If b <> 0 Then
pb = pb & " align=" & Chr(34) & "center" & Chr(34)
Else
c = InStr(align_text, "right")
If c <> 0 Then
pb = pb & " align=" & Chr(34) & "right" & Chr(34)
End If
End If
End If
End If
pb = pb & ">"
FOUT.WriteLine pb & Mid(Row, InStr(Row, ">") + 1)
' //a <h> tag-ek kipucolása
ElseIf Left(Row, 2) = "<h" And Left(Row, 5) <> "<head" And Left(Row, 5) <> "<html" And Left(Row, 3) <> "<hr" Then
pb = Left(Row, 3)
p = InStr(Row, "align=")
If p <> 0 Then
align_text = Mid(Row, p, 15)
a = InStr(align_text, "left")
If a <> 0 Then
pb = pb & " align=" & Chr(34) & "left" & Chr(34)
Else
b = InStr(align_text, "center")
If b <> 0 Then
pb = pb & " align=" & Chr(34) & "center" & Chr(34)
Else
c = InStr(align_text, "right")
If c <> 0 Then
pb = pb & " align=" & Chr(34) & "right" & Chr(34)
End If
End If
End If
End If
pb = pb & ">"
FOUT.WriteLine pb & Mid(Row, InStr(Row, ">") + 1)
' //minden egyéb sort csak szimplán másol
Else
FOUT.WriteLine Row
End If
Loop
FIN.Close
FOUT.Close
If save_temp = False Then
FS.DeleteFile TMP1
End If
' //tisztítás harmadik fázisa
Set FIN = FS.OpenTextFile(TMP2, 1, False)
Set FOUT = FS.CreateTextFile(FINAL, True, unicode_html)
Do While Not FIN.AtEndOfStream
Row = FIN.ReadLine
' //teljes tag típusok eltávolítása a beolvasott sorból
Do
p = InStr(Row, "<span")
If p > 0 Then
Row = Left(Row, p - 1) & Mid(Row, InStr(p, Row, ">") + 1)
End If
If p = 0 Then Exit Do
Loop
Row = Replace(Row, "</span>", "")
Do
p = InStr(Row, "<font")
If p > 0 Then
Row = Left(Row, p - 1) & Mid(Row, InStr(p, Row, ">") + 1)
End If
If p = 0 Then Exit Do
Loop
Row = Replace(Row, "</font>", "")
' //<i>, <b> és <br/> tag-ekben maradt szemét eltávolítása
Do
p = InStr(Row, "<i ")
If p > 0 Then
Row = Left(Row, p + 1) & Mid(Row, InStr(p, Row, ">"))
End If
If p = 0 Then Exit Do
Loop
Do
p = InStr(Row, "<b ")
If p > 0 Then
Row = Left(Row, p + 1) & Mid(Row, InStr(p, Row, ">"))
End If
If p = 0 Then Exit Do
Loop
Do
p = InStr(Row, "<br ")
If p > 0 Then
Row = Left(Row, p + 2) & "/" & Mid(Row, InStr(p, Row, ">"))
End If
If p = 0 Then Exit Do
Loop
' //felhasználói markerek becserélése <y> tag-ekre
If sign0_start <> "" Then
Row = Replace(Row, sign0_start, "<y0>")
End If
If sign0_end <> "" Then
Row = Replace(Row, sign0_end, "</y0>")
END If
If sign1_start <> "" Then
Row = Replace(Row, sign1_start, "<y1>")
End If
If sign1_end <> "" Then
Row = Replace(Row, sign1_end, "</y1>")
END If
If sign2_start <> "" Then
Row = Replace(Row, sign2_start, "<y2>")
End If
If sign2_end <> "" Then
Row = Replace(Row, sign2_end, "</y2>")
END If
' //pagebreak marker alapján <div> szakaszok készítése lapdobással
If sign_brake <> "" Then
valami=0
End If
' //régi képhivatkozásokból a relatív mappajelzés törlése
If pict_path_corr = True Then
Row = Replace(Row, img_src, img_rpl)
End If
' //további általános lecserélések
Row = Replace(Row, "<br>", "<br/>")
Row = Replace(Row, "<b><br/> </b>", "<br/> ")
Row = Replace(Row, "<i><br/> </i>", "<br/> ")
Row = Replace(Row, Chr(160), " ")
Row = Replace(Row, "</b><b>", "")
Row = Replace(Row, "<b></b>", "")
Row = Replace(Row, "</i><i>", "")
Row = Replace(Row, "<i></i>", "")
Row = Replace(Row, "</b> <b>", " ")
Row = Replace(Row, "</i> <i>", " ")
Row = Replace(Row, "</b> <b>", " ")
Row = Replace(Row, "</i> <i>", " ")
Row = Replace(Row, "</i></b> <b><i>", " ")
Row = Replace(Row, "</b></i> <i><b>", " ")
Row = Replace(Row, " ", " ")
Row = Replace(Row, " ", " ")
FOUT.WriteLine Row
Loop
FIN.Close
FOUT.Close
If save_temp = False Then
FS.DeleteFile TMP2
End If
End If