Переробіть скрипт VBS

[vitalis(Guest)]

Для чого він? Перетворює текстові файли на wap-сторінки, що дозволяє читати книги на мобільних телфонах без підтримки Java.

Проблема даного скрипта у тому, що не обробляються суто українські літери - Іі Її Єє Ґґ - і, відповідно, у телефоні замість них стоять знаки питання.

Скрипт подаю нижче (в оригіналі був файлом txt2wmlc.vbs)

Код: [Вибрати]

LF=Chr(10):CRLF=Chr(13) & Chr(10)
set RusWinHEX = CreateObject("Scripting.Dictionary")
RusWinHEX.CompareMode=0
for i=192 to 239
  RusWinHEX.add chr(i),chr(208) & chr(i-48)
next
for i=240 to 255
  RusWinHEX.add chr(i),chr(209) & chr(i-112)
next
RusWinHEX.add "Ё",chr(208) & chr(149)
RusWinHEX.add "ё",chr(208) & chr(181)
RusWinHEX.Item("Ь")=chr(208) & chr(172)
RusWinHEX.Item("Ъ")=chr(208) & chr(170)
RusWinHEX.Item("ь")=chr(209) & chr(140)
RusWinHEX.Item("ъ")=chr(209) & chr(138)
RusWinHEX.Item(chr(169))=chr(194) & chr(169)
RusWinHEX.Item(chr(174))=chr(194) & chr(174)
RusWinHEX.Item(chr(153))="TM"
RusWinHEX.Item(chr(10))=chr(0) & chr(38) & chr(3)

bytes=1030
numbs=0
indexn=0
set fso=CreateObject("Scripting.FileSystemObject")
Set objArgs = WScript.Arguments
if objArgs.count=0 then
   outnamefst=InputBox("Перетворювач тексту в WMLC (WAP Markup Language) версії 1.2a © CheSer software 2002" & CRLF & CRLF & "Ця програма дозволяє перетворюва текстові файли *.txt у файли *.wmlc, які можна переглядати у WAP-оглядачі мобільних телефонів Siemens 45-75 серій." & CRLF & "У рядку наказів вкажіть: ""start txt2wmlc.vbs ім'я_файлу.txt""" & CRLF & "Результатом роботы буде один чи декілька файлів з розширенням *.wmlc, які потрібно помістити у пам'яті телефону. Переглядати файли можна через Оглядач пам'яті телефону (Card-Explorer) чи вписуючи такий URL у WAP-оглядачі: ""file:a:\шлях\ім'я_файлу.wmlc""" & CRLF & CRLF & "Впишіть ім'я текстового файлу, який слід перетворити (Увага!!! Файли понад 100 КБ обробляються досить довго.)","Converter txt2wmlc")
   if instr(outnamefst,".")=0 then outnamefst=outnamefst & ".txt"
else
   outnamefst=objArgs(0)
end if
If outnamefst=".txt" Then
'
elseIf not (fso.FileExists(outnamefst)) Then
  MsgBox "Файл " & outnamefst & " не знайдено !!!",,"Converter txt2wmlc"
else
  outname=outnamefst
  if instr(outname,".")<>0 then outname=mid(outname,1,instrrev(outname,".")-1)
  outname=name2imya(outname)
  outname=left(outname,10)
  Main()
  if numbs>1 then
     MsgBox"Створено файли для перегляду у WAP-оглядачі телефонів Siemens - зміст і частини з 1 по " & numbs & " у підтеці """ & outname & """",,"Converter txt2wmlc"
  else
     MsgBox"Файл для перегляду у WAP-оглядачі телефонів Siemens створено з ім'ям """ & outname & ".wmlc""",,"Converter txt2wmlc"
  end if
end if

Function name2imya(winstr)
  RusWin= Split("А|Б|В|Г|Д|Е|Ё|Ж|З|И|Й|К|Л|М|Н|О|П|Р|С|Т|У|Ф|Х|Ц|Ч|Ш|Щ|Ъ|Ы|Ь|Э|Ю|Я|а|б|в|г|д|е|ё|ж|з|и|й|к|л|м|н|о|п|р|с|т|у|ф|х|ц|ч|ш|щ|ъ|ы|ь|э|ю|я", "|", -1, 0)
  RusLAT= Split("A|B|V|G|D|E|E|ZH|Z|I|IY|K|L|M|N|O|P|R|S|T|U|F|H|TC|CH|SH|SCH|'|Y|'|E|YU|YA|a|b|v|g|d|e|e|zh|z|i|iy|k|l|m|n|o|p|r|s|t|u|f|h|tc|ch|sh|sch|'|y|'|e|yu|ya", "|", -1, 0)
  for i=0 to 65
   winstr=replace(winstr,RusWin(i),RusLAT(i),1,-1,0)
  next
  name2imya=replace(replace(replace(replace(replace(winstr,chr(34),"'")," ","_"),"<","("),">",")"),"&","and")
