Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - Работа с данными

Страница: 1 |

 

  Вопрос: Раскодировка текста Добавлено: 08.07.04 16:58  

Автор вопроса:  Alexndr1 | Web-сайт: avpsun.mail333.com
Может быть кто знает как раскодировать текст из строки 1 в текст строки 2?

1. "=?Windows-1251?B?yO3y5fDg6vLo4u375SDu4fP34P756OUg7/Du4/Dg7Oz7IO3gIENELXNpbW9u?="
2. "Интерактивные обучающие программы на CD-simon"

Стандартная функция перекодировки из Windows-1251 в koi8-r или обратно не работает.

Ответить

  Ответы Всего ответов: 11  

Номер ответа: 1
Автор ответа:
 sne



Разработчик Offline Client

ICQ: 233286456 

Вопросов: 34
Ответов: 5445
  Web-сайт: hw.t-k.ru
 Профиль | | #1 		Добавлено: 08.07.04 18:05
вот это: Windows-1251 больше похоже на передачу кодировки...

Т.о. по-моему уж если что и раскодировать, так вот это:
yO3y5fDg6vLo4u375SDu4fP34P756OUg7/Du4/Dg7Oz7IO3gIENELXNpbW9u

Может это base64 ?

Ответить

Номер ответа: 2
Автор ответа:
 Alexndr1



Вопросов: 8
Ответов: 29
  Web-сайт: avpsun.mail333.com
 Профиль | | #2 		Добавлено: 08.07.04 18:32
То что перекодируется именно этот кусок - это понятно, а вот как его перекодировать?
Строка была приведена полностью для более полного представления о чем идет реч.

Ответить

Номер ответа: 3
Автор ответа:
 Павел



Администратор

ICQ: 326066673 

Вопросов: 368
Ответов: 5968
  Web-сайт: www.vbnet.ru
 Профиль | | #3 		Добавлено: 08.07.04 18:57
О! Как раз на днях по этой теме объяснял следующее:

Формат кодирования заголовков выглядит примерно таким образом
(на примере темы данного треда):

=?KOI8-R?Q?=CB=CF=C4=C9=D2=CF=D7=CB=C1=3F?=

=? - начало строки

KOI8-R - кодировка заголовка (может быть, например, WIN-1251)

? - разделитель

Q - тип кодирования.
Я знаю 2 варианта:
Q - Quoted-printable. Это то, про что Вы спрашивали. То есть ряд
символов (английские буквы, цифры, некоторые другие знаки) пишутся как
есть, остальное кодируется в шестнадцатеричном виде с добавлением в
начале знака "="
B - Base64. Я обычно им пользуюсь :)

? - разделитель

=CB=CF=C4=C9=D2=CF=D7=CB=C1=3F - собственно сам текст заголовка

?= - конец строки

Где-то валялся у меня класс для декодинга таких вещей на VB6... Если
надо, поищу. На .Net тоже есть, только выдрать из DLL будет трудновато
:(

Ответить

Номер ответа: 4
Автор ответа:
 sne



Разработчик Offline Client

ICQ: 233286456 

Вопросов: 34
Ответов: 5445
  Web-сайт: hw.t-k.ru
 Профиль | | #4 		Добавлено: 08.07.04 20:09
Хе :) даже угадал ;) ну или почти угадал :)

А вот дальше идет как раз класс...
Павел, когда ждать цитирование кода и прикрепления мелких файлов? Ты опять расслабляешься ;)


VERSION 1.0 CLASS
BEGIN
  MultiUse = -1 'True
  Persistable = 0 'NotPersistable
  ;DataBindingBehavior = 0 'vbNone
  ;DataSourceBehavior = 0 'vbNone
  MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "Base64"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'*************************************************************************************
'Base 64 Encoding class
'
'Author: Wil Johnson
' Wil.Johnson@att.net
'
'Version: 1.1
'
'Date: 3/21/2000
'
'Notes:
' This code is for example purposes only, and is provided as-is. While it has
' worked well under limited testing, the current error handling is minimal and
' should be expanded upon before release into a production environment. Please
' report all bugs found to the author for correction, even if you have already
' corrected them yourself.
'
' Again, this code is a rough draft. Feel free to use it, but do so at your own
' risk. These release notes must also remain intact.
'
'*************************************************************************************


Option Explicit

Private m_bytIndex(0 To 63) As Byte
Private m_bytReverseIndex(0 To 255) As Byte

Private Const k_bytEqualSign As Byte = 61

