Page 1 of 1

cbPacker

Posted: Tue Dec 16, 2008 7:52 pm
by Valtzu
Olen tässä jokunen kuukausi sitten koodaillut pakkaussysteemiä CB:lle, ja nyt se alkaa olla jokseenkin valmis. Sillä voi pakata mitä tahansa tiedostoja yhdeksi tiedostoksi ja toisin päin. Pakkausmenetelmä on perinteinen bytepair, joten samaan pakkaussuhteeseen kuin esim. rar:lla ei päästä. Esimerkiksi cbPacker.cb -tiedosto pienenee 14 164 tavusta 8 469 tavuun.

Käyttö:

SetArchive( arkiston_tiedostonimi$ ) - asettaa arkistona käytettävän tiedoston
PackFile( tiedosto$, [pakkaus=1], [arkisto$] ) - Lisää tiedoston arkistoon. Pakkaus-parametrin ollessa 0, tiedosto tallennetaan pakkaamattomana.
UnpackFile( tiedosto$, [overwrite=0], [arkisto$] ) - Purkaa tiedoston arkistosta.
UnpackAll( [overwrite=0], [arkisto$] ) - Purkaa kaikki arkiston tiedostot.


Palautetta ja parannusehdotuksia otetaan vastaan :)

cbPacker.cb

Code: Select all

// --------------------------------- //
//                                   //
//             cbPacker              //
//             by Valtzu             //
//                                   //
// --------------------------------- //

Global gCurrentArchive As String, gErrorString As String

Function SetArchive(arc$)
    If Len( arc ) = 0 Then Return False
    
    If FileExists( arc ) = True Then
        If FileSize( arc ) < 5 Then Return False
        f = OpenToRead( arc )
            arcFileHeader = ReadInt( f )
        CloseFile f
        If arcFileHeader <> 223363651 Then Return False
    EndIf
    
    gCurrentArchive = arc
End Function

Function PackFile(file$,compress=1,arc$="")
    // Tarkistetaan tiedoston olemassaolo
    If FileExists(file) = False Then
        gErrorString = "Invalid archive header"
        Return False
    EndIf
    
    // Jos arkiston nimeä ei annettu, käytetään oletusta
    If Len( arc ) = 0 Then arc = gCurrentArchive
    
    // Jos oletusta ei ole, keskeytetään funktio
    If Len( arc ) = 0 Then
        gErrorString = "Archive Not found"
        Return False
    EndIf
    
    If FileExists( arc ) = False Then
        f = OpenToWrite( arc )
            WriteInt f, 223363651
            WriteInt f, 0
        CloseFile f
    EndIf
    
    filelist  = GetFilelist( arc )
    filec     = PeekInt(filelist, 0)
    offs      = 4
    For i = 1 To filec
        filu$ = Lower(_PeekString(filelist,offs))
        If filu = Lower(file) Then
            DeleteMEMBlock filelist
            gErrorString = "File '"+file+"' already exists in archive '"+arc+"'"
            Return False
        EndIf
        offs = offs + 21 + Len(filu)
    Next i
    DeleteMEMBlock filelist
    
    fSize = FileSize(file)
    
    // Luodaan muistipala tiedostolle
    fMem  = MakeMEMBlock( fSize + 4 )
    
    PokeInt fMem, 0, fSize
    
    fHandle = OpenToRead( file )
    
        // Luetaan tiedosto muistipalaan
        For i=0 To ( fSize - (fSize Mod 4) ) / 4 - 1
            PokeInt fMem, 4 + i * 4, ReadInt( fHandle )
        Next i
        For i=1 To (fSize Mod 4)
            PokeByte fMem, 4 + fSize-1-(fSize Mod 4) + i, ReadByte( fHandle )
        Next i
    
    CloseFile fHandle
    
    hash = Crc32( file )
    
    If compress Then pMem = _packMem( fMem )
    If pMem = False Then
        packed = False
    Else
        packed = True
        fMem=pMem
    EndIf
    
    If packed Then fPackedSize = PeekInt( fMem, 0 ) Else fPackedSize = fSize
    
    arcSize = FileSize( arc )
    
    fHandle = OpenToEdit( arc )
        
        // 223363651 = "CBP" + Chr(13)
        arcFileHeader = ReadInt( fHandle )
        If arcFileHeader <> 223363651 Then
            gErrorString = "Invalid archive header"
            DeleteMEMBlock fMem
            CloseFile fHandle
            Return False
        EndIf
        
        // Luetaan arkistosta tiedostojen lukumäärä
        arcFileCount = ReadInt( fHandle )
        
        SeekFile fHandle, 4
        WriteInt fHandle, arcFileCount + 1
        
        SeekFile fHandle, arcSize
        
        WriteInt fHandle, fSize
        WriteInt fHandle, fPackedSize
        WriteInt fHandle, Len( file )
        For i=1 To Len( file )
            WriteByte fHandle, Asc(Mid(file, i, 1))
        Next i
        WriteByte fHandle, packed
        WriteInt fHandle, hash
        
        For i = 0 To fPackedSize - 1
            WriteByte fHandle, PeekByte( fMem, i + 4 )
        Next i
        
    CloseFile fHandle
    
    Return True
    
End Function

Function UnpackAll(overwrite=0,arc$="")
    
    // Jos arkiston nimeä ei annettu, käytetään oletusta
    If Len( arc ) = 0 Then arc = gCurrentArchive
    
    // Jos oletusta ei ole, keskeytetään funktio
    If Len( arc ) = 0 Then Return False
    
    f = OpenToRead(arc)
        check = ReadInt(f)
    CloseFile f
    If check <> 223363651 Then Return False


    filelist  = GetFilelist( arc )
    filec     = PeekInt(filelist, 0)
    
    If filec <= 0 Then
        DeleteMEMBlock filelist
        Return False
    EndIf
    offs = 4
    For i = 1 To filec
        file$=_PeekString(filelist,offs)
        UnpackFile(file, overwrite, arc)
        offs = offs + 21 + Len(file)
    Next i
    DeleteMEMBlock filelist
    
    Return True

End Function

Function UnpackFile(file$,overwrite=0,arc$="")
    // Tarkistetaan tiedoston olemassaolo
    If FileExists(file) = True And overwrite = False Then
        gErrorString = "File '"+file+"' already exists"
        Return False
    EndIf
    
    // Jos arkiston nimeä ei annettu, käytetään oletusta
    If Len( arc ) = 0 Then arc = gCurrentArchive
    
    // Jos oletusta ei ole, keskeytetään funktio
    If Len( arc ) = 0 Then
        gErrorString = "Archive Not found"
        Return False
    EndIf
    
    f = OpenToRead(arc)
        check = ReadInt(f)
    CloseFile f
    If check <> 223363651 Then
        gErrorString = "Invalid archive header"
        Return False
    EndIf
    
    filelist  = GetFilelist( arc )
    filec     = PeekInt(filelist, 0)
    found     = 0
    offs      = 4
    For i = 1 To filec
        filu$=Lower(_PeekString(filelist,offs))
        offs = offs + 4 + Len(filu)
        If filu = Lower(file) Then
            found = i
            realsize = PeekInt(filelist, offs)
            size     = PeekInt(filelist, offs+4)
            offset   = PeekInt(filelist, offs+8)
            packed   = PeekByte(filelist, offs+12)
            hash     = PeekInt(filelist, offs+13)
            Exit
        EndIf
        offs = offs + 17
    Next i
    DeleteMEMBlock filelist
    
    If Not found Then
        gErrorString = "File '"+file+"' doesn't exists in archive '"+arc+"'"
        Return False
    EndIf
    
    memBlock = MakeMEMBlock(size+4)
    ofs=0
    PokeInt memBlock,ofs,size:ofs+4
    f=OpenToRead(arc)
        SeekFile f,offset
        For i=0 To size-1
            PokeByte memBlock,ofs,ReadByte(f):ofs+1
        Next i
    CloseFile f
    
    If packed Then
        asd=_unpackMem(memBlock,realsize)
        DeleteMEMBlock memBlock
        memBlock=asd
    EndIf
    f=OpenToWrite(file)
        s=PeekInt(memBlock,0)
        For i=0 To s-1
            WriteByte f,PeekByte(memBlock,4+i)
        Next i
    CloseFile f
    
    If Crc32(file)<>hash Then
        DeleteFile file
        gErrorString = "Checksums didn't match"
        Return False
    EndIf
    
    Return True
    
End Function

Function GetFilelist(arc$)
    If FileExists( arc ) = False Then Return ""
    
    f = OpenToRead( arc )
        If ReadInt( f ) <> 223363651 Then Return ""
        fileCount = ReadInt( f )
        mem       = MakeMEMBlock(4 + 21 * fileCount)
        PokeInt mem, 0, fileCount
        offsetMem = 4
        For i = 1 To fileCount
            size   = ReadInt( f )
            psize  = ReadInt( f )
            strlen = ReadInt( f )
            ResizeMEMBlock mem, MEMBlockSize(mem) + strlen
            PokeInt mem, offsetMem, strlen : offsetMem + 4
            For a = 1 To strlen
                PokeByte mem, offsetMem, ReadByte( f ) : offsetMem + 1
            Next a
            packed = ReadByte( f )
            hash   = ReadInt( f )
            ofs    = FileOffset(f)
            PokeInt  mem, offsetMem, size   : offsetMem + 4
            PokeInt  mem, offsetMem, psize  : offsetMem + 4
            PokeInt  mem, offsetMem, ofs    : offsetMem + 4
            PokeByte mem, offsetMem, packed : offsetMem + 1
            PokeInt  mem, offsetMem, hash   : offsetMem + 4
            SeekFile f,ofs + psize
        Next i
        
    CloseFile f
    
    Return mem
    
End Function

Function _unpackMem(memBlock,realsize=0)
    offset=0
    memSize       = PeekInt(memBlock, offset) : offset+4
    bytePairCount = PeekByte(memBlock, offset) : offset+1
    mbp  = MakeMEMBlock(bytePairCount*3)
    For i = 1 To bytePairCount
        PokeByte mbp, (i - 1) * 3 + 0, PeekByte(memBlock, offset)
        PokeByte mbp, (i - 1) * 3 + 1, PeekByte(memBlock, offset+1)
        PokeByte mbp, (i - 1) * 3 + 2, PeekByte(memBlock, offset+2)
        offset + 3
    Next i
    datSize       = PeekInt(memBlock, offset) : offset+4
    memUnpacked   = MakeMEMBlock(4 + datSize)
    offset2       = 4
    PokeInt memUnpacked,0,datSize
    sss=MEMBlockSize(memBlock)
    For i = 0 To datSize - 1
        b = PeekByte(memBlock, offset) : offset + 1
        found = 0
        For o = 1 To bytePairCount
            If b = PeekByte(mbp, (o - 1) * 3) Then
                found = 1
                sh=PeekByte(mbp,(o-1)*3+1)+(PeekByte(mbp,(o-1)*3+2)Shl 8)
                PokeShort memUnpacked,offset2,sh
                offset2 + 2
                i + 1 : Exit
            EndIf
        Next o
        If Not found Then
            PokeByte memUnpacked, offset2, b
            offset2 + 1
        EndIf
    Next i
    DeleteMEMBlock mbp
    If realsize>0 And realsize=MEMBlockSize(memUnpacked)-4 Then
        Return memUnpacked
    ElseIf realsize<MEMBlockSize(memUnpacked)+4 Then
        MakeError "Something terrible went wrong!"
    Else
        tenp=_unpackMem(memUnpacked,realsize)
        Return tenp
    EndIf
End Function