end Function

Function SaveWML(instr,number)
  outnm=outname & number & ".wmlc"
  nextstrlbl="NEXT":nextstract= outname & number+1 & ".wmlc"
  if number=numbs then nextstrlbl="EXIT":nextstract="device:L-56"
  If (fso.FileExists(outname & "/" & outnm)) Then fso.DeleteFile(outname & "/" & outnm)
  Set f = fso.OpenTextFile(outname & "/" & outnm, 2, True)
  f.Write chr(1) & chr(4) & chr(106) & chr(0) & chr(127) & chr(231) & chr(54) & chr(3) & outname & " #" & number & chr(0) & chr(1) & chr(232) & chr(24) & chr(3) & nextstrlbl & chr(0) & chr(56) & chr(1) & chr(171) & chr(74) & chr(3) & nextstract & chr(0) & chr(1) & chr(1) & chr(232) & chr(24) & chr(3) & "INDEX" & chr(0) & chr(69) & chr(1) & chr(171) & chr(74) & chr(3) & outname & ".wmlc" & chr(0) & chr(1) & chr(1) & chr(96) & chr(120) & chr(3) & chr(32)
  f.Write instr & chr(32) & chr(0) & chr(1) & chr(1) & chr(1) & chr(1)
  f.close
end Function


Function SaveWML1(instr)
  outnm=outname & ".wmlc"
  If (fso.FileExists(outnm)) Then fso.DeleteFile(outnm)
  Set f = fso.OpenTextFile(outnm, 2, True)
  f.Write chr(1) & chr(4) & chr(106) & chr(0) & chr(127) & chr(231) & chr(54) & chr(3) & outname & chr(0) & chr(85) & chr(158) & chr(3) & chr(120) & chr(0) & chr(1) & chr(232) & chr(24) & chr(3) & "TOP" & chr(0) & chr(56) & chr(1) & chr(171) & chr(74) & chr(3) & chr(35) & chr(0) & chr(158) & chr(3) & chr(120) & chr(0) & chr(1) & chr(1) & chr(232) & chr(24) & chr(3) & "EXIT" & chr(0) & chr(69) & chr(1) & chr(171) & chr(74) & chr(3) & "device:L-56" & chr(0) & chr(1) & chr(1) & chr(96) & chr(120) & chr(3) & chr(32) & instr & chr(32) & chr(0) & chr(1) & chr(1) & chr(1) & chr(1)
  f.close
end Function

Function SaveIndex()
if numbs>9 then
  If (fso.FileExists(outname & "/" & outname & ".wmlc")) Then fso.DeleteFile(outname & "/" & outname & ".wmlc")
  Set f = fso.OpenTextFile(outname & "/" & outname & ".wmlc", 2, True)
  snum=2
  if numbs>99 then snum=3
  f.Write chr(1) & chr(4) & chr(106) & chr(7) & "partno" & chr(0) & chr(127) & chr(231) & chr(54) & chr(3) & outname & chr(0) & chr(1) & chr(232) & chr(24) & chr(3) & "EXIT" & chr(0) & chr(69) & chr(1) & chr(171) & chr(74) & chr(3) & "device:L-56" & chr(0) & chr(1) & chr(1) & chr(232) & chr(24) & chr(3) & "GO" & chr(0) & chr(56) & chr(1) & chr(171) & chr(74) & chr(3) & outname & chr(0) & chr(130) & chr(0) & chr(03) & ".wmlc" & chr(0) & chr(1) & chr(1) & chr(96) & chr(120) & chr(3) & "Enter PART 1-" & numbs & ": " & chr(0) & chr(1) & chr(175) & chr(49) & chr(3) & snum & chr(0) & chr(26) & chr(3) & snum & chr(0) & chr(33) & chr(3) & "partno" & chr(0) & chr(18) & chr(3) & snum & "N" & chr(0) & chr(1) & chr(120) & chr(3) & " and press " & chr(0) & chr(100) & chr(3) & "GO" & chr(0) & chr(1) & chr(3) & " button for View" & chr(0) & chr(1) & chr(1) & chr(1) & chr(1)
  f.close
