Hab mal vor langer Zeit nen kleinen Datei-Archiver geschrieben, der mehrere Dateien in eine Packt. Der Code liegt bei mir schon seit einiger Zeit rum und ich kann ihn nicht mehr brauchen, vielleicht findet jemand anderes verwendung dafür
Hier die Include Datei:
BlitzBasic: [AUSKLAPPEN] [EINKLAPPEN] Global newbank=CreateBank(0) Global caesar_count=0 Function CreateArchive(file$)
newfile=WriteFile(file$) If newfile = 0 Then RuntimeError("Das Archiv "+Chr(34)+file$+Chr(34)+" konnte nicht erstellt werden!") End If CloseFile newfile Return(1) End Function
Function AddToArchive(Arch$,resFile$,key$="") size=FileSize(resFile$) sizeofar=FileSize(Arch$) ResizeBank(newbank,size+sizeofar+1) newfile=ReadFile(resFile) If newfile=0 Then RuntimeError("Die Datei "+Chr(34)+resFile$+Chr(34)+" existiert nicht!") End If archfile=ReadFile(Arch$) If archfile=0 Then RuntimeError("Die Archivdatei "+Chr(34)+Arch$+Chr(34)+" existiert nicht!") End If If Instr(resFile,"/")<>0 Or Instr(resFile,"\")<>0 Then For i=1 To Len(resFile) If Instr(Mid(resFile,i,-1),"/")=0 And Instr(Mid(resFile,i,-1),"\")=0 Then resFile=Replace(resFile,Mid(resFile,1,i-1),"") Exit End If Next End If readed=ReadBytes(newbank,newfile,0,size) ReadBytes(newbank,archfile,readed+1,sizeofar) CloseFile(archfile) CloseFile(newfile) archfile=OpenFile(Arch$) WriteLine(archfile,"") WriteLine(archfile,resFile$) WriteLine(archfile,size) If key$<>"" Then caesar_count=1 For i=0 To size+sizeofar byte=PeekByte(newbank,i) byte=byte+Asc(Mid(key$,caesar_count,1)) byte=255-byte If caesar_count<Len(key$) Then caesar_count=caesar_count+1 Else If caesar_count=Len(key$) Then caesar_count=1 End If PokeByte(newbank,i,byte) Next End If WriteBytes(newbank,archfile,0,size+sizeofar) CloseFile(archfile) Return(1) End Function
Function GetFromArchive(Arch$,resFile$,key$="",toPos$="") getit=ReadFile(Arch$) If getit=0 Then RuntimeError("Die Archivdatei "+Chr(34)+Arch$+Chr(34)+" existiert nicht!") End If job_done=0 While Not Eof(getit) And job_done=1 name$ = ReadLine(getit) If name$=resFile$ Then sizeof = ReadLine(getit) curpos=FilePos(getit) ResizeBank(newbank,sizeof) archfile=ReadFile(Arch) ReadBytes(newbank,getit,0,sizeof) CloseFile archfile job_done=1 End If If Eof(getit) And job_done=0 Then RuntimeError("Die Datei "+Chr(34)+resFile+Chr(34)+" konnte in der Archivdatei "+Chr(34)+Arch$+Chr(34)+" nicht gefunden werden!") End If Wend
If Right(toPos$,1)<>"/" Or Right(toPos$,1)<> "\" And toPos$<>"" Then toPos$=toPos$+"/" End If newfile=WriteFile(toPos$+resFile$) If key$<>"" Then caesar_count=1 For i=0 To BankSize(newbank)-1 byte=PeekByte(newbank,i) byte=255-byte byte=byte-Asc(Mid(key$,caesar_count,1)) If caesar_count<Len(key$) Then caesar_count=caesar_count+1 Else If caesar_count=Len(key$) Then caesar_count=1 End If PokeByte(newbank,i,byte) Next End If WriteBytes(newbank,newfile,0,sizeof) CloseFile newfile End Function
Hier noch ein Anwendungsbeispiel:
BlitzBasic: [AUSKLAPPEN] [EINKLAPPEN] Include "FreeFilePacker.bb"
CreateArchive("test.archiv") AddToArchive("test.archiv","testdatei.exe","passwort")
GetFromArchive("test.archiv","testdatei.exe","passwort","data")
Und hier die Befehls erklärungen:
CreateArchive(file$)
- File$ = [Pfad+]Name der Archiv Datei die erstellt werden soll.
_____
AddToArchive(Arch$,resFile$,key$="")
- Arch$ = Name einer erstellten Archivdatei in die die Datei hinzugefügt werden soll.
- resFile$= = Datei die ins Archiv hinzugefügt werden soll.
- key$ = Code mit dem die Datei verschlüsselt werden soll.Wird zum entschlüsseln auch wieder benutzt.
_____
GetFromArchive(Arch$,resFile$,key$="",toPos$="")
- Arch$ = Name einer erstellten Archivdatei aus der die Datei exportiert werden soll.
- resFile$ = Datei die aus dem Archiv exportiert werden soll.
- key$ = Optionaler Parameter! Code zum entschlüsseln einer Passwort geschützten Datei.(Der Code muss gleich sein wie der, mit dem die Datei verschlüsselt wurde.)
- toPos$ = Optionaler Parameter! Falls die Datei in einem anderen Ordner gespeichert werden soll.
Dazu einfach den Ordnername hineinschreiben.
_____
Viel Spaß damit
Ihr könnt den File Packer frei verwenden, Credits eintrag bei benutzung ist kein muss, wäre aber nett
www.FREEMOTION-Studios.com
|