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
GetPBInfo - get constants structures procedures interfaces
Re: GetPBInfo.pb for PB 5.10
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?
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?
Please pardon my English, my native tongue is German.
Re: GetPBInfo - get constants structures procedures interfac
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.
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.
has-been wanna-be (You may not agree with what I say, but it will make you think).
Re: GetPBInfo - get constants structures procedures interfac
APIFunctionListing.txt is not enough.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.
I found this for API
So, i have added thisIMPORTLIST
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)
Tks again__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)
A+
Denis
Denis
Re: GetPBInfo - get constants structures procedures interfac
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
"W̷i̷s̷h̷i̷n̷g o̷n a s̷t̷a̷r"
Re: GetPBInfo - get constants structures procedures interfac
@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.
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
"That's not a bug..." said the programmer. "it's a feature! "
"Oh! I see..." replied the blind man.
"Oh! I see..." replied the blind man.
Re: GetPBInfo - get constants structures procedures interfac
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
Why OpenSource should have a license :: PB-CodeArchiv-Rebirth :: Pleasant-Dark (syntax color scheme) :: RegEx-Engine (compiles RegExes to NFA/DFA)
Manjaro Xfce x64 (Main system) :: Windows 10 Home (VirtualBox) :: Newest PureBasic version
Re: GetPBInfo - get constants structures procedures interfac
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:
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
my pb for chinese:
http://ataorj.ys168.com
http://ataorj.ys168.com