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

   
   
     

Форум - Общий форум

Страница: 1 | 2 |

 

  Вопрос: Декодер Base64 Добавлено: 02.09.07 00:12  

Автор вопроса:  Stasik
Приветствую Вас снова!

Получаю Email по POP3 с прекреплённым файлом. Использую при этом уже готовую библиотеку OSPOP3.dll
http://www.ostrosoft.com/pop3_component.asp

В библиотеке уже предусмотренна функция декодеровки Base64. Требуется отследить статус декодеровки в процентах (ProgressBar). Библиотека этого не предусматривает. Т.е. функция перекодировки не возвращает ничего...

Соответсвенно требуется внешний декодер, который можно было бы редактирыватьл и добавить в него ProgressBar.

У кого-нибудь есть рабочий декодер?
Нашел парочку, но они либо глючат, либо вообще не работают...

Буду очень благодарен за помощь!

Ответить

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

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



Вопросов: 87
Ответов: 2795
  Web-сайт: winandfx.narod.ru
 Профиль | | #1 		Добавлено: 02.09.07 02:15
Вот модуль для Base64
из
Test Programm For Compressors V1.04

Весь пример не могу кинуть - очень большой т.к. куча разных (де)компрессоров
Option Explicit

Private Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

Public Sub Base64Array_Encode(ByteArray() As Byte)
    Dim OutStream() As Byte
    Dim OutPos As Long
    Dim InpPos As Long
    Dim c1, c2, c3 As Integer
    ReDim OutStream(500)
    InpPos = 0
    OutPos = 0
    Do While InpPos <= UBound(ByteArray)
        c1 = ReadValue(ByteArray, InpPos)
        c2 = ReadValue(ByteArray, InpPos)
        c3 = ReadValue(ByteArray, InpPos)
        Call AddValueToStream(OutStream, OutPos, mimeencode(Int(c1 / 4)))
        Call AddValueToStream(OutStream, OutPos, mimeencode((c1 And 3) * 16 + Int(c2 / 16)))
        If InpPos - 2 <= UBound(ByteArray) Then
            Call AddValueToStream(OutStream, OutPos, mimeencode((c2 And 15) * 4 + Int(c3 / 64)))
        End If
        If InpPos - 1 <= UBound(ByteArray) Then
            Call AddValueToStream(OutStream, OutPos, mimeencode(c3 And 63))
        End If
    Loop
    ReDim ByteArray(OutPos - 1)
    Call CopyMem(ByteArray(0), OutStream(0), OutPos)
End Sub

Public Sub Base64Array_Decode(ByteArray() As Byte)
    Dim OutStream() As Byte
    Dim OutPos As Long
    Dim InpPos As Long
    Dim w1, w2, w3, w4 As Integer
    ReDim OutStream(500)
    InpPos = 0
    OutPos = 0
    Do While InpPos < UBound(ByteArray)
        w1 = mimedecode(ReadValue(ByteArray, InpPos))
        w2 = mimedecode(ReadValue(ByteArray, InpPos))
        w3 = mimedecode(ReadValue(ByteArray, InpPos))
        w4 = mimedecode(ReadValue(ByteArray, InpPos))
        If w2 >= 0 Then Call AddValueToStream(OutStream, OutPos, (w1 * 4 + Int(w2 / 16)) And 255)
        If w3 >= 0 Then Call AddValueToStream(OutStream, OutPos, (w2 * 16 + Int(w3 / 4)) And 255)
        If w4 >= 0 Then Call AddValueToStream(OutStream, OutPos, (w3 * 64 + w4) And 255)
    Loop
    ReDim ByteArray(OutPos - 1)
    Call CopyMem(ByteArray(0), OutStream(0), OutPos)
End Sub

Private Function mimeencode(w As Integer) As Byte
   If w >= 0 Then mimeencode = ASC(Mid$(Base64, w + 1, 1)) Else mimeencode = 0
End Function

Private Function mimedecode(A As Integer) As Integer
   If A = 0 Then mimedecode = -1: Exit Function
   mimedecode = InStr(Base64, Chr(A)) - 1
End Function

Private Function ReadValue(FromArray() As Byte, FromPos As Long) As Integer
    If FromPos <= UBound(FromArray) Then
        ReadValue = FromArray(FromPos)
    Else
        ReadValue = 0
    End If
    FromPos = FromPos + 1
End Function

Private Sub AddValueToStream(ToStream() As Byte, ToPos As Long, Number As Byte)
    If ToPos > UBound(ToStream) Then ReDim Preserve ToStream(ToPos + 100)
    ToStream(ToPos) = Number
    ToPos = ToPos + 1
End Sub

Ответить

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



Вопросов: 3
Ответов: 21
  Профиль | | #2 Добавлено: 02.09.07 03:06
Два вопроса:

