Newsgroup: it.comp.lang.visual-basic
Titolo: Problema velocità

Sto scrivendo un programma di posta elettronica in VB6.
La funzione Decode64 serve a decodificare gli allegati Mime in base64. 
(Nelle mail sono validi solo i caratteri 0-127, il base 64 fa corrispondere 
3byte da 8bit a 4 byte da 6 bit presi da un alfabeto a parte A-Z (0-25) a-z 
(26-51) 0-1 (52-61) + 62 e / 63, l'uguale si usa per rimpire l'ultimo 
quartetto, nel caso i byte da codificare siano 1 o 2). Ho passato alla 
funzione un'allegato di una mail da 1900000 byte circa. La classica "Prova 
di carico". Dopo oltre 10 min sul mio PIV 3,2Ghz mi sono preoccupato.
Ho inserito una funzione che nel caso l'allegato superi i 10000 byte mostri 
frmWait che contiene una Label (lblWait) e una progressbar (pb) che mostrano 
l'avanzamento della routine, il tempo trascorso (ElTime in secondi e ElT in 
stringa) e il tempo stimato (EsTime in secondi e EsT in stringa).
Appena il programma comincia a decodificare va "a scheggia", passa blocchi 
su blocchi e mi stima un fiducioso 45 secondi.
Man mano che il mid(S,i,4) va avanti nella stringa il programma rallenta 
paurosamente e quando è arrivato a stimare 45 min e 7 secondi per l'allegato 
di cui sopra mi sono arreso.
Ci sono errori nel codice? Ci sono ottimizzazioni a cui non ho pensato? 
AIUUUUTOOOOOO
Non può metterci 3 quarti d'ora per un allegato da 2Mb
Public Function Decode64(ByVal S As String) As String
Dim WaitShow As Boolean, ShowTime As Long, WaitTime As Long, ElTime As Long, 
EsTIme As Long, ElT As String * 8, esT As String * 8 ' Variabili per frmWait
Dim i As Long
Dim C As String
Dim DecS As String
Dim D As Integer
Dim b1 As Integer, b2 As Integer, b3 As Integer, b4 As Integer, c1 As 
Integer, c2 As Integer, c3 As Integer
  WaitShow = False
  If Len(S) > 10000 Then WaitShow = True        ' accende il frmWait
    If WaitShow = True Then
    Load frmWait
    WaitTime = Int(Timer)
    frmWait.Caption = "Decoding base64.."
    frmWait.lblWait.Caption = "Wait for decoding..."
    frmWait.pb.Value = 0
    frmWait.Show
    ShowTime = Int(Len(S) / 1000)
    DoEvents
  End If
  i = 1
  DecS = ""
  S = Replace(S, Chr(13), "")    ' tolgo gli accapo dall'allegato
  S = Replace(S, Chr(10), "")
  Do
  C = Mid(S, i, 4)                        ' prendo il quartetto di byte da 6 
bit
  b1 = GetUUValue(Mid(C, 1, 1))        ' calcolo il valore 0-63
  b2 = GetUUValue(Mid(C, 2, 1))
  b3 = GetUUValue(Mid(C, 3, 1))
  b4 = GetUUValue(Mid(C, 4, 1))
  c1 = b1 * 4 + b2 \ 16                    ' compongo la trippletta a 8 bit 
(111111 112222 222233 333333)
  c2 = (b2 And 15) * 16 + b3 \ 4
  c3 = (b3 And 3) * 64 + b4
  If InStr("=", C) <> 0 Then
    If Len(C) - Len(Replace(C, "=", "")) = 2 Then        ' se ci sono uguali 
nell'ultimo quartetto
      DecS = DecS + Chr(c1)
    Else
      DecS = DecS + Chr(c1) + Chr(c2)
    End If
  Else
    DecS = DecS + Chr(c1) + Chr(c2) + Chr(c3)         ' In DecS 
(decodedString) il nostro risultat)
  End If
  i = i + 4                    ' Successivo quartetto
  If WaitShow = True Then                ' aggiorno il frmWait
   If (i Mod ShowTime) <= 4 Then
   ElTime = Int(Timer) - WaitTime
   ElT = Right("00" + Trim(Str(Int(ElTime / 3600))), 2) + ":" + Right("00" + 
Trim(Str(Int((ElTime \ 60) Mod 60))), 2) + ":" + Right("00" + 
Trim(Str(ElTime Mod 60)), 2)
   esT = Right("00" + Trim(Str(Int(EsTIme / 3600))), 2) + ":" + Right("00" + 
Trim(Str(Int((EsTIme \ 60) Mod 60))), 2) + ":" + Right("00" + 
Trim(Str(EsTIme Mod 60)), 2)
   EsTIme = Int((ElTime / i) * Len(S))
    frmWait.pb.Value = Int(i / Len(S) * 100)
    frmWait.lblWait.Caption = "Wait for decoding ..." + Str(i) + "/" + 
Str(Len(S)) + " Elapsed:" + ElT + " Est:" + esT
    DoEvents                ' per un po' restituisco il controllo a Win 
sennò mi si blocca tutto
    End If
  End If
  Loop Until i >= Len(S)
  Decode64 = DecS
End Function
Private Function GetUUValue(S As String) As Integer        ' trasforma i 
caratteri ascii nel loro valore 6bit
  Select Case Left(S, 1)
  Case "A" To "Z"
    GetUUValue = Asc(Left(S, 1)) - Asc("A")
  Case "a" To "z"
    GetUUValue = Asc(Left(S, 1)) - Asc("a") + 26
  Case "0" To "9"
    GetUUValue = Asc(Left(S, 1)) - Asc("0") + 52
  Case "+"
    GetUUValue = 62
  Case "/"
    GetUUValue = 63
  Case "="
    GetUUValue = 0
  End Select
End Function
Anche considerando che la routine di visualizzazione perda molto tempo, il 
problema non è quello. Vorrei che ci mettesse quei 45/60 secondi che stima 
all'inizio :-(
Saluti e grazie
Riccardo 

 PIV 3,2Ghz mi sono preoccupato.
Prova questa:
"Encode and Decode base64 at 6 megabytes per second !!!(on a Intel Pentium 
233) Documentation is in the zip (full source code included). Based on 
Sebastien's functions posted few monts ago on this site"
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=3600&lngWId=1
-- 
Gianluca Cannalire
Microsoft MVP/MCP - Visual Basic
http://www.visual-basic.it
http://community.visual-basic.it/gianluca


Acc....
Sul mio fa 66,67 Mb/Sec !!!!
Ci ho guardato bene, alcune ottimizzazioni sono tipo le mie ma meglio 
scritte in vb (or invece di + ecc...)
La cosa base mi sembra perň che usando una Byte Array vada molto meglio e 
molto piů veloce di una String e varie Mid, Left eccetera.
Che sia il fatto che uso una string che con un ciclo a costo computazionale 
lineare rallenti esponenzialmente con l'aumentare della stringa?

 della stringa?
UH!
O_o
....che cazzo hai detto????
che lingua č?...ma č italiano?


cmq
se le prestazioni sono un problema....
guarda anche qui
http://www.xbeat.net/vbspeed/c_Base64Dec.htm

 molto piů veloce di una String e varie Mid, Left eccetera.
Sě, le stringhe in VB6 sono piuttosto lente.
Lavorare su un array di byte č decisamente piů veloce.
Ciao
--
Reporting tool: 
http://www.neodatatype.net


Ho beccato dove esattamente è il problema,
Nella mia routine accodo i byte decodificati con un'istruzione del tipo
DecS = DecS + c1 +c2 +c3
Dove DecS sta per Decoded String. Man Mano che l'algoritmo va avanti 
(mettiamo di aver decodificato 500.000 byte) quando va a calcolare la parte 
destra della funzione prima di reimmettere il valore in DecS, il basic copia 
tutti i 500.000 byte in una temporanea istanza di decs (come risultato del 
"parser" del vb per l'operazione stringa), quindi ci accoda i nuovi byte e 
rimette tutto in decs.
All'inizio che decs è molto piccola non ti accorgi di questa operazione, ma 
se la stringa finale della decodifica è di 1000000 bytes il tempo di 
esecuzione non è lineare del tipo k * 1000000, ma esponenziale del tipo 
Sommatoria da 1 a 1000000 cioè n(n+1)/2 quindi in base ad n^2 perchè ogni 
volta duplica una stringa sempre pi grande :-(((( Ci ho messo due giorni a 
capirlo ma ne è valsa la pena :-)
Invece con un array già dimensionato il tempo di fare 
MioArray(indice)=qualchevalore è costante.
:-)
Grazie ancora a tutti e ciao.