Aktuelle Zeit: 19.07.2018 08:09

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 1 Beitrag ] 
Autor Nachricht
 Betreff des Beitrags: [Module] FileExModule.pbi
BeitragVerfasst: 05.12.2017 22:07 
Offline
Benutzeravatar

Registriert: 04.02.2005 15:40
Wohnort: Kaufbeuren
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:
;/ ============================================
;/ ||  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

_________________
Meine PureBasic-Projekte:
EasySetup - Setups für eigene Programme erstellen
___________________________________________
Windows 10 - 64Bit | PureBasic V5.61 & V5.3
Bild


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 1 Beitrag ] 

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 3 Gäste


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  
cron

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye