Any Files to DataSection

[RASHAD]

- You can add as many files to one DataSection file
- Can create more than one DataSection files in the same session
- No of columns can be changed even in the same file

Your created files will be in your Home directory

Code: Select all

#UDS_HOTTRACK            =  $0100

Procedure.s GetFileName(File.s)
    If Len(GetExtensionPart(File))
      Temp$+Left(GetFilePart(File), Len(GetFilePart(File))-1-Len(GetExtensionPart(File))) 
    Else
      Temp$+File
    EndIf
    Temp$ = RemoveString(Temp$," ")
  ProcedureReturn Temp$  
EndProcedure

LoadFont(0,"Georgia",16)
new = 1  
  
If OpenWindow(0,0,0,600,400,"Any File 2 DataSection",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  ExplorerTreeGadget(0, 10, 10, 200, 320, "*.*")
  SetGadgetColor(0, #PB_Gadget_BackColor, $FEE9D3)
  ;SetGadgetColor(0, #PB_Gadget_FrontColor, $00FEEF) 
  ExplorerListGadget(1, 220, 10, 370, 320, "C:\*.bmp",#PB_Explorer_NoFolders|#PB_Explorer_NoParentFolder| #PB_Explorer_AutoSort|#PB_Explorer_FullRowSelect)
  SetGadgetColor(1, #PB_Gadget_BackColor, $E2FEFD)
  SetGadgetColor(1, #PB_Gadget_FrontColor, $EA0801)
  RemoveGadgetColumn(1,1) 
  RemoveGadgetColumn(1,2)
  SetGadgetItemAttribute(1, 0, #PB_Explorer_ColumnWidth, 250,0)
  StringGadget(2,220,335,370,20,"")
  ComboBoxGadget(3,450,370,140,20,#PB_ComboBox_Editable)
  AddGadgetItem(3, -1, "*.bmp")
  AddGadgetItem(3, -1, "*.jpg")
  AddGadgetItem(3, -1, "*.png")
  AddGadgetItem(3, -1, "*.*")
  SetGadgetState(3,0)
  StringGadget(4,60,335,110,34,"Choose  No.  of"+#CRLF$+ "Columns per Line",#ES_MULTILINE|#ESB_DISABLE_LEFT|#ESB_DISABLE_RIGHT)
;   TextGadget(4,10,335,120,20,"Choose No.of"+#CRLF$+"Columns per Line",#SS_CENTERIMAGE )
;   SpinGadget(5,140,335,30,20,1,10,#PB_Spin_Numeric)
;   SetGadgetState(5,5)
  ;hwnd = GetWindow_(GadgetID(5),#GW_HWNDNEXT)
  ;MoveWindow_(hwnd,160,335,20,20,1)
  SGhwnd = TextGadget(5,170,335,40,32,"",#SS_CENTERIMAGE|#SS_CENTER| #PB_Text_Border)
  CreateUpDownControl_(#WS_CHILD|#WS_BORDER| #WS_VISIBLE|#UDS_ALIGNRIGHT| #UDS_SETBUDDYINT| #UDS_HOTTRACK| #UDS_ARROWKEYS, 10,10,80,22,WindowID(0),1, GetModuleHandle_(0), SGhwnd,10,1,5)
  ;TextGadget(6,50,374,80,20,"Add Data 2 Bin ? :",#SS_CENTERIMAGE)
  ButtonGadget(7,60,374,70,20,"Add File")
  ButtonGadget(8,140,374,70,20,"New File")
  TextGadget(9,290,365,110,40,"")
  SetGadgetFont(9,FontID(0))
  SetGadgetColor(9,#PB_Gadget_FrontColor,#Red)
  ButtonGadget(10,5,335,50,60,"EXIT")
  
  If FileSize(GetHomeDirectory() + "Bin2Data.txt") > 0
      DeleteFile(GetHomeDirectory() + "Bin2Data.txt")
  EndIf
  OpenFile(0,GetHomeDirectory() + "Bin2Data.txt")  
  
  Repeat 
    Select WaitWindowEvent() 
      Case #PB_Event_CloseWindow 
              If IsFile(0)
                  WriteStringN(0,"EndDataSection")
                  CloseFile(0)
              EndIf
              Quit = 1
         
      Case #PB_Event_Gadget 
        Select EventGadget() 
          Case 0             
              SetGadgetText(1,GetGadgetText(0))
              
          Case 1
              SetGadgetText(2,GetGadgetItemText(1,GetGadgetState(1)))
              SetGadgetText(9,"Add File !")
              
          Case 3
              Select EventType()
                 Case #PB_EventType_Change
                      SetGadgetText(2,"")
                      SetGadgetText(1,GetGadgetText(3))
                      SetActiveGadget(1)
              EndSelect
              
          Case 7
              File$ = GetGadgetText(0)+GetGadgetText(2)              
              If File$ <> ""
                  SetGadgetText(9,"WAIT")
                  ReadFile(1,File$)
                  If RUN = 0
                      WriteStringN(0,"DataSection")
                  Else
                      WriteStringN(0,"")
                  EndIf                 
                  WriteStringN(0,GetFileName(File$)+":") 
                  noc = Val(GetGadgetText(5))  
                      Repeat
                          For x = 1 To noc
                            For y = 1 To 8 
                              If Eof(1)
                                 Break
                              Else               
                                 RetVal$ = RSet(Hex(ReadByte(1),#PB_Byte),2,"0") + RetVal$
                              EndIf
                            Next
                            If x = noc
                               RowText$ = RowText$ +"$"+RetVal$
                            ElseIf Eof(1)
                               RowText$ = RowText$ + "$" + RetVal$
                               Break
                            Else
                                RowText$ = RowText$ +"$"+RetVal$ + ","
                            EndIf
                            RetVal$ = ""
                          Next 
                          WriteStringN(0,"   Data.q "+RowText$)
                          RowText$ = ""
                          RetVal$ = ""
                      Until Eof(1)
                      CloseFile(1)
                      SetGadgetText(9,"Add File !")                 
                  WriteStringN(0,GetFileName(File$)+"end:")
                  RUN = 1
              EndIf
          
          Case 8
              If IsFile(0)
                  WriteStringN(0,"EndDataSection")
                  CloseFile(0)
              EndIf
              new + 1 
              OpenFile(0,GetHomeDirectory() + "Bin2Data"+Str(new)+".txt")
              SetGadgetText(9,"New File")
              RUN = 0
               
          Case 10
              If IsFile(0)
                  WriteStringN(0,"EndDataSection")
                  CloseFile(0)
              EndIf
              Quit = 1        
            
        EndSelect 
    EndSelect 
  Until Quit = 1 
EndIf 

Edit :Fixed some bugs

[Kwai chang caine]

I have tested with bmp, works great
Thanks RASHAD, nice and useful

[davido]

Thanks RASHAD.

Works fine.

[ts-soft]

Nice one, but you should make sure, the created label names a valid (without spaces).

Greetings - Thomas

[skywalk]

Thanks Rashad.
Question?
Since you are storing all data as quads. Doesn't that mean the size of the datasection <> size of source data?
Meaning, not all files are evenly divisible by 8bytes = quad.

[IdeasVacuum]

Here is another way, posted by STARGÅTE.
You can simply drag and drop any number of files directly into a pb/pbi file in the PB IDE.
Compile to an exe and add to the Tools list.

Code: Select all

EnableExplicit

Enumeration
   #File
   #RegularExpression
EndEnumeration

Structure QuadArray
   q.q[0]
EndStructure


Procedure GetProcessFromWindow(WindowID.i)
   Protected ProcessID.i
   If GetWindowThreadProcessId_(WindowID, @ProcessID)
      ProcedureReturn OpenProcess_(#PROCESS_ALL_ACCESS, #False, ProcessID)
   EndIf
EndProcedure

Procedure SendText(ScintillaID.i, Text.s)
   Protected ProcessID.i = GetProcessFromWindow(ScintillaID)
   Protected Length.i
   Protected *MemoryID, *Buffer, Format.i
   If ProcessID
      Select SendMessage_(ScintillaID, #SCI_GETCODEPAGE, #Null, #Null)
         Case 0     : Format = #PB_Ascii
         Case 65001 : Format = #PB_UTF8
      EndSelect
      Length.i = StringByteLength(Text, Format)
      *Buffer = AllocateMemory(Length+SizeOf(Character))
      If *Buffer
         PokeS(*Buffer, Text, #PB_Default, Format)
         *MemoryID = VirtualAllocEx_(ProcessID, #Null, Length, #MEM_RESERVE|#MEM_COMMIT, #PAGE_EXECUTE_READWRITE)
         If *MemoryID
            WriteProcessMemory_(ProcessID, *MemoryID, *Buffer, Length, #Null)
            SendMessage_(ScintillaID, #SCI_ADDTEXT, Length, *MemoryID)
            VirtualFreeEx_(ProcessID, *MemoryID, Length, #MEM_RELEASE)
         EndIf
         FreeMemory(*Buffer)
      EndIf
      CloseHandle_(ProcessID)
   EndIf
EndProcedure

Procedure.s GetNamePart(FullPathName.s)
   If GetExtensionPart(FullPathName)
      ProcedureReturn Left(GetFilePart(FullPathName), Len(GetFilePart(FullPathName))-Len(GetExtensionPart(FullPathName))-1)
   Else
      ProcedureReturn GetFilePart(FullPathName)
   EndIf
EndProcedure

Procedure.s GetIndentString()
   OpenPreferences(GetEnvironmentVariable("APPDATA")+"\PureBasic\PureBasic.prefs")
   PreferenceGroup("Global")
   If Val(ReadPreferenceString("RealTab", "1"))
      ProcedureReturn #TAB$
   Else
      ProcedureReturn Space(Val(ReadPreferenceString("TabLength", "2")))
   EndIf
   ClosePreferences()
EndProcedure


Define IndentString.s = GetIndentString()
Define FileName.s = ProgramParameter(0)
Define *Buffer.QuadArray, Length.i
Define Output.s, Index.i, LastIndex.i
Define WindowID.i = Val(GetEnvironmentVariable("PB_TOOL_MAINWINDOW"))
Define Label.s = GetNamePart(FileName)


If Not WindowID
   MessageRequester("IncludeBinary.Tool", "Error: The program can not be started outside of PureBasic!")
   End
EndIf

If Not (Len(FileName) > 0)
   MessageRequester("IncludeBinary.Tool", "Error: No file!")
   End
EndIf


CreateRegularExpression(#RegularExpression, "\W")
Label = ReplaceRegularExpression(#RegularExpression, Label, "_")
FreeRegularExpression(#RegularExpression)
CreateRegularExpression(#RegularExpression, "^\d")
If MatchRegularExpression(#RegularExpression, Label)
   Label = "_" + Label
EndIf
FreeRegularExpression(#RegularExpression)


If ReadFile(#File, FileName)
   Length = Lof(#File)
   If Length % SizeOf(Quad)
      Length + (SizeOf(Quad) - Length % SizeOf(Quad))
   EndIf
   LastIndex = Length / SizeOf(Quad) - 1
   *Buffer = AllocateMemory(Length)
   If *Buffer
      ReadData(#File, *Buffer, Length)
      Output + "DataSection" + #CRLF$
      Output + IndentString + Label + ":"
      For Index = 0 To LastIndex
         If Index % 5 = 0
            Output + #CRLF$ + IndentString + "Data.q $" + RSet(Hex(*Buffer\q[Index], #PB_Quad), 16, "0")
         Else
            Output + ",$"+RSet(Hex(*Buffer\q[Index], #PB_Quad), 16, "0")
         EndIf
      Next
      Output + #CRLF$ + "EndDataSection" + #CRLF$
        SendText(FindWindowEx_(WindowID,0,"Scintilla",0), Output)
      FreeMemory(*Buffer)
   EndIf
   CloseFile(#File)
EndIf

[RASHAD]

@KCC,davido,ts-soft,skywalk & IdeasVacuum
Thank you guys for your concern

@ts-soft
Thanks for the tip I will try to fix that and post it

@skywalk
I did the coding long time back and I think I took your point of view into consideration because I was using it
in Hex Editor
So please check that the size in DataSection is exact the size of the file(No.of bytes)

@IdeasVacuum
Thanks for posting StarGate tip (It is not working with me now) I will look further for the problem

Guys thanks again

[skywalk]

Sorry for late reply...
If you write all quads, there will be extra 0 bytes in the datasection when the number of bytes are not exactly divisible by 8.
numQuads = LengthOfMemoryBuffer / SizeOf(Quad)
Not a big deal unless you are comparing the CRC's or SHA1 fingerprints of your DataSection to its original source.
The extra 0's will break the comparison.

[RASHAD]

Hi skywalk

First this is a modified procedure to eliminate the spaces in the file name as
ts-soft pointed out

Code: Select all

Procedure.s GetFileName(File.s)
    If Len(GetExtensionPart(File))
      Temp$+Left(GetFilePart(File), Len(GetFilePart(File))-1-Len(GetExtensionPart(File))) 
    Else
      Temp$+File
    EndIf
    Temp$ = RemoveString(Temp$," ")
  ProcedureReturn Temp$  
EndProcedure

Second No there is no extra zeros
- save any file you suspect
- Check it to see if the no. of bytes are different than the original
If so let me know

Thanks mate

exam:

Code: Select all

Debug  ?girlend-?girl
 
DataSection
girl:
.
.
girlend:
EndDataSection