<![CDATA[Серый форум — VBScript: конвертация текста из кодировки в кодировку]]> http://forum.script-coding.com/viewtopic.php?id=1179 Fri, 18 Sep 2020 03:46:56 +0000 PunBB <![CDATA[Re: VBScript: конвертация текста из кодировки в кодировку]]> http://forum.script-coding.com/viewtopic.php?pid=142185#p142185 Да. Ты прав. Боевые функции для программистов, Универсальные для домохозяек, которым не надо исполнять код здесь и сейчас без перекодирования с временными файлами.
Вообщем - глубоко передаланный твой код декодирования и мой личный код кодирования через MSHTA-JS.
Принимает данные из буфера обмена и в качестве входного параметра. Обратно, в качестве ответа, ничего не возвращает
Временные файлы не создаются.

Encode URI

    Option Explicit
    Const WshRunning = 0,WshFailed = 1:Dim cmd,text,i,objShell
    Dim strCmd, objWnd, objParent, strSignature, output, wowError, exec, arr, j, temp
    wowError=False
    Set objShell = WScript.CreateObject("WScript.Shell")
    Sub RunCScriptHidden()
        strSignature = Left(CreateObject("Scriptlet.TypeLib").Guid, 38)
        GetObject("new:{C08AFD90-F2A1-11D1-8455-00A0C91F3880}").putProperty strSignature, Me
        objShell.Run ("""" & Replace(LCase(WScript.FullName), "wscript", "cscript") & """ //nologo """ & WScript.ScriptFullName & """ ""/signature:" & strSignature & """"), 0, True
    End Sub
    Sub WshShellExecCmd()
        For Each objWnd In CreateObject("Shell.Application").Windows
            If IsObject(objWnd.getProperty(WScript.Arguments.Named("signature"))) Then Exit For
        Next
        Set objParent = objWnd.getProperty(WScript.Arguments.Named("signature"))
        objWnd.Quit
        Set exec = CreateObject("WScript.Shell").Exec(objParent.strCmd)
    While exec.Status = WshRunning
    WScript.Sleep 50
    Wend
    Dim err
    If exec.ExitCode = WshFailed Then
    err = exec.StdErr.ReadAll
    Else
    output = Split(exec.StdOut.ReadAll,Chr(10))
    End If
    If err="" Then
    objParent.text = output(UBound(output)-1) 'array of results, you can: output(0) Join(output) - Usually needed is the last
    Else
    objParent.wowError = err
    End If
    WScript.Quit
    End Sub
    text=CreateObject("HTMLFile").parentWindow.clipboardData.GetData("text")
    text=Replace(text,"\","\\")
    text=Replace(text,"'","\%27")
    text=Replace(text,Chr(34),"%22")
    text=Replace(text,"^","%5E")
   
    cmd="for /f ""usebackq"" %i in " & _
    "(`mshta ""javascript:Code(close(new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write(" & _
    "encodeURIComponent('" & text & "')" & _
    ")));""`) do set e=%i&set e=!e:'=%27!&set e=!e:(=%28!&set e=!e:)=%29!&echo !e!":strCmd = "%comspec% /v /c " & cmd
    If WScript.Arguments.Named.Exists("signature") Then WshShellExecCmd
    RunCScriptHidden
    If wowError=False Then
    text=text
    For j = 0 To 13
    text=Replace(text,Chr(j),"")
    Next
    objShell.popup(text)
    Else
    objShell.popup("Error=" & wowError)
    End If

Encode with IE

    Option Explicit
    Dim text,ws,F,FSO,path,name,j
    text=CreateObject("HTMLFile").parentWindow.clipboardData.GetData("text")
    Dim oIE: Set oIE = CreateObject("InternetExplorer.application")
    With oIE
    .Visible = False
    .Navigate ("")
    .Offline = True
    End With
    Do Until oIE.ReadyState = 4
    wscript.sleep 100
    Loop
    For j = 0 To 13 'text=Replace(text,Chr(13),"")
    text=Replace(text,Chr(j),"")
    Next
    text=Replace(text,"\","\\")
    text=Replace(text,Chr(34),"%22")
    text=Replace(text,"(","%28")
    text=Replace(text,")","%29")
    oIE.Document.parentWindow.execScript("var ultimateAnswer = function(){return encodeURIComponent(""" & text & """);};ultimateAnswer()") 'Get Return value
    text = oIE.Document.parentWindow.ultimateAnswer()
    'text=Replace(text,"[","%5B")
    'text=Replace(text,"]","%5D")
    'text=Replace(text," ","%20")
    'text=Replace(text,"+","%2B")
    text=Replace(text,"'","`%27")
    text=Replace(text,"%2522","`%22")
    text=Replace(text,"%2528","%28")
    text=Replace(text,"%2529","%29")
    text= Chr(34) & text & Chr(34)
    objShell.popup(text)
oIE.Quit

Decode URI

Option Explicit
Dim Kod
If WScript.Arguments.Count()=0 Then
    Kod=CreateObject("HTMLFile").parentWindow.clipboardData.GetData("text")
Else
    Kod=WScript.Arguments(0)
End if
if IsNull(Kod) Then
    WScript.Echo "No data to execute.."
Else
    Dim chunk,Recoded,k1,k2,k3,i:i=0:Dim arr:arr=Split(Kod,"%")
    Do While i <= UBound(arr)
        if i<>0 Then
            chunk = Left(arr(i),2)     
            If "&H"&Left(chunk,2)>=128 then
                arr(i)="":i=i+1:chunk = chunk & Left(arr(i),2)
                If "&H"&Left(chunk,2)<224 then
                    k1=Cint("&H"&Left(chunk,2)) mod 32
                    k2 = Cint("&H"&Mid(chunk,3,2)) mod 64
                    Recoded=ChrW( k2 + k1 * 64 )
                Else
                    arr(i)="":i=i+1:chunk = chunk & Left(arr(i),4)
                    k1=Cint("&H"&Left(chunk,2)) mod 16
                    k2 = Cint("&H"&Mid(chunk,3,2)) mod 32
                    k3 = Cint("&H"&Mid(chunk,5,2)) mod 64
                    Recoded=ChrW( k3 + ( k2 + k1 * 64 ) * 64 )
                End if
            Else Recoded=Chr("&H"&chunk)
            End If
            arr(i)=Recoded & Mid(arr(i),3)
        end if:i=i+1
    loop
    Kod=Join(arr,""):WScript.Echo Kod
End if

]]> Fri, 18 Sep 2020 03:46:56 +0000 http://forum.script-coding.com/viewtopic.php?pid=142185#p142185 <![CDATA[Re: VBScript: конвертация текста из кодировки в кодировку]]> http://forum.script-coding.com/viewtopic.php?pid=42972#p42972 Вот примитивная конвертация:

function convert_cyr_string(str,src,dst)
   src = lcase(src)
   dst = lcase(dst)
   dim Fsrc, Fdst, ArrFdos, ArrFwin, ArrFutf, d, Simv, n
   ArrFdos = split("128;129;130;131;132;133;134;135;136;137;138;139;140;141;142;143;144;145;146;147;148;149;150;151;152;153;154;155;156;157;158;159;160;161;162;163;164;165;166;167;168;169;170;171;172;173;174;175;224;225;226;227;228;229;230;231;232;233;234;235;236;237;238;239;240;241",";")
   ArrFwin = split("192;193;194;195;196;197;198;199;200;201;202;203;204;205;206;207;208;209;210;211;212;213;214;215;216;217;218;219;220;221;222;223;224;225;226;227;228;229;230;231;232;233;234;235;236;237;238;239;240;241;242;243;244;245;246;247;248;249;250;251;252;253;254;255;168;184",";")
   ArrFutf = split("208:144;208:145;208:146;208:147;208:148;208:149;208:150;208:151;208:152;208:153;208:154;208:155;208:156;208:157;208:158;208:159;208:160;208:161;208:162;208:163;208:164;208:165;208:166;208:167;208:168;208:169;208:170;208:171;208:172;208:173;208:174;208:175;208:176;208:177;208:178;208:179;208:180;208:181;208:182;208:183;208:184;208:185;208:186;208:187;208:188;208:189;208:190;208:191;209:128;209:129;209:130;209:131;209:132;209:133;209:134;209:135;209:136;209:137;209:138;209:139;209:140;209:141;209:142;209:143;208:129;209:145",";")
   if (src = "w" and dst = "w") or (src = "d" and dst = "d") or (src = "u" and dst = "u") then
      convert_cyr_string = str
      exit function
   end if
   if src = "w" then
         Fsrc = ArrFwin
      elseif lcase(src) = "d" then
         Fsrc = ArrFdos
      elseif lcase(src) = "u" then
         Fsrc = ArrFutf
      else
         convert_cyr_string = "Err: The variable src isn't true"
         exit function
   end if
   if dst = "w" then
         Fdst = ArrFwin
      elseif dst = "d" then
         Fdst = ArrFdos
      elseif dst = "u" then
         Fdst = ArrFutf
      else
         convert_cyr_string = "Err: The variable dst isn't true"
         exit function
   end if
   Set d = CreateObject("Scripting.Dictionary") 
   for n=0 to ubound(Fsrc)
         d.Add Fsrc(n), Fdst(n)
   next
   if (src = "w" and dst = "d") or (src = "d" and dst = "w") then
      for n = 1 to len(str)
         if d.item(cStr(asc(mid(str,n,1)))) <> "" then
            Simv = Simv & chr(d.item(cStr(asc(mid(str,n,1)))))
         else
            Simv = Simv & mid(str,n,1)
         end if
      next
   elseif src = "u" then
      for n = 1 to len(str)
         if asc(mid(str,n,1)) = 208 or asc(mid(str,n,1)) = 209 then
            Simv = Simv & chr(d.Item(cStr(asc(left(mid(str,n,2),1)) & ":" & asc(right(mid(str,n,2),1)))))
            n = n + 1
         else
            Simv = Simv & mid(str,n,1)
         end if
      next
   elseif dst = "u" then
      for n = 1 to len(str)
         if d.item(cStr(asc(mid(str,n,1)))) <> "" Then
            Simv = Simv & chr(left(d.item(cStr(asc(mid(str,n,1)))),3)) & chr(right(d.item(cStr(asc(mid(str,n,1)))),3)) 
         else
            Simv = Simv & mid(str,n,1)
         end if
      next
   end if
   set d = Nothing
   convert_cyr_string = Simv
end function

Немного усовершенствовал с последнего раза. Функция принимает строку в кодировке src и возвращает в кодировке dst.
src и  dst могу принимать следующие значения: "d", "w", "u" - 866, 1251 и UTF соответственно.

]]> Fri, 24 Dec 2010 09:05:04 +0000 http://forum.script-coding.com/viewtopic.php?pid=42972#p42972 <![CDATA[Re: VBScript: конвертация текста из кодировки в кодировку]]> http://forum.script-coding.com/viewtopic.php?pid=40603#p40603 fps пишет:

SourceCharset и DestCharset в нем тоже перепутаны

Описанная путаница возникает не здесь , а гораздо раньше - в названии функции StrConv. Дело в том, что это не функция конвертации по своему основному смыслу, конвертирование там есть одно вспомогательное, а это функция рассмотрения одной кодиовки КАК другой (ЧЕРЕЗ призму другой), т.е. назвать ее следовало бы сделать StrViewAs. И написать примерно следующее :

' Серия преобразований strText как SourceCharset, рассмотрение полученного как TargetCharset
Public Function StrViewAs(ByVal strText, ByVal CharsetList) '
' http://forum.script-coding.com/viewtopic.php?id=997
' http://p10903.clients.m-10.ru/viewtopic.php?pid=30379
' HKEY_CLASSES_ROOT\Mime\Database - разрешенные для использования кодировки
' HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Nls\CodePage\  ACP=1251 - текущая кодировка Windows, OEMCP=866 - текущая кодировка DOS
'
' Внутренне каждый символ strText при этом представлен в UTF16-LE (Unicode Windows) двумя байтами, как и везде в VB строках .
' CharsetList -> "[SourceCharset]/[TargetCharset]..." Т.е. это список пар,разделенных / кодировок преобразования/рассмотрения
'                 SourceCharset - кодировка в которой должна интерпретироваться исходная строка
'                 TargetCharset - кодировка через призму которой должна смотреться преобразованная исходная строка, после чего преобразованная
'                                 вновь дожна интерпретироваться/рассматриваться следующей из списка парой [SourceCharset]/[TargetCharset]
'                 Если какая-то кодировка опущена , то считается - системная по умолчанию ("Windows-1251" для нас).
'                 OEM в имени кодировки означает использование кодировки по умолчанию для DOS ("cp866" для нас)
' Примеры :
'  StrViewAs("Ю","koi8-r/"), StrViewAs("Ю","windows-1251/koi8-r/koi8-r/windows-1251"),StrViewAs("Юра","koi8-r///koi8-r")
Const adTypeText = 2, adModeReadWrite = 3
Dim objStream, i, WshShell, ACP, OEMCP

Set objStream = CreateObject("ADODB.Stream")
Set WshShell = CreateObject("WScript.Shell")
ACP = "Windows-" & WshShell.RegRead("HKLM\SYSTEM\CurrentControlSet\Control\Nls\CodePage\ACP")
OEMCP = "cp" & WshShell.RegRead("HKLM\SYSTEM\CurrentControlSet\Control\Nls\CodePage\OEMCP")

CharsetList = Split(Trim(CharsetList), "/")
With objStream
 .Type = adTypeText: .Mode = adModeReadWrite: .Open
 
 For i = 0 To UBound(CharsetList) Step 2
  If CharsetList(i) = "" Then CharsetList(i) = ACP
  If UCase(CharsetList(i)) = "OEM" Then CharsetList(i) = OEMCP
  .Position = 0: .Charset = CharsetList(i)     ' strText будем заносить в поток под SourceCharset
  .WriteText strText                           ' strText Unicode -:-> SourceCharset
  If CharsetList(i + 1) = "" Then CharsetList(i + 1) = ACP
  If UCase(CharsetList(i + 1)) = "OEM" Then CharsetList(i + 1) = OEMCP
  .Position = 0: .Charset = CharsetList(i + 1) ' рассматриваем SourceCharset как TargetCharset
  strText = .ReadText                          ' TargetCharset  -:-> Unicode
 Next

End With
StrViewAs = strText
Set objStream = Nothing
End Function ' StrViewAs -->>

В связи с чем хотелось бы уточнить, т.к. сомневаюсь правильно ли сделал нахождение имен кодировок по умолчанию для Windows и для DOS : ACP и OEMCP. Плз. подскажите - как их правильно сформировать можно ?

RootAdmin пишет:

Имхо, использовать объекты - не то...
Лучше самостоятельно.
Вот, пожалуйста, "боевые функции"

Я вот тоже пробовал писать такие, только желание было досконально разобраться и все учесть - так все учесть не получилось, поэтому решил лучше черз потоки использовать.

]]> Tue, 19 Oct 2010 21:20:42 +0000 http://forum.script-coding.com/viewtopic.php?pid=40603#p40603 <![CDATA[Re: VBScript: конвертация текста из кодировки в кодировку]]> http://forum.script-coding.com/viewtopic.php?pid=30379#p30379 Абсолютно согласен, но в практике чего только не приходилось встречать. И по три-четыре преобразования в почтовых клиентах, когда "URL-Quoted printable" завернуто в base-64 и обозвано UTF-8?B?
Опять же, когда сам попробуешь - приходит опыт, когда начинаешь понимать что ж именно отдаешь системе для преобразования, как именно оно выглядит на уровне байт.
Приходилось видеть как система тупо (вместо преобразования кодировки) дописывает в начало строки два байта BOM и возвращает. Хотя это было давно, лет 5 назад.

]]> Wed, 11 Nov 2009 09:07:27 +0000 http://forum.script-coding.com/viewtopic.php?pid=30379#p30379 <![CDATA[Re: VBScript: конвертация текста из кодировки в кодировку]]> http://forum.script-coding.com/viewtopic.php?pid=30378#p30378 RootAdmin, видите ли в чём дело: Ваш метод работает для одной выбранной пары кодировок (и кодовых страниц), а тут всё ручное преобразование отдаётся на откуп ОС.

Хотя, не спорю, в ряде случаев приходится пользоваться именно подобным «ручным» способом.

]]> Wed, 11 Nov 2009 08:50:52 +0000 http://forum.script-coding.com/viewtopic.php?pid=30378#p30378 <![CDATA[Re: VBScript: конвертация текста из кодировки в кодировку]]> http://forum.script-coding.com/viewtopic.php?pid=30377#p30377 Имхо, использовать объекты - не то...
Лучше самостоятельно.
Вот, пожалуйста, "боевые функции"

Set WshShell = Wscript.CreateObject("Wscript.Shell")

Kod="%D0%B2%D1%8B%D0%B3%D1%80%D1%83%D0%B7%D0%BA%D0%B0%5F%30"
Kod=Replace(Kod,"%","")
WshShell.popup Kod&" длина "&Len(kod)
        'Перекодирую. Первый ДВА байта строки - код кодировки в H записи, следующие - код символа.
        While len(kod)>0
            'Проверим ПЕРВЫЙ символ, определим сколько битное кодирование
            If "&H"&Left(kod,2)>=128 then 
            'Больше чем байт
                If "&H"&Left(kod,2)<224 then 
                'Два байта
                    k1=Cint("&H"&Left(kod,2)) mod 32
                    k2 = Cint("&H"&Mid(kod,3,2)) mod 64
                    NameKoder=NameKoder&ChrW( k2 + k1 * 64 )
                    Kod=Right(kod,Len(kod)-4)
                Else
                'Три байта
                    k1=Cint("&H"&Left(kod,2)) mod 16
                    k2 = Cint("&H"&Mid(kod,3,2)) mod 32
                    k2 = Cint("&H"&Mid(kod,5,2)) mod 64
                    NameKoder=NameKoder&ChrW( k3 + ( k2 + k1 * 64 ) * 64 )
                    Kod=Right(kod,Len(kod)-6)
                End if
            Else
            NameKoder=NameKoder&Chr("&H"&Left(kod,2))
            Kod=Right(kod,Len(kod)-2)
            'WshShell.popup("NameKoder Добавлен очередной КОДОсимвол, теперь "&Cstr(Kod)&" а имя "&NameKoder)
            End If
            WshShell.popup("NameKoder Добавлен очередной КОДОсимвол, теперь "&Cstr(Kod)&" а имя "&NameKoder)
        Wend

'
'ЗолуС?РєР°-5
Kod="ЗолуС?РєР°-5"
WshShell.popup Kod&" исходный длина "&Len(kod)

'Перекодирую из двухбайтной UTF  в однобайтную ASC
'Первый байт - код кодировки, второй - код символа
        While len(kod)>0
        WshShell.popup Kod&" Код первого символа "&Asc(Left(kod,1))
            'Проверим ПЕРВЫЙ символ, определим сколько битное кодирование
            If Asc(Left(kod,1))>=128 then 
            'Больше чем байт
                If Asc(Left(kod,1))<224 then 
                'Два байта
                    k1=Asc(Left(kod,1)) mod 32
                    k2 = Asc(Mid(kod,2,1)) mod 64
                    NameKoder=NameKoder&ChrW( k2 + k1 * 64 )
                    Kod=Right(kod,Len(kod)-2)
                Else
                'Три байта
                    k1=Asc(Left(kod,1)) mod 16
                    k2 = Asc(Mid(kod,2,1)) mod 32
                    k2 = Asc(Mid(kod,3,1)) mod 64
                    NameKoder=NameKoder&ChrW( k3 + ( k2 + k1 * 64 ) * 64 )
                    Kod=Right(kod,Len(kod)-3)
                End if
            Else
            NameKoder=NameKoder&Left(kod,1)
            Kod=Right(kod,Len(kod)-1)
            'WshShell.popup("NameKoder Добавлен очередной КОДОсимвол, теперь "&Cstr(Kod)&" а имя "&NameKoder)
            End If
            WshShell.popup("NameKoder Добавлен очередной КОДОсимвол, теперь "&Cstr(Kod)&" а имя "&NameKoder)
        Wend

Все это - из моего разборщика почтовых сообщений, в котором компоненты не используются вообще, но упрощено и запускабельно.
Когда-то наваял "почтовый парсер" для понимания того, как оно все работает и кодируется. Понимание кодировок приходит сразу и навсегда - из опыта.

]]> Wed, 11 Nov 2009 08:03:31 +0000 http://forum.script-coding.com/viewtopic.php?pid=30377#p30377 <![CDATA[Re: VBScript: конвертация текста из кодировки в кодировку]]> http://forum.script-coding.com/viewtopic.php?pid=9094#p9094 По-моему (если только я сам не глючу), во всех примерах всё логично. Оба движка хранят строки в памяти в Юникоде (UTF-16), и объектам их передают тоже в Юникоде.

В первом примере fps метод WriteText пишет строку в Stream, преобразуя её в UTF-8. ReadText читает Stream в переменную (конвертация ANSI -> Unicode), предполагая, что его кодировка Windows-1251. В переменной должна получиться белиберда, но! Т.к. целевой файл открыт как ANSI, при записи в него происходит автоматическое обратное преобразование Unicode -> ANSI с использованием дефолтной кодовой страницы, т.е. той же 1251, и в файле оказывается опять UTF-8.

Отличие примера Xameleon'a в том, что исходная строка уже искажена неправильной конвертацией. бНОПНЯ получается, если ANSI 1251 конвертировать в Юникод с использованием таблицы для КОИ8-Р. Значит, вначале надо сделать обратную конвертацию с той же таблицей КОИ8-Р, чтобы получить исходный, нормальный ANSI-текст. Затем этот текст читается в переменную, т.е. конвертируется из ANSI в Unicode уже с использованием правильной для него таблицы 1251.

В последнем примере файл 866 читается в переменную inText (преобразование ANSI -> Unicode) с использование дефолтной кодовой страницы (1251). В переменной получается белиберда. Её пишут в Stream (Unicode -> ANSI) с использованием той же 1251, тем самым восстанавливая нормальный текст в 866. Затем его считывают опять в переменную (ANSI -> Unicode), но используя правильную для него таблицу 866. Получается уже нормальный читабельный текст, который и пишут в файл.

]]> Fri, 22 Feb 2008 06:59:24 +0000 http://forum.script-coding.com/viewtopic.php?pid=9094#p9094 <![CDATA[Re: VBScript: конвертация текста из кодировки в кодировку]]> http://forum.script-coding.com/viewtopic.php?pid=9093#p9093 > P.S. В Коллекции не дискутируем

ОК

Но дело не в кодировке скрипта.
И при загрузке строки из файла результат то-же.

вот пример на vbs, который перекодирует файл в ОЕМ кодировке в кодировку win-1251.
SourceCharset и DestCharset в нем тоже перепутаны

 set fs=CreateObject("Scripting.FilesystemObject")

 inText=fs.openTextFile("in.txt",1).readAll()

 x=strConv(inText,"ibm866","windows-1251")

 fs.openTextFile("out.txt",2,true).write(x)

 Function StrConv(Text,SourceCharset,DestCharset)
  Set Stream=CreateObject("ADODB.Stream")
  Stream.Type=2
  Stream.Mode=3
  Stream.Open
  Stream.Charset=DestCharset
  Stream.WriteText Text
  Stream.Position=0
  Stream.Charset=SourceCharset
  StrConv=Stream.ReadText
 End Function
]]> Fri, 22 Feb 2008 04:31:55 +0000 http://forum.script-coding.com/viewtopic.php?pid=9093#p9093 <![CDATA[VBScript: конвертация текста из кодировки в кодировку]]> http://forum.script-coding.com/viewtopic.php?pid=9090#p9090 Вопрос по теме в Коллекции VBScript: пример конвертации текста из кодировки в кодировку.

fps пишет:

переписал предыдущий пример на JS:

 var x=strConv("например","windows-1251","utf-8");

 new ActiveXObject("Scripting.FilesystemObject").openTextFile("out.txt",2,true).write(x);

 function strConv(txt, sourceCharset, destCharset)
 {
  with(new ActiveXObject("ADODB.Stream"))
  {
   type=2, mode=3, charset=destCharset;
   open();
   writeText(txt);
   position=0, charset=sourceCharset;
   return readText();
  }
 }

работает.

но, в моем примере sourceCharset и destCharset поменялись местами !
а если их использовать, как в предыдущем примере, то не работает.

я глючу?

P.S. В Коллекции не дискутируем, см. Правила, раздел 6.
Может, дело в кодировке файла самого скрипта?

]]> Thu, 21 Feb 2008 18:44:41 +0000 http://forum.script-coding.com/viewtopic.php?pid=9090#p9090