Newsgroup: it.comp.programmare.win32
Titolo: compressione stringhe in ram (scusate il cross-post)

salve a tutti gli utenti di questo NG (sul quale non ho mai postato prima),
qualcuno è a conoscenza di codice per visual basic (VB5) che implementi
routines per la compressione / decompressione di stringhe binarie in ram
attraverso algoritmi tipo il Lempel Ziv Huffman ?
La scarsa velocità e/ o la non compatibilità con gli standard sttuali non
rappresentano alcun problema, tuttavia avrei bisogno di codice freeware o
meglio ancora di pubblico dominio, perchè mi servirà per implementare la
compressione di pagine di libri elettronici (di cui sono autore e legittimo
proprietario) che vorrei poi vendere e sfruttare commercialmente se
possibile
grazie in anticipo
Soviet-Mario

 ha scritto nel messaggio
news:bhecel$fte$1...@newsread.albacom.net...

provare le zlib ??? il vb non puo' linkare librerie esterne in c ??? se si
usale ...
ciao

>qualcuno è a conoscenza di codice per visual basic (VB5) che >implementi
routines per la compressione...
Ho due funzioni ben implementate per comprimere/decomprimere con l'algoritmo
di Huffaman. Sono in un altro dialetto Basic, tuttavia le puoi convertire
per VB, facilmente. Se ti interessa, scrivimi in email.
--------------------------------
Inviato via 
http://usenet.libero.it


Sono stati scritti diversi ActiveX basati su zlib, cercali nella pagina
-- 
  < 
http://www.reactos.com/
 >  Open source clone of Windows NT. Current
      Don't stand, REACT!      version 0.1.2. C, C++ and ASM developers
                               and beta testers are welcome!

 wrote in message
Xns93D7DCF5...@127.0.0.1...


 in C e non in VB (ed in parte ASM).
scarica gli OCX già pronti, no?


 scarica gli OCX già pronti, no?
si ma gli OCX non sono editabili, se non ho il codice sorgente.
A me serve una interfaccia memory to memory per le operazioni.
Quella file to file (su disco), non soltanto non mi occorre, ma non posso
proprio utilizzarla.
Ciao
Soviet


 si ma gli OCX non sono editabili, se non ho il codice sorgente
gli darò un'occchiata io, ma non garantisco assolutamente nulla


 gli darò un'occchiata io, ma non garantisco assolutamente nulla
grazie .... anche se non ho capito che intenderesti fare
:-)
Ciao
Soviet-Mario


|
'|-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-|
'|For any comments or questions, please contact        |
'|the writer/modifier of this code.                    |
'|-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-|
'|This code will sometimes not yield a very high       |
'|compression ratio, due to 9-bit code-words.          |
'|If you use this code or modify it, I would appreciate|
'|it if you would mention my name somewhere and send me|
'|a copy of the code (if it has been modified).        |
'|-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-|
'|LZW is property of Unisys and is free for            |
'|noncommercial software.                              |
'|(The decoding function is free)                      |
' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
Private Dict(0 To 511) As String
Private Count As Integer
Private cont()
Private Sub Init()
'Here we fill our dictionary with all ASCII values
'so that we have some code-words to start with.
  Dim i As Integer
  For i = 0 To 255
      Dict(i) = Chr(i)
  Next
End Sub
Private Function Search(inp As String) As Integer
'This function will search our dictionary and return
'the code-word for the best match.
  Dim i As Integer, c As Integer
  If Len(inp) = 1 Then
    Search = Asc(inp)
  Else
    For i = 258 To Count - 1 'ASCII 256 & 257 are reserved
        If Dict(i) = inp Then Search = i: Exit Function
    Next
    Search = 512
  End If
End Function
Private Function Add(inp As String) As Boolean
'This function will add a string to our dictionary,
'if the dictionary is full the function is set to false
  Add = False
  If Count = 512 Then Wipe: Add = True 'Dictionary is full
  Dict(Count) = inp
  Count = Count + 1
End Function
Private Sub Wipe()
'Here we reset our dictionary
  Dim i As Integer
  For i = 256 To 511
      Dict(i) = ""
  Next
  Count = 258 'So we start out right
