It`s module based. uses a constant.txt file placed in the same directory as the module itself. (from Danilo`s GetPBInfo Constant part incorporated into the module) if the constants.txt file is missing or older than the current compiler version then a new constants.txt file is generated. On failure of those two condition
Code: Select all
InitPBConstants()
1. call
Code: Select all
IdentifyPBConstants::InitPBConstants()
2. call
Code: Select all
IdentifyPBConstants::ComparePBConstant(value)
3. call
Code: Select all
IdentifyPBConstants::DestroyPBConstants()
Code: Select all
EnableExplicit
DeclareModule IdentifyPBConstants
Structure PBCONSTANTS_DATA
constant.s
value.i
EndStructure
Global NewList _llPBConstants.PBCONSTANTS_DATA()
Global NewList _llResults.s()
Declare.b InitPBConstants()
Declare.s ComparePBConstant(value.i)
Declare DestroyPBConstants()
EndDeclareModule
Module IdentifyPbConstants
;-------------------------------------------------------------------------------------
;-------------------------------------------------------------------------------------
; GetPBInfo.pb
;
; Thanks to Danilo ---
#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)
Protected x$
If AvailableProgramOutput(compiler)
x$ = ReadProgramString(compiler)
ProcedureReturn x$
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$)
EndIf
out$ = Trim(out$)
If out$
AddElement(out())
out()=space$+out$
EndIf
EndIf
Wend
EndProcedure
Procedure GetConstantsList(compiler,List out.s())
If ProgramRunning(compiler)
SendCompilerCommand(compiler,"CONSTANTLIST")
FillConstantList(compiler,out())
EndIf
EndProcedure
Procedure WaitCompilerReady(compiler)
Protected out$
While out$<>"READY" And Left(out$,5)<>"ERROR"
out$ = GetCompilerOutput(compiler)
Wend
EndProcedure
;-------------------------------------------------------------------------------------
;-------------------------------------------------------------------------------------
; zebuddi ----------------------------------------------------------------------
Procedure.b _InternalCreatePBCFile()
Define pb, out$, bFileOK.b
NewList constants.s()
pb = StartCompiler()
If pb
WaitCompilerReady(pb)
GetConstantsList(pb,constants())
SortList(constants(),#PB_Sort_Ascending|#PB_Sort_NoCase)
If CreateFile(0, GetCurrentDirectory()+"\Constants.txt")
WriteStringN(0, Str(#PB_Compiler_Version))
WriteStringN(0, Str(ListSize(constants())))
ForEach constants()
WriteStringN(0,constants())
Next
CloseFile(0)
FreeList(constants())
bFileOK = #True
EndIf
EndIf
StopCompiler(pb)
If bFileOK
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure.s GetVersion(iFileID.i)
ProcedureReturn ReadString(iFileID)
EndProcedure
Procedure.b InitPBConstants() ; must be called first to check if Linked list and data initialised
Protected sData.s, version$, iVersionCurrent.i, iContantCount.i, bFileOK.b, bMakePBCFile.b
#File = 0
If ReadFile(#File, "constants.txt") And Val(GetVersion(#File)) = #PB_Compiler_Version ; check to see if constant file is valid. If not try to created new constants file
FileSeek(#File, 0)
version$ = GetVersion(#File)
bFileOK = #True
ElseIf ReadFile(#File, "constants.txt") And Val(GetVersion(#File)) <> #PB_Compiler_Version ; readfile ok version different
bFileOK = _InternalCreatePBCFile() ; try to create new constants file
If bFileOK = #True
ReadFile(#File, "Constants.txt")
version$ = GetVersion(#File)
Else
bFileOK = #False
EndIf
ElseIf Not ReadFile(#File, "constants") ; try create if dont exist
bFileOK = _InternalCreatePBCFile() ; try to create new constants file
If bFileOK
ReadFile(#File, "Constants.txt")
version$ = GetVersion(#File)
Else
bFileOK = #False
EndIf
EndIf
If bFileOK ; constants file is ok
iContantCount = Val(ReadString(0))
While Not Eof(#File)
sData = ReadString(#File)
AddElement(_llPBConstants())
With _llPBConstants()
\constant = Trim(StringField(sData, 1, Chr(61)))
sData = Trim(RemoveString(sData, \constant + " = "))
\value = Val(StringField(sData, 1, #CRLF$))
EndWith
Wend
CloseFile(#File)
If (Val(version$) = #PB_Compiler_Version) And (ListSize(_llPBConstants()) = iContantCount)
iVersionCurrent = #True
ProcedureReturn #True
Else
iVersionCurrent = #False
EndIf
Else
MessageRequester("file Error", "Unable to read or create PBConstant`s file")
EndIf
EndProcedure
Procedure.s ComparePBConstant(value.i)
Protected sPBC.s
With _llPBConstants()
ForEach _llPBConstants()
If \value = value
AddElement(_llResults())
_llResults() = \constant
EndIf
Next
SortList(_llResults(), #PB_Sort_Ascending)
ForEach _llResults()
sPBC + _llResults() + #CRLF$
Next
ClearList(_llResults())
ProcedureReturn sPBC
EndWith
EndProcedure
Procedure DestroyPBConstants()
FreeList(_llPBConstants())
FreeList(_llResults())
EndProcedure
EndModule
CompilerIf #PB_Compiler_IsMainFile
UseModule IdentifyPBConstants
Procedure WinCallback(hWnd, uMsg, WParam, LParam)
Debug uMsg
Debug IdentifyPBConstants::ComparePBConstant(uMsg)
Debug " "
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
If OpenWindow(0, 0, 0, 200, 100, "Messages", #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)
If IdentifyPBConstants::InitPBConstants()
SetWindowCallback(@WinCallback()) ; activate the callback
EndIf
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
End
EndSelect
ForEver
EndIf
IdentifyPBConstants::DestroyPBConstants()
UnuseModule IdentifyPBConstants
CompilerEndIf