else
  If (fso.FileExists(outname & "/" & outname & ".wmlc")) Then fso.DeleteFile(outname & "/" & outname & ".wmlc")
  Set f = fso.OpenTextFile(outname & "/" & outname & ".wmlc", 2, True)
  f.Write chr(1) & chr(4) & chr(106) & chr(0) & chr(127) & chr(231) & chr(54) & chr(3) & outname & chr(0) & chr(1) & chr(232) & chr(24) & chr(3) & "EXIT" & chr(0) & chr(69) & chr(1) & chr(171) & chr(74) & chr(3) & "device:L-56" & chr(0) & chr(1) & chr(1) & chr(224) & chr(7) & chr(1) & chr(100)
  for i=1 to numbs
    f.Write chr(220) & chr(54) & chr(3) & "GO" & chr(0) & chr(74) & chr(3) & outname & i & ".wmlc" & chr(0) & chr(1) & chr(3) & "PART " & i & chr(0) & chr(1) & chr(38)
  next
  f.Write chr(1) & chr(1) & chr(1) & chr(1)
  f.close
end if
end Function


Function Main()
  Set ff = fso.GetFile(outnamefst)
  Set f = ff.OpenAsTextStream(1)
  infile=""
  insize=ff.size
  infile=f.Read(ff.size)
  set f = nothing
  set ff = nothing
  set outfile = CreateObject("Scripting.Dictionary")
  outfile.CompareMode=0  
    Bytes=1908-len(outname)-5
    infile=replace(infile,CRLF,LF)
    do while 0<>instr(infile,"  ")
       infile=replace(infile,"  "," ")
    loop
    do while 0<>instr(infile,LF & LF & LF)
       infile=replace(infile,LF & LF & LF,LF & LF)
    loop
    insize=len(infile)
     tmpstr=""
     for ir=1 to insize
       bt=mid(infile,ir,1)
       if RusWinHEX.Exists(bt) then bt=RusWinHEX.Item(bt)
       if len(tmpstr & bt)>bytes then
          numbs=numbs+1
          outfile.add numbs,tmpstr
          tmpstr=""
       end if
       tmpstr=tmpstr & bt
     next
    if tmpstr<>"" then numbs=numbs+1:outfile.add numbs,tmpstr
  if numbs>1 then
    If not (fso.FolderExists(outname)) Then Set f = fso.CreateFolder(outname)
    SaveIndex()
       For Each Items in outfile
           a=SaveWML(outfile.Item(Items),Items)
       Next
  else
       numbs=1
       a=SaveWML1(outfile.Item(1))
  end if
end Function



[Абрамчук Вадим]

Це стосується Лінукса?  :-?
Чи Ви безкоштовних працівників шукаєте?
А мо' у Вас не доходять просто руки? Там 5 секунд роботи!

Гидко.

[vitalis(Guest)]

Лінакса це не стосується. Це стосується українських читачів, яким незручно читати в умі замінюючи кожен знак питання на якусь з 4-х укр. літер.

Висловив прохання тут, бо:
1. Сам я абсолютно в тому не тямлю, а тому те, що у Вас триватиме 5 секунд у мене триватиме невідомо на скільки часу;
2. Знаю, що тут люди розбираються у програмуванні і вболівають за укр. мову.
3. Сподівався знайти людину, яка знається на тому і зробить добре діло для громадськості (якщо хочете, то нехай буде безкоштовна робоча сила).

Скрипт буде викладено для загального доступу. Мій інтерес - викладення скрипта на www.chtyvo.org.ua в якості альтернативного способу читання текстів на мобільнику. Інші способи читання див. тут: http://chtyvo.org.ua/dovidka.htm (може Вас зацікавить Symbian OS?!)


Отже, якщо знайдеться охочий, що підправить скрипт, то було б добре (якщо є бажання і хист) додати обробку й інших літер та символів.

[Yaroslav Fedevych]

Це офтопік. Вам треба на windows.org.ua.

[vitalis(Guest)]

В такому випадку прошу адміністрацію перенести тему до смітника. Вибачте за офтоп.

Дякую.

[Абрамчук Вадим]

