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 1 of 2

GetPBInfo - get constants structures procedures interfaces

Posted: Wed Feb 27, 2013 9:35 am
by Danilo
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.

Code: Select all

;
; GetPBInfo.pb
;
; by Danilo
;
; Version: PureBasic 5.10
;
; [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

#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
                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.pb for PB 5.10

Posted: Wed Feb 27, 2013 11:06 am
by sec
Does Anything secret find in "Structures.pb", "Interfaces.pb", "Constants.pb", and "Procedures.pb"? :evil:

Re: GetPBInfo.pb for PB 5.10

Posted: Wed Feb 27, 2013 11:39 am
by Danilo
sec wrote:Does Anything secret find in "Structures.pb", "Interfaces.pb", "Constants.pb", and "Procedures.pb"? :evil:
No, what secrets did you expect? :lol:

The info is not useful for most PB users, as it is the same as structure viewer etc. within the PB IDE.
It can be useful for guys wanting to replace the PB IDE, in this case you could use the info for Intellisense popup and such stuff.
I used it successfully to extract PB structures when I wrote a structure compare-tool some time ago, so I could compare PB with C WinAPI structures for checking correctness.
A guy in german forum was asking for a full list of all PB commands yesterday. It is just some cases where it can be useful, but there are no secrets in it AFAIK. :)

Re: GetPBInfo.pb for PB 5.10

Posted: Wed Feb 27, 2013 11:34 pm
by netmaestro
Firstly, let me say thank you very much for this, it will be very useful to me. However, it runs a couple of seconds and outputs that it found 665 structures, 1489 procedures, 13897 constants and 2111 interfaces, and then I get a box saying 'pbcompiler.exe has stopped working', 'Check online for a solution to the problem' and 'Close the program'. I have all compiler options unselected and 'Create temporary executable in the source directory' is checked.

PB 5.10 final with event and window quickfix libs, Win 7. When it started crashing I moved my userlibs out and restarted the IDE, no change.

Re: GetPBInfo.pb for PB 5.10

Posted: Thu Feb 28, 2013 12:21 am
by skywalk
Outstanding Danilo!
Way faster than the Structure Viewer since it is stored in a text file for quick browsing.

Code: Select all

STARTING	5.10	PureBasic 5.10 (Windows 7 - x86)
READY
found 664 structures
found 1485 procedures
found 13798 constants
found 2111 interfaces
DONE.

Re: GetPBInfo.pb for PB 5.10

Posted: Thu Feb 28, 2013 12:56 am
by yrreti
Thanks for this too, but the program always crashes for me, giving the windows 7 error pbcompiler.exe has stopped working,
when running the following code?
I'm using PB 5.10 final with Win 7 64bit.

Code: Select all

     ClearList(structureInfo())
     ForEach structures()
         AddElement(structureInfo())
         structureInfo()="Structure "+structures()
         GetStructureInfo(pb,structures(),structureInfo())
         AddElement(structureInfo())
         structureInfo()="EndStructure"
         AddElement(structureInfo())
         structureInfo()=""
         Delay(5)
     Next
If I comment that part out, it runs fine.
I don't have time to troubleshoot right now, but any ideas on what to check?
Thanks for the interesting program

yrreti

Re: GetPBInfo.pb for PB 5.10

Posted: Thu Feb 28, 2013 1:06 am
by rsts
Runs perfectly on win 8 x64 pb5.1 32 bit.

Thanks for posting :)

Re: GetPBInfo.pb for PB 5.10

Posted: Thu Feb 28, 2013 1:26 am
by netmaestro
Uninstalled PB thru control panel, deleted my PureBasic folder, reinstalled PB 5.10 in a new clean folder. Works fine now. Thanks again!

Re: GetPBInfo.pb for PB 5.10

Posted: Thu Feb 28, 2013 3:07 pm
by yrreti
Continuation from previous post, but now using PB5.11 beta 1.
After a little investigation, I found that the Procedure GetStructureInfo crash problem occurs
when struct$="BITMAP".
I tried testing just using the following:
BITMAPCOREHEADER
BITMAPCOREINFO
BITMAPFILEHEADER
BITMAPINFO
BITMAPINFOHEADER
BITMAPV4HEADER
BITMAPV5HEADER
But they all failed.
Only by bypassing by using "BITMAP" as follows, will the program run fine.

Code: Select all

Procedure GetStructureInfo(compiler,struct$,List out.s())
  If ProgramRunning(compiler)
    Debug "STRUCTURE:  "+struct$
    If FindString(struct$,"BITMAP",1)=0
      SendCompilerCommand(compiler,"STRUCTURE"+#TAB$+struct$)
      Delay(50)
      FillList(compiler,out(),4)
    EndIf
  EndIf
EndProcedure
Because I'm definitely not familiar yet with those commands, could this mean that the BITMAP structure section
is defective? All the other structs work fine.

yrreti

Re: GetPBInfo.pb for PB 5.10

Posted: Thu Feb 28, 2013 4:57 pm
by LuCiFeR[SD]
Danilo, nice! very nice. Thanks :)

Re: GetPBInfo.pb for PB 5.10

Posted: Thu Feb 28, 2013 5:44 pm
by Denis
Nice tool Danilo :D

works without problem under Seven pro x64

Re: GetPBInfo.pb for PB 5.10

Posted: Thu Feb 28, 2013 10:38 pm
by Nico
Window 7 x64 compiler crash with Purebasic 5.1 x86

Re: GetPBInfo.pb for PB 5.10

Posted: Fri Mar 01, 2013 1:11 am
by Bisonte
Win7 (x64) - PB 5.10 compiled with x86 and x64 works without error....

Re: GetPBInfo.pb for PB 5.10

Posted: Fri Mar 01, 2013 7:23 am
by Danilo
yrreti wrote:Because I'm definitely not familiar yet with those commands, could this mean that the BITMAP structure section
is defective? All the other structs work fine.

yrreti
Could you try please with a clean PB install, like netmaestro did? Maybe something goes wrong when
there are 3rd party Resident files installed, or something like this.

Re: GetPBInfo.pb for PB 5.10

Posted: Tue Mar 05, 2013 2:58 am
by yrreti
Danilo, I'm sorry, I just couldn't get back to you. I've been quite busy lately.
I did finally get to try it on a clean install, and it worked fine. At this point
I'm going to add my addins one at a time, until the problem occurs again.
Then I can decide what to do about it, because that addin may be causing other
issues too. Again, thanks for sharing this nice program.

yrret
All times are UTC+01:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited