Newsgroup: it.comp.lang.visual-basic
Titolo: base64 da ottimizzare

Come precedentemente annunciato, allego il codice relativo alle funzioni di
codifica/decodifica del base64:
Sub Base64Encode2(filei As String, fileo As String)
    On Error Resume Next
    Dim l As Long
    Dim i As Long
    Dim Filein As Long
    Dim Fileout As Long
    Dim temp As Variant
    Dim b As Integer
    Dim Base64Tab As Variant
    Dim s As Variant
    Dim Bidone As String
    Dim TabI() As Byte
    Dim bin(3) As Byte
'tabella di conversione
    Base64Tab = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K",
"L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z",
"a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o",
"p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "0", "1", "2", "3",
"4", "5", "6", "7", "8", "9", "+", "/")
'legge in blocco il file di input
    Filein = FreeFile
    Open filei For Binary As Filein
    l = LOF(Filein) - (LOF(Filein) Mod 3)
    Bidone = Space(l)
    Get Filein, 1, Bidone
    ReDim TabI(0 To Len(Bidone))
    TabI = StrConv(Bidone, vbFromUnicode)
'apre il file di output
    Fileout = FreeFile
    Open fileo For Output As Fileout
'legge blocchi di 3 byte e scrive
    For i = 1 To l Step 3
    'legge tre byte
    'scriva la stringa
        If Len(s) > 64 Then
            Print #Fileout, s
            s = ""
        End If
    'calcola il codice base 64
        s = s + Base64Tab((TabI(i - 1) \ 4) And &H3F)
        s = s + Base64Tab(((TabI(i - 1) And &H3) * 16) Or ((TabI(i) \ 16)
And &HF))
        s = s + Base64Tab(((TabI(i) And &HF) * 4) Or ((TabI(i + 1) \ 64) And
&H3))
        s = s + Base64Tab(TabI(i + 1) And &H3F)
    Next i
'finisce di leggere il resto del file
    If Not (LOF(Filein) Mod 3 = 0) Then
    'legge i byte rimanenti
        For i = 1 To (LOF(Filein) Mod 3)
            Get Filein, , bin(i - 1)
        Next i
    'se ci sono 2 byte...
        If (LOF(Filein) Mod 3) = 2 Then
            s = s + Base64Tab((bin(0) \ 4) And &H3F)
            s = s + Base64Tab(((bin(0) And &H3) * 16) Or ((bin(1) \ 16) And
&HF))
            s = s + Base64Tab(((bin(1) And &HF) * 4) Or ((bin(2) \ 64) And
&H3))
            s = s + "="
    'se c'e' un solo byte...
        Else
            s = s + Base64Tab((bin(0) \ 4) And &H3F)
            s = s + Base64Tab(((bin(1) And &H3) * 16) Or ((bin(1) \ 16) And
&HF))
            s = s + "=="
        End If
    End If
'salva gli ultimi dati
    If s <> "" Then
        Print #Fileout, s
    End If
'uscita
    Close Filein
    Close Fileout
End Sub
Sub Base64Decode2(filei As String, fileo As String)
    On Error Resume Next
    Dim f1 As Integer
    Dim f2 As Integer
    Dim Tabella(300) As Byte
    Dim out1 As String * 1
    Dim out2 As String * 1
    Dim out3 As String * 1
    Dim a As Byte
    Dim b As Byte
    Dim c As Byte
    Dim d As Byte
    Dim Riga As String
    Dim TabRiga() As Byte
    Dim Bidone As String
    Dim TabBidone() As String
    Dim r As Long
    Dim ll As Long
    Dim n As Integer
    Dim x As Integer
    Dim TabOutput() As Byte
'crea la tabella di conversione
    Riga =
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
    For n = 0 To Len(Riga$) - 1
        indice = Asc(Mid$(Riga, n + 1, 1))
        Tabella(indice) = n
    Next n
    Tabella(Asc("=")) = 100
'legge il file in blocco e lo spezza in righe
    f1 = FreeFile
    Open filei For Binary As f1
    Bidone = Space$(LOF(f1))
    Get #f1, 1, Bidone
    TabBidone = Split(Bidone, vbCrLf)
    f2 = FreeFile
'apre file di output
    Open fileo For Binary As f2
'converte le prime righe
    Bidone = ""
    ll = UBound(TabBidone)
    ReDim TabRiga(0 To Len(TabBidone(0)))
    ReDim TabOutput(0 To (Len(TabBidone(0)) / 4 * 3) - 1)
    For r = 0 To ll - 2
        Riga = TabBidone(r)
        TabRiga = StrConv(Riga, vbFromUnicode)
        x = 0
        For n = 0 To Len(Riga$) - 1 Step 4
            a = Tabella(TabRiga(n))
            b = Tabella(TabRiga(n + 1))
            c = Tabella(TabRiga(n + 2))
            d = Tabella(TabRiga(n + 3))
            TabOutput(x) = ((a And 63) * 4) + (b \ 16)
            TabOutput(x + 1) = ((b And 15) * 16) + (c \ 4)
            TabOutput(x + 2) = ((c And 3) * 64) + d
            x = x + 3
        Next n
        Bidone = StrConv(TabOutput, vbUnicode)
        Put f2, , Bidone
    Next r
