The actual file is stored in a compressed file container (ZIP). Additional files or resources (e. g. pictures) can be added.
The files in the container can also be encrypted with a password.
When the file is opened, all files are unpacked into the specified directory (e. g. Temp-Dir) and moved back to the file container when closing.
Code: Select all
;/ ============================================
;/ || FileExModule.pbi [PureBasic V5.6x] ||
;/ ============================================
;/
;/ Fileformat mit komprimiertem Dateicontainer für weitere Dateien bzw. Resourcen
;/
;/ (c) Dez. 2017 by Thorsten1867
;/
;/ [ QAES_SmartCoder() by Werner Albus ]
;/
DeclareModule FileEx
;{ ----- Structures -----
Structure File_Structure
Path.s
Size.i
Modified.i
EndStructure
Structure Content_Structure
ProgID.s ; ID for assignment to a specific program
SH3.s ; SH3 password
Map File.File_Structure() ; Filesize (Key: Filename)
Map Info.s() ; Additional information
EndStructure
;} ----------------------
Global Content.Content_Structure
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 IsOpen(PackID.i)
Declare.s Open(PackID.i, FileEx$, Path$="", Password$="")
Declare Close(PackID.i)
EndDeclareModule
Module FileEx
EnableExplicit
UseZipPacker()
UseSHA3Fingerprint()
;{ ----- Constants -----
#XML = 1
#ContentXML = "Content.xml"
#DualCrypting = #False
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
#Slash = "\"
CompilerElse
#Slash = "/"
CompilerEndIf
;}
;{ ----- Structures -----
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.s ValidPackName(Value$)
Value$ = ReplaceString(LCase(Value$), "ä", "ae")
Value$ = ReplaceString(Value$, "ö", "oe")
Value$ = ReplaceString(Value$, "ü", "ue")
Value$ = ReplaceString(Value$, "ß", "S")
ProcedureReturn Value$
EndProcedure
Procedure QAES_SmartCoder(*buffer_in.quad, *buffer_out.quad, bytes.q, key$, counter.q=0)
; A very smart and simple to using special coder for many things
; The coder go ever forward, a extra decoder is unnecessary !
; You cipher a file blockwise, set ever the current block number (consecutive) with the counter - Important !
; UNICODE results are other as ASCII results
; Author Werner Albus - www.nachtoptik.de - www.quick-aes-256.de
; No warranty whatsoever - Use at your own risk
If Not bytes.q Or key$="" : ProcedureReturn 0 : EndIf
Protected ii, iii, len_char=SizeOf(character)
Protected.q i, swap_, rounds.q=bytes>>4
Protected hash$=key$+Str(counter)+"t8690352cj2p1ch7fgw34uotmq09745$%()=)&%" ; + Salt, you can change
Protected stepp=len_char<<1, remnant=bytes%16, bytes_minus_1=bytes-1, remnant_minus_1=remnant-1
Static fixed_key_string${64}
Static Dim register.q(3)
fixed_key_string$=Fingerprint(@hash$, StringByteLength(hash$), #PB_Cipher_SHA3, 256) ; Or use a hash generator - ever 256bit
For ii = 0 To 31 : PokeA(@register(0)+ii, Val("$"+PeekS(@fixed_key_string$+iii, 2))) : iii+stepp : Next ; Create a key
Macro go_
If Not AESEncoder(@register(0), @register(0), 32, @register(0), 256, 0, #PB_Cipher_ECB) : ProcedureReturn 0 : EndIf
swap_=register(0) : register(0)=register(3) : register(3)=swap_ ; Never use here
swap_=register(1) : register(1)=register(2) : register(2)=swap_ ; the PB Swap function !
If #DualCrypting
If Not AESEncoder(@register(0), @register(0), 16, @register(0), 256, 0, #PB_Cipher_ECB) : ProcedureReturn 0 : EndIf
EndIf
EndMacro
If bytes<16 ; Less 16 bytes
go_
For ii=0 To bytes_minus_1
PokeA(*buffer_out+ii, PeekA(*buffer_in+ii) ! PeekA(@register(0)+ii))
Next
ProcedureReturn 1
EndIf
While i<rounds ; =>16 bytes
go_
*buffer_out\q=*buffer_in\q ! register(0) : *buffer_in+8 : *buffer_out+8
*buffer_out\q=*buffer_in\q ! register(1) : *buffer_in+8 : *buffer_out+8 : i+1
Wend
If remnant
go_
For ii=0 To remnant_minus_1
PokeA(*buffer_out+ii, PeekA(*buffer_in+ii) ! PeekA(@register(0)+ii))
Next
EndIf
ProcedureReturn 1
EndProcedure
Procedure.i EncryptFile(PackID.i, File$, FileName$="", Password$="")
Define Ext$, Result.i, FileID.i, FileSize.q
Define *FileMemory, *MemoryBuffer
If FileName$ = "" : FileName$ = GetFilePart(File$) : EndIf
Ext$ = GetExtensionPart(File$)
FileName$ = ReplaceString(FileName$, "."+Ext$, "["+Ext$+"].aes")
Password$ = StringFingerprint(Password$, #PB_Cipher_SHA3)
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 QAES_SmartCoder(*FileMemory, *MemoryBuffer, MemorySize(*FileMemory), Password$, FileSize)
If PackID
If AddPackMemory(PackID, *MemoryBuffer, MemorySize(*FileMemory), ValidPackName(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.q, 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_SHA3)
If FileSize <= 0 : ProcedureReturn #False : EndIf
If PackID
*MemoryBuffer = AllocateMemory(FileSize)
If *MemoryBuffer
If UncompressPackMemory(PackID, *MemoryBuffer, FileSize, ValidPackName(FileName$))
*FileMemory = AllocateMemory(FileSize)
If *FileMemory
If QAES_SmartCoder(*MemoryBuffer, *FileMemory, MemorySize(*MemoryBuffer), Password$, FileSize)
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\SH3 = StringFingerprint(Password$, #PB_Cipher_SHA3)
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 IsOpen(PackID.i)
If FindMapElement(FileEx(), Str(PackID))
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure.s Open(PackID.i, FileEx$, Path$="", Password$="")
Define File$, FileDate.i
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)
ExtractXMLStructure(MainXMLNode(#XML), @Content, Content_Structure)
FreeXML(#XML)
EndIf
EndIf ;}
;{ ----- Password -----
If FileEx()\Content\SH3
If FileEx()\Content\SH3 = StringFingerprint(Password$, #PB_Cipher_SHA3)
FileEx()\Password = Password$
FileEx()\AES = #True
Else
FileEx()\Password = ""
FileEx()\AES = #False
ProcedureReturn "ERROR:Password"
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 FileSize(FileEx()\Content\File()\Path) > 0
FileDate = GetFileDate(FileEx()\Content\File()\Path, #PB_Date_Modified)
If FileDate > FileEx()\Content\File()\Modified
Continue
EndIf
EndIf
If FileEx()\AES
DecryptFile(PackID, FileEx()\Content\File()\Path, FileEx()\Content\File()\Size, File$, Password$)
Else
UncompressPackFile(PackID, FileEx()\Content\File()\Path, ValidPackName(File$))
EndIf
Next
ClosePack(PackID)
Else
ProcedureReturn "ERROR:OpenPack"
EndIf ;}
If CreatePack(PackID, FileEx$, #PB_PackerPlugin_Zip) ;{ Create new archiv
ProcedureReturn FileEx()\Content\ProgID
Else
ProcedureReturn "ERROR:CreatePack"
EndIf ;}
EndIf
ProcedureReturn "ERROR"
EndProcedure
Procedure Close(PackID.i)
Define FilePath$, FileName$
Define Result.i, Size.i, FileDate.i, *Buffer
Define Files.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
FileEx()\Content\File()\Modified = GetFileDate(FileEx()\Content\File()\Path, #PB_Date_Modified)
If FileEx()\AES
EncryptFile(PackID, FileEx()\Content\File()\Path, FileName$, FileEx()\Password)
Else
AddPackFile(PackID, FileEx()\Content\File()\Path, ValidPackName(FileName$))
EndIf
Else
DeleteMapElement(FileEx()\Content\File())
Result = #False
EndIf
;}
Next
If CreateXML(#XML) ;{ Content.xml
CopyStructure(@FileEx()\Content, @Files, Content_Structure)
InsertXMLStructure(RootXMLNode(#XML), @Files, 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$ = #PB_Compiler_Home+"Examples\Sources\Clipboard.pb"
File2$ = #PB_Compiler_Home+"Examples\Sources\Data\PureBasicLogo.bmp"
File3$ = #PB_Compiler_Home+"Examples\Sources\Data\world.png"
FileEx$ = GetHomeDirectory()+"Clipboard.pbx"
If FileEx::Create(#Pack, "PureBasic", File1$, "pbx", GetHomeDirectory(), "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$, GetHomeDirectory(), "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