 |
Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
csde_rats
Anmeldungsdatum: 07.01.2007
Beiträge: 2292
Wohnort: Zwischen Sessel und Tastatur
|
 Verfasst am: 19.09.2007, 19:46 Titel: Packfunktionen funzen net! [GELÖST!!!!!!!!!!!!!!!!!!!!!!!!!] |
 |
|
Hi @all!
Ich habe mir folgende Packfunktionen (ab)geschrieben:
| Code: | Function ING_Compress_File(File As String, SaveFile As String) As Boolean Export
Dim As Integer anzahlbyt, j, myi, myff
Dim img As Integer Ptr
Dim bptr As UByte Ptr
myff=FreeFile
Open File For Binary As #myff
anzahlbyt=Lof(myff)
Close #myff
img=Allocate(anzahlbyt)
Dim Buffer(anzahlbyt) As UByte 'in diesen Buffer wird das Image komprimiert
j = anzahlbyt
'Encode bekommt die Adresse des Image, Anzahl Byte des Image,
' die Adresse des Buffers,Anzahl Byte des Buffers
Encode (img, anzahlbyt, @Buffer(0), j)
'nach dem Aufruf enthält j die neue Anzahl Byte
myff = FreeFile 'als Datei abspeichern
Open SaveFile for binary Access write as #myff
Put #myff,, anzahlbyt
For myi = 0 To j-1
put #myff,, Buffer(myi)
next
Close #myff
DeAllocate(img)
Return TRUE
End Function
Function ING_DeCompress_File(File As String, SaveFile As String) As Boolean Export
Dim As Integer anzahlbyt, Filelaenge, myff, myi
myff=FreeFile
Open File For Binary Access Read As #myff
Get #1,, anzahlbyt
'nehmen wir ein einfaches Bytearray für das Image
Dim Buffer (anzahlbyt) As UByte
Filelaenge = Lof(myff) 'mit der Dateilänge
Filelaenge -= 4 ' Wir haben ja noch den Integer mit den Bytes am anfang! (4 Bytes)
Dim compbf (0 To Filelaenge) As UByte 'einen Zwischenspeicher schaffen
get #myff,, compbf() 'gepackte Datei laden
Close #myff
Decode (@compbf(0), Filelaenge, @Buffer(0), anzahlbyt) 'entpacken
myff = FreeFile 'als Datei abspeichern
Open SaveFile for binary Access write as #myff
For myi = 0 To anzahlbyt-1
put #myff,, Buffer(myi)
next
Close #myff
Return TRUEFunction ING_Compress_File(File As String, SaveFile As String) As Boolean Export
Dim As Integer anzahlbyt, j, myi, myff
Dim As String * 1 tmp
Dim img As Integer Ptr
Dim bptr As UByte Ptr
myff=FreeFile
Open File For Binary As #myff
anzahlbyt=Lof(myff)
img=Allocate(anzahlbyt)
Dim Buffer(anzahlbyt) As UByte 'in diesen Buffer wird das Image komprimiert
For myi = 0 To Lof(myff)
Get #myff,,tmp
Buffer(myi) = Asc(tmp)
Next
Close #myff
j = anzahlbyt
'Encode bekommt die Adresse des Image, Anzahl Byte des Image,
' die Adresse des Buffers,Anzahl Byte des Buffers
Encode (img, anzahlbyt, @Buffer(0), j)
'nach dem Aufruf enthält j die neue Anzahl Byte
myff = FreeFile 'als Datei abspeichern
Open SaveFile for binary Access write as #myff
Put #myff,, anzahlbyt
For myi = 0 To j-1
put #myff,, Buffer(myi)
next
Close #myff
DeAllocate(img)
Return TRUE
End Function
Function ING_DeCompress_File(File As String, SaveFile As String) As Boolean Export
Dim As Integer anzahlbyt, Filelaenge, myff, myi
myff=FreeFile
Open File For Binary Access Read As #myff
Get #1,, anzahlbyt
'nehmen wir ein einfaches Bytearray für das Image
Dim Buffer (anzahlbyt) As UByte
Filelaenge = Lof(myff) 'mit der Dateilänge
Filelaenge -= 4 ' Wir haben ja noch den Integer mit den Bytes am anfang! (4 Bytes)
Dim compbf (0 To Filelaenge) As UByte 'einen Zwischenspeicher schaffen
get #myff,, compbf() 'gepackte Datei laden
Close #myff
Decode (@compbf(0), Filelaenge, @Buffer(0), anzahlbyt) 'entpacken
myff = FreeFile 'als Datei abspeichern
Open SaveFile for binary Access write as #myff
For myi = 0 To anzahlbyt-1
put #myff,, Buffer(myi)
next
Close #myff
Return TRUE
End Function |
Die Dateigrößen stimmen überein, aber nicht der Inhalt!
Originaldateianfang:
| Code: | #Include once "windows.bi"
#include once "win/mmsystem.bi"
#Include once "win/dsound.bi"
#include Once "fbgfx.bi"
#Include Once "vbcompat.bi"
#include once "crt.bi"
#inclib "fbgfx" |
Wieder extrahierte Datei:
Naja, sind halt ein "paar" Zeichen drin, die man normal nicht sieht...
jedenfalls ist die extrahierte Datei immer dasselbe!!
ACHJA!!!!:::
Ich kann im Prog leider keinen fbGFX-Screen aufrufen, deswegen habe ich die fbGFX.bi includet, und per #inclib "fbGFX" eingebunden!! Kann es daran liegen!?
_________________
If hilfreicher_Beitrag then klick(location.here)
Klick
Zuletzt bearbeitet von csde_rats am 19.09.2007, 23:14, insgesamt einmal bearbeitet |
|
| Nach oben |
|
 |
csde_rats
Anmeldungsdatum: 07.01.2007
Beiträge: 2292
Wohnort: Zwischen Sessel und Tastatur
|
|
| Nach oben |
|
|
Sebastian
Administrator
Anmeldungsdatum: 10.09.2004
Beiträge: 5969
Wohnort: Deutschland
|
|
| Nach oben |
|
|
csde_rats
Anmeldungsdatum: 07.01.2007
Beiträge: 2292
Wohnort: Zwischen Sessel und Tastatur
|
| Verfasst am: 19.09.2007, 21:42 Titel: |
|
|
 Sorry, kannst du das bitte berichtigen? Danke!
| Code: | #Include Once "zlib.bi"
#Include Once "fbgfx.bi"
Const TRUE = -1
Const FALSE = Not TRUE
Declare Function file_SpeichereWert (Dateinummer As Integer, BlockID As String, Block As String) As Integer
Declare Function file_HoleWert (Dateinummer As Integer, BlockID As String) As String
Declare Function CompressA(InputFile As String, OutputFile As String) As Integer
Declare Function DeCompressA(InputFile As String, OutputFile As String) As Integer
CompressA("Engine32.dll", "Engine32.pak")
DeCompressA("Engine32.pak", "2Engine32.dll")
Sleep
End
Function CompressA(InputFile As String, OutputFile As String) As Integer
Dim As Ubyte Ptr src, dest
Dim As Integer dest_len, src_len, i, errlev, ff, erro
Dim As Uinteger crc
ff=FreeFile
Open InputFile For Binary Access Read As #ff
src_len=Lof(ff)
' Die Funktion compressBound berechnet die Buffergröße für die zu komprimierende Anzahl Byte.
' Der Buffer ist immer > als die Anzahl komprimierender Byte.
dest_len = compressBound(src_len)
' Allocate ,reservieren der benötigten Speicherbereiche
src = Allocate(src_len)
dest = Allocate(dest_len)
' Daten lesen...
For i = 0 To src_len - 1
Get #ff,,src[i]
Next
Close #ff
' Eine crc32 Prüfsumme der Testdaten bilden. Damit prüfen wir ob zlib
' die Testdaten richtig gepackt und entpackt hat.
crc = crc32(0, src, src_len)
' Die Variable dest_len wird der compress Funktion als Pointer übergeben,
' da nach erfolgreicher komprimierung hier die Anzahl der gepackten Daten eingetragen ist.
errlev = compress(dest, @dest_len, src, src_len)
If errlev <> 0 Then
' Ein Rückgabewert <> 0 zeigt einen Fehler bei der Komprimierung an.
erro = TRUE
End If
Dim As String Destination
ff=FreeFile
For i = 0 To dest_len - 1
Destination += Chr(dest[i])
Next
Open OutputFile For Binary As #ff
file_SpeichereWert(ff, "SRCLEN", Str(src_len))
file_SpeichereWert(ff, "DSTLEN", Str(dest_len))
file_SpeichereWert(ff, "CRC32", Str(crc))
file_SpeichereWert(ff, "DATA", Destination)
Close #ff
DeAllocate(src)
DeAllocate(dest)
If erro = TRUE Then
Return FALSE
Else
Return TRUE
EndIf
End Function
Function DeCompressA(InputFile As String, OutputFile As String) As Integer
Dim As Ubyte Ptr src, dest
Dim As Integer dest_len, src_len, i, errlev, ff, erro
Dim As Uinteger crc
ff=FreeFile
Open InputFile For Binary Access Read As #ff
src_len=Val(file_HoleWert(ff, "SRCLEN"))
dest_len=Val(file_HoleWert(ff, "DSTLEN"))
crc=Val(file_HoleWert(ff, "CRC32"))
src=Allocate(src_len)
dest=Allocate(dest_len)
Dim Destination As String=file_HoleWert(ff, "DATA")
For i = 0 To dest_len - 1
dest[i] = Asc(Mid(Destination,i,1))
Next
' Die Variable src_len wird der uncompress Funktion als Pointer übergeben,
' da nach erfolgreicher dekomprimierung hier die Anzahl der ungepackten Daten eingetragen ist.
errlev = uncompress(src, @src_len, dest, dest_len)
If errlev <> 0 Then
' Ein Rückgabewert <> 0 zeigt einen Fehler bei der Dekomprimierung an.
Print "**** Fehler beim entpacken der Daten - FehlerNr. " & errlev & " ****"
End If
Print "entpackt : " & src_len & " Byte."
' Erneut eine crc32 Prüfsumme der entpackten Testdaten bilden,
' und mit der ersten Prüfsumme vergleichen.
If crc <> crc32(0, src, src_len) Then
Print "crc32 Pruefsumme : FALSCH"
Else
Print "crc32 Pruefsumme : RICHTIG"
End If
Close #ff
Open OutputFile For Binary Access Read As #ff
For i = 0 To src_len - 1
Put #1,,src[i]
Next
Close #ff
' Reservierte Speicherbereiche freigeben
Deallocate(src)
Deallocate(dest)
Return TRUE
End Function
Function file_SpeichereWert (Dateinummer As Integer, BlockID As String, Block As String) As Integer
Dim ID As String * 6
Dim BlockLaenge As Integer
ID = BlockID + Space(6 - Len(BlockID))
BlockLaenge = Len(Block)
Put #Dateinummer, , ID
Put #Dateinummer, , BlockLaenge
Put #Dateinummer, , Block
Return TRUE
End Function
Function file_HoleWert (Dateinummer As Integer, BlockID As String) As String
Dim ID As String * 6
Dim BlockLaenge As Integer
Dim Block As String
Do
Get #Dateinummer, , ID
Get #Dateinummer, , BlockLaenge
Block = String(BlockLaenge, 0)
Get #Dateinummer, , Block
If Trim(UCase(ID)) = Trim(UCase(BlockID)) Then Function = Block: Exit Function
Loop Until Eof(DateiNummer)
Function = ""
End Function
|
Aber iwie kommt immer Fehler -3  (Beim Entpacken)
EDIT:
 
ICH BIN SOOOOOOOOO GLÜCKLICH! ES FUNKTONIERT!!! JUHU!!!
| Code: | #Include Once "zlib.bi"
#Include Once "fbgfx.bi"
Const TRUE = -1
Const FALSE = Not TRUE
Type CFile
SRCLEN As Integer
DESTLEN As Integer
CRC As UInteger
' Then follows the compressed Data...
End Type
Declare Function file_SpeichereWert (Dateinummer As Integer, BlockID As String, Block As String) As Integer
Declare Function file_HoleWert (Dateinummer As Integer, BlockID As String) As String
Declare Function CompressA(InputFile As String, OutputFile As String) As Integer
Declare Function DeCompressA(InputFile As String, OutputFile As String) As Integer
CompressA("Engine32.dll", "Engine32.pak")
DeCompressA("Engine32.pak", "2Engine32.dll")
Sleep
End
Function CompressA(InputFile As String, OutputFile As String) As Integer
Dim As Ubyte Ptr src, dest
Dim As Integer dest_len, src_len, i, errlev, ff, erro
Dim As Uinteger crc
Dim FHead As CFile
ff=FreeFile
Open InputFile For Binary Access Read As #ff
src_len=Lof(ff)
' Die Funktion compressBound berechnet die Buffergröße für die zu komprimierende Anzahl Byte.
' Der Buffer ist immer > als die Anzahl komprimierender Byte.
dest_len = compressBound(src_len)
' Allocate ,reservieren der benötigten Speicherbereiche
src = Allocate(src_len)
dest = Allocate(dest_len)
' Daten lesen...
For i = 0 To src_len - 1
Get #ff,,src[i]
Next
Close #ff
' Eine crc32 Prüfsumme der Testdaten bilden. Damit prüfen wir ob zlib
' die Testdaten richtig gepackt und entpackt hat.
crc = crc32(0, src, src_len)
Print "CRC32:" & crc
' Die Variable dest_len wird der compress Funktion als Pointer übergeben,
' da nach erfolgreicher komprimierung hier die Anzahl der gepackten Daten eingetragen ist.
errlev = compress(dest, @dest_len, src, src_len)
If errlev <> 0 Then
' Ein Rückgabewert <> 0 zeigt einen Fehler bei der Komprimierung an.
Print "err. " & errlev
erro = TRUE
End If
Dim As String Destination
ff=FreeFile
FHead.SRCLEN=src_len
FHead.DESTLEN=dest_len
FHead.CRC=crc
Open OutputFile For Binary As #ff
Put #ff, , FHead.SRCLEN
Put #ff, , FHead.DESTLEN
Put #ff, , FHead.CRC
For i = 0 To dest_len
Put #ff, , dest[i]
Next
'Put #ff, , *FHead.CDATA
'file_SpeichereWert(ff, "SRCLEN", Str(src_len))
'file_SpeichereWert(ff, "DSTLEN", Str(dest_len))
'file_SpeichereWert(ff, "CRC32", Str(crc))
'file_SpeichereWert(ff, "DATA", Destination)
Close #ff
DeAllocate(src)
DeAllocate(dest)
If erro = TRUE Then
Return FALSE
Else
Return TRUE
EndIf
End Function
Function DeCompressA(InputFile As String, OutputFile As String) As Integer
Dim As Ubyte Ptr src, dest
Dim As Integer dest_len, src_len, i, errlev, ff, erro
Dim As Uinteger crc
Dim FHead As CFile
ff=FreeFile
Open InputFile For Binary Access Read As #ff
Get #ff,,FHead.SRCLEN
Get #ff,,FHead.DESTLEN
Get #ff,,FHead.CRC
src_len=FHead.SRCLEN
dest_len=FHead.DESTLEN
crc=FHead.CRC
src=Allocate(src_len)
dest=Allocate(dest_len)
For i = 0 To dest_len
Get #ff,,dest[i]
Next
' Die Variable src_len wird der uncompress Funktion als Pointer übergeben,
' da nach erfolgreicher dekomprimierung hier die Anzahl der ungepackten Daten eingetragen ist.
errlev = uncompress(src, @src_len, dest, dest_len)
If errlev <> 0 Then
' Ein Rückgabewert <> 0 zeigt einen Fehler bei der Dekomprimierung an.
Print "**** Fehler beim entpacken der Daten - FehlerNr. " & errlev & " ****"
End If
Print "entpackt : " & src_len & " Byte."
' Erneut eine crc32 Prüfsumme der entpackten Testdaten bilden,
' und mit der ersten Prüfsumme vergleichen.
If crc <> crc32(0, src, src_len) Then
Print "crc32 Pruefsumme : FALSCH"
Else
Print "crc32 Pruefsumme : RICHTIG"
End If
Print "readed CRC32:" & crc
Print "getted CRC32:" & crc32(0, src, src_len)
Close #ff
ff=FreeFile
Open OutputFile For Binary As #ff
For i = 0 To src_len - 1
Put #1,,src[i]
Next
Close #ff
' Reservierte Speicherbereiche freigeben
Deallocate(src)
Deallocate(dest)
Return TRUE
End Function
Function file_SpeichereWert (Dateinummer As Integer, BlockID As String, Block As String) As Integer
Dim ID As String * 6
Dim BlockLaenge As Integer
ID = BlockID + Space(6 - Len(BlockID))
BlockLaenge = Len(Block)
Put #Dateinummer, , ID
Put #Dateinummer, , BlockLaenge
Put #Dateinummer, , Block
Return TRUE
End Function
Function file_HoleWert (Dateinummer As Integer, BlockID As String) As String
Dim ID As String * 6
Dim BlockLaenge As Integer
Dim Block As String
ID = BlockID + Space(6 - Len(BlockID))
Do
Get #Dateinummer, , ID
Get #Dateinummer, , BlockLaenge
Block = String(BlockLaenge, 0)
Get #Dateinummer, , Block
If Trim(UCase(ID)) = Trim(UCase(BlockID)) Then Function = Block: Exit Function
Loop Until Eof(DateiNummer)
Function = ""
End Function
|
_________________
If hilfreicher_Beitrag then klick(location.here)
Klick |
|
| Nach oben |
|
|
PMedia
Anmeldungsdatum: 14.08.2006
Beiträge: 2847
|
| Verfasst am: 19.09.2007, 23:22 Titel: |
|
|
Ich hab da mal ne Frage....
warum lernst du nichts aus deinen Fehlern?
Ich hab jetzt mind. 5 Postings gesehen, in welchen du das Problem (fast?) ganz allein gelöst hast... warum arbeitest du nach der Reihenfolge "Erst Posten, dann Gehirn einschalten" ? Warum nicht mal umgedreht?
Erst durchwursteln, und direkt vorm verzweifeln (ich weiß schon warum ich nicht "kurz vorm Verzweifeln" gesagt hab... weils relativ ist) erst posten. |
|
| Nach oben |
|
|
volta
Anmeldungsdatum: 04.05.2005
Beiträge: 1876
Wohnort: D59192
|
| Verfasst am: 20.09.2007, 13:19 Titel: |
|
|
Ach, lass mal...
einen verzweifelten oder hilfsbedürftigen Eindruck macht csderats auf mich nicht.
Ja, manchmal sollte er ein Problem erst überschlafen, bevor er es hier veröffentlicht.
Aber es ist doch schön das ...klick... bei Ihm fast hörbar mit zu erleben....  )
_________________
Warnung an Choleriker:
Dieser Beitrag kann Spuren von Ironie & Sarkasmus enthalten.
Zu Risiken & Nebenwirkungen fragen Sie Ihren Therapeuten oder Psychiater. |
|
| Nach oben |
|
|
|
|
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