1. Как переменную содержащую body прикреплённого к письму файла(String) перевести ByteArray()?

2. Как всё это добро сохранить в фаил? Т.е. получить конечный фаил если это например фотография...

Ответить

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



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

ICQ: 233286456 

Вопросов: 34
Ответов: 5445
  Web-сайт: hw.t-k.ru
 Профиль | | #3 		Добавлено: 02.09.07 11:20
1. StrConv

2.
dim nf as integer

nf = freefile()
open nf for binary acces write lock read as nf
    put nf, , byte_array
close nf

Ответить

Номер ответа: 4
Автор ответа:
 el-paso



Вопросов: 0
Ответов: 56
  Профиль | | #4 Добавлено: 02.09.07 12:57
Если речь идет о VB6, то по первому вопросу могу предложить более простой вариант:

Dim s As String: s = "Превед!"
Dim b() As Byte: b = s

Ответить

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



Вопросов: 3
Ответов: 21
  Профиль | | #5 Добавлено: 02.09.07 13:49
Речь идёт о VB6...
Спасибо всем за помощь...
Всё собрал! Всё работает! Программа ошибок никаких не выдаёт, но сохранённый фаил (в моём случае это фотография) всегда получается размером в 1 байт вместо мегобайта...

В чём может быть проблема? Помогите пожалуйста...



Option Explicit
Private Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Sub Main()
Dim arr() As Byte
'body - это строка, тело прикреплённого файла, полученная с почтового ящика.

arr = StrConv(fileCont, vbFromUnicode)
      Call Base64Array_Encode(arr)
End Sub

ublic Sub Base64Array_Encode(ByteArray() As Byte)
    Dim OutStream() As Byte
    Dim nf As Integer
    Dim OutPos As Long
    Dim InpPos As Long
    Dim c1, c2, c3 As Integer
    Dim fname As String
    ReDim OutStream(500)
    InpPos = 0
    OutPos = 0
    Do While InpPos <= UBound(ByteArray)
        c1 = ReadValue(ByteArray, InpPos)
        c2 = ReadValue(ByteArray, InpPos)
        c3 = ReadValue(ByteArray, InpPos)
        Call AddValueToStream(OutStream, OutPos, mimeencode(Int(c1 / 4)))
        Call AddValueToStream(OutStream, OutPos, mimeencode((c1 And 3) * 16 + Int(c2 / 16)))
        If InpPos - 2 <= UBound(ByteArray) Then
            Call AddValueToStream(OutStream, OutPos, mimeencode((c2 And 15) * 4 + Int(c3 / 64)))
        End If
        If InpPos - 1 <= UBound(ByteArray) Then
            Call AddValueToStream(OutStream, OutPos, mimeencode(c3 And 63))
        End If
    Loop
    ReDim ByteArray(OutPos - 1)
    Call CopyMemory(ByteArray(0), OutStream(0), OutPos)

'Здесь я прописываю сохранение в фаил. В данно случае фотография (jpg)

    nf = FreeFile()
    fname = "c:/fff.jpg"
Open fname For Binary Access Write Lock Read As nf
    Put nf, , ByteArray(0)
Close nf
End Sub

Private Function mimeencode(w As Integer) As Byte
   If w >= 0 Then mimeencode = Asc(Mid$(Base64, w + 1, 1)) Else mimeencode = 0
End Function

Private Function ReadValue(FromArray() As Byte, FromPos As Long) As Integer
    If FromPos <= UBound(FromArray) Then
        ReadValue = FromArray(FromPos)
    Else
        ReadValue = 0
    End If
    FromPos = FromPos + 1
End Function

Private Sub AddValueToStream(ToStream() As Byte, ToPos As Long, Number As Byte)
    If ToPos > UBound(ToStream) Then ReDim Preserve ToStream(ToPos + 100)
    ToStream(ToPos) = Number
    ToPos = ToPos + 1
End Sub

Ответить

Номер ответа: 6
Автор ответа:
 el-paso



Вопросов: 0
Ответов: 56
  Профиль | | #6 Добавлено: 02.09.07 13:53
Put nf, , ByteArray(0) - это неправильно
Put nf, , ByteArray()

Ответить

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



Вопросов: 3
Ответов: 21
  Профиль | | #7 Добавлено: 02.09.07 14:08
Подправил... Теперь вообще конечный фаил получается 3,6 мега вместо одного мега и естестествено не открывается...

Ещё ошибки где-то есть... :(

Ответить

Номер ответа: 8
Автор ответа:
 el-paso



Вопросов: 0
Ответов: 56
  Профиль | | #8 Добавлено: 02.09.07 14:09
А ты уверен, что там base64 кодировка?

Ответить

Номер ответа: 9
Автор ответа:
 el-paso



Вопросов: 0
Ответов: 56
  Профиль | | #9 Добавлено: 02.09.07 14:15
Еще вижу ошибку..
ReDim ByteArray(OutPos - 1)

Правильно:
ReDim Preserve ByteArray(OutPos - 1)

Ответить

Номер ответа: 10
Автор ответа:
 el-paso



Вопросов: 0
Ответов: 56
  Профиль | | #10 Добавлено: 02.09.07 14:16
Кхм.. Нет с предыдущим постом я погорячился :)