Якщо хочете читати на мобільнику - беріть Tequilla Cat Book Reader (TCBR), це краще з того, що я знайшов. Працює на мому Семені C->SL65 на Java. Також є варіант для MIDP-1 (Siemens C60, S55 і навіть (мабуть) Nokia 3410 (!!!) ).

[vitalis(Guest)]

Якщо хочете читати на мобільнику - беріть Tequilla Cat Book Reader (TCBR), це краще з того, що я знайшов. Працює на мому Семені C->SL65 на Java. Також є варіант для MIDP-1 (Siemens C60, S55 і навіть (мабуть) Nokia 3410 (!!!) ).

Для мобіл з підтримкою Java я вже познаходив багатенько гарних програм. Найкращі є ось тут: http://chtyvo.org.ua/dovidka.htm

Сам я користуюсь MicroReader'ом (сам переклав - сам користуюсь ).
Не ображайтесь, але TCBR не найкращий варіант. Якщо для Siemens, то перші місця посідають MicroReader i ReadManiac. Якщо для інших телефонів, тоді, безперечно, ReadManiac. Хоча, "на колір і смак товариш не всяк". Спробуйте.

Тут же проблема полягає у тому, щоб уможливити читання текстів на телефонах без підтримки Java, які мають вмонтовану пам'ять. Наприклад, Siemens А60.

[Абрамчук Вадим]

Там на початку скрипту додані деякі символи. Додайте туди ще й українські. Як все просто ?.. 8-)

[vitalis(Guest)]

Там на початку скрипту додані деякі символи. Додайте туди ще й українські. Як все просто ?.. 8-)

Якщо я все вірно розумію, то Ви мали на увазі оці рядки:

RusWinHEX.add "Ё",chr(208) & chr(149) --- 1-й спосіб
RusWinHEX.add "ё",chr(208) & chr(181)
RusWinHEX.Item("Ь")=chr(208) & chr(172)
RusWinHEX.Item("Ъ")=chr(208) & chr(170) --- 2-й спосіб
RusWinHEX.Item("ь")=chr(209) & chr(140)
RusWinHEX.Item("ъ")=chr(209) & chr(138)
RusWinHEX.Item(chr(169))=chr(194) & chr(169) --- 3-й спосіб
RusWinHEX.Item(chr(174))=chr(194) & chr(174)
RusWinHEX.Item(chr(153))="TM" --- 4-й спосіб
RusWinHEX.Item(chr(10))=chr(0) & chr(38) & chr(3)

Я вже думав над тим, але:
1. Символи додані чотирма різними способами (принаймні,  саме так я це візуально сприймаю).
2. Не знаю звідки беруться коди символів (виділено жирним).

Кажу ж, що я в тому ламер  :-/

[Євген Ященко]

VBS - це масонська поробка . Краще вже користуйтесь ReadManiac чи BookReader

[Абрамчук Вадим]

VBS - це масонська поробка . Краще вже користуйтесь ReadManiac чи BookReader

2 vitalis: От і я Вам скажу, як кажуть в мому місті: не ї... не майте свої роги!  

[Володимир Лісівка]

Все що потрібно:
  - транслітерувати текст або перетворити на UTF-8;
  - замінити два порожніх рядка на <br/><br/>;
  - побити текст на шматки не більше певної довжини;
  - обгорнути кожен шматок у обгортку з wml.

Якби потрібно було це зробити для Лінукс - це п'ять хвилин роботи.

Щодо того, де беруться ті числа - там просто йде перетворення з Cp1251 у UTF-8.

Ось вам табличка українських символів в UTF-8:

Код: [Вибрати]

і 209 150
І 208 134
ї 209 151
Ї 208 135
є 209 148
Є 208 132
ґ 210 145
Ґ 210 144


[vitalis]

Все що потрібно:
  - транслітерувати текст або перетворити на UTF-8;
  - замінити два порожніх рядка на <br/><br/>;
  - побити текст на шматки не більше певної довжини;
  - обгорнути кожен шматок у обгортку з wml.

Якщо хто зробить подібне для Лінакса, то я подякую і посприяю розповсюдженню.

Дякую за таблицю. Ви єдина, як бачу, конструктивна людина  


З.І. То були мої дописи - проблеми з реєстрацією, знаєте :-/

[Абрамчук Вадим]

Колись робив подібне на ПХП. В мене там був скрипт переробки (здається, інклюд і + одна функція). Але його вже нема - ушуршав разом з половиною харда .