[Module] FileExModule.pbi

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
Thorsten1867
Beiträge: 1359
Registriert: 04.02.2005 15:40
Computerausstattung: [Windows 10 x64] [PB V5.7x]
Wohnort: Kaufbeuren
Kontaktdaten:

[Module] FileExModule.pbi

Beitrag von Thorsten1867 »

Extended File Format

Die eigentliche Datei wird in einem komprimierten Datei-Container (ZIP) abgelegt. Es können noch weitere Dateien bzw. Ressourcen (z.B. Bilder) hinzugefügt werden.
Die Dateien im Container können zusätzlich mit einem Passwort verschlüsselt werden.
Beim Öffnen der Datei werden alle enthaltenen Dateien in das angegebene Verzeichnis (z.B. Temp-Dir) entpackt und beim Schließen wieder in den Datei-Container verschoben.

Code: Alles auswählen

;/ ============================================
;/ ||  FileExModule.pbi  [PureBasic V5.6x]  ||
;/ ============================================
;/
;/ Fileformat mit komprimiertem Dateicontainer für weitere Dateien bzw. Resourcen
;/
;/ (c) Dez. 2017 by Thorsten1867
;/

DeclareModule FileEx
  
  Declare.i Create(PackID.i, ProgID.s, File$, Extension$="", Path$="", Password$="", Move=#False)
  Declare   AddFile(PackID.i, File$)
  Declare   AddInfo(PackID.i, Key$, Text$)
  Declare.s Open(PackID.i, FileEx$, Path$="", Password$="")
  Declare   Close(PackID.i)
  
EndDeclareModule


Module FileEx
  
  EnableExplicit
  
  UseZipPacker()
  UseSHA2Fingerprint()
  
  ;{ ----- Constants  -----
  #XML = 1
  #DESKey     = "F18EX67"
  #ContentXML = "Content.xml"
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    #Slash = "\"
  CompilerElse  
    #Slash = "/"
  CompilerEndIf
  ;}
  
  ;{ ----- Structures -----
  Structure File_Structure
    Path.s
    Size.i
  EndStructure
  
  Structure Content_Structure
    ProgID.s                  ; ID for assignment to a specific program
    DES.s                     ; DES password
    Map File.File_Structure() ; Filesize (Key: Filename)
    Map Info.s()              ; Additional information
  EndStructure
  
  Structure FileEx_Structure
    Path.s  ; Path with unpacked files
    File.s  ; FileContainer
    Password.s
    AES.i ; valid password (#True/#False)
    Move.i  ; Delete files after packing (#True/#False)
    Content.Content_Structure
  EndStructure ;}
  
  Global NewMap FileEx.FileEx_Structure()
  
  
  Procedure.i EncryptFile(PackID.i, File$, FileName$="", Password$="") 
    Define Ext$, Result.i, FileID.i, FileSize.i
    Define *FileMemory, *MemoryBuffer
   
    If FileName$ = "" : FileName$ = GetFilePart(File$) : EndIf
    
    Ext$      = GetExtensionPart(File$)
    FileName$ = ReplaceString(FileName$, "."+Ext$, "["+Ext$+"].aes")
    Password$ = StringFingerprint(Password$, #PB_Cipher_SHA2)
    
    FileID = ReadFile(#PB_Any, File$)
    If FileID
      FileSize = Lof(FileID)
        *FileMemory = AllocateMemory(FileSize)
        If *FileMemory
          If ReadData(FileID, *FileMemory, FileSize)
            *MemoryBuffer = AllocateMemory(FileSize)
            If *MemoryBuffer
              If AESEncoder(*FileMemory, *MemoryBuffer, MemorySize(*FileMemory), @Password$, 128, #False, #PB_Cipher_ECB)
                If PackID
                  If AddPackMemory(PackID, *MemoryBuffer, MemorySize(*FileMemory), FileName$)
                    Result = FileSize
                  EndIf
                EndIf
              EndIf
              FreeMemory(*MemoryBuffer)
            EndIf
          FreeMemory(*FileMemory)
        EndIf
      EndIf
      CloseFile(FileID)
    EndIf
    
    ProcedureReturn Result
  EndProcedure  

  Procedure.i DecryptFile(PackID.i, File$, FileSize.i, FileName$="", Password$="") 
    Define Ext$, FileID.i, Result.i
    Define *FileMemory, *MemoryBuffer
    
    Ext$      = GetExtensionPart(File$)
    FileName$ = ReplaceString(FileName$, "."+Ext$, "["+Ext$+"].aes")
    Password$ = StringFingerprint(Password$, #PB_Cipher_SHA2)
    
    If FileSize <= 0 : ProcedureReturn #False : EndIf
     
    If PackID
      *MemoryBuffer = AllocateMemory(FileSize)
      If *MemoryBuffer
        If UncompressPackMemory(PackID, *MemoryBuffer, FileSize, FileName$)
          *FileMemory = AllocateMemory(FileSize)
          If *FileMemory
            If AESDecoder(*MemoryBuffer, *FileMemory, MemorySize(*MemoryBuffer), @Password$, 128, #False, #PB_Cipher_ECB)
              FileID = OpenFile(#PB_Any, File$)
              If FileID
                Result = WriteData(FileID, *FileMemory, MemorySize(*FileMemory))
                CloseFile(FileID)
              EndIf
            EndIf
            FreeMemory(*FileMemory)
          EndIf
        EndIf
        FreeMemory(*MemoryBuffer)
      EndIf
    EndIf
    
    ProcedureReturn Result
  EndProcedure  
  
  
  Procedure.i Create(PackID.i, ProgID.s, File$, Extension$="", Path$="", Password$="", Move=#False)
    Define Path$, FileName$, ArchiveFile$
    Define.i Result
    
    If Path$ = "" : Path$ = GetPathPart(File$) : EndIf
    FileName$ = GetFilePart(File$, #PB_FileSystem_NoExtension)
    
    If Extension$ = "" : Extension$ = GetExtensionPart(File$)+"x" : EndIf
    
    ArchiveFile$ = Path$ + FileName$ + "." + Extension$
    
    Result = CreatePack(PackID, ArchiveFile$, #PB_PackerPlugin_Zip)
    If Result
      
      If PackID = #PB_Any : PackID  = Result : EndIf
      
      If AddMapElement(FileEx(), Str(PackID))
        
        FileEx()\File = ArchiveFile$
        FileEx()\Path = Path$
        FileEx()\Move = Move
        FileEx()\AES  = #True
        FileEx()\Password       = Password$
        FileEx()\Content\DES    = DESFingerprint(Password$, #DESKey)
        FileEx()\Content\ProgID = ProgID
        
        If AddMapElement(FileEx()\Content\File(), GetFilePart(File$))
          FileEx()\Content\File()\Path = File$
          FileEx()\Content\File()\Size = FileSize(File$)
        EndIf
        
      EndIf
      
      ProcedureReturn PackID
    EndIf
    
  EndProcedure
  
  Procedure AddFile(PackID.i, File$)
    
    If FindMapElement(FileEx(), Str(PackID))
      
      If AddMapElement(FileEx()\Content\File(), GetFilePart(File$))
        FileEx()\Content\File()\Path = File$
        FileEx()\Content\File()\Size = FileSize(File$)
      EndIf
 
    EndIf
    
  EndProcedure
  
  Procedure AddInfo(PackID.i, Key$, Text$)
    
    If FindMapElement(FileEx(), Str(PackID))
      
      FileEx()\Content\Info(Key$) = Text$
 
    EndIf
    
  EndProcedure
  
  Procedure.s Open(PackID.i, FileEx$, Path$="", Password$="")
    Define File$
    
    If Path$ = "" : Path$ = GetPathPart(FileEx$) : EndIf
    Path$ = RTrim(Path$, #Slash) + #Slash
    
    If AddMapElement(FileEx(), Str(PackID))
      
      If OpenPack(PackID, FileEx$, #PB_PackerPlugin_Zip)   ;{ Unpack files
        
        ;{ ----- FileEx_Content.xml -----
        If UncompressPackFile(PackID, Path$ + #ContentXML, #ContentXML)
          If LoadXML(#XML, Path$ + #ContentXML)
            ExtractXMLStructure(MainXMLNode(#XML), @FileEx()\Content, Content_Structure)
            FreeXML(#XML)
          EndIf
        EndIf ;}
        
        ;{ ----- Password -----
        If FileEx()\Content\DES
          If FileEx()\Content\DES = DESFingerprint(Password$, #DESKey)
            FileEx()\Password = Password$
            FileEx()\AES = #True
          Else
            FileEx()\Password = ""
            FileEx()\AES = #False
            ProcedureReturn ""
          EndIf
        EndIf ;}
        
        FileEx()\File = FileEx$
        FileEx()\Path = Path$
        FileEx()\Move = #True
        
        ForEach FileEx()\Content\File()
          
          File$ = MapKey(FileEx()\Content\File())
          
          FileEx()\Content\File()\Path = Path$ + File$
          
          If FileEx()\AES
            DecryptFile(PackID, FileEx()\Content\File()\Path, FileEx()\Content\File()\Size, File$, Password$)
          Else
            UncompressPackFile(PackID, FileEx()\Content\File()\Path, File$)
          EndIf
          
        Next
        
        ClosePack(PackID)
      Else
        ProcedureReturn ""
      EndIf ;}
      
      If CreatePack(PackID, FileEx$, #PB_PackerPlugin_Zip) ;{ Create new archiv
        ProcedureReturn FileEx()\Content\ProgID
      Else
        ProcedureReturn ""
      EndIf ;}
      
    EndIf
    
    ProcedureReturn ""
  EndProcedure
  
  Procedure Close(PackID.i)
    Define FilePath$, FileName$
    Define Result.i, Size.i, *Buffer
    Define Content.Content_Structure
    
    If FindMapElement(FileEx(), Str(PackID))
      Result = #True
      ForEach FileEx()\Content\File() ;{ Add files to pack
        FileName$ = MapKey(FileEx()\Content\File())
        If FileSize(FileEx()\Content\File()\Path) >= 0
          If FileEx()\AES
            EncryptFile(PackID, FileEx()\Content\File()\Path, FileName$, FileEx()\Password)
          Else
            AddPackFile(PackID, FileEx()\Content\File()\Path, FileName$)
          EndIf 
        Else
          DeleteMapElement(FileEx()\Content\File())
          Result = #False
        EndIf
        ;}
      Next
      
      If CreateXML(#XML) ;{ Content.xml
        CopyStructure(@FileEx()\Content, @Content, Content_Structure)
        InsertXMLStructure(RootXMLNode(#XML), @Content, Content_Structure)
        FormatXML(#XML, #PB_XML_ReFormat)
        Size    = ExportXMLSize(#XML)
        *Buffer = AllocateMemory(Size)
        If *Buffer
          ExportXML(#XML, *Buffer, Size)
          AddPackMemory(PackID, *Buffer, Size, #ContentXML)
          FreeMemory(*Buffer)
        EndIf
        FreeXML(#XML) ;}
      EndIf
      
      ClosePack(PackID)
      
      If FileEx()\Move
        ForEach FileEx()\Content\File()
          DeleteFile(FileEx()\Content\File()\Path)
        Next
        DeleteFile(FileEx()\Path + #ContentXML)
      EndIf
      
      DeleteMapElement(FileEx())
      
    EndIf
    
    ProcedureReturn Result
  EndProcedure
  
EndModule


CompilerIf #PB_Compiler_IsMainFile
  
  Define ProgID.s
  
  #Pack = 1
  
  File1$  = "D:\Programme\Entwicklung\PureBasic V56x\Examples\Sources\Clipboard.pb"
  File2$  = "D:\Programme\Entwicklung\PureBasic V56x\Examples\Sources\Data\PureBasicLogo.bmp"
  File3$  = "D:\Programme\Entwicklung\PureBasic V56x\Examples\Sources\Data\world.png"
  FileEx$ = "D:\Clipboard.pbx"
  
  If FileEx::Create(#Pack, "PureBasic", File1$, "pbx", "D:\", "TestPasswort")
    FileEx::AddFile(#Pack, File2$)
    FileEx::AddFile(#Pack, File3$)
    FileEx::AddInfo(#Pack, "Info", "Clipboard example file")
    FileEx::Close(#Pack)
  EndIf
  
  MessageRequester("Test FileEx", "File was created."+#LF$+"Now the file will be opened.", #PB_MessageRequester_Ok|#PB_MessageRequester_Info)

  ProgID = FileEx::Open(#Pack, FileEx$, "D:\", "TestPasswort")
  If ProgID
    Debug "ProgID: " + ProgID
    MessageRequester("Test FileEx", "File has been opened."+#LF$+"Now the file will be closed.", #PB_MessageRequester_Ok|#PB_MessageRequester_Info)
    FileEx::Close(#Pack)
  EndIf
  
CompilerEndIf
Download of PureBasic - Module
Download of PureBasic - Programmes

[Windows 11 x64] [PB V6]

Bild