Function _packMem(memBlock)
    memBytes     = MakeMEMBlock( 256 )
    memFreeBytes = MakeMEMBlock( 256 )
    memSize      = PeekInt( memBlock, 0 )
    
    For i = 0 To memSize - 1
        b = PeekByte( memBlock, 4 + i )
        PokeByte memBytes, b, 1
    Next i
    
    freeBytes = 0
    For i = 0 To 255
        If PeekByte( memBytes, i ) = 0 Then
            PokeByte memFreeBytes, freeBytes, i
            freeBytes + 1
        EndIf
    Next i
    
    DeleteMEMBlock memBytes
    
    If freeBytes = 0 Then
        DeleteMEMBlock memFreeBytes
        gErrorString = "No free chars"
        Return False
    EndIf
    
    mbp     = _BytePairs( memBlock )
    bytePairCount    = 0
    
    For i = 0 To freeBytes - 1
        If PeekInt(mbp, i * 6) > 7 Then bytePairCount + 1
    Next i
    
    If bytePairCount = 0 Then
        DeleteMEMBlock mbp
        Return False
    EndIf
    
    // Luodaan muistipala pakatulle datalle
    memBlockPacked = MakeMEMBlock( memSize + 4 + 1024 )
    
    offset = 4
    PokeByte memBlockPacked, offset, bytePairCount : offset + 1
    
    For i = 1 To bytePairCount
        PokeByte  memBlockPacked, offset, PeekByte(memFreeBytes, i - 1)
        PokeShort memBlockPacked, offset + 1, PeekShort(mbp, (i - 1) * 6 + 4)
        offset + 3
    Next i
    
    PokeInt memBlockPacked, offset, memSize : offset + 4
    
    For i = 0 To memSize - 2
        b1       = PeekByte(memBlock, 4 + i)
        b2       = PeekByte(memBlock, 4 + i + 1)
        twobytes = b1 + (b2 Shl 8)
        found    = 0
        For o = 1 To bytePairCount
            If twobytes = PeekShort(mbp, (o - 1) * 6 + 4) Then
                found = 1
                PokeByte memBlockPacked, offset, PeekByte(memFreeBytes, o - 1)
                offset + 1
                i + 1 : Exit
            EndIf
        Next o
        If (Not found) And i<memSize-1 Then
            PokeByte memBlockPacked,offset,b1
            offset + 1
        EndIf
    Next i
    If i=memSize-1 Then
        PokeByte memBlockPacked, offset, PeekByte(memBlock, 4 + memSize - 1)
        offset + 1
    EndIf
    PokeInt memBlockPacked, 0, offset - 4
    ResizeMEMBlock memBlockPacked, offset
    DeleteMEMBlock memBlock
    DeleteMEMBlock memFreeBytes
    DeleteMEMBlock mbp
    
    memTMP = MakeMEMBlock(MEMBlockSize(memBlockPacked))
    MemCopy memBlockPacked, 0, memTMP, 0, MEMBlockSize(memBlockPacked)
    memTMP2 = _packMem(memTMP)
    
    If memTMP2 Then
        If MEMBlockSize(memTMP2)<MEMBlockSize(memBlockPacked) Then
            DeleteMEMBlock memBlockPacked
            memBlockPacked = memTMP2
        EndIf
    Else
        DeleteMEMBlock memTMP
    EndIf
    
    Return memBlockPacked
    
End Function

Function _PeekString$(mem, offset)
    l = PeekInt(mem, offset)
    offset + 3
    For i=1 To l
        s$ = s + Chr(PeekByte(mem,offset + i))
    Next i
    Return s
End Function