'converte le ultime 2 righe
    Bidone = ""
    For r = ll - 1 To ll
        Riga = TabBidone(r)
        ReDim TabRiga(0 To Len(Riga))
        TabRiga = StrConv(Riga, vbFromUnicode)
        For n = 0 To Len(Riga$) - 1 Step 4
            a = Tabella(TabRiga(n))
            b = Tabella(TabRiga(n + 1))
            c = Tabella(TabRiga(n + 2))
            d = Tabella(TabRiga(n + 3))
            If c = 100 And d = 100 Then
                out1 = Chr$(((a And 63) * 4) + (b \ 16))
                Bidone = Bidone + out1
            Else
                If d = 100 Then
                    out1 = Chr$(((a And 63) * 4) + (b \ 16))
                    out2 = Chr$(((b And 15) * 16) + (c \ 4))
                    Bidone = Bidone + out1 + out2
                Else
                    out1 = Chr$(((a And 63) * 4) + (b \ 16))
                    out2 = Chr$(((b And 15) * 16) + (c \ 4))
                    out3 = Chr$(((c And 3) * 64) + d)
                    Bidone = Bidone + out1 + out2 + out3
                End If
            End If
        Next n
        Put f2, , Bidone
        Bidone = ""
    Next r
'fine
    Close f1
    Close f2
End Sub

 s = s + Base64Tab((TabI(i - 1) \ 4) And &H3F)
Ritorno al dicorso del concatenamento stringhe: è lento, usa un array di
byte, così scrivi direttamente nella cella che desideri aggiornare
Comunque, visto che in ingresso hai un byte, ovvero il valore di TabI(i -
1), puoi creare, prima del ciclo un array tipo
TIdiv4And3f().
Inizializzi tale array per tutti i valori di ingresso possibili (256).
in questo modo l'assegnamento risulta (sempre parlando di stringhe)
s=s+Base64Tab(TIdiv4And3f((TabI(i - 1)))
Ancor meglio, visto che anche Base64Tab è un array, crea un array luteriore
tipo
Base64TabTIdiv4And3f() che inizializzi con tutti i valori di ingresso
possibili.
in questo modo l'assegnamento risulta (sempre parlando di stringhe)
s=s+Base64TabTIdiv4And3f((TabI(i - 1))
ovvero molto veloce, indipendentemente dal tipo di calcolo che è sotteso.
Ovviamente i nomi degli array puoi semplificarli a piacere :)
<x:termoPilucco>

"termoPilucco"  ha scritto nel messaggio:
Qui sotto ti posto il codice che avevo creato ai tempi per codificare un
file generico in UUE.
Lascia perdere i nomi idioti che usato per le variabili (l'ho fatto in
fretta e furia), ma puoi prendere spunto dal modo in cui leggo/scrivo i dati
e come utilizzo gli array di appoggio per evitare di fare calcoli.
Sub encode(strNomefile As String)
' crea un file codificato UUencode.
' input: nome file da codificare
Dim a As Long        ' contatore
Dim b As Long        ' contatore
Dim ss As String     ' stringa output
Dim filesize As Long ' massimo 2 Gigabyte
Dim f As Long        ' file handle
Dim s1 As Long       ' file handle
Dim tot As Long
Dim pt As Long
Dim mm As Long
Dim newdim As Long
Dim npt As Long
Dim riga As Long
Dim ll As Long
Dim dimsorg As Long
Dim righe As Long
Dim nd
Dim zz As Long
' tabelle d'appoggio per velocizzare calcolo
Dim enc(255) As Byte
Dim enc_a(255) As Byte
Dim d_enc_b1(255) As Byte
Dim d_enc_b2(255) As Byte
Dim d_enc_c1(255) As Byte
Dim d_enc_c2(255) As Byte
Dim enc_d(255) As Byte
' popolamento tabelle d'appoggio
enc(0) = 96
For a = 1 To 223
      enc(a) = a + 32
Next
For a = 0 To 255
      enc_a(a) = enc((a And 252) \ 4)
Next
For a = 0 To 255
      d_enc_b1(a) = (a And 240) \ 16
Next
For a = 0 To 255
      d_enc_b2(a) = ((a And 3) * 16)
Next
For a = 0 To 255
      d_enc_c1(a) = (a And 192) \ 64
Next
For a = 0 To 255
      d_enc_c2(a) = ((a And 15) * 4)
Next
For a = 0 To 255
      enc_d(a) = enc((a And 63))
Next
f = FreeFile
filesize = FileLen(strNomefile)
If Dir(strNomefile & ".uue") <> "" Then
      If MsgBox("Il file di destinazione esite già; lo elimino?", vbYesNo)
<> vbYes Then Exit Sub
      Kill (strNomefile & ".uue")
End If
Open strNomefile & ".uue" For Binary As f
s1 = FreeFile
Open strNomefile For Binary Access Read As s1
' intestazione
ss = "begin 664 " & Mid(strNomefile, InStrRev(strNomefile, "\") + 1) &
vbCrLf
Put #f, , ss
pt = filesize
While pt <> 0
    If pt >= 45000 Then
          ReDim sorg(44999) As Byte
          pt = pt - 45000
    Else
          If pt Mod 3 = 0 Then
                ReDim sorg(pt - 1)
                npt = 0
          Else
                npt = (pt \ 3) * 3 + 3
                ReDim sorg(npt - 1)
                npt = npt - pt
          End If
          pt = 0
    End If
    Get #s1, , sorg
    tot = UBound(sorg) + 1 - LBound(sorg)
    ' tot*4\3 rappresenta i 4 byte ogni 3 byte.
    '  (((tot - 1) \ 45) + 1) * 3 rappresenta lo spazio per i caratteri
vbcrlf a fine di ogni riga e del carattere iniziale (la dimensione in byte
della riga)
    righe = ((tot - 1) \ 45) + 1
    nd = ((tot * 4) \ 3 + (righe * 3))
    ReDim t(nd - 1) As Byte
    a = 0
    b = 0
    riga = 0
    While tot > a
          If a Mod 45 = 0 Then
                riga = riga + 1
                If riga = righe Then
                      ll = (tot - a) - npt
                Else
                      ll = IIf(tot - a >= 45, 45, tot - a)
                End If
                t(b) = enc(ll)
                b = b + 1
          End If
          t(b) = enc_a(sorg(a))
          b = b + 1
          t(b) = enc(d_enc_b1(sorg(a + 1)) + d_enc_b2(sorg(a)))
          b = b + 1
          t(b) = enc(d_enc_c1(sorg(a + 2)) + d_enc_c2(sorg(a + 1)))
          b = b + 1
          t(b) = enc_d(sorg(a + 2))
          b = b + 1
          a = a + 3
          If a Mod 45 = 0 Or tot = a Then t(b) = 13: b = b + 1: t(b) = 10: b
= b + 1
    Wend
    Put #f, , t()
Wend
ss = "'" & vbCrLf & "end"
Put #f, , ss
Close f
Close s1
End Sub
' <x:termoPilucco>

 po' troppo.
si, e' vero, pero' ho scelto questo sistema perche' usavo la funzione solo
per creare allegati ad email.
Per il resto ti ringrazio molto: il fatto di creare delle tabelle
"premasticate" mi era completamente sfuggito  :-P
Ciao  :)
HD

 "premasticate" mi era completamente sfuggito  :-P
Mi è rimasto da quando programmavo in Assembler su Amiga :)
Allora si faceva gara a chi ce l'aveva più grosso (il motore 3D, che avete
capito?).
Il mio faceva una cosa sola (poligoni scialbi e flat con pochi colori), ma
andava tipo tre volte più veloce di quelli utilizzati dai videogiochi :)
Occupava meno di quattro Kb su disco, ma quasi mezzo mega in memoria :)
<x:termoPilucco>

 Bla bla bla
Se ti interessano solo le prestazioni, potresti provare a sfruttare in
maniera estrmamante poco ortodossa le MSXML. Per informazioni prova a
cercare qualcosa tipo "bin.base64" sul sito microsoft. Codifica e
decodifica sono *istantanee*.
Se invece era a scopo didattico, o ti interessava comunque scriverle
in codice puro, niente.
Ciao.

 ha
scritto:

Saresti così gentile da fornirmi anche il codice per la decodifica dei file
uuencode fatta da te?
Mi serve per poter trasferire dei file in remoto tra due programmi in VB6
con il controllo Winsock.
Ringrazio anticipatamente
--------------------------------
Inviato via 
http://arianna.libero.it/usenet/

 decodifica dei file  uuencode fatta da te?
Non l'ho scritta :)
Ho scritto solo la funzione che hai quotato (quella per codificare), e ho
usato Winzip per verificarne la correttezza.
termoPilucco

 ha
scritto:

Ho capito. Sapresti darmi un consiglio su come potrei agire?
Ti ricordo che uso l'uuencode per scomporre un file ed inviarlo a pacchetti
tramite winsock ad un programma in remoto al quale volevo applicare il
sistema di decodifica che purtroppo non hai.
Grazie


 Ho capito. Sapresti darmi un consiglio su come potrei agire?
Prova vedere qui:
http://www.vbip.com/winsock/winsock_uucode_04.asp
Non credo che sia performante, però.
termoPilucco

 sistema di decodifica che purtroppo non hai.
http://sevillaonline.com/ActiveX/Base64.htm
ciao
	maxx
-- 
NOSPAM: Rimuovere i trattini dallo username!
Cut hyphens from my username!