ich habe mal ein bisschen mit dem integrierten Packer herumgespielt. Das ist dabei herausgekommen:
Code: Alles auswählen
; MiniPacker mit PB
; Archiv anlegen (eine Textdatei mit Fileliste wird erstellt)
; Doppelpack
; 1. anlegen des Packs
; 2. Textdatei mit Pack verschmelzen
; Die Index-Textdatei liegt vor der eigentlichen Packdatei
; PB Version 3.94 - Karl
;- Deklarationen
Enumeration
#Neu
#Open
#Exit
#Pack
#Unpack
EndEnumeration
Enumeration
#LI_LEFT
#LI_CENTER
#LI_RIGHT
EndEnumeration
DefType.l quit, ET
DefType.s packdatei
;- GUI
Procedure fmt_ListIconFormat(column.l, format.l)
li.lv_column
li\mask = #LVCF_FMT
Select format
Case #LI_LEFT
li\fmt = #LVCFMT_LEFT
Case #LI_CENTER
li\fmt = #LVCFMT_CENTER
Case #LI_RIGHT
li\fmt = #LVCFMT_RIGHT
Default
li\fmt = #LVCFMT_LEFT
EndSelect
SendMessage_(GadgetID(0), #LVM_SETCOLUMN, column, li)
EndProcedure
Procedure.l GUI()
If OpenWindow(0, 0, 0, 600, 400, #PB_Window_SystemMenu, "MiniPacker für unterwegs")
If CreateGadgetList(WindowID(0))
If CreateMenu(0, WindowID(0))
MenuTitle("Datei")
MenuItem(#Neu, "Neues Pack")
MenuItem(#Open, "Öffnen")
MenuItem(#Exit, "Beenden")
MenuTitle("Bearbeiten")
MenuItem(#Pack, "Packen")
MenuItem(#Unpack, "Entpacken")
EndIf
ListIconGadget(0, 10, 10, 580, 360, "Datei", 200, #PB_ListIcon_FullRowSelect|#PB_ListIcon_GridLines)
AddGadgetColumn(0, 1, "Größe in Byte", 100)
AddGadgetColumn(0, 2, "erstellt", 100)
fmt_ListIconFormat(1, #LI_RIGHT)
fmt_ListIconFormat(2, #LI_RIGHT)
ProcedureReturn #True
EndIf
EndIf
ProcedureReturn #False
EndProcedure
;- Pack
Procedure.l Pack()
Shared packdatei
Protected datei.s, pfad.s, i.l
i = CountGadgetItems(0)
If i
datei = SaveFileRequester("Bitte geben Sie einen Namen für das Archiv an", "", "Packdatei (*.pak)|*.pak", 0)
If datei
datei + ".pak"
pfad = GetPathPart(datei)
CreateFile(0, pfad + "Packinfo.txt")
CreatePack(pfad + "Packtemp.pak")
For i = 0 To CountGadgetItems(0)-1
AddPackFile(GetGadgetItemText(0, i, 0))
WriteStringN(GetFilePart(GetGadgetItemText(0, i, 0)) + ";" + GetGadgetItemText(0, i, 1) + ";" + GetGadgetItemText(0, i, 2))
Next
ClosePack()
CloseFile(0)
CreatePack(datei)
AddPackFile(pfad + "Packinfo.txt")
AddPackFile(pfad + "Packtemp.pak")
ClosePack()
DeleteFile(pfad + "Packinfo.txt")
DeleteFile(pfad + "Packtemp.pak")
packdatei = datei
MessageRequester("Pack erstellt", "Die Packdatei wurde erstellt.")
ProcedureReturn #True
EndIf
EndIf
ProcedureReturn #False
EndProcedure
;- Unpack
Procedure.l Unpack()
Shared packdatei
Protected datei.s, pfad.s, gross.l, Adr.l, i.l, hFile.l
i=CountGadgetItems(0)
If i
pfad = PathRequester("Bitte geben Sie das Zielverzeichnis an:", "")
If pfad And packdatei
OpenPack(packdatei)
;erst Packinfo und Packfile holen
Repeat
Adr = NextPackFile()
If Adr
i=i+1
gross = PackFileSize()
If i=1
CreateFile(1, pfad + "Packinfo.txt")
Else
CreateFile(1, pfad + "Packtemp.pak")
EndIf
WriteData(Adr, gross)
CloseFile(1)
EndIf
Until Adr = 0
ClosePack()
;jetzt Packfile entpacken
OpenPack(pfad + "Packtemp.pak")
i=0
Repeat
Adr = NextPackFile()
If Adr
gross = PackFileSize()
datei = GetGadgetItemText(0, i, 0)
hFile = CreateFile(#PB_Any, pfad + datei)
WriteData(Adr, gross)
CloseFile(hFile)
EndIf
i=i+1
Until Adr = 0
CloseFile(1)
ClosePack()
DeleteFile(pfad + "Packtemp.pak")
DeleteFile(pfad + "Packinfo.txt")
MessageRequester("Pack entpackt", "Die Packdatei wurde entpackt.")
ProcedureReturn #True
EndIf
EndIf
ProcedureReturn #False
EndProcedure
;- Filedarstellung
Procedure LIC(Aktion.l)
Shared packdatei
Protected hFile.l, ft1.filetime, ft2.filetime, ft3.filetime, datum.s, syt.systemtime, gross.l, i.l
Protected datei.s, pfad.s, zeile.s, gesamt.l
;Auswahl und lesen des Infofiles
Select Aktion
Case 0 ;Auswahl hinzufügen
datei = OpenFileRequester("Bitte wählen Sie die Dateien aus:", "", "Alle Dateien (*.*)|*.*", 0, #PB_Requester_MultiSelection)
If datei
Repeat
hFile = ReadFile(10, datei)
datum = "01.01.1900"
If hFile
GetFileTime_(hFile, @ft1, @ft2, @ft3)
FileTimeToLocalFileTime_(@ft3, @ft1)
fileTimeToSystemTime_(@ft1, @syt)
gross = Lof()
CloseFile(10)
datum = RSet(Str(syt\wDay), 2, "0") + "." + RSet(Str(syt\wMonth), 2, "0") + "." + Str(syt\wYear)
EndIf
AddGadgetItem(0, -1, datei + #LF$ + Str(gross) + #LF$ + datum)
datei = NextSelectedFileName()
Until datei = ""
packdatei = ""
EndIf
Case 1 ;öffnen eines Packs
datei = OpenFileRequester("Bitte wählen Sie die Packdatei aus:", "", "Packdateien (*.pak)|*.pak", 0)
If datei
packdatei = datei
pfad = GetPathPart(datei)
OpenPack(datei)
;Packinfo holen
Adr = NextPackFile()
If Adr
gross = PackFileSize()
zeile = PeekS(Adr, gross)
zeile = ReplaceString(zeile, #crlf$, ";")
gesamt = CountString(zeile, ";")
Debug zeile
While i<=gesamt
i=i+1
AddGadgetItem(0, -1, StringField(zeile, 2*(i-1)+i, ";") + #LF$ + StringField(zeile, 2*(i-1)+i+1, ";") + #LF$ + StringField(zeile, 2*(i-1)+i+2, ";"))
Wend
EndIf
ClosePack()
EndIf
EndSelect
EndProcedure
;- MainLoop
If GUI()
Repeat
ET = WaitWindowEvent()
Select ET
Case #PB_Event_CloseWindow
quit = 1
Case #PB_Event_Menu
Select EventMenuID()
Case #Exit
quit = 1
Case #Neu
ClearGadgetItemList(0)
LIC(0)
Case #Pack
Pack()
Case #Unpack
Unpack()
Case #Open
ClearGadgetItemList(0)
LIC(1)
EndSelect
EndSelect
Until quit
EndIf
End
Gruß Karl
geändert: Procedure LIC/case 1/if datei/if adr ...
jetzt sollten die CRLF nicht mehr auftauchen
geändert: Returnwerte als Long (#True, #False)
