A PGM to expand a structure including other structures.

Share your advanced PureBasic knowledge/code with the community.
User avatar
CONVERT
Enthusiast
Enthusiast
Posts: 130
Joined: Fri May 02, 2003 12:19 pm
Location: France

A PGM to expand a structure including other structures.

Post by CONVERT »

Hello,

A tool to expand structures.

Copy and paste into "test_data.pb" the following example code containing the structure INV to expand.

Code: Select all

EnableExplicit

Structure Lo
  login$
  descr$
  susp$
EndStructure

Structure AD_LS
  AD$
  LS$
  Diff$
EndStructure

Structure LO_AD_LS
  LO$
  AD$
  LS$
  Diff_AD_LS$
  Diff_AD_LO$
EndStructure

Structure date_serv
  date$
  serv$
EndStructure

Structure dble
  d$
  dble$
EndStructure

Structure log_dom
  login$
  susp$
  domain$
  diff_site_3L$
EndStructure

Structure os_lg
  version$
  lg$
EndStructure

Structure iudates
  init$
  prec$
  last$
EndStructure

Structure vers_def
  version$
  date_def$
  server$
  iu.iudates
EndStructure

Structure full_free
  full.q
  free.q
  used.q
EndStructure

Structure pc_descr
  modele$
  sn.dble
  mem.l
  mobi$
  date_bios$
  c.full_free
  d.full_free
  total.full_free
EndStructure


Structure inv
  reseau$
  susp$
  orig$
  PC_Serv.AD_LS
  Site.AD_LS
  Usage_ad$
  Description.LO_AD_LS
  date.AD_LS
  lotus.date_serv
  ad.log_dom
  os.os_lg
  antivirus.vers_def
  audros$
  pc.pc_descr
  obs$
EndStructure
Copy and paste the following code into a pb file you execute.
It will create INV.TXT containing the expanded structure.

Code: Select all

; List an expanded structure

; V02 Dec 31, 2012. Includes all PB variable types.

EnableExplicit

Global GTitre$, GTitre_commercial$

Gtitre$ = GetFilePart(ProgramFilename())
Gtitre$ = Left(GTitre$,Len(Gtitre$) - 4)  ; remove .exe
GTitre_commercial$ = "Expand_Structure"


Global Gpgm$ = "test_data.pb"      ; Pgm containing the structures.
Global GStructure$ = "inv"         ; Structure in this Pgm to be expanded.

Global Gno_pgm, Gno_struct

Structure struct
  titre$
  element$
EndStructure

Global NewList GL_all.struct()
Global NewMap  *GM_titre_GL_all()

Procedure err(Plib$)
  MessageRequester(Gtitre$,Plib$)
EndProcedure

Procedure fill_gl(Pstruct$,Pelement$)
  
  AddElement(GL_all())          ; fill the linked list with the structures included in the read Pgm
  gl_all()\titre$ = Pstruct$
  gl_all()\element$ = Pelement$
 
  If *GM_titre_GL_all(Pstruct$) = 0         ; keep in memory the first element of a structure in the linked list.
    *GM_titre_GL_all(Pstruct$) = @GL_all()  ; This allow ecr_out() to start at the beginning of a structure in the linked list
  EndIf

EndProcedure

Procedure search_structures ()  ; select the lines between "Structure" and "EndStructure" in the read pgm.        
  Define wenr_l$, wenr$, wstruct_encours$, wpos, wpos2

  While Eof(Gno_pgm) = 0
    wenr$ = Trim(ReadString(Gno_pgm))
    wenr_l$ = LCase(wenr$)
                              ;123456789
    wpos = FindString(wenr_l$,"structure")
    If wpos <> 0
      wstruct_encours$ = Trim(Mid(wenr$,wpos + 10))
      wpos2 = FindString(wstruct_encours$,";")
      If wpos2 <> 0
        wstruct_encours$ = Trim(Left(wstruct_encours$,wpos2 - 1))
      EndIf
    Else
      wpos = FindString(wenr_l$,"endstructure")
      If wpos <> 0
        wstruct_encours$ = ""
      Else
        If wstruct_encours$ <> ""
          fill_gl(wstruct_encours$,Trim(wenr$)) ; fill the linked list with all the structures included in the read Pgm.
        EndIf
      EndIf
    EndIf
  Wend

EndProcedure
 

Procedure ecr_out(Ptitre$,Penr_out$)         ; recursive
  Define wpos, welement$, *wgl, *wcome_back, wsuffix$, wdirect_write, wi, w1$

  *wgl = *GM_titre_GL_all(Ptitre$)
  If *wgl <> 0
    ChangeCurrentElement(GL_all(), *wgl)
    While GL_all()\titre$ = Ptitre$
      welement$ = GL_all()\element$

      ; ----------------------------------- Detection if a sub-structure
      wdirect_write = 0
      wpos = FindString(welement$,".")
      If wpos = 0
        wdirect_write = 1
      Else
        wsuffix$ = Mid(welement$,wpos + 1)
        If Len(wsuffix$) = 1
          If FindString("bacwuclifqds",LCase(wsuffix$))  ; Purebasic variables
            wdirect_write = 1
          EndIf
        Else
          If Left(LCase(wsuffix$),1) = "s"
            wdirect_write = 1   ; Fixed length string variable supposed Snnnn
            For wi = 2 To Len(wsuffix$)
              w1$ = Mid(wsuffix$,wi,1)
              If FindString("0123456789",w1$) = 0
                wdirect_write = 0  ; It is not Snnnn, so it is a structure.
                Break
              EndIf
            Next
          EndIf 
        EndIf
      EndIf

      ; ------------------------------ Write out (no subtructure) or search again (substructure)
      If wdirect_write = 1
        WriteStringN(Gno_struct,Penr_out$ + "\" + welement$)  ; normal variable.
      Else
        *wcome_back = @GL_all()  ; There is a '.' and it is not a Purebasic variable.
                                 ; So, exploration of the linked List starting at the substructure found.
        ecr_out(wsuffix$,Penr_out$ + "\" + Left(welement$,wpos - 1))
        ChangeCurrentElement(GL_all(), *wcome_back)  ; it is better coming back because ecr_out was travelling across the linked list.
      EndIf

      If NextElement(GL_all()) = 0
        Break
      EndIf
 
    Wend
  EndIf

EndProcedure


;- BEGIN

; ----------------------------------- Open Pgm

Gno_pgm = ReadFile(#PB_Any,Gpgm$)
If Gno_pgm = 0
  err("Unable to open " + Gpgm$)
  End
EndIf

; ----------------------------------- Create file out containing the expanded structure.

Gno_struct = CreateFile(#PB_Any,Gstructure$+".txt")
If Gno_struct = 0
  err("Unable to open " + Gstructure$+".txt")
  End
EndIf

search_structures ()            ; fill the linked list with all the structures included in the read Pgm

ecr_out(Gstructure$,"Pracine")  ; récursive because under structure some element can contain a structure. 
                                ; Create the file out.

CloseFile (Gno_pgm)
CloseFile (Gno_struct)

err("End of job." + Chr(13) + "Please, consult " + Gstructure$+".txt")

End

The result is:
  • Pracine\reseau$
    Pracine\susp$
    Pracine\orig$
    Pracine\PC_Serv\AD$
    Pracine\PC_Serv\LS$
    Pracine\PC_Serv\Diff$
    Pracine\Site\AD$
    Pracine\Site\LS$
    Pracine\Site\Diff$
    Pracine\Usage_ad$
    Pracine\Description\LO$
    Pracine\Description\AD$
    Pracine\Description\LS$
    Pracine\Description\Diff_AD_LS$
    Pracine\Description\Diff_AD_LO$
    Pracine\date\AD$
    Pracine\date\LS$
    Pracine\date\Diff$
    Pracine\lotus\date$
    Pracine\lotus\serv$
    Pracine\ad\login$
    Pracine\ad\susp$
    Pracine\ad\domain$
    Pracine\ad\diff_site_3L$
    Pracine\os\version$
    Pracine\os\lg$
    Pracine\antivirus\version$
    Pracine\antivirus\date_def$
    Pracine\antivirus\server$
    Pracine\antivirus\iu\init$
    Pracine\antivirus\iu\prec$
    Pracine\antivirus\iu\last$
    Pracine\audros$
    Pracine\pc\modele$
    Pracine\pc\sn\d$
    Pracine\pc\sn\dble$
    Pracine\pc\mem.l
    Pracine\pc\mobi$
    Pracine\pc\date_bios$
    Pracine\pc\c\full.q
    Pracine\pc\c\free.q
    Pracine\pc\c\used.q
    Pracine\pc\d\full.q
    Pracine\pc\d\free.q
    Pracine\pc\d\used.q
    Pracine\pc\total\full.q
    Pracine\pc\total\free.q
    Pracine\pc\total\used.q
    Pracine\obs$
PureBasic 6.20 beta 2 (x64) | Windows 10 Pro x64 | Intel(R) Core(TM) i7-8700 CPU @ 3.20Ghz 16 GB RAM, SSD 500 GB, PC locally assembled.
Come back to 6.11 LTS 64 bits because of an issue with #PB_ComboBox_UpperCase in ComboBoxGadget() (Oct. 10, 2024).