Ответить

Номер ответа: 11
Автор ответа:
 el-paso



Вопросов: 0
Ответов: 56
  Профиль | | #11 Добавлено: 02.09.07 14:18
А этта.. Почему ты кодируешь свой массив в base64, а не наоборот. Разве не логичнее юзать функцию Base64_Decode()?

Ответить

Номер ответа: 12
Автор ответа:
 Stasik



Вопросов: 3
Ответов: 21
  Профиль | | #12 Добавлено: 02.09.07 14:26
Вот описание библиотеки которой пользуюсь:
http://www.ostrosoft.com/pop3_component.asp

Смотри в самом низу - Methods: object.Save

Там написано если кодеровка принятого файла Base64, то при сохранени он будет автоматически перекодирыван, т.е. это процедура внутри dll библиотеки. Если сохраняю этот же фаил с помощью библиотеки, то всё работает на ура. Значит фаил перекодируется, значит кодировка Base64. Плюс ко всему параметр object.ContentTransferEncoding (смотри в описании библиотеки) даёт именно Base64. А вот с внешним декодером не хочет работать.

Ответить

Номер ответа: 13
Автор ответа:
 el-paso



Вопросов: 0
Ответов: 56
  Профиль | | #13 Добавлено: 02.09.07 14:29
Значит все-таки нужно использовать не Encode, а Decode, не?

Ответить

Номер ответа: 14
Автор ответа:
 Stasik



Вопросов: 3
Ответов: 21
  Профиль | | #14 Добавлено: 02.09.07 14:33
Уфффф... Во я дурак... Уже меняю...
Я просто сутки не спал... Голова уже не варит!

Ответить

Номер ответа: 15
Автор ответа:
 Stasik



Вопросов: 3
Ответов: 21
  Профиль | | #15 Добавлено: 02.09.07 14:38
Всё. Поменял... Теперь конечный фаил получается правильнго размера, но он не открывается...
Опять что-то не так... :/

Option Explicit
Private Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Sub Main()
Dim arr() As Byte
'body - это строка, тело прикреплённого файла, полученная с почтового ящика.

arr = StrConv(fileCont, vbFromUnicode)
      Call Base64Array_Decode(arr)
End Sub

Public Sub Base64Array_Decode(ByteArray() As Byte)
    Dim OutStream() As Byte
    Dim OutPos As Long
    Dim InpPos As Long
    Dim nf As Integer
    Dim fname As String
    Dim w1, w2, w3, w4 As Integer
    ReDim OutStream(500)
    InpPos = 0
    OutPos = 0
    Do While InpPos < UBound(ByteArray)
        w1 = mimedecode(ReadValue(ByteArray, InpPos))
        w2 = mimedecode(ReadValue(ByteArray, InpPos))
        w3 = mimedecode(ReadValue(ByteArray, InpPos))
        w4 = mimedecode(ReadValue(ByteArray, InpPos))
        If w2 >= 0 Then Call AddValueToStream(OutStream, OutPos, (w1 * 4 + Int(w2 / 16)) And 255)
        If w3 >= 0 Then Call AddValueToStream(OutStream, OutPos, (w2 * 16 + Int(w3 / 4)) And 255)
        If w4 >= 0 Then Call AddValueToStream(OutStream, OutPos, (w3 * 64 + w4) And 255)
    Loop
    ReDim ByteArray(OutPos - 1)
    Call CopyMem(ByteArray(0), OutStream(0), OutPos)
    
    nf = FreeFile()

    fname = "c:/fff.jpg"
Open fname For Binary Access Write Lock Read As nf
    Put nf, , ByteArray()
Close nf
End Sub

Private Function mimedecode(A As Integer) As Integer
   If A = 0 Then mimedecode = -1: Exit Function
   mimedecode = InStr(Base64, Chr(A)) - 1
End Function

Private Function ReadValue(FromArray() As Byte, FromPos As Long) As Integer
    If FromPos <= UBound(FromArray) Then
        ReadValue = FromArray(FromPos)
    Else
        ReadValue = 0
    End If
    FromPos = FromPos + 1
End Function

Private Sub AddValueToStream(ToStream() As Byte, ToPos As Long, Number As Byte)
    If ToPos > UBound(ToStream) Then ReDim Preserve ToStream(ToPos + 100)
    ToStream(ToPos) = Number
    ToPos = ToPos + 1
End Sub

Ответить

Страница: 1 | 2 |

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



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