Gemme binær, binært

Ja, du skal bruge "as binary", men det er ikke nok.
Hver 8 bits klump kan omsættes til en byte, det kan f.eks. gøres således:

for x= 0 to len(din string) / 8

if mid(langstring,0+x,1) = 1 then minbyte = 128
if mid(langstring,1+x,1) = 1 then minbyte = minbyte + 64
if mid(langstring,2+x,1) = 1 then minbyte = minbyte + 32
if mid(langstring,3+x,1) = 1 then minbyte = minbyte + 16
if mid(langstring,4+x,1) = 1 then minbyte = minbyte + 8
if mid(langstring,5+x,1) = 1 then minbyte = minbyte + 4
if mid(langstring,6+x,1) = 1 then minbyte = minbyte + 2
if mid(langstring,7+x,1) = 1 then minbyte = minbyte + 1

skriv minbyte

next x

Der er nok en mere elegant måde at gøre det på og der skal nok også tages højde for at længden på din streng ikke nødvendigvis altid er et multiplum af 8.

Hey,

As binary, har du et lille eksempel?

Hvis jeg konventere til en byte variabel, får jeg så foranstillede 0'er med? De er jo ret vigtige i et hoffman træ :)

Hey,

Jeg har brugt dette, men det en fil på ca 0,6MB fylder så 1,6MB. ikke det mest effektive pakkeprogram...


CodeStream = "00010010010010100"  ' Bare et eksempel...
Open "C:\hoffman_bitstream.bin" For Binary Lock Read Write As #1
  Put #1, , myCode
close #1

Ja du får foranstillede nuller med.

Her er et lille eksempel, det kan nok gøres smartere og hurtigere.
Har du prøvet google, man skulle tro, at nogen allerede har fundet på en smart løsning.

Når programmet er kørt skal filen indeholde:
1C 00 00 00 AA 00 55 F0  i hexadecimal
De første fire byte længden på din string, de næste fire er indholdet
Du får nok brug for en hex-viewer som f.eks Hex Workshop", filen kan ganske vist åbnes med notepad, men det giver ingen mening


    Dim BinaryStr As String
           
    ' test string i HEX AA 00 55 F0
   
    BinaryStr = "10101010" _
              & "00000000" _
              & "01010101" _
              & "1111"
    Dim OutputFile As String
    OutputFile = App.Path & "\BinaryFile.txt"
   
    Dim Filenum As Integer
    Filenum = FreeFile
   
    Open OutputFile$ For Binary Access Write As #Filenum
   
    ' gem længden, den skal bruges når filen skal dekodes
    Put #Filenum, , Len(BinaryStr)
     
    Dim Inx As Long
     
    For Inx = 1 To Len(BinaryStr) Step 8
        Put #Filenum, , Bin2Byte(Mid$(BinaryStr & "00000000", Inx, 8))
        ' binarystr forlænges med 8 nuller, ellers går det galt i bin2byte
        ' hvis ikke binarystr er multiplum af 8
    Next Inx
    Close #Filenum
   
    Me.Caption = "færdig"
       
End Sub

Public Function Bin2Byte(BinStr As String) As Byte
    Bin2Byte = 0
    If Mid(BinStr, 1, 1) = 1 Then Bin2Byte = 128
    If Mid(BinStr, 2, 1) = 1 Then Bin2Byte = Bin2Byte + 64
    If Mid(BinStr, 3, 1) = 1 Then Bin2Byte = Bin2Byte + 32
    If Mid(BinStr, 4, 1) = 1 Then Bin2Byte = Bin2Byte + 16
    If Mid(BinStr, 5, 1) = 1 Then Bin2Byte = Bin2Byte + 8
    If Mid(BinStr, 6, 1) = 1 Then Bin2Byte = Bin2Byte + 4
    If Mid(BinStr, 7, 1) = 1 Then Bin2Byte = Bin2Byte + 2
    If Mid(BinStr, 8, 1) = 1 Then Bin2Byte = Bin2Byte + 1
End Function

Dette er allerede forældet, da jeg skrev det uden at have set netpxg's andet indlæg, men du får det alligevel, da det giver en større besparelse i plads (halv så stor) end netxpgs metode.