Private Const k_bytMask1 As Byte = 3 '00000011
Private Const k_bytMask2 As Byte = 15 '00001111
Private Const k_bytMask3 As Byte = 63 '00111111

Private Const k_bytMask4 As Byte = 192 '11000000
Private Const k_bytMask5 As Byte = 240 '11110000
Private Const k_bytMask6 As Byte = 252 '11111100



Private Const k_bytShift2 As Byte = 4
Private Const k_bytShift4 As Byte = 16
Private Const k_bytShift6 As Byte = 64


Private Const k_lMaxBytesPerLine As Long = 152

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
    


Public Function Encode(ByRef sInput As String) As String
    If sInput = "" Then Exit Function
    ;Dim bytTemp() As Byte
    bytTemp = StrConv(sInput, vbFromUnicode)
    Encode = EncodeArr(bytTemp)
End Function

Public Function EncodeFromFile(sFileName As String) As String
    On Error GoTo ErrorHandler:
    ;Dim bytFile() As Byte
    ;Dim iFile As Integer
    
    'get new file handle
    iFile = FreeFile

    Open sFileName For Input As #iFile
    'size the array to the size of the file
    ReDim bytFile(0 To VBA.LOF(iFile) - 1) As Byte
    'get everything in the file
    Input #iFile, bytFile
    Close #iFile
    
    'encode it
    EncodeFromFile = EncodeArr(bytFile)
    
    GoTo Done:
    
ErrorHandler:
    EncodeFromFile = ""
    Resume Done:

Done:
    On Error Resume Next
    Close #iFile
    
End Function

