PureBasic Forum

; This tool allows to post arbitrary binary files to a text oriented forum. It does this by creating a PureBasic source code which is output using the debug command.
; Run this program in PurBasic and then use "copy all" in the debug output window and paste the result into the PureBasic IDE. To create the binary file, simply execute the program.
; This allows to publicize binaries to a forum and have crawlers later archive the posting. Free eternal backupping :)
;
; Add a specific tagword so you can later find any Binary again in one of the www archives like the wayback machine at http://www.archive.org or http://www.theeuropeanlibrary.org/tel4/ or https://www.dnb.de/DE/Netzpublikationen/netzpublikationen_node.html
; This is intended to avoid longterm data loss of essential software and avoid services that might be discontinued in the future like filehosting sites or cloud hosting services

UseSHA2Fingerprint()

DataFileName$ = OpenFileRequester("Filename of the datafile to encode", "", "*.*", 0)

If (DataFileName$ <> "")
  DataFileID = OpenFile(#PB_Any, DataFileName$)
 
  If (DataFileID = 0)
    MessageRequester("Fatal error", " Could not open '" + GetFilePart(DataFileName$) + "'!", #PB_MessageRequester_Error | #PB_MessageRequester_Ok)
    End 990
  EndIf
 
  DataFileSize = Lof(DataFileID)
  *DataBuffer = AllocateMemory(DataFileSize)
 
  If (*DataBuffer = 0)
    MessageRequester("Fatal error", " Could not allocate " + StrD(DataFileSize) + " bytes of memory!", #PB_MessageRequester_Error | #PB_MessageRequester_Ok)
    End 990
  EndIf
 
  ReadDataSize = ReadData(DataFileID, *DataBuffer, DataFileSize)
 
  If (ReadDataSize <> DataFileSize)
    MessageRequester("Fatal error", "Failure while trying to read from the file (" + Str(ReadDataSize) + " / " + Str(DataFileSize) + ")", #PB_MessageRequester_Error | #PB_MessageRequester_Ok)
    FreeMemory(*DataBuffer)
    End 991
  EndIf
 
  DataFingerPrint$ = Fingerprint(*DataBuffer, DataFileSize, #PB_Cipher_SHA2)
 
  ; we make a really large target buffer to avoid any memory size problems and let virtual memory / windows handle the details for any large case
  ; instead of making this tightproof - simply assign more virtual memory for the machine and let the OS handle the problem
 
  EncodedDataSize = (DataFileSize * 2) + 64
  *EncodedDataBuffer = AllocateMemory(EncodedDataSize)
  EncodedDataSize = Base64EncoderBuffer(*DataBuffer, DataFileSize, *EncodedDataBuffer, EncodedDataSize)
 
  EncodedData$ = PeekS(*EncodedDataBuffer, EncodedDataSize, #PB_Ascii)
  ChunkSize = 4096
 
  ; generate header
  Debug "; File '" + GetFilePart(DataFileName$) + "' with a size of " + Str(DataFileSize) + " resulted in " + Str(EncodedDataSize) + " bytes encoded data" + Chr(10)
  Debug "; the sha2 fingerprint is '" + DataFingerPrint$ + "'"
  Debug "; the maximum dataline size was set to " + Str(ChunkSize) + Chr(10)
  Debug "UseSHA2Fingerprint()" + Chr(10)
 
  ; generate EncodedData$ with actual data
  Chunks = (EncodedDataSize + ChunkSize - 1) / ChunkSize
  For f = 1 To Chunks
    If (f = 1)
      Debug "DataMessage$ = " + Chr(34) + Mid(EncodedData$, (f - 1) * ChunkSize + 1, ChunkSize) + Chr(34)
    Else
      Debug "DataMessage$ + " + Chr(34) + Mid(EncodedData$, (f - 1) * ChunkSize + 1, ChunkSize) + Chr(34)
    EndIf
  Next
  Debug ""
  ; generate the unpacker / decoder
  Debug "FileName$ = " + Chr(34) + GetFilePart(DataFileName$) + Chr(34)
  Debug "*DecodeBuffer = AllocateMemory(" + Str(DataFileSize + 512) + ")"
  Debug "if (*DecodeBuffer = 0)"
  Debug "  MessageRequester(" + Chr(34) + "Fatal error" + Chr(34) + ", " + Chr(34) + "Out of memory!" + Chr(34) + ", #PB_MessageRequester_Error | #PB_MessageRequester_Ok)"
  Debug "  end 999"
  Debug "endif"
  Debug "if (Base64Decoder(DataMessage$, *DecodeBuffer, " + Str(DataFileSize) + ") <> " + Str(DataFileSize) + ")"
  Debug "  MessageRequester(" + Chr(34) + "Fatal error" + Chr(34) + ", " + Chr(34) + "The decoding returned an invalid size." + Chr(34) + ", #PB_MessageRequester_Error | #PB_MessageRequester_Ok)"
  Debug " end 998"
  Debug "endif"
  Debug "OutputPath$ = PathRequester(" + Chr(34) + "Select the directory To store the file" + Chr(34) + ", " + Chr(34) + Chr(34) + ")"
  Debug "If (OutputPath$ <> " + Chr(34) + Chr(34) + ")" + Chr(10) + "  SetCurrentDirectory(OutputPath$)" + Chr(10) + "else" + Chr(10) + "end 997" + Chr(10) + "EndIf" + Chr(10)
  Debug "FileID = CreateFile(#PB_Any, "+ Chr(34) + GetFilePart(DataFileName$) + Chr(34) + ")"
  Debug "if (FileID <> 0)"
  Debug "  Result = WriteData(FileID, *DecodeBuffer, " + Str(DataFileSize) + ")"
  Debug "  CloseFile(FileID)"
  Debug "  if (Result <> " + Str(DataFileSize) + ")"
  Debug "    DeleteFile(" + Chr(34) + GetFilePart(DataFileName$) + Chr(34) + ")"
  Debug "    MessageRequester(" + Chr(34) + "Fatal error" + Chr(34) + ", " + Chr(34) + "Writing the destination file '" + GetFilePart(DataFileName$) + "' failed." + Chr(34) + ", #PB_MessageRequester_Error | #PB_MessageRequester_Ok)"
  Debug "    end 996"
  Debug "  endif"
 
  Debug "  DataFingerPrint$ = Fingerprint(*DecodeBuffer, " + Str(DataFileSize) + ", #PB_Cipher_SHA2)"
  Debug "  if (FileFingerprint(" + Chr(34) + GetFilePart(DataFileName$) + Chr(34) + ", #PB_Cipher_SHA2) <> " + Chr(34) + DataFingerPrint$ + Chr(34) + ")"
  Debug "    DeleteFile(" + Chr(34) + GetFilePart(DataFileName$) + Chr(34) + ")"
  Debug "    MessageRequester(" + Chr(34) + "Fatal error" + Chr(34) + ", " + Chr(34) + "Checksum failure!" + Chr(34) + ", #PB_MessageRequester_Error | #PB_MessageRequester_Ok)"
  Debug "    end 995"
  Debug "  endif"
  Debug "endif"
  ; MessageRequester("Success.", "Successfully created the file 'winmessage.chm' in '" + OutputPath$ + "'.", #PB_MessageRequester_Info | #PB_MessageRequester_Ok)
  Debug "MessageRequester(" + Chr(34) + "Success." + Chr(34) + ", " + Chr(34) + "Successfully created the file '" + GetFilePart(DataFileName$) + "' in '" + Chr(34) + " + OutputPath$ + " + Chr(34) + "'." + Chr(34) + ", #PB_MessageRequester_Info | #PB_MessageRequester_Ok)"
 
  FreeMemory(*EncodedDataBuffer)
  *EncodedDataBuffer = 0
  FreeMemory(*DataBuffer)
  *DataBuffer = 0
  CloseFile(DataFileID)
  DataFileID = 0
EndIf