Jeg ville gøre som netpxg foreslår, og omregne dine bitstrings først, og derefter indsætte dem i filen. Der kan dog blive problemer med længden af dine bitstrings, som han nævner, så derfor er det måske lidt nemmere (omend det vil fylde -lidt- mere) at skrive værdierne som Long eller Currency types. DVS:

    Long = 4 Bytes = 32 bits (op til 32, altså 0-31)
    Currency = 8 Bytes = 64 bits

Hvis du ved at du ikke har bitstrenge længere end 31 bits, så brug Long sådan:

1.) konverter din bitstreng til en Long:
    "1100101001000010110010011011011" = 1696687323

2.) skriv den binært til filen

Når du skal læse data ud er du nødt til at gørte det samme (bare omvendt).
Men du kan jo udføre en del operationer på data, selvom de er Longs; Her tænker jeg på BitWise operationer som AND OR XOR osv. Disse operationer er langt hurtigere end diverse string sammenligninger.

Jeg har testet ovenstående ved at gemme to filer:

1) 10000 records med 31-karakter strenge a la "1100101001000010110010011011011" giver en fillængde på 322 kB.

2) 10000 records med Longs a la 1696687323 giver en fillængde på 39 kB.

Altså en besparelse på næsten faktor 10.

Konvertering kan laves med et par små funktioner (her med Longs):

Public Function BinToDec(ByVal sIn As String) As Long
    Dim i As Long, lLenString As Long, lOutNumber As Long, lBit As Long
   
    If sIn = "" Then
        BinToDec = 0
    Else
        lLenString = Len(sIn)
        For i = 1 To lLenString
            lBit = CLng(Mid(sIn, i, 1))
            lOutNumber = (lOutNumber * 2) + lBit
        Next i
        BinToDec = lOutNumber
    End If

End Function

Public Function DecToBin(ByVal lIn As Long) As String
    Dim lNumber As Long, sBits As String

    lNumber = lIn
    Do
        sBits = CStr(lNumber Mod 2) & sBits
        lNumber = Int(lNumber / 2)
    Loop Until lNumber = 0
    lNumber = Len(sBits)
    If lNumber < 31 Then sBits = String(31 - iNumber, "0") & sBits
    DecToBin = sBits

End Function
Bemærk at foranstående nuller paddes i denne funktion, således at outputstrengen altid er på 31 karakterer.

Udlæsning/indlæsning gøres sådan:

Udlæsning til fil:

1) konverter og gem bitstrengene i et Long array:

    for i = 1 To 'antal records'
        sTmp = 'din bitstreng'
    lArray(i) = BinToDec(sTmp)
    next i

2) gem i fil:

    sPath = 'din fil'
    i = FreeFile
    Open sPath For Binary Lock Read Write As #i
        For j = 1 To Ubound(lArray)
            Put #i, , lArray(j)        'VIGTIGT!: lArray SKAL være defineret som Long
        Next j
    Close #i

Indlæsning til variabel:

1) Indlæs fra fil til array:

    sPath = 'din fil'
    i = FreeFile
    j = 0
    Open sPath For Binary Access Read Lock Read Write As #i
        Do While Not EOF(i)
            j = j + 1
            ReDim Preserve lArrIn(1 To j)
            Get #i, , lArrIn(j)
        Loop
    Close #i

2) Konverter Long array til Bit-Strings:

    Dim sArray() as String
    Redim sArray (1 to Ubound(lArrIn))
    For i = 1 to Ubound(lArrIn)
    sArray(i) = DecToBin(lArrIn(i))
    Next i

Dette er skrevet i en fart, så det kan godt være der skal finpudses lidt hist og her.

Hey,

Har fundet et par fejl i mit program, så nu bliver filen faktisk mindre end originalen :P

Det er super spændende, og jeg vil så hurtig som mulig lige prøve og teste det.
Hvis nogen er interesseret i koden må i maile mig. Det er skod kodet da jeg har måtte prøve mig frem, men det ser ud til at virke. Mail via speakerbuilder prik dk. Mangler dog at gemme chars i de rigtige positioner. Smider dem bare ned i filen det antal gange de optræder, så jeg kan se om størrelsen på filen er god eller dårlig.

Dog lider det en DEL af dårlig perfomance. Men det kigger jeg på når jeg har det hele til at virke.