Public Function EncodeArr(ByRef bytInput() As Byte) As String
    On Error GoTo ErrorHandler:
    ;Dim bytWorkspace() As Byte 'array for the "rough draft" of the encoded data
    ;Dim bytResult() As Byte 'array for the "final draft"
    ;Dim bytCrLf(0 To 3) As Byte 'array that will contain vbCrLf, for CopyMemory purposes
    
    ;Dim lCounter As Long 'counter used to iterate through input bytes
    ;Dim lWorkspaceCounter As Long 'counter used to iterate through workspace bytes
    ;Dim lLineCounter As Long 'counter used when inserting CrLfs
    ;Dim lCompleteLines As Long 'used for calculations when inserting CrLfs
    ;Dim lBytesRemaining As Long 'used to determine how much work is left after coming out of a loop

    'pointers
    ;Dim lpWorkSpace As Long 'pointer to bytWorkspace. it's offset will change as bytes are copied out of the array
    ;Dim lpResult As Long 'pointer to bytResult. it's offset will also change
    ;Dim lpCrLf As Long 'pointer to bytCrLf. it is not offset and will not change
    

    'create a workspace larger than we need
    'this is to prevent VB from having to allocate memory constantly
    If UBound(bytInput) < 1024 Then
        ReDim bytWorkspace(LBound(bytInput) To (LBound(bytInput) + 4096)) As Byte
    Else
        ReDim bytWorkspace(LBound(bytInput) To (UBound(bytInput) * 4)) As Byte
    End If

    
    lWorkspaceCounter = LBound(bytWorkspace)

    'step through in 3 byte increments
    For lCounter = LBound(bytInput) To (UBound(bytInput) - ((UBound(bytInput) Mod 3) + 3)) Step 3
        'result set byte 1 = 6 most significant bits of first byte of input set
        'bits are right shifted by 2
        bytWorkspace(lWorkspaceCounter) = m_bytIndex((bytInput(lCounter) \ k_bytShift2))
        
        'result set byte 2 = 2 least significant bits of first byte and 4 most significant bits of second byte of input set
        'bits from first byte are left shifted by 4
        'bits from second byte are right shifted by 4
        bytWorkspace(lWorkspaceCounter + 2) = m_bytIndex(((bytInput(lCounter) And k_bytMask1) * k_bytShift4) + ((bytInput(lCounter + 1)) \ k_bytShift4))
        
        'result set byte 3 = 4 least significant bits of second byte and 2 most significant bits of third byte of input set
        'bits from second byte are left shifted by 2
        'bits from third byte are right shifted by 6
        bytWorkspace(lWorkspaceCounter + 4) = m_bytIndex(((bytInput(lCounter + 1) And k_bytMask2) * k_bytShift2) + (bytInput(lCounter + 2) \ k_bytShift6))
        
        'result set byte 4 = 6 least significant bits of third byte of input set
        'bits from third byte are not shifted at all
        bytWorkspace(lWorkspaceCounter + 6) = m_bytIndex(bytInput(lCounter + 2) And k_bytMask3)
        lWorkspaceCounter = lWorkspaceCounter + 8
    Next lCounter

    
    Select Case (UBound(bytInput) Mod 3):
        'for information on how bits are masked and shifted, see above
        Case 0:
            bytWorkspace(lWorkspaceCounter) = m_bytIndex((bytInput(lCounter) \ k_bytShift2))
            bytWorkspace(lWorkspaceCounter + 2) = m_bytIndex((bytInput(lCounter) And k_bytMask1) * k_bytShift4)
            bytWorkspace(lWorkspaceCounter + 4) = k_bytEqualSign
            bytWorkspace(lWorkspaceCounter + 6) = k_bytEqualSign
           
        Case 1:
            bytWorkspace(lWorkspaceCounter) = m_bytIndex((bytInput(lCounter) \ k_bytShift2))
            bytWorkspace(lWorkspaceCounter + 2) = m_bytIndex(((bytInput(lCounter) And k_bytMask1) * k_bytShift4) + ((bytInput(lCounter + 1)) \ k_bytShift4))
            bytWorkspace(lWorkspaceCounter + 4) = m_bytIndex((bytInput(lCounter + 1) And k_bytMask2) * k_bytShift2)
            bytWorkspace(lWorkspaceCounter + 6) = k_bytEqualSign

        Case 2:
            bytWorkspace(lWorkspaceCounter) = m_bytIndex((bytInput(lCounter) \ k_bytShift2))
            bytWorkspace(lWorkspaceCounter + 2) = m_bytIndex(((bytInput(lCounter) And k_bytMask1) * k_bytShift4) + ((bytInput(lCounter + 1)) \ k_bytShift4))
            bytWorkspace(lWorkspaceCounter + 4) = m_bytIndex(((bytInput(lCounter + 1) And k_bytMask2) * k_bytShift2) + ((bytInput(lCounter + 2)) \ k_bytShift6))
            bytWorkspace(lWorkspaceCounter + 6) = m_bytIndex(bytInput(lCounter + 2) And k_bytMask3)
        
    End Select

    lWorkspaceCounter = lWorkspaceCounter + 8

    'base64 encoding allows no more than 76 characters per line,
    'which translates to 152 bytes since the string is unicode
    If lWorkspaceCounter <= k_lMaxBytesPerLine Then
        'no need to line wrap.
        EncodeArr = Left$(bytWorkspace, InStr(1, bytWorkspace, Chr$(0)) - 1)
        'EncodeArr = bytWorkspace
    Else
        'must wrap lines
        'first, populate the CrLf byte array
        bytCrLf(0) = 13
        bytCrLf(1) = 0
        bytCrLf(2) = 10
        bytCrLf(3) = 0
                
        'size the end result array
        ReDim bytResult(LBound(bytWorkspace) To UBound(bytWorkspace))
        
        'get pointers to the various arrays
        lpWorkSpace = VarPtr(bytWorkspace(LBound(bytWorkspace)))
        lpResult = VarPtr(bytResult(LBound(bytResult)))
        lpCrLf = VarPtr(bytCrLf(LBound(bytCrLf)))
        
        'get count of complete lines
        lCompleteLines = Fix(lWorkspaceCounter / k_lMaxBytesPerLine)
        
        For lLineCounter = 0 To lCompleteLines
            'copy first line
            CopyMemory lpResult, lpWorkSpace, k_lMaxBytesPerLine
            
            'offset the workspace and result pointers by k_lMaxBytesPerLine
            lpWorkSpace = lpWorkSpace + k_lMaxBytesPerLine
            lpResult = lpResult + k_lMaxBytesPerLine
            
            'copy CrLf to result
            CopyMemory lpResult, lpCrLf, 4&
            
            'offset result pointer by another 4 bytes to account for the CrLf
            lpResult = lpResult + 4&
        Next lLineCounter
        
        'check if there are any remaining bytes in an incomplete line to be copied
        lBytesRemaining = lWorkspaceCounter - (lCompleteLines * k_lMaxBytesPerLine)
        If lBytesRemaining > 0 Then
            'copy remaining bytes to result
            CopyMemory lpResult, lpWorkSpace, lBytesRemaining
        End If
        
        'no need to resize the result before passing it back to a string,
        'since the empty space is made up of null chars that will terminate the
        'string automatically.
        'CopyMemory StrPtr(EncodeArr), VarPtr(bytResult(LBound(bytResult))), lpResult + lBytesRemaining
        EncodeArr = Left$(bytResult, InStr(1, bytResult, Chr$(0)) - 1)
    End If
    
    Exit Function

ErrorHandler:
    'on error just return an empty array
    Erase bytResult
    EncodeArr = bytResult
End Function

Public Function Decode(sInput As String) As String
    If sInput = "" Then Exit Function
    ;Decode = StrConv(DecodeArr(sInput), vbUnicode)
End Function

Public Sub DecodeToFile(sInput As String, sFileName As String)
    On Error GoTo ErrorHandler:
    ;Dim iFile As Integer
    
    'do not overwrite existing files
    If Dir(sFileName) <> "" Then
        Err.Raise vbObjectError + 1000, "Base64.DecodeToFile", "File already exists."
        GoTo Done:
    End If
    
    iFile = FreeFile
    Open sFileName For Binary As #iFile
    Put #iFile, , DecodeArr(sInput)
    Close #iFile
    
    GoTo Done
    
ErrorHandler:
    Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
    Resume Done:
    
Done:
    On Error Resume Next
    Close #iFile
End Sub

Public Function DecodeArr(sInput As String) As Byte()
    'returns a SBCS byte array
    ;Dim bytInput() As Byte 'base64 encoded string to work with
    ;Dim bytWorkspace() As Byte 'byte array to use as workspace
    ;Dim bytResult() As Byte 'array that result will be copied to
    ;Dim lInputCounter As Long 'iteration counter for input array
    ;Dim lWorkspaceCounter As Long 'iteration counter for workspace array
    
    
    'get rid of CrLfs, and "="s since they're not required for decoding,
    'and place the input in the byte array
    bytInput = Replace(Replace(sInput, vbCrLf, "";), "=", "";)
    
    'size the workspace
    ReDim bytWorkspace(LBound(bytInput) To (UBound(bytInput) * 2)) As Byte
    lWorkspaceCounter = LBound(bytWorkspace)
    
    'pass bytes back through index to get original values
    For lInputCounter = LBound(bytInput) To UBound(bytInput)
        bytInput(lInputCounter) = m_bytReverseIndex(bytInput(lInputCounter))
    Next lInputCounter
    
    For lInputCounter = LBound(bytInput) To (UBound(bytInput) - ((UBound(bytInput) Mod 8) + 8)) Step 8
        'left shift first input byte by 2 and right shift second input byte by 4
        bytWorkspace(lWorkspaceCounter) = (bytInput(lInputCounter) * k_bytShift2) + (bytInput(lInputCounter + 2) \ k_bytShift4)
        
        'mask bits 5-8 of second byte, left shift it by 4
        'right shift third byte by 2, add it to result of second byte
        bytWorkspace(lWorkspaceCounter + 1) = ((bytInput(lInputCounter + 2) And k_bytMask2) * k_bytShift4) + _
                                              ;(bytInput(lInputCounter + 4) \ k_bytShift2)
        
        'mask bits 3-8 of third byte, left shift it by 6, add it to fourth byte
        bytWorkspace(lWorkspaceCounter + 2) = ((bytInput(lInputCounter + 4) And k_bytMask1) * k_bytShift6) + _
                                              bytInput(lInputCounter + 6)
                                              
        lWorkspaceCounter = lWorkspaceCounter + 3
    Next lInputCounter
    
    
    'decode any remaining bytes that are not part of a full 4 byte block
    Select Case (UBound(bytInput) Mod 8):
        Case 3:
            'left shift first input byte by 2 and right shift second input byte by 4
            bytWorkspace(lWorkspaceCounter) = (bytInput(lInputCounter) * k_bytShift2) + (bytInput(lInputCounter + 2) \ k_bytShift4)
            
        Case 5:
            'left shift first input byte by 2 and right shift second input byte by 4
            bytWorkspace(lWorkspaceCounter) = (bytInput(lInputCounter) * k_bytShift2) + (bytInput(lInputCounter + 2) \ k_bytShift4)
            
            'mask bits 5-8 of second byte, left shift it by 4
            'right shift third byte by 2, add it to result of second byte
            bytWorkspace(lWorkspaceCounter + 1) = ((bytInput(lInputCounter + 2) And k_bytMask2) * k_bytShift4) + _
                                                  ;(bytInput(lInputCounter + 4) \ k_bytShift2)
            lWorkspaceCounter = lWorkspaceCounter + 1
            
        Case 7:
            'left shift first input byte by 2 and right shift second input byte by 4
            bytWorkspace(lWorkspaceCounter) = (bytInput(lInputCounter) * k_bytShift2) + (bytInput(lInputCounter + 2) \ k_bytShift4)
            
            'mask bits 5-8 of second byte, left shift it by 4
            'right shift third byte by 2, add it to result of second byte
            bytWorkspace(lWorkspaceCounter + 1) = ((bytInput(lInputCounter + 2) And k_bytMask2) * k_bytShift4) + _
                                                  ;(bytInput(lInputCounter + 4) \ k_bytShift2)
            
            'mask bits 3-8 of third byte, left shift it by 6, add it to fourth byte
            bytWorkspace(lWorkspaceCounter + 2) = ((bytInput(lInputCounter + 4) And k_bytMask1) * k_bytShift6) + _
                                                  bytInput(lInputCounter + 6)
            lWorkspaceCounter = lWorkspaceCounter + 2
    
        
    End Select
    
    'size the result array
    ReDim bytResult(LBound(bytWorkspace) To lWorkspaceCounter) As Byte
    
    'if option base is set to 1 then don't increment this value
    If LBound(bytWorkspace) = 0 Then
        lWorkspaceCounter = lWorkspaceCounter + 1
    End If
    
    'move decoded data to a properly sized array
    CopyMemory VarPtr(bytResult(LBound(bytResult))), VarPtr(bytWorkspace(LBound(bytWorkspace))), lWorkspaceCounter
    'return
    ;DecodeArr = bytResult