Function _BytePairs(memBlock)
    size   = PeekInt( memBlock, 0 )
    
    // Luodaan temppi-muistipala kaikkia mahdollisia tavupareja varten
    tmpMem = MakeMEMBlock(4 + 65536 * 6)
    PokeInt tmpMem, 0, 65536
    
    For a = 0 To 255
        For b = 0 To 255
            PokeByte tmpMem, 4 + (a * 256 + b) * 6 + 4, a
            PokeByte tmpMem, 4 + (a * 256 + b) * 6 + 5, b
        Next b
    Next a
    
    For i = 0 To size - 2
        a    = PeekByte(memBlock, 4 + i)
        b    = PeekByte(memBlock, 5 + i)
        offs = a * 256
        PokeInt tmpMem, 4 + (offs + b) * 6, PeekInt(tmpMem, 4 + (offs+b)*6)+1
    Next i
    
    // CombSort alkaa
    count = PeekInt(tmpMem, 0)
    iGap  = count
    While (iGap > 1) Or (bSwitchFlag = True)
        iGap = iGap * 10 / 13
        If iGap < 1 Then iGap = 1
        If iGap = 9 Or iGap = 10 Then iGap = 11
        bSwitchFlag = False
        For i = 0 To count - iGap
            If (PeekInt(tmpMem, 4 + i * 6)<PeekInt(tmpMem, 4+(i+iGap)*6)) Then
                helper1 = PeekInt(tmpMem, 4 + i * 6)
                helper2 = PeekShort(tmpMem,4 + i * 6 + 4)
                PokeInt tmpMem, 4 + i * 6, PeekInt(tmpMem,4+(i+iGap)*6)
                PokeShort tmpMem, 4 + i*6+4,PeekShort(tmpMem,4+(i+iGap)*6+4)
                PokeInt tmpMem, 4 + (i + iGap) * 6, helper1
                PokeShort tmpMem, 4 + (i + iGap) * 6 + 4, helper2
                bSwitchFlag = True
            EndIf
        Next i
    Wend
    // CombSort loppuu
    
    rtnMem = MakeMEMBlock(256 * 6)
    MemCopy tmpMem, 4, rtnMem, 0, 256 * 6
    DeleteMEMBlock tmpMem
    Return rtnMem
End Function
example.cb

Code: Select all

Include "cbPacker.cb"

SetArchive("cbPacker.cbp")

Print "Paina enter pakataksesi tiedoston tai"
Print "mitä tahansa muuta purkaaksesi sen"

a = WaitKey()
t = Timer()


If a = 28 Then // Jos painetaan enter, niin pakataan tiedosto...
    
    Print "Pakataan..."
    If PackFile("cbPacker.cb") = False Then
        Print "Ei onnistunut."
        Print gErrorString
    Else
        Print "Onnistui! (" + (Timer()-t) + "ms)"
    EndIf
    
    WaitKey

Else // ...muuten puretaan
    
    Print "Puretaan..."
    If UnpackFile("cbPacker.cb", True) = False Then
        Print "Ei onnistunut."
        Print gErrorString
    Else
        Print "Onnistui! (" + (Timer()-t) + "ms)"
    EndIf
    
    WaitKey

EndIf

Re: cbPacker

Posted: Tue Dec 16, 2008 9:07 pm
by KilledWhale
Tämähän on kätevä. Pakkaa melko tiiviiksi ja on lisäksi äärettömän nopea ;)

Re: cbPacker

Posted: Tue Dec 16, 2008 9:55 pm
by axu
Pitänee testata, luultavasti tulee käytettyä esim. questi saatais yhdeksi tiedostoksi useiden mappejen, skriptejen ja grafiikoiden sijasta(niin pitäis se pelikin tehdä :D )
Olisikohan mahdollista avata tiedostoa purkamatta sitä? Ja klassinen kyssäri eli tarviiko nimeä mainita(juu juu oon kuullu monta kertaa sen esimerkit vapaata riistaa jutun)

Re: cbPacker

Posted: Tue Dec 16, 2008 10:12 pm
by Valtzu
axu wrote:Olisikohan mahdollista avata tiedostoa purkamatta sitä?
Toistaiseksi noilla funktioilla kyseinen operaatio ei onnistu. Tekstitiedosto on tosin helppo lukea muistista merkkijonoon;

Code: Select all

Function UnpackFileToString(file$,arc$="")
    // Jos arkiston nimeä ei annettu, käytetään oletusta
    If Len( arc ) = 0 Then arc = gCurrentArchive
    // Jos oletusta ei ole, keskeytetään funktio
    If Len( arc ) = 0 Then
        gErrorString = "Archive Not found"
        Return False
    EndIf
    f = OpenToRead(arc)
        check = ReadInt(f)
    CloseFile f
    If check <> 223363651 Then
        gErrorString = "Invalid archive header"
        Return False
    EndIf
    filelist  = GetFilelist( arc )
    filec     = PeekInt(filelist, 0)
    found     = 0
    offs      = 4
    For i = 1 To filec
        filu$=Lower(_PeekString(filelist,offs))
        offs = offs + 4 + Len(filu)
        If filu = Lower(file) Then
            found = i
            realsize = PeekInt(filelist, offs)
            size     = PeekInt(filelist, offs+4)
            offset   = PeekInt(filelist, offs+8)
            packed   = PeekByte(filelist, offs+12)
            hash     = PeekInt(filelist, offs+13)
            Exit
        EndIf
        offs = offs + 17
    Next i
    DeleteMEMBlock filelist
    If Not found Then
        gErrorString = "File '"+file+"' doesn't exists in archive '"+arc+"'"
        Return False
    EndIf
    memBlock = MakeMEMBlock(size+4)
    ofs=0
    PokeInt memBlock,ofs,size:ofs+4
    f=OpenToRead(arc)
        SeekFile f,offset
        For i=0 To size-1
            PokeByte memBlock,ofs,ReadByte(f):ofs+1
        Next i
    CloseFile f
    If packed Then
        asd=_unpackMem(memBlock,realsize)
        DeleteMEMBlock memBlock
        memBlock=asd
    EndIf
    s=PeekInt(memBlock,0)
    For i=0 To s-1
        mjono$ = mjono + Chr(PeekByte(memBlock,4+i))
    Next i
    DeleteMEMBlock memBlock
    Return mjono
End Function
axu wrote:tarviiko nimeä mainita
Ei tarvitse mainita.

Re: cbPacker

Posted: Tue Dec 16, 2008 11:40 pm
by MaGetzUb
Loisi pelin ajaksi näennäisen piiloitetun media kansion, ja lataisi sieltä tiedot, sitten poistaisi sen, kun lopettaa pelin. ;)

Re: cbPacker

Posted: Wed Dec 17, 2008 11:17 am
by ristis
Hieno kehitelmä.
Uskoisin, että kuvatiedostojen avaaminen siten, että pakkia ei koskaan pureta onnistuu varmaan.
Kokeilepa Valtzu kehitellä sellainen toiminto niin käyttöarvo nousee kummasti.

Re: cbPacker

Posted: Wed Dec 17, 2008 1:14 pm
by axu
ristis wrote:Uskoisin, että kuvatiedostojen avaaminen siten, että pakkia ei koskaan pureta onnistuu varmaan.
Tämähän onnistuu, kun koodaa kuvatiedoston rakenteen(eli miten luetaan tiedostoa).
½Offtopic:Löytyykö jostain hyviä tutoja eri tiedostomuotojen lukemiseen? Midit olisi hyvä löytää niin löytyis SDK:n midifunktioille käyttöä :)

Re: cbPacker

Posted: Wed Dec 17, 2008 5:14 pm
by vilQuri
Voiko tuon pakkaus päätteen .cbp laittaa miksi tahansa? Siitä on hiukan haittaa kun se on sama pääte kuin CodeBlocksin projekti tiedostoilla.

Re: cbPacker

Posted: Wed Dec 17, 2008 6:02 pm
by axu
vilQuri wrote:Voiko tuon pakkaus päätteen .cbp laittaa miksi tahansa?
Voi, päätehän on vain osa nimeä, mutta tiedoston sisältö ratkaisee sen, mikä tiedostomuoto se on. Pääte on tiedostonimen perässä(minun mielestä) sen takia, että voidaan saada selville mikä tiedostomuoto on avaamatta itse tiedostoa, ja avata sen jälkeen oikeassa ohjelmassa.

upps tais olla offtopiccia :oops: