PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

GetPBInfo - get constants structures procedures interfaces

https://www.purebasic.fr/english/viewtopic.php?t=53701

Page 2 of 2

Re: GetPBInfo.pb for PB 5.10

Posted: Sun Apr 14, 2013 4:22 pm
by jack
works perfect except the output files are stored in "C:\Users\UserName\AppData\Local\Temp"
instead of "C:\Users\UserName\Desktop\jaPBe4+" which is where I stored GetPBinfo.pb
more than likely my system is screwed up, time for a fresh system install.
using PB 5.11 x86 Windows 7 Home Premium

Re: GetPBInfo.pb for PB 5.10

Posted: Thu Apr 18, 2013 3:58 pm
by uweb
don't work here - "pbcompiler.exe funktioniert nicht mehr" (pbcompiler.exe do not work any more)
i have win64 with C:\Program Files (x86)\PureBasic and C:\Program Files\PureBasic.
after update to PB 5.11 it is the same.

it looks like the point is when GetStructureInfo calls Procedure FillList.
whitout this call it waits endless. naturally.
with the call the compiler breaks.
without GetStructureInfo it works - naturally whithout Structurelist.pb.

...
after many times uninstall and install with reboot, shutdown, shutdown twice, and ccleaner between for x86 and x64 (PB 5.10 and PB 5.11) and a new user ... do not remember what else. i give up.
the exe is now (PB 5.11 x86) 29,0KB. i have a old copy with 30,0KB. may my problem is outside purebasic.

Procedures.pb, Interfaces.pb and Constants.pb are looking good. Thank you for this!
would anybody please make the Structurelist.pb public?

Re: GetPBInfo - get constants structures procedures interfac

Posted: Thu Oct 01, 2015 8:05 am
by oldefoxx
Wow. Got a bunch of help on this one. This is really great. I'm very impressed. I knew there was a lot to PureBasic, but I had no idea how much. I'm going to have to study the code you used to do this.

I noted several people were not using the latest version of PureBasic. Is there a reason for this? Just curious.

I spoke before about the idea of a search tool that would search on partial words or terms, but instead of searching all the PB, PBI, and PBF files, would only have to search one text file that contained everything. I haven't planned it all out yet, but it seemed like something worth trying. Having a complete list gives me something to work with.

Actually, it might be a text file with several fields added. The fields might be:
KeyWord, Explained, Group, Example(s), Context, Reverse.
The first field is what the compiler requires for proper use in terms of case and (.
The second field is a text file that explains what it does.
The third field is the group that it belongs to, and the other members of that group.
The fourth field is various example files that can be compiled which use it.
The fifth field is an extended effort to show its use in context with other commands. The sixth field is what other command counters or reverses what this one does.

The text file might end up being multiple files bound by a common index. I haven't really decided yet, But if the first field is set apart, then searches for possible matches should be fairly fast.

Re: GetPBInfo - get constants structures procedures interfac

Posted: Sat Nov 14, 2015 10:04 am
by Denis
Danilo wrote:Just updated GetPBInfo.pb for PureBasic 5.10 and added the new CONSTANTLIST feature.

GetPBInfo.pb gets information about structures, interfaces, constants and PB functions directly from the PB compiler
and saves the information to files "Structures.pb", "Interfaces.pb", "Constants.pb", and "Procedures.pb".

For API functions known by PureBasic, look at "PureBasic\Compilers\APIFunctionListing.txt".

Can be useful for IDE and tool writers to get this information.
APIFunctionListing.txt is not enough.

I found this for API
IMPORTLIST
So, i have added this

Code: Select all

Global NewList Imports$()

Procedure GetImportList(compiler, List out$())
    If ProgramRunning(compiler)
        SendCompilerCommand(compiler, "IMPORTLIST")
        FillList(compiler,out$())
    EndIf
EndProcedure

    GetImportList(pb, Imports$())
    Debug "found "+Str(ListSize(Imports$()))+" imports"
    SortList(Imports$(),#PB_Sort_Ascending|#PB_Sort_NoCase)
and as partial result (64 bit)
__WSAFDIsSet_(arg1, arg2)
_hread_(arg1, arg2, arg3)
_hwrite_(arg1, arg2, arg3)
_lclose_(arg1)
_lcreat_(arg1, arg2)
_llseek_(arg1, arg2, arg3)
_lopen_(arg1, arg2)
_lread_(arg1, arg2, arg3)
_lwrite_(arg1, arg2, arg3)
_TrackMouseEvent_(arg1)
AbortDoc_(arg1)
AbortPath_(arg1)
AbortPrinter_(arg1)
AbortSystemShutdown_(arg1)
AboutDlg_(arg1, arg2, arg3, arg4)
accept_(arg1, arg2, arg3)
AcceptEx_(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8)
AcceptSecurityContext_(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9)
AccessCheck_(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8)
AccessCheckAndAuditAlarm_(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11)
AccessNtmsLibraryDoor_(arg1, arg2, arg3)
acmDriverAdd_(arg1, arg2, arg3, arg4, arg5)
acmDriverClose_(arg1, arg2)
Tks again

Re: GetPBInfo - get constants structures procedures interfac

Posted: Tue Feb 23, 2016 10:47 pm
by Lunasole
Thank, sometime useful thing. Here I adjusted code to work regardless of compiler unicode setting.

Code: Select all

;
; GetPBInfo.pb
;
; by Danilo
;
; Version: PureBasic 5.10
;
; [X] Create temporary executable in the source directory

EnableExplicit

#Compiler = #PB_Compiler_Home+"compilers\pbcompiler.exe"
#Switch	  = #PB_Ascii				; encoding used to interpret compiler output

Procedure StartCompiler()
    ProcedureReturn RunProgram(#Compiler,"/STANDBY","",#PB_Program_Open|#PB_Program_Read|#PB_Program_Write|#PB_Program_Hide)
EndProcedure

Procedure StopCompiler(compiler)
    WriteProgramStringN(compiler, "END", #Switch)
    WaitProgram(compiler,5000)
    CloseProgram(compiler)
EndProcedure

Procedure SendCompilerCommand(compiler,command$)
    If ProgramRunning(compiler)
        WriteProgramStringN(compiler, command$, #Switch)
    EndIf
EndProcedure

Procedure.s GetCompilerOutput(compiler)
    If AvailableProgramOutput(compiler)
        ProcedureReturn ReadProgramString(compiler, #Switch)
    EndIf
EndProcedure

Procedure FillList(compiler,List out.s(),space=0)
    Protected out$
    Protected space$=Space(space)
    While out$<>"OUTPUT"+#TAB$+"COMPLETE" And Left(out$,5)<>"ERROR"
        out$=GetCompilerOutput(compiler)
        If out$ And out$<>"OUTPUT"+#TAB$+"COMPLETE" And Left(out$,5)<>"ERROR" And FindString("0123456789",Mid(out$,1,1))=0
            AddElement(out())
            out()=space$+out$
        EndIf
    Wend
EndProcedure

Procedure FillConstantList(compiler,List out.s(),space=0)
    Protected out$
    Protected space$=Space(space)
    While out$<>"OUTPUT"+#TAB$+"COMPLETE" And Left(out$,5)<>"ERROR"
        out$=GetCompilerOutput(compiler)
        If out$<>"" And out$<>"OUTPUT"+#TAB$+"COMPLETE" And Left(out$,5)<>"ERROR" And FindString("0123456789",Mid(out$,2,1))=0
            If FindString("01",Mid(out$,1,1))
                out$ = "#"+Mid(out$,2,Len(out$)-1)
                out$ = ReplaceString(out$,#TAB$," = ")
                out$ = ReplaceString(out$,"# = ","#")
            ElseIf FindString("2",Mid(out$,1,1))
                Protected i, found_non_printable = #False
                Protected oldout$ = out$
                Protected sconst_value$  = StringField(oldout$,3,Chr(9))
                out$ = "#"+StringField(oldout$,2,#TAB$)
                For i = 1 To Len(sconst_value$)
                    If Asc(Mid(sconst_value$,i)) < 32 Or Asc(Mid(sconst_value$,i)) > 126
                        found_non_printable = #True
                    EndIf
                Next i
                If out$ = "#TAB$"
                    out$ + " = Chr(9)"
                ElseIf out$ = "#HT$"
                    out$ + " = Chr(9)"
                ElseIf out$ = "#CRLF$"
                    out$ + " = Chr(13) + Chr(10)"
                ElseIf out$ = "#LFCR$"
                    out$ + " = Chr(10) + Chr(13)"
                ElseIf out$ = "#LF$"
                    out$ + " = Chr(10)"
                ElseIf out$ = "#CR$"
                    out$ + " = Chr(13)"
                ElseIf out$ = "#DOUBLEQUOTE$"
                    out$ + " = Chr(34)"
                ElseIf out$ = "#DQUOTE$"
                    out$ + " = Chr(34)"
                ElseIf found_non_printable = #False
                    out$ + " = " + #DQUOTE$ + StringField(oldout$,3,#TAB$) + #DQUOTE$
                Else
                    out$ + " ="
                    Protected temp$ = StringField(oldout$,3,#TAB$)
                    For i = 0 To Len(sconst_value$)-1
                        out$ + " Chr("+Str(PeekB(@temp$+(i*SizeOf(Character)))) + ") +"
                    Next
                EndIf
                out$ = RTrim(out$,"+")
                out$ = Trim(out$)
            Else
                Debug out$
            EndIf
            out$ = Trim(out$)
            If out$
                AddElement(out())
                out()=space$+out$
            EndIf
        EndIf
    Wend
EndProcedure

Procedure GetStructureList(compiler,List out.s())
    If ProgramRunning(compiler)
        SendCompilerCommand(compiler,"STRUCTURELIST")
        FillList(compiler,out())
    EndIf
EndProcedure

Procedure GetProcedureList(compiler,List out.s())
    If ProgramRunning(compiler)
        SendCompilerCommand(compiler,"FUNCTIONLIST")
        FillList(compiler,out())
    EndIf
EndProcedure

Procedure GetConstantsList(compiler,List out.s())
    If ProgramRunning(compiler)
        SendCompilerCommand(compiler,"CONSTANTLIST")
        FillConstantList(compiler,out())
    EndIf
EndProcedure


Procedure GetInterfaceList(compiler,List out.s())
    If ProgramRunning(compiler)
        SendCompilerCommand(compiler,"INTERFACELIST")
        FillList(compiler,out())
    EndIf
EndProcedure

Procedure GetStructureInfo(compiler,struct$,List out.s())
    If ProgramRunning(compiler)
        SendCompilerCommand(compiler,"STRUCTURE"+#TAB$+struct$)
        FillList(compiler,out(),4)
    EndIf
EndProcedure

Procedure GetInterfaceInfo(compiler,interf$,List out.s())
    If ProgramRunning(compiler)
        SendCompilerCommand(compiler,"INTERFACE"+#TAB$+interf$)
        FillList(compiler,out(),4)
    EndIf
EndProcedure


Procedure WaitCompilerReady(compiler)
    Protected out$
    While out$<>"READY" And Left(out$,5)<>"ERROR"
        out$ = GetCompilerOutput(compiler)
        If out$
            Debug out$
        EndIf
    Wend
EndProcedure

Define  pb, out$
NewList constants.s()
NewList structures.s()
NewList procedures.s()
NewList interfaces.s()

NewList structureInfo.s()
NewList interfaceInfo.s()

pb = StartCompiler()
If pb
    WaitCompilerReady(pb)

    GetStructureList(pb,structures())
    Debug "found "+Str(ListSize(structures()))+" structures"

    GetProcedureList(pb,procedures())
    Debug "found "+Str(ListSize(procedures()))+" procedures"

    GetConstantsList(pb,constants())
    Debug "found "+Str(ListSize(constants()))+" constants"
    SortList(constants(),#PB_Sort_Ascending|#PB_Sort_NoCase)

    GetInterfaceList(pb,interfaces())
    Debug "found "+Str(ListSize(interfaces()))+" interfaces"

    ClearList(structureInfo())
    ForEach structures()
        AddElement(structureInfo())
        structureInfo()="Structure "+structures()
        GetStructureInfo(pb,structures(),structureInfo())
        AddElement(structureInfo())
        structureInfo()="EndStructure"
        AddElement(structureInfo())
        structureInfo()=""
    Next

    ClearList(interfaceInfo())
    ForEach interfaces()
        AddElement(interfaceInfo())
        interfaceInfo()="Interface "+interfaces()
        GetInterfaceInfo(pb,interfaces(),interfaceInfo())
        AddElement(interfaceInfo())
        interfaceInfo()="EndInterface"
        AddElement(interfaceInfo())
        interfaceInfo()=""
    Next

    If CreateFile(0,GetPathPart(ProgramFilename())+"Structures.pb")
        ForEach structureInfo()
            WriteStringN(0,structureInfo())
        Next
        CloseFile(0)
    EndIf

    If CreateFile(0,GetPathPart(ProgramFilename())+"Interfaces.pb")
        ForEach interfaceInfo()
            WriteStringN(0,interfaceInfo())
        Next
        CloseFile(0)
    EndIf

    If CreateFile(0,GetPathPart(ProgramFilename())+"Constants.pb")
        ForEach constants()
            WriteStringN(0,constants())
        Next
        CloseFile(0)
    EndIf

    If CreateFile(0,GetPathPart(ProgramFilename())+"Procedures.pb")
        ForEach procedures()
            WriteStringN(0,procedures())
        Next
        CloseFile(0)
    EndIf

    
    StopCompiler(pb)
    Debug "DONE."
EndIf

Re: GetPBInfo - get constants structures procedures interfac

Posted: Sat Apr 22, 2017 6:54 pm
by Blue
@Danilo : Thank you so much for this most useful code.
It is exactly what I was looking for.
--------------------------------------------------------------------
Danilo's PB files indexed for IDE :
I took the liberty of adding alphabetical indexes to the PB files produced by Danilo's program, to facilitate navigating through the huge files in PB's IDE. In the process, i also streamlined Lists and a few other details. Some people may find the following extended (and revised) code as useful as I do.

Code: Select all

; source : http://www.forums.purebasic.com/english/viewtopic.php?f=12&t=53701&sid=e87f676515fc09e22ba15c89039f4219#p406202
; GetPBInfo.pb
;
;- original work by Danilo - 2013
;
; Version: PureBasic 5.10
;
;- modified by Blue - 2017-04-16
;  1. compiler output encoding specified as Ascii 
;  2. insertion of IDE index markers in PB output files
;  3. re-use of common lists 
;  4. output into source code folder 
; NB : ";-." (start) and ";." (end) are used as keywords for code folding
;      add those to your preferences, to fold the following as intended


EnableExplicit
Macro Debugg : Debug "" : EndMacro
#Compiler = #PB_Compiler_Home+"compilers\pbcompiler.exe"

;-. variables et constantes
  NewList out.s()
  NewList outHeader.s()

  Define.s    out, items
  Define compiler, count
  
  #marge = 2 
  #detailed_infos = 01 
;.
;-
; ***************************
;-******* Procédures ********
Procedure StartCompiler()
  ProcedureReturn RunProgram(#Compiler,"/STANDBY","",
     #PB_Program_Open|#PB_Program_Read|#PB_Program_Write|#PB_Program_Hide)
EndProcedure
Procedure StopCompiler(pb)
  WriteProgramStringN(pb, "END", #PB_Ascii)
  WaitProgram(pb,5000)
  CloseProgram(pb)
EndProcedure
Procedure SendCompilerCommand(pb,command$)
  If ProgramRunning(pb)
    WriteProgramStringN(pb, command$, #PB_Ascii)
  EndIf
EndProcedure
Procedure.s GetCompilerOutput(pb)
  If AvailableProgramOutput(pb)
    ProcedureReturn ReadProgramString(pb, #PB_Ascii)
  EndIf
EndProcedure
Procedure WaitCompilerReady(pb)
  Protected out$
  While out$<>"READY" And Left(out$,5)<>"ERROR"
    out$ = GetCompilerOutput(pb)
    If out$
      Debug out$
    EndIf
  Wend
EndProcedure

Procedure FillList(pb,List out.s(),marge=0)
  Protected out$
  Protected marge$=Space(marge)
  While out$<>"OUTPUT"+#TAB$+"COMPLETE" And Left(out$,5)<>"ERROR"
    out$=GetCompilerOutput(pb)
    If out$ And out$<>"OUTPUT"+#TAB$+"COMPLETE" And Left(out$,5)<>"ERROR" And FindString("0123456789",Mid(out$,1,1))=0
      AddElement(out())
      out()= marge$ + out$
    EndIf
  Wend
EndProcedure
Procedure Insert_markers(List out.s(),i=1)
  ; in a sorted listed, it's possible and useful 
  ; to add indexed markers for quick browsing in PB IDE

  Protected.s temp, car
  ForEach out()
    If UCase(Mid(out(),i,1)) <> car
      temp = out()                  ; mémoriser la ligne courante
      car  = UCase(Mid(temp,i,1))
      out() = ";- " + car           ; insérer la lettre à utiliser dans l'IDE
      AddElement(out())             ; nouvelle ligne...
      out() = temp                  ; et ré-insérer la ligne remplacée
    EndIf 
  Next
EndProcedure
Procedure Insert_Interface_markers(List out.s())
  ; of 2011 interfaces, 1926 start with I !
  ; useful then to index the I group by smaller sub-groups. 
  Protected.s temp, car, car2

  ForEach out()
    If Asc(out()) = 'I'
      If Left(out(),2) <> car2        ; for I, use 2 letters for index
        temp = out()                  ; mémoriser la ligne courante
        car2 = Left(temp,2)
        out() = ";- " + car2          ; insérer les 2 lettres à utiliser dans l'IDE
        AddElement(out())             ; ajouter une ligne ...
        out() = temp                  ; et ré-insérer la ligne remplacée
      EndIf
    Else
      If Asc(out()) <> Asc(car)
        temp = out()                  ; mémoriser la ligne courante
        car = Left(temp,1)
        out() = ";- " + car           ; insérer la lettre à utiliser dans l'IDE
        AddElement(out())             ; ajouter une ligne ...
        out() = temp                  ; et ré-insérer la ligne remplacée
      EndIf
    EndIf 
  Next
EndProcedure
Procedure Save_outList(items.s, how_many)
  Shared out()
  Protected pbFile.s
  pbFile.s = items +".pb"
  If CreateFile(0, #PB_Compiler_FilePath + pbFile)
    Debug "  >> writing " + pbFile
    WriteStringN(0,";- "+Str(how_many) + " " + items)
    ForEach out()
      WriteStringN(0,out())
    Next
    CloseFile(0)
  EndIf
EndProcedure

;- ...procedures
Procedure.i GetProcedureList(pb,List out.s())
  If ProgramRunning(pb)
    SendCompilerCommand(pb,"FUNCTIONLIST")
    FillList(pb,out())
  EndIf
  ; comment out the procedure description/help text 
  ForEach out()
    ReplaceString(out(),"-",";",#PB_String_InPlace,8,1)
  Next
  ProcedureReturn ListSize(out())
EndProcedure

;- ...constants
Procedure FillConstantList(pb,List out.s(),space=0)
  Protected out$
  Protected space$=Space(space)
  While out$<>"OUTPUT"+#TAB$+"COMPLETE" And Left(out$,5)<>"ERROR"
    out$=GetCompilerOutput(pb)
    If out$<>"" And out$<>"OUTPUT"+#TAB$+"COMPLETE" And Left(out$,5)<>"ERROR" And FindString("0123456789",Mid(out$,2,1))=0
      If FindString("01",Mid(out$,1,1))
        out$ = "#"+Mid(out$,2,Len(out$)-1)
        out$ = ReplaceString(out$,#TAB$," = ")
        out$ = ReplaceString(out$,"# = ","#")
      ElseIf FindString("2",Mid(out$,1,1))
        Protected i, found_non_printable = #False
        Protected oldout$ = out$
        Protected sconst_value$  = StringField(oldout$,3,Chr(9))
        out$ = "#"+StringField(oldout$,2,#TAB$)
        For i = 1 To Len(sconst_value$)
          If Asc(Mid(sconst_value$,i)) < 32 Or Asc(Mid(sconst_value$,i)) > 126
            found_non_printable = #True
          EndIf
        Next i
        If     out$ = "#TAB$"   :  out$ + " = Chr(9)"
        ElseIf out$ = "#HT$"    :  out$ + " = Chr(9)"
        ElseIf out$ = "#CRLF$"  :  out$ + " = Chr(13) + Chr(10)"
        ElseIf out$ = "#LFCR$"  :  out$ + " = Chr(10) + Chr(13)"
        ElseIf out$ = "#LF$"    :  out$ + " = Chr(10)"
        ElseIf out$ = "#CR$"    :  out$ + " = Chr(13)"
        ElseIf out$ = "#DOUBLEQUOTE$"  :  out$ + " = Chr(34)"
        ElseIf out$ = "#DQUOTE$"       :  out$ + " = Chr(34)"
        ElseIf found_non_printable = #False
          out$ + " = " + #DQUOTE$ + StringField(oldout$,3,#TAB$) + #DQUOTE$
        Else
          out$ + " ="
          Protected temp$ = StringField(oldout$,3,#TAB$)
          For i = 0 To Len(sconst_value$)-1
            out$ + " Chr("+Str(PeekB(@temp$+(i*SizeOf(Character)))) + ") +"
          Next
        EndIf
        out$ = RTrim(out$,"+")
      Else
        Debug out$
      EndIf
      out$ = Trim(out$)
      If out$
        AddElement(out())
        out() = space$ + out$
      EndIf
    EndIf
  Wend
EndProcedure
Procedure.i GetConstantsList(pb,List out.s())
  If ProgramRunning(pb)
    SendCompilerCommand(pb,"CONSTANTLIST")
    FillConstantList(pb,out())
  EndIf
  ProcedureReturn ListSize(out())
EndProcedure

;- ...interfaces
Procedure GetInterfaceList(pb,List out.s())
  If ProgramRunning(pb)
    SendCompilerCommand(pb,"INTERFACELIST")
    FillList(pb,out())
  EndIf
  ProcedureReturn ListSize(out())
EndProcedure
Procedure.i GetInterfaceInfo(pb,interf$,List out.s())
  If ProgramRunning(pb)
    SendCompilerCommand(pb,"INTERFACE"+#TAB$+interf$)
    FillList(pb,out(),#marge)
  EndIf
  ProcedureReturn ListSize(out())
EndProcedure

;- ...structures
Procedure.i GetStructureInfo(pb,struct$,List out.s())
  If ProgramRunning(pb)
    SendCompilerCommand(pb,"STRUCTURE"+#TAB$+struct$)
    FillList(pb,out(),#marge)
  EndIf
  ProcedureReturn ListSize(out())
EndProcedure
Procedure.i GetStructureList(pb,List out.s())
  If ProgramRunning(pb)
    SendCompilerCommand(pb,"STRUCTURELIST")
    FillList(pb,out())
  EndIf
  ProcedureReturn ListSize(out())
EndProcedure

;-
; ************************
;- ********** START ***
  compiler = StartCompiler()
  If compiler = 0 
    End
  EndIf
  
  Debug "Output folder : "
  Debug "  >> " + #PB_Compiler_FilePath 
  #sort_infos = 01 
  If #sort_infos
    Debug "Sorting ? Yes"
  Else
    Debug "Sorting ? NO"
  EndIf
  Debug "*******************************"
  WaitCompilerReady(compiler)

;-.. Constants
  items = "constants"
  ClearList(out())
  count = GetConstantsList(compiler,out())
  Debug "*******************************"
  Debug items + ": " + "found "+Str(count)
  If #sort_infos
    Debug "  >> sorting..."
    SortList(out(),#PB_Sort_Ascending|#PB_Sort_NoCase)
    Insert_markers(out(),2)
  EndIf
  Save_outList(items,count)
;.
;-.. Procedures
  items = "procedures"
  ClearList(out())
  count = GetProcedureList(compiler,out())
  Debug "*******************************"
  Debug items + ": " + "found "+Str(count)
  If #sort_infos
    Debug "  >> sorting..."
    SortList(out(),#PB_Sort_Ascending)
    ; when sorted, insert indexed markers used by PB IDE
    Insert_markers(out())
  EndIf 
  Save_OutList(items, count)
;.
;-.. Interfaces
  items = "interfaces"
  ClearList(outHeader())
  count = GetInterfaceList(compiler,outHeader())
  Debug "*******************************"
  Debug items + ": " + "found "+Str(count)
  If #sort_infos
    Debug "  >> sorting..."
    SortList(outHeader(),#PB_Sort_Ascending|#PB_Sort_NoCase)
    Insert_Interface_markers(outHeader())
  EndIf
 
  Debug "  >> inserting method declarations"
  ClearList(out())
  ForEach outHeader()
    AddElement(out())
    If Asc(outHeader()) = ';'
      out()= outHeader()
    Else
      out()="Interface " + outHeader()
      If #detailed_infos
        GetInterfaceInfo(compiler,outHeader(),out())
        AddElement(out())  :  out()= "EndInterface"
        AddElement(out())  :  out()= ""
      EndIf
    EndIf
  Next
  Save_OutList(items,count)
;.
;-.. Structures
  items = "structures"
  ClearList(outHeader())
  count = GetStructureList(compiler,outHeader())
  Debug "*******************************"
  Debug items + ": " + "found "+Str(count)
  If #sort_infos
    Debug "  >> sorting..."
    SortList(outHeader(),#PB_Sort_Ascending)
  EndIf
  
  Debug "  >> inserting components"
  ClearList(out())
  ForEach outHeader()
    AddElement(out())  :  out() = ";- " + outHeader()
    AddElement(out())  :  out() = "Structure " + outHeader()
    If #detailed_infos
      GetStructureInfo(compiler,outHeader(),out())
      AddElement(out())  :  out() = "EndStructure"
      AddElement(out())  :  out() = ""
    EndIf
  Next
  Save_OutList(items, count)
;.

;- ********** FINISH ***
  StopCompiler(compiler)
  Debug "*******************************"
  Debugg
  Debug "DONE."
  Debugg
  Debugg
End

Re: GetPBInfo - get constants structures procedures interfac

Posted: Sun May 21, 2017 10:57 pm
by Sicro
Added Linux (and Mac?) support:

Code: Select all

; source : http://www.forums.purebasic.com/english/viewtopic.php?f=12&t=53701#p406202
; GetPBInfo.pb
;
;- original work by Danilo - 2013
;
; Version: PureBasic 5.60
;
;- modified by Blue - 2017-04-16
;  1. compiler output encoding specified as Ascii
;  2. insertion of IDE index markers in PB output files
;  3. re-use of common lists
;  4. output into source code folder
; NB : ";-." (start) and ";." (end) are used as keywords for code folding
;      add those to your preferences, to fold the following as intended

;- modified by Sicro - 2017-05-21
;  Added Linux (and Mac?) support

EnableExplicit
Macro Debugg : Debug "" : EndMacro
CompilerSelect #PB_Compiler_OS
  CompilerCase #PB_OS_Windows
    #Compiler = #PB_Compiler_Home+"compilers\pbcompiler.exe"
  CompilerDefault
    #Compiler = #PB_Compiler_Home+"compilers/pbcompiler"
CompilerEndSelect

;-. variables et constantes
  NewList out.s()
  NewList outHeader.s()

  Define.s    out, items
  Define compiler, count
 
  #marge = 2
  #detailed_infos = 01
;.
;-
; ***************************
;-******* Procédures ********
Procedure StartCompiler()
  ProcedureReturn RunProgram(#Compiler,"--standby","",
     #PB_Program_Open|#PB_Program_Read|#PB_Program_Write|#PB_Program_Hide)
EndProcedure
Procedure StopCompiler(pb)
  WriteProgramStringN(pb, "END", #PB_Ascii)
  WaitProgram(pb,5000)
  CloseProgram(pb)
EndProcedure
Procedure SendCompilerCommand(pb,command$)
  If ProgramRunning(pb)
    WriteProgramStringN(pb, command$, #PB_Ascii)
  EndIf
EndProcedure
Procedure.s GetCompilerOutput(pb)
  If AvailableProgramOutput(pb)
    ProcedureReturn ReadProgramString(pb, #PB_Ascii)
  EndIf
EndProcedure
Procedure WaitCompilerReady(pb)
  Protected out$
  While out$<>"READY" And Left(out$,5)<>"ERROR"
    out$ = GetCompilerOutput(pb)
    If out$
      Debug out$
    EndIf
  Wend
EndProcedure

Procedure FillList(pb,List out.s(),marge=0)
  Protected out$
  Protected marge$=Space(marge)
  While out$<>"OUTPUT"+#TAB$+"COMPLETE" And Left(out$,5)<>"ERROR"
    out$=GetCompilerOutput(pb)
    If out$ And out$<>"OUTPUT"+#TAB$+"COMPLETE" And Left(out$,5)<>"ERROR" And FindString("0123456789",Mid(out$,1,1))=0
      AddElement(out())
      out()= marge$ + out$
    EndIf
  Wend
EndProcedure
Procedure Insert_markers(List out.s(),i=1)
  ; in a sorted listed, it's possible and useful
  ; to add indexed markers for quick browsing in PB IDE

  Protected.s temp, car
  ForEach out()
    If UCase(Mid(out(),i,1)) <> car
      temp = out()                  ; mémoriser la ligne courante
      car  = UCase(Mid(temp,i,1))
      out() = ";- " + car           ; insérer la lettre à utiliser dans l'IDE
      AddElement(out())             ; nouvelle ligne...
      out() = temp                  ; et ré-insérer la ligne remplacée
    EndIf
  Next
EndProcedure
Procedure Insert_Interface_markers(List out.s())
  ; of 2011 interfaces, 1926 start with I !
  ; useful then to index the I group by smaller sub-groups.
  Protected.s temp, car, car2

  ForEach out()
    If Asc(out()) = 'I'
      If Left(out(),2) <> car2        ; for I, use 2 letters for index
        temp = out()                  ; mémoriser la ligne courante
        car2 = Left(temp,2)
        out() = ";- " + car2          ; insérer les 2 lettres à utiliser dans l'IDE
        AddElement(out())             ; ajouter une ligne ...
        out() = temp                  ; et ré-insérer la ligne remplacée
      EndIf
    Else
      If Asc(out()) <> Asc(car)
        temp = out()                  ; mémoriser la ligne courante
        car = Left(temp,1)
        out() = ";- " + car           ; insérer la lettre à utiliser dans l'IDE
        AddElement(out())             ; ajouter une ligne ...
        out() = temp                  ; et ré-insérer la ligne remplacée
      EndIf
    EndIf
  Next
EndProcedure
Procedure Save_outList(items.s, how_many)
  Shared out()
  Protected pbFile.s
  pbFile.s = items +".pb"
  If CreateFile(0, #PB_Compiler_FilePath + pbFile)
    Debug "  >> writing " + pbFile
    WriteStringN(0,";- "+Str(how_many) + " " + items)
    ForEach out()
      WriteStringN(0,out())
    Next
    CloseFile(0)
  EndIf
EndProcedure

;- ...procedures
Procedure.i GetProcedureList(pb,List out.s())
  If ProgramRunning(pb)
    SendCompilerCommand(pb,"FUNCTIONLIST")
    FillList(pb,out())
  EndIf
  ; comment out the procedure description/help text
  ForEach out()
    ReplaceString(out(),"-",";",#PB_String_InPlace,8,1)
  Next
  ProcedureReturn ListSize(out())
EndProcedure

;- ...constants
Procedure FillConstantList(pb,List out.s(),space=0)
  Protected out$
  Protected space$=Space(space)
  While out$<>"OUTPUT"+#TAB$+"COMPLETE" And Left(out$,5)<>"ERROR"
    out$=GetCompilerOutput(pb)
    If out$<>"" And out$<>"OUTPUT"+#TAB$+"COMPLETE" And Left(out$,5)<>"ERROR" And FindString("0123456789",Mid(out$,2,1))=0
      If FindString("01",Mid(out$,1,1))
        out$ = "#"+Mid(out$,2,Len(out$)-1)
        out$ = ReplaceString(out$,#TAB$," = ")
        out$ = ReplaceString(out$,"# = ","#")
      ElseIf FindString("2",Mid(out$,1,1))
        Protected i, found_non_printable = #False
        Protected oldout$ = out$
        Protected sconst_value$  = StringField(oldout$,3,Chr(9))
        out$ = "#"+StringField(oldout$,2,#TAB$)
        For i = 1 To Len(sconst_value$)
          If Asc(Mid(sconst_value$,i)) < 32 Or Asc(Mid(sconst_value$,i)) > 126
            found_non_printable = #True
          EndIf
        Next i
        If     out$ = "#TAB$"   :  out$ + " = Chr(9)"
        ElseIf out$ = "#HT$"    :  out$ + " = Chr(9)"
        ElseIf out$ = "#CRLF$"  :  out$ + " = Chr(13) + Chr(10)"
        ElseIf out$ = "#LFCR$"  :  out$ + " = Chr(10) + Chr(13)"
        ElseIf out$ = "#LF$"    :  out$ + " = Chr(10)"
        ElseIf out$ = "#CR$"    :  out$ + " = Chr(13)"
        ElseIf out$ = "#DOUBLEQUOTE$"  :  out$ + " = Chr(34)"
        ElseIf out$ = "#DQUOTE$"       :  out$ + " = Chr(34)"
        ElseIf found_non_printable = #False
          out$ + " = " + #DQUOTE$ + StringField(oldout$,3,#TAB$) + #DQUOTE$
        Else
          out$ + " ="
          Protected temp$ = StringField(oldout$,3,#TAB$)
          For i = 0 To Len(sconst_value$)-1
            out$ + " Chr("+Str(PeekB(@temp$+(i*SizeOf(Character)))) + ") +"
          Next
        EndIf
        out$ = RTrim(out$,"+")
      Else
        Debug out$
      EndIf
      out$ = Trim(out$)
      If out$
        AddElement(out())
        out() = space$ + out$
      EndIf
    EndIf
  Wend
EndProcedure
Procedure.i GetConstantsList(pb,List out.s())
  If ProgramRunning(pb)
    SendCompilerCommand(pb,"CONSTANTLIST")
    FillConstantList(pb,out())
  EndIf
  ProcedureReturn ListSize(out())
EndProcedure

;- ...interfaces
Procedure GetInterfaceList(pb,List out.s())
  If ProgramRunning(pb)
    SendCompilerCommand(pb,"INTERFACELIST")
    FillList(pb,out())
  EndIf
  ProcedureReturn ListSize(out())
EndProcedure
Procedure.i GetInterfaceInfo(pb,interf$,List out.s())
  If ProgramRunning(pb)
    SendCompilerCommand(pb,"INTERFACE"+#TAB$+interf$)
    FillList(pb,out(),#marge)
  EndIf
  ProcedureReturn ListSize(out())
EndProcedure

;- ...structures
Procedure.i GetStructureInfo(pb,struct$,List out.s())
  If ProgramRunning(pb)
    SendCompilerCommand(pb,"STRUCTURE"+#TAB$+struct$)
    FillList(pb,out(),#marge)
  EndIf
  ProcedureReturn ListSize(out())
EndProcedure
Procedure.i GetStructureList(pb,List out.s())
  If ProgramRunning(pb)
    SendCompilerCommand(pb,"STRUCTURELIST")
    FillList(pb,out())
  EndIf
  ProcedureReturn ListSize(out())
EndProcedure

;-
; ************************
;- ********** START ***
  compiler = StartCompiler()
  If compiler = 0
    End
  EndIf
 
  Debug "Output folder : "
  Debug "  >> " + #PB_Compiler_FilePath
  #sort_infos = 01
  If #sort_infos
    Debug "Sorting ? Yes"
  Else
    Debug "Sorting ? NO"
  EndIf
  Debug "*******************************"
  WaitCompilerReady(compiler)

;-.. Constants
  items = "constants"
  ClearList(out())
  count = GetConstantsList(compiler,out())
  Debug "*******************************"
  Debug items + ": " + "found "+Str(count)
  If #sort_infos
    Debug "  >> sorting..."
    SortList(out(),#PB_Sort_Ascending|#PB_Sort_NoCase)
    Insert_markers(out(),2)
  EndIf
  Save_outList(items,count)
;.
;-.. Procedures
  items = "procedures"
  ClearList(out())
  count = GetProcedureList(compiler,out())
  Debug "*******************************"
  Debug items + ": " + "found "+Str(count)
  If #sort_infos
    Debug "  >> sorting..."
    SortList(out(),#PB_Sort_Ascending)
    ; when sorted, insert indexed markers used by PB IDE
    Insert_markers(out())
  EndIf
  Save_OutList(items, count)
;.
;-.. Interfaces
  items = "interfaces"
  ClearList(outHeader())
  count = GetInterfaceList(compiler,outHeader())
  Debug "*******************************"
  Debug items + ": " + "found "+Str(count)
  If #sort_infos
    Debug "  >> sorting..."
    SortList(outHeader(),#PB_Sort_Ascending|#PB_Sort_NoCase)
    Insert_Interface_markers(outHeader())
  EndIf
 
  Debug "  >> inserting method declarations"
  ClearList(out())
  ForEach outHeader()
    AddElement(out())
    If Asc(outHeader()) = ';'
      out()= outHeader()
    Else
      out()="Interface " + outHeader()
      If #detailed_infos
        GetInterfaceInfo(compiler,outHeader(),out())
        AddElement(out())  :  out()= "EndInterface"
        AddElement(out())  :  out()= ""
      EndIf
    EndIf
  Next
  Save_OutList(items,count)
;.
;-.. Structures
  items = "structures"
  ClearList(outHeader())
  count = GetStructureList(compiler,outHeader())
  Debug "*******************************"
  Debug items + ": " + "found "+Str(count)
  If #sort_infos
    Debug "  >> sorting..."
    SortList(outHeader(),#PB_Sort_Ascending)
  EndIf
 
  Debug "  >> inserting components"
  ClearList(out())
  ForEach outHeader()
    AddElement(out())  :  out() = ";- " + outHeader()
    AddElement(out())  :  out() = "Structure " + outHeader()
    If #detailed_infos
      GetStructureInfo(compiler,outHeader(),out())
      AddElement(out())  :  out() = "EndStructure"
      AddElement(out())  :  out() = ""
    EndIf
  Next
  Save_OutList(items, count)
;.

;- ********** FINISH ***
  StopCompiler(compiler)
  Debug "*******************************"
  Debugg
  Debug "DONE."
  Debugg
  Debugg
End

Re: GetPBInfo - get constants structures procedures interfac

Posted: Sun Nov 26, 2017 1:45 am
by gurj
i arranging out code in GetPBInfo.pb:
del [add ';']:
CompilerIf #PB_Compiler_Unicode
CompilerError "Please turn off compiler option 'Create unicode executable'"
CompilerEndIf
----------
in identical folder, GetPBInfo.pb out[pb_v5.61]:
pb561.Constants
pb561.Interfaces
pb561.log
pb561.Procedures
pb561.Structures
---------
GetPBInfo.pb:

Code: Select all

;==================
; GetPBInfo.pb by Danilo
; Version: PureBasic 5.10
; add out Procedures by Denis
; arranging out code by gurj on [pb_v5.61]
; [X] Create temporary executable in the source directory
; [ ] Create unicode executable
;==================

; CompilerIf #PB_Compiler_Unicode
;     CompilerError "Please turn off compiler option 'Create unicode executable'"
; CompilerEndIf


EnableExplicit
Global log.s
#Compiler = #PB_Compiler_Home+"compilers\pbcompiler.exe"

Procedure StartCompiler()
 ProcedureReturn RunProgram(#Compiler,"/STANDBY","",#PB_Program_Open|#PB_Program_Read|#PB_Program_Write|#PB_Program_Hide)
EndProcedure

Procedure StopCompiler(compiler)
 WriteProgramStringN(compiler, "END")
 WaitProgram(compiler,5000)
 CloseProgram(compiler)
EndProcedure

Procedure SendCompilerCommand(compiler,command$)
 If ProgramRunning(compiler)
  WriteProgramStringN(compiler, command$)
 EndIf
EndProcedure

Procedure.s GetCompilerOutput(compiler)
 If AvailableProgramOutput(compiler)
  ProcedureReturn ReadProgramString(compiler)
 EndIf
EndProcedure

Procedure FillList(compiler,List OUT.s(),space=0)
 Protected out$
 Protected space$=Space(space)
 While out$<>"OUTPUT"+#TAB$+"COMPLETE" And Left(out$,5)<>"ERROR"
  out$=GetCompilerOutput(compiler)
  If out$ And out$<>"OUTPUT"+#TAB$+"COMPLETE" And Left(out$,5)<>"ERROR" And FindString("0123456789",Mid(out$,1,1))=0
   AddElement(out())
   out()=space$+out$
  EndIf
 Wend
EndProcedure

Procedure FillConstantList(compiler,List OUT.s(),space=0)
 Protected out$
 Protected space$=Space(space)
 While out$<>"OUTPUT"+#TAB$+"COMPLETE" And Left(out$,5)<>"ERROR"
  out$=GetCompilerOutput(compiler)
  If out$<>"" And out$<>"OUTPUT"+#TAB$+"COMPLETE" And Left(out$,5)<>"ERROR" And FindString("0123456789",Mid(out$,2,1))=0
   If FindString("01",Mid(out$,1,1))
    out$ = "#"+Mid(out$,2,Len(out$)-1)
    out$ = ReplaceString(out$,#TAB$," = ")
    out$ = ReplaceString(out$,"# = ","#")
   ElseIf FindString("2",Mid(out$,1,1))
    Protected i, found_non_printable = #False
    Protected oldout$ = out$
    Protected sconst_value$  = StringField(oldout$,3,Chr(9))
    out$ = "#"+StringField(oldout$,2,#TAB$)
    For i = 1 To Len(sconst_value$)
     If Asc(Mid(sconst_value$,i)) < 32 Or Asc(Mid(sconst_value$,i)) > 126
      found_non_printable = #True
     EndIf
    Next i
    If out$ = "#TAB$"
     out$ + " = Chr(9)"
    ElseIf out$ = "#HT$"
     out$ + " = Chr(9)"
    ElseIf out$ = "#CRLF$"
     out$ + " = Chr(13) + Chr(10)"
    ElseIf out$ = "#LFCR$"
     out$ + " = Chr(10) + Chr(13)"
    ElseIf out$ = "#LF$"
     out$ + " = Chr(10)"
    ElseIf out$ = "#CR$"
     out$ + " = Chr(13)"
    ElseIf out$ = "#DOUBLEQUOTE$"
     out$ + " = Chr(34)"
    ElseIf out$ = "#DQUOTE$"
     out$ + " = Chr(34)"
    ElseIf found_non_printable = #False
     out$ + " = " + #DQUOTE$ + StringField(oldout$,3,#TAB$) + #DQUOTE$
    Else
     out$ + " ="
     Protected temp$ = StringField(oldout$,3,#TAB$)
     For i = 0 To Len(sconst_value$)-1
      out$ + " Chr("+Str(PeekB(@temp$+(i*SizeOf(Character)))) + ") +"
     Next
    EndIf
    out$ = RTrim(out$,"+")
    out$ = Trim(out$)
   Else
    log + out$+#LF$
   EndIf
   out$ = Trim(out$)
   If out$
    AddElement(out())
    out()=space$+out$
   EndIf
  EndIf
 Wend
EndProcedure

Procedure GetStructureList(compiler,List OUT.s())
 If ProgramRunning(compiler)
  SendCompilerCommand(compiler,"STRUCTURELIST")
  FillList(compiler,out())
 EndIf
EndProcedure

Procedure GetProcedureList(compiler,List OUT.s())
 If ProgramRunning(compiler)
  SendCompilerCommand(compiler,"FUNCTIONLIST")
  FillList(compiler,out())
 EndIf
EndProcedure

Procedure GetConstantsList(compiler,List OUT.s())
 If ProgramRunning(compiler)
  SendCompilerCommand(compiler,"CONSTANTLIST")
  FillConstantList(compiler,out())
 EndIf
EndProcedure


Procedure GetInterfaceList(compiler,List OUT.s())
 If ProgramRunning(compiler)
  SendCompilerCommand(compiler,"INTERFACELIST")
  FillList(compiler,out())
 EndIf
EndProcedure

Procedure GetStructureInfo(compiler,struct$,List OUT.s())
 If ProgramRunning(compiler)
  SendCompilerCommand(compiler,"STRUCTURE"+#TAB$+struct$)
  FillList(compiler,out(),4)
 EndIf
EndProcedure

Procedure GetInterfaceInfo(compiler,interf$,List OUT.s())
 If ProgramRunning(compiler)
  SendCompilerCommand(compiler,"INTERFACE"+#TAB$+interf$)
  FillList(compiler,out(),4)
 EndIf
EndProcedure


Procedure WaitCompilerReady(compiler)
 Protected out$
 While out$<>"READY" And Left(out$,5)<>"ERROR"
  out$ = GetCompilerOutput(compiler)
  If out$
   log + out$+#LF$
  EndIf
 Wend
EndProcedure

Define  pb, out$
NewList constants.s()
NewList structures.s()
NewList procedures.s()
NewList interfaces.s()

NewList structureInfo.s()
NewList interfaceInfo.s()

pb = StartCompiler()
If pb
 WaitCompilerReady(pb)
 
 GetStructureList(pb,structures())
 log + "found "+Str(ListSize(structures()))+" structures"+#LF$
 
 GetProcedureList(pb,procedures())
 log + "found "+Str(ListSize(procedures()))+" procedures"+#LF$
 
 GetConstantsList(pb,constants())
 log + "found "+Str(ListSize(constants()))+" constants"+#LF$
 SortList(constants(),#PB_Sort_Ascending|#PB_Sort_NoCase)
 
 GetInterfaceList(pb,interfaces())
 log + "found "+Str(ListSize(interfaces()))+" interfaces"+#LF$
 
 ClearList(structureInfo())
 ForEach structures()
  AddElement(structureInfo())
  structureInfo()="Structure "+structures()
  GetStructureInfo(pb,structures(),structureInfo())
  AddElement(structureInfo())
  structureInfo()="EndStructure"
  AddElement(structureInfo())
  structureInfo()=""
 Next
 
 ClearList(interfaceInfo())
 ForEach interfaces()
  AddElement(interfaceInfo())
  interfaceInfo()="Interface "+interfaces()
  GetInterfaceInfo(pb,interfaces(),interfaceInfo())
  AddElement(interfaceInfo())
  interfaceInfo()="EndInterface"
  AddElement(interfaceInfo())
  interfaceInfo()=""
 Next
 
 If CreateFile(0,"pb"+#PB_Compiler_Version+".Structures")
  ForEach structureInfo()
   WriteStringN(0,structureInfo())
  Next
  CloseFile(0)
 EndIf
 
 If CreateFile(0,"pb"+#PB_Compiler_Version+".Interfaces")
  ForEach interfaceInfo()
   WriteStringN(0,interfaceInfo())
  Next
  CloseFile(0)
 EndIf
 
 If CreateFile(0,"pb"+#PB_Compiler_Version+".Constants")
  ForEach constants()
   WriteStringN(0,constants())
  Next
  CloseFile(0)
 EndIf
 
 If CreateFile(0,"pb"+#PB_Compiler_Version+".Procedures")
  ForEach procedures()
   WriteStringN(0,procedures())
  Next
  CloseFile(0)
 EndIf
 
 If CreateFile(0,"pb"+#PB_Compiler_Version+".log")
  WriteString(0,log)
  CloseFile(0)
 EndIf
 
 StopCompiler(pb)
 MessageRequester( "GetPBInfo","DONE.")
EndIf
All times are UTC+01:00
Page 2 of 2

Powered by phpBB® Forum Software © phpBB Limited