End Function


Private Sub Class_Initialize()
    m_bytIndex(0) = 65 'Asc("A";)
    m_bytIndex(1) = 66 'Asc("B";)
    m_bytIndex(2) = 67 'Asc("C";)
    m_bytIndex(3) = 68 'Asc(";D";)
    m_bytIndex(4) = 69 'Asc("E";)
    m_bytIndex(5) = 70 'Asc("F";)
    m_bytIndex(6) = 71 'Asc("G";)
    m_bytIndex(7) = 72 'Asc("H";)
    m_bytIndex(8) = 73 'Asc("I";)
    m_bytIndex(9) = 74 'Asc("J";)
    m_bytIndex(10) = 75 'Asc("K";)
    m_bytIndex(11) = 76 'Asc("L";)
    m_bytIndex(12) = 77 'Asc("M";)
    m_bytIndex(13) = 78 'Asc("N";)
    m_bytIndex(14) = 79 'Asc("O";)
    m_bytIndex(15) = 80 'Asc("P";)
    m_bytIndex(16) = 81 'Asc("Q";)
    m_bytIndex(17) = 82 'Asc("R";)
    m_bytIndex(18) = 83 'Asc("S";)
    m_bytIndex(19) = 84 'Asc("T";)
    m_bytIndex(20) = 85 'Asc("U";)
    m_bytIndex(21) = 86 'Asc("V";)
    m_bytIndex(22) = 87 'Asc("W";)
    m_bytIndex(23) = 88 'Asc("X";)
    m_bytIndex(24) = 89 'Asc("Y";)
    m_bytIndex(25) = 90 'Asc("Z";)
    m_bytIndex(26) = 97 'Asc("a";)
    m_bytIndex(27) = 98 'Asc("b";)
    m_bytIndex(28) = 99 'Asc("c";)
    m_bytIndex(29) = 100 'Asc("d";)
    m_bytIndex(30) = 101 'Asc("e";)
    m_bytIndex(31) = 102 'Asc("f";)
    m_bytIndex(32) = 103 'Asc("g";)
    m_bytIndex(33) = 104 'Asc("h";)
    m_bytIndex(34) = 105 'Asc("i";)
    m_bytIndex(35) = 106 'Asc("j";)
    m_bytIndex(36) = 107 'Asc("k";)
    m_bytIndex(37) = 108 'Asc("l";)
    m_bytIndex(38) = 109 'Asc("m";)
    m_bytIndex(39) = 110 'Asc("n";)
    m_bytIndex(40) = 111 'Asc("o";)
    m_bytIndex(41) = 112 'Asc("p";)
    m_bytIndex(42) = 113 'Asc("q";)
    m_bytIndex(43) = 114 'Asc("r";)
    m_bytIndex(44) = 115 'Asc("s";)
    m_bytIndex(45) = 116 'Asc("t";)
    m_bytIndex(46) = 117 'Asc("u";)
    m_bytIndex(47) = 118 'Asc("v";)
    m_bytIndex(48) = 119 'Asc("w";)
    m_bytIndex(49) = 120 'Asc("x";)
    m_bytIndex(50) = 121 'Asc("y";)
    m_bytIndex(51) = 122 'Asc("z";)
    m_bytIndex(52) = 48 'Asc("0";)
    m_bytIndex(53) = 49 'Asc("1";)
    m_bytIndex(54) = 50 'Asc("2";)
    m_bytIndex(55) = 51 'Asc("3";)
    m_bytIndex(56) = 52 'Asc("4";)
    m_bytIndex(57) = 53 'Asc("5";)
    m_bytIndex(58) = 54 'Asc("6";)
    m_bytIndex(59) = 55 'Asc("7";)
    m_bytIndex(60) = 56 'Asc("8";)
    m_bytIndex(61) = 57 'Asc("9";)
    m_bytIndex(62) = 43 'Asc("+";)
    m_bytIndex(63) = 47 'Asc("/";)
    
    m_bytReverseIndex(65) = 0 'Asc("A";)
    m_bytReverseIndex(66) = 1 'Asc("B";)
    m_bytReverseIndex(67) = 2 'Asc("C";)
    m_bytReverseIndex(68) = 3 'Asc(";D";)
    m_bytReverseIndex(69) = 4 'Asc("E";)
    m_bytReverseIndex(70) = 5 'Asc("F";)
    m_bytReverseIndex(71) = 6 'Asc("G";)
    m_bytReverseIndex(72) = 7 'Asc("H";)
    m_bytReverseIndex(73) = 8 'Asc("I";)
    m_bytReverseIndex(74) = 9 'Asc("J";)
    m_bytReverseIndex(75) = 10 'Asc("K";)
    m_bytReverseIndex(76) = 11 'Asc("L";)
    m_bytReverseIndex(77) = 12 'Asc("M";)
    m_bytReverseIndex(78) = 13 'Asc("N";)
    m_bytReverseIndex(79) = 14 'Asc("O";)
    m_bytReverseIndex(80) = 15 'Asc("P";)
    m_bytReverseIndex(81) = 16 'Asc("Q";)
    m_bytReverseIndex(82) = 17 'Asc("R";)
    m_bytReverseIndex(83) = 18 'Asc("S";)
    m_bytReverseIndex(84) = 19 'Asc("T";)
    m_bytReverseIndex(85) = 20 'Asc("U";)
    m_bytReverseIndex(86) = 21 'Asc("V";)
    m_bytReverseIndex(87) = 22 'Asc("W";)
    m_bytReverseIndex(88) = 23 'Asc("X";)
    m_bytReverseIndex(89) = 24 'Asc("Y";)
    m_bytReverseIndex(90) = 25 'Asc("Z";)
    m_bytReverseIndex(97) = 26 'Asc("a";)
    m_bytReverseIndex(98) = 27 'Asc("b";)
    m_bytReverseIndex(99) = 28 'Asc("c";)
    m_bytReverseIndex(100) = 29 'Asc("d";)
    m_bytReverseIndex(101) = 30 'Asc("e";)
    m_bytReverseIndex(102) = 31 'Asc("f";)
    m_bytReverseIndex(103) = 32 'Asc("g";)
    m_bytReverseIndex(104) = 33 'Asc("h";)
    m_bytReverseIndex(105) = 34 'Asc("i";)
    m_bytReverseIndex(106) = 35 'Asc("j";)
    m_bytReverseIndex(107) = 36 'Asc("k";)
    m_bytReverseIndex(108) = 37 'Asc("l";)
    m_bytReverseIndex(109) = 38 'Asc("m";)
    m_bytReverseIndex(110) = 39 'Asc("n";)
    m_bytReverseIndex(111) = 40 'Asc("o";)
    m_bytReverseIndex(112) = 41 'Asc("p";)
    m_bytReverseIndex(113) = 42 'Asc("q";)
    m_bytReverseIndex(114) = 43 'Asc("r";)
    m_bytReverseIndex(115) = 44 'Asc("s";)
    m_bytReverseIndex(116) = 45 'Asc("t";)
    m_bytReverseIndex(117) = 46 'Asc("u";)
    m_bytReverseIndex(118) = 47 'Asc("v";)
    m_bytReverseIndex(119) = 48 'Asc("w";)
    m_bytReverseIndex(120) = 49 'Asc("x";)
    m_bytReverseIndex(121) = 50 'Asc("y";)
    m_bytReverseIndex(122) = 51 'Asc("z";)
    m_bytReverseIndex(48) = 52 'Asc("0";)
    m_bytReverseIndex(49) = 53 'Asc("1";)
    m_bytReverseIndex(50) = 54 'Asc("2";)
    m_bytReverseIndex(51) = 55 'Asc("3";)
    m_bytReverseIndex(52) = 56 'Asc("4";)
    m_bytReverseIndex(53) = 57 'Asc("5";)
    m_bytReverseIndex(54) = 58 'Asc("6";)
    m_bytReverseIndex(55) = 59 'Asc("7";)
    m_bytReverseIndex(56) = 60 'Asc("8";)
    m_bytReverseIndex(57) = 61 'Asc("9";)
    m_bytReverseIndex(43) = 62 'Asc("+";)
    m_bytReverseIndex(47) = 63 'Asc("/";)
