PureBoard

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