PureBoard

Code: Alles auswählen

;PB 3.94
NewList packfiles.s()
Procedure FindStringRight(String.s,StringToFind.s,StartPos)
  asc=Asc(StringToFind)
  For x=(Len(String)-StartPos) To 0 Step -1
    If PeekB(@String+x)=asc
      Break
    EndIf
  Next
  ProcedureReturn Len(String)-x
EndProcedure
Procedure SearchFile(Folder.s) 
  Protected Search.s 
  Static DirID.l 
  
  If ExamineDirectory(DirID, Folder, "") 
    DirID + 1 
    Repeat 
      
      type = NextDirectoryEntry() 
      
      If type : Search = Trim(DirectoryEntryName()) : EndIf 
      
      Select type 
        Case 2 
          If Search <> "." And Search <> ".." 
            AddElement(packfiles())
            packfiles()="mkdir "+Search
            AddElement(packfiles())
            packfiles()="cd "+Search
            Search = Folder + Search + "\" 
            SearchFile(Search) 
            AddElement(packfiles())
            packfiles()="cd .."
            UseDirectory(DirID - 1) 
          EndIf 
          
        Case 1 
            AddElement(packfiles())
            packfiles()="unpack " + Search
          
      EndSelect 
      
    Until type = 0 
    
    DirID - 1 
  EndIf 
  
EndProcedure 
Procedure PackDir(dir.s,destination.s)
  If Right(dir,1)<>"\"
    dir+"\"
  EndIf
  ClearList(packfiles())
  SearchFile(dir)
  CreatePack(destination)
  hFile=CreateFile(#PB_Any,GetTempPath()+"\index.txt")
  ForEach packfiles()
    WriteStringN(packfiles()) 
  Next
  CloseFile(hFile)
  AddPackFile(GetTempPath()+"\index.txt",9)
  ForEach packfiles()
    command$=Trim(Left(packfiles(),FindString(packfiles()," ",0)))
    param$=Trim(Right(packfiles(),Len(packfiles())-Len(command$)))
    Select command$
      Case "cd"
        If param$<>".."
          dir+param$+"\"
        Else
          dir=Left(dir,Len(dir)-FindStringRight(dir,"\",2))+"\"
        EndIf
      Case "unpack"
        AddPackFile(dir+param$,9)
    EndSelect
  Next
  ClosePack()
EndProcedure
Procedure UnpackFile(file.s, destination.s)
  If Right(destination,1)<>"\"
    destination+"\"
  EndIf
  If OpenPack(file)
    pFile=NextPackFile()
    pMem=AllocateMemory(PackFileSize())
    Debug PackFileSize()
    UnpackMemory(pFile,pMem)
    hFile=CreateFile(#PB_Any,GetTempPath()+"\index.txt")
    WriteData(hFile,PackFileSize())
    CloseFile(hFile)
    FreeMemory(pMem)
    hFile=ReadFile(#PB_Any,GetTempPath()+"\index.txt")
    Repeat
      String$=ReadString()
      command$=Trim(Left(String$,FindString(String$," ",0)))
      param$=Trim(Right(String$,Len(String$)-Len(command$)))
      Select command$
        Case "cd"
          If param$<>".."
            destination+param$+"\"
          Else
            destination=Left(destination,Len(destination)-FindStringRight(destination,"\",2))+"\"
          EndIf
        Case "mkdir"
          CreateDirectory(destination+param$)
        Case "unpack"
          pFile=NextPackFile()
          pMem=AllocateMemory(PackFileSize())
          UnpackMemory(pFile,pMem)
          hFile=CreateFile(#PB_Any,destination+param$)
          WriteData(pMem,PackFileSize())
          CloseFile(hFile)
          FreeMemory(pMem)
      EndSelect
    Until Eof(hFile)
    CloseFile(hFile)
    ClosePack()
  EndIf
EndProcedure

dir$=PathRequester("zu komprimierender Ordner","")
If dir$
  dest$=SaveFileRequester("Koprimieren als","","Comp|*.cmp",0)
  If dest$
    PackDir(dir$,dest$)
  EndIf
EndIf
dest$=""
file$=OpenFileRequester("Datei zum dekomprimieren wählen","","Comp|*.cmp",0)
If file$
  dest$=PathRequester("Zielordner","")
  If dest$
    UnpackFile(file$,dest$)
  EndIf
EndIf