End Sub

Ответить

Номер ответа: 5
Автор ответа:
 Alexndr1



Вопросов: 8
Ответов: 29
  Web-сайт: avpsun.mail333.com
 Профиль | | #5 		Добавлено: 08.07.04 23:34
Уважаемый SNE огромное Вам спасибо все сработало.
С уважением, Alexandr1

Ответить

Номер ответа: 6
Автор ответа:
 Alexndr1



Вопросов: 8
Ответов: 29
  Web-сайт: avpsun.mail333.com
 Профиль | | #6 		Добавлено: 08.07.04 23:42
Павел, сработает ли код приведенный SNE в Вашем примере? Я попробовал результат не впечетляет, или, возможно требуется дополнительная перекодировка полученного после декодирования текста из koi8 в windows-1251?
Попробую сам, но пока это вопрос.

Ответить

Номер ответа: 7
Автор ответа:
 Alexndr1



Вопросов: 8
Ответов: 29
  Web-сайт: avpsun.mail333.com
 Профиль | | #7 		Добавлено: 09.07.04 00:08
Я попробовал перекодировать Ваш текст (koi8-r?Q?) у меня ничего не получилось. Хотя (koi8-r?B?) декодировался нормально. Если можете, подскажите, что делать c Q-типом.

Ответить