End Sub
Public Function Comprimi(ByVal inp As String) As String
  Dim i As Long, j As Long, Length As Long
  Dim p As String, c As String, temp As String, o As String
  Init
  Wipe
  p = ""
  i = 1
  ReDim cont(0 To (Len(inp) + 3)) 'so we don't get buffer overflow
  Do Until i > Len(inp)
      c = Mid(inp, i, 1)
      i = i + 1
      temp = p & c
      If Not Search(temp) = 512 Then
          p = temp
      Else
          Length = Length + 1
          cont(Length) = Search(p)
          'Here we make sure that when we wipe our dictionary, the decoder
does the same
          If Add(temp) = True Then Length = Length + 1: cont(Length) = 256
          p = c
      End If
  Loop
  cont(0) = 256
  cont(Length + 1) = Search(p)
  cont(Length + 2) = 257
  cont(Length + 3) = 0
  o = Eight_Bit(cont(), Length + 3)
  Comprimi = Mid(o, 2) 'Since all strings will start with chr(0), we skip
it.
                       'If we want to be compatible with the GIF standard
then we
                       'keep this chr(0) and of course don't add one whilst
decoding
End Function
Public Function Decomprimi(ByVal inp As String) As String
  Dim Length As Long, cw As Long, o As String, i As Long, pw As Long, p As
String, c As String
  Init
  Wipe
  inp = Chr(0) & inp 'So we don't get mixed up
  Length = Nine_Bit(inp)
  If Not cont(0) = 256 Then Exit Function
  cw = cont(1)
  o = Dict(cw)
  i = 2
  Do Until i > Length
      pw = cw
      cw = cont(i)
      i = i + 1
      If cw = 256 Then Wipe: GoTo bottom
      If cw = 257 Then GoTo done
      If Not Dict(cw) = "" Then
          o = o & Dict(cw)
          p = Dict(pw)
          c = Mid(Dict(cw), 1, 1)
          Add (p & c)
      ElseIf Dict(cw) = "" Then
          p = Dict(pw)
          c = Mid(Dict(pw), 1, 1)
          o = o & p & c
          Add (p & c)
      End If
bottom:
  Loop
done:
  Decomprimi = o
End Function
Private Function Eight_Bit(inp(), Length As Long) As String
  Dim i As Long, c As Long
  Dim bits As String, bitstream As String, stream As String
  bitstream = Space((Length + 1) * 9)
  For i = 0 To Length
      Mid(bitstream, (Length - i) * 9 + 1, 9) = Format(Encode(inp(i)),
"000000000")
  Next
  stream = Space((Len(bitstream) \ 8) + 1)
  For i = (Len(bitstream) - 7) To 1 Step -8
      bits = Mid(bitstream, i, 8)
      c = c + 1
      Mid(stream, c, 1) = Chr(Decode(bits))
  Next
  bits = "1" & Mid(bitstream, 1, 7)
  Mid(stream, Len(stream), 1) = Chr(Decode(bits))
  Eight_Bit = Mid(stream, 1, Len(stream) - 1)
End Function
Private Function Nine_Bit(inp As String) As Long
  Dim i As Long, j As Long, o As String, h As String, inpLen As Long
  inpLen = Len(inp)
  o = Space(inpLen * 8)
  For i = 1 To inpLen
     Mid(o, (inpLen - i) * 8 + 1, 8) = Encode(Asc(Mid(inp, i, 1)))
  Next
  ReDim cont(0 To (Len(inp) - 2))
  j = 0
  For i = (Len(o) - 8) To 1 Step -9
      h = Mid(o, i, 9)
      cont(j) = Decode(h)
      j = j + 1
  Next
  Nine_Bit = Len(inp) - 2
End Function
Private Function Encode(ByVal inp As Long) As String
  Dim DecValue As Long, BinValue As String, TempValue As Long
  DecValue = inp
  Do
      TempValue = DecValue Mod 2
      BinValue = CStr(TempValue) & BinValue
      DecValue = DecValue \ 2
  Loop Until DecValue = 0
  BinValue = Format(BinValue, "00000000")
  Encode = BinValue
End Function
Private Function Decode(ByVal inp As String) As Long
  Dim o As Long, i As Long, inpLen As Long
  inpLen = Len(inp)
  For i = 1 To inpLen
      If Mid(inp, i, 1) = "1" Then
          o = o + 2 ^ (inpLen - i)
      End If
  Next
  Decode = o
End Function