Номер ответа: 8
Автор ответа:
 sne



Разработчик Offline Client

ICQ: 233286456 

Вопросов: 34
Ответов: 5445
  Web-сайт: hw.t-k.ru
 Профиль | | #8 		Добавлено: 09.07.04 01:36
Q тип нужно:
1. разбить в массив - strArray = Split(str, "=";)
2. создать Byte массив размерности такой же, как и получившийся массив
3. Циклом преобразовать все значения, в строку - str = str & Chr(Val$(strAray(i)))

Ответить

Номер ответа: 9
Автор ответа:
 Павел



Администратор

ICQ: 326066673 

Вопросов: 368
Ответов: 5968
  Web-сайт: www.vbnet.ru
 Профиль | | #9 		Добавлено: 09.07.04 05:48
ИМХО, чушь какая-то... Для раскодирования Quoted-Printable нужно
пройтись циклом по строке, пропускать все символы, а при встрече "="
получить следующие за ним 2 символа и, приняв их за шестнадцатеричное
предстанвление кода символа, преобразовать в символ.

Вообще, вот код моего модуля на VB .NET для полного разбора таких
заголовоков.

Public Module mdlMIME
Public Enum EncType As Integer
None = 0
Base64 = 1
QuotedPrintable = 2
End Enum

Public Function MIMEDecode(ByVal Source As String) As String
Dim enc As String
Dim typeenc As String
Dim pr As String
Dim pp As Integer
Dim np As Integer
Dim Result As String
Dim Header As String
Dim Footer As String

If Source = "" Then Return Source

Try
pp = Source.IndexOf("=?")
np = Source.IndexOf("?", pp + 2)

If pp = -1 Or np = -1 Then
Result = Source
enc = "win-1251"
Exit Function
End If

enc = Source.Substring(pp + 2, np - pp - 2)
Header = Source.Substring(1, pp)

pp = np
np = Source.IndexOf("?", pp + 1)
typeenc = Source.Substring(pp + 1, np - pp)

pp = np
np = Source.IndexOf("?=", pp + 1)
If np = 0 Then
np = Source.Length
Footer = ""
Else
'np = np
If np <> Source.Length - 1 Then
Footer = Source.Substring(np + 2).Trim
End If
End If
pr = Source.Substring(pp + 1, np - pp - 1)

Select Case typeenc.Substring(0, 1)
Case "B"
Result = B64Decode(pr)
Case "Q"
Result = QPDecode(pr)
Case Else
Result = Source
End Select

Catch e As Exception
MsgBox(e.Message)
Finally
Dim temp As String
Dim encoding1 As Text.Encoding = Text.Encoding.GetEncoding(1251) 'Здесь по идее нужно поставить дефолтную кодировку
Dim encoding2 As Text.Encoding = Text.Encoding.GetEncoding(1251)

'Пока в этом смысла нет (пока я убрал дефолтную кодировку)
'temp = encoding1.GetString(encoding2.GetBytes(Header))
temp = Header

encoding1 = Text.Encoding.GetEncoding(EncFromString(enc))
temp &= encoding1.GetString(encoding2.GetBytes(Result))
If Footer <> "" Then
temp &= MIMEDecode(Footer)
End If
MIMEDecode = temp
End Try
End Function

Private Function EncFromString(ByVal Source As String) As Integer
Select Case Source.ToLower
Case "win-1251", "windows-1251"
Return 1251
Case "koi8-r"
Return 20866
End Select
End Function

Public Function QPDecode(ByVal Source As String) As String
Dim result As String
Dim i As Integer
Dim l As Integer

Dim C As Char

l = Source.Length
i = 1
Do While i <= l
C = Convert.ToChar(Mid(Source, i, 1))
If C = "=" Then
Try
result = result & Chr(CInt("&H0" & Mid(Source, i + 1, 1) & Mid(Source, i + 2, 1)))
Catch ex As Exception
'MsgBox("Ошибка в Utils.mdlMIMEDecode.QPDecode" & vbCrLf & ex.Message)
End Try
i = i + 3
Else
result = result & C
i = i + 1
End If
Loop
Return result
End Function

Public Function B64Decode(ByVal Source As String) As String
Dim pr As String
Dim i As Integer
'Удаление символов, не соответствующих base64-алфавиту
For i = 1 To Source.Length
If InStr(1, "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=", Mid(Source, i, 1)) <> 0 Then
pr = pr & Mid(Source, i, 1)
End If
Next i
If (pr.Length Mod 4) <> 0 Then
pr &= StrDup(4 - (pr.Length Mod 4), "=")
End If
Dim encoding As System.Text.Encoding = System.Text.Encoding.GetEncoding(1251)
Try
pr = encoding.GetString(Convert.FromBase64String(pr))
Catch ex As Exception
MsgBox("Ошибка в Utils.mdlMIMEDecode.B64Decode" & vbCrLf & ex.Message)
End Try
Return pr
End Function

Public Function MIMEEncode(ByVal Source As String, ByVal EncodeType As EncType, ByVal Encoding As String) As String
Dim temp As String
Dim EType As String
Select Case EncodeType
Case EncType.Base64
EType = "B"
Case EncType.QuotedPrintable
EType = "Q"
End Select
Dim enc As Text.Encoding = Text.Encoding.GetEncoding(Encoding)
temp = Convert.ToBase64String(enc.GetBytes(Source))

Return "=?" & Encoding & "?" & EType & "?" & temp & "?="
End Function
End Module

Ответить

Номер ответа: 10
Автор ответа:
 Alexndr1



Вопросов: 8
Ответов: 29
  Web-сайт: avpsun.mail333.com
 Профиль | | #10 		Добавлено: 09.07.04 14:44
Предложенный Вами вариант для .NET я переделал под VB6
Пример:
' str = QPDecode("CB=CF=C4=C9=D2=CF=D7=CB=C1=3F=";)
'
'После чего содержимое переменной str
'перекодируем в Windows-1251
'Как результат: "кодировка?"
'

Public Function QPDecode(ByVal Source As String) As String
Dim result As String
Dim i As Integer
Dim l As Integer
Dim v As Variant

'конвертируем строку в массив
v = Split(Source, "=";)
l = UBound(v)
i = 0
'проверяем действительно ли получен массив
If IsArray(v) And l >= 0 Then
    'собираем строку отчета
    ;Do While i <= l
result = result & Chr(CInt("&H0" & CStr(v(i))))
        i = i + 1
    Loop
    Erase v
Else
    QPDecode = Source
End If
QPDecode = result
result = vbNullString
End Function

Ответить

Номер ответа: 11
Автор ответа:
 Alexndr1



Вопросов: 8
Ответов: 29
  Web-сайт: avpsun.mail333.com
 Профиль | | #11 		Добавлено: 09.07.04 14:47
Огромное всем спасибо за помощь.
Каждый из ваших советов оказался нужным и очень полезным.
Пока все.

С уважением, Alexandr1

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам