Denis was in 2006 with the help of an analysis of the file FRED residents.
http://www.purebasic.fr/english/viewtop ... t=resident
Comtois and asked the list of macros:http://www.purebasic.fr/english/viewtop ... ilit=macro
Files directory residents RESIDENTS are not compiled information of the 5 types of objects needed to PB.
We can even install one of these types in the resident file with option pbcompiler.exe / RESIDENT see doc.
We find these files in residents:
Constants.
Structures.
Interfaces.
Macros.
Prototypes.
Recent years this program did not work (install the structure res5).
PRG also do this were to list only 3 types (Structures and Constants interfaces).
After a few galleys I managed to make it work on res5.
I took the opportunity to extract as Macros.
It only remains for me to extract the prototypes, but I have not seen a single info stored in this section.
To run the PRG must necessarily be a directory RESIDENTS. It does not start otherwise.
There are 3 PRG:
The first extract the constants structures interfaces and macros.
The second reshapes macros extracted.
The third check if there is no duplication in the constants of the structures or interfaces.
Each of these little PRG be attached to the first either physically or by call.
IncludeFile "FileName"
XIncludeFile "FileName"
PRG first extraction CONSTANTS AND MACROS INTERFACES STRUCTURES.
Code: Select all
; Author : Denis/ PAPIPP
; Version de PB : 5B8
; Date :
; Gadget
#gadget_ecrire_texte=0
#gadget_bouton_ajout_element=1
#gadget_liste=2
#texte_ecrire_ici=3
#texte_selection=4
#texte_affiche_selection=5
Enumeration
#Fenetre_Principale
#ListIconConstantes
#StringGadgetCst
#StringGadgetStruc
#StringGadgetInterface
#Container1
#ListIconStructures
#ListIconInterfaces
#BoutonRechercherCst
#BoutonRechercherStruc
#BoutonRechercherInterface
#gadSplitter
#mess_cst
#mess_str
#mess_int
EndEnumeration
;- --- Enumeration Type résident -----------------
Enumeration
#res1=1 ; codage du type de réside, de la version 1 à 4
#res2
#res3
#res4
#res5
#M15=15
EndEnumeration
;- --- Enumeration des types CT -----------------
Enumeration ; type codé des constantes dans les résidents de type 4
#CT_Byte=0 ; codage des types de constantes stockée dans le res
#CT_Word=1
#CT_Long=2
#CT_Quad=3
#CT_Float_Double=5 ; c'est un double précision
#CT_String=6
EndEnumeration
;- --- Enumeration des types CT res3 -----------------
Enumeration ; type codé des constantes dans les résidents de type 3
#CT_Long_Res3=0 ; codage sur un long pour les byte, word et long
#CT_Float_Simple_Res3=4 ; c'est un simple précision
#CT_String_Res3=8
EndEnumeration
;- --- Enumeration des chaînes Type -----------------
#CT_Byte_String="byte"
#CT_String_Char_A="caractère ascii"
#CT_String_Char_U="caractère unicode"
#CT_Word_String="word"
#CT_Long_String="long"
#CT_Quad_String="quad"
#CT_Float_String="float"
#CT_Double_String="double"
#CT_String_String="string"
#CT_Interface_String="interface"
#CT_Structure_String="structure"
#CT_ListeChainer_String="liste chainée"
;- --- Enumeration des types -----------------
Enumeration ; type utilisé pour coder les éléments dans les structures
#ST_Byte=1 ; codage des types de constantes stockée dans le res
#ST_Word=2
#ST_Long=4
#ST_Quad=8
#ST_Float=16 ; simple précision
#ST_Double=32 ; double précision
#ST_String=64
#ST_Structure=128
#ST_Interface=256
#ST_Char=512
#ST_CharUnicode=1024
#ST_tableau=2048
#ST_Non_tableau=4096
#ST_Pointeur=8192
#ST_NonPointeur=16384
#ST_ListeChainer=32768
EndEnumeration
Structure ListDeParametres
Nom_parametre$ ; > le nom du paramètre
Type_Parametre.l ; le type
Nom_Structure$
Nom_Interface$
EndStructure
Structure ListDeVariables
Nom_Variable$ ; le nom de la variable
Type_Variable.l ; le type
Nom_Structure$
Nom_Interface$
Taille.l ; à remplir lorsque l'on crée une string sur la pile, correspond
; à la taille réelle de la chaine sans les 4 octets pour stocker
; l'adresse de la variable elle-même
Type.l ; à #Global si global sinon à #local
Argument_AdresseVar$ ; utilisé uniquement lorsque le registre d'accès est différent de
; esp, par ex l'adresse de la var est dword [ebp+32] donc lorsque
; l'on génère le code pour charger l'adresse effective en local
; on stocke 'dword [ebp + 36]' soit ebp +32 + 4
EndStructure
Structure StructureCourante
Element$ ; l'élément courant
Type_Variable.l ; le type long, word, structure etc de l'élément courant stocké sous forme d'une constante
; #ST_tableau = %10000000
; #ST_Non_tableau = %01000000
; #ST_Pointeur = %00100000
; #ST_NonPointeur = %00010000
Type_Variable$ ; la chaine lue du type dans le res, ex : 'c' , 'd' , ou le npm de la structure ou interface
TailleElement.l ; Taille de l'élément courant en octets
TailleTableau.l ; Taille du tableau (valeur entre crochets) en octets, non utilisé si pas tableau
offset.l ; déplacement par rapport au début structure
EndStructure
Structure ListeStructures
Nom_Structure$ ; stocke le nom de la structure
FichierOrigine$ ; le nom du fichier res ou est déclarée la structure
TailleStructure.l ; la taille de la structure
Nb_ElementsStructure.l ; le nombre d’éléments de la structure
IndexStructureDansListe.l ; stocke l'adresse dans la liste globale pour atteindre directement l'élément
; dans la liste chaînée StructureCourante
EndStructure
Structure Constante
Nom_Constante$
FichierResident$
StructureUnion
ValeurL.l ; utilisé pour les byte, word, Long
ValeurQ.q ; utilisé pour les quad
ValeurF.f ; utilisé pour les float simple précision version #res3 (pas de double)
ValeurD.d ; utilisé pour les float double précision, pas de simple codé pour #res4
ValeurS.s{20} ; utilisé pour les constantes de texte
EndStructureUnion
Type.l ; type = #CT_String ou #CT_Float sinon c'est une valeur
Selection.b ; élément sélectionné ou non
EndStructure
Structure Macros
Nom_Macro$
FichierResident$
Ligne_param$ ; élément sélectionné ou non
EndStructure
Structure Macrom
Nom_Macro$
type.b
NB_PARAM.l ; type = #CT_String ou #CT_Float sinon c'est une valeur
PARAM${16}[15]
Ligne_macro$ ; élément sélectionné ou non
EndStructure
Structure PB_InterfaceMethod
TailleElement.l
NbParameters.l
; TypeElement.l ; 8 types à coder
; #ST_Byte = 1 ; codage des types de constantes stockée dans le res
; #ST_Word = 2
; #ST_Long = 4
; #ST_Quad = 8
; #ST_Float = 16 ; simple précision
; #ST_Double = 32 ; double précision
; #ST_String = 64
; #ST_Structure = 128
EndStructure
Structure InterfaceInfos
; Adresse_InfosElement.l ; adresse de la zone mémoire allouée par PB pour stocker les infos des éléménts
NomMethode$ ; le nom de la méthode
Nb_Args.b ; le nombre d'arguments pour chaque méthode
ArgsMethode.s ; la chaine représentant les types d'arguments de la méthode
EndStructure
Structure Nom_ListeInterfaces
Nom_Interface$ ; le nom de l'interface
FichierOrigine$ ; le nom du fichier res ou est déclarée l'interface
TailleInterface.l ; la taille de l'interface
Nb_Methodes.l ; le nombre de méthodes de l'interface
IndexInterfaceDansListe.l ; stocke l'adresse dans la liste globale pour atteindre directement l'élément
EndStructure
;- --- listes chaînées -----------------
Global NewList ListParametres.ListDeParametres()
Global NewList ListeVariables.ListDeVariables()
Global NewList Constantes.Constante()
Global NewList Macros.Macros()
Global NewMap Macrom.Macrom()
Global NewList Nom_Structure.ListeStructures() ; la liste des noms de structures
Global NewList Structures.StructureCourante() ; le détails pour chaque élément de la Structure
; ; dans la liste chainée détaillée
Global NewList Nom_ListeInterfaces.Nom_ListeInterfaces() ; la liste des noms de structures
Global NewList Interfaces.InterfaceInfos() ; le détails pour chaque élément de la Structure
Global NewList Methode.PB_InterfaceMethod()
Global PbConstantFolder$,Prem_lg$,Liste_MACR$
Define posit.POINT
Procedure ExtractionConstantes(ResType.l,*PointeurDebut.l)
Protected *ConstantsEnd,Type.b
Protected CT_String.b,CT_Long.b
; ici, le pointeur doit être sur le 1er caractère qui suit le long 'TSNC'
If PeekL(*PointeurDebut)=0
ProcedureReturn *PointeurDebut+4
EndIf
*ConstantsEnd=*PointeurDebut+PeekL(*PointeurDebut)+4
*PointeurDebut+4
While *PointeurDebut<*ConstantsEnd
If AddElement(Constantes())
; db_h(*pointeurdebut,32,1)
Constantes()\Nom_Constante$=PeekS(*PointeurDebut) ; lecture nom constante
Constantes()\FichierResident$=DirectoryEntryName(0)
*PointeurDebut+Len(Constantes()\Nom_Constante$)+1 ; déplacement du pointeur
; Debug Constantes()\Nom$
Type.b=PeekB(*PointeurDebut)
; #CT_Byte = 0 ; codage des types de constantes stockée dans le res
; #CT_Word = 1
; #CT_Long = 2
; #CT_Quad = 3
; #CT_Float_Double = 5 ; c'est un double précision
; #CT_String = 6
;
; Enumeration ; type codé des constantes dans les résidents de type 3
; #CT_Long_Res3 = 0 ; codage sur un long pour les byte, word et long
; #CT_Float_Simple_Res3 = 4 ; c'est un simple précision
; #CT_String_Res3 = 8
Select ResType
Case #res4,#res5
CT_String=#CT_String
CT_Long=#CT_Long
Case #res3,#res2
CT_String=#CT_String_Res3
CT_Long=0
Case #res1
Type=0
CT_Long=Type
*PointeurDebut-1 ;- 1 car il n'y a pas de type codé, donc
; il faut revenir en arrière du au Type.b = PeekB(*PointeurDebut)
EndSelect
Select Type
Case CT_Long
*PointeurDebut+1
Constantes()\ValeurL=PeekL(*PointeurDebut)
*PointeurDebut+4 ; on arrive sur la nouvelle chaine
Select ResType
Case #res4
Constantes()\Type=#CT_Long
Case #res3,#res2,#res1
Select Constantes()\ValeurL
Case 0 To 255
Constantes()\Type=#CT_Byte
Case 256 To 65535
Constantes()\Type=#CT_Word
Default
Constantes()\Type=#CT_Long
EndSelect
EndSelect
Case CT_String
*PointeurDebut+1
Constantes()\ValeurS=PeekS(*PointeurDebut)
*PointeurDebut+Len(Constantes()\ValeurS)+1
Constantes()\Type=#CT_String
Case #CT_Float_Double ; c'est un flottant double précision
*PointeurDebut+1
Constantes()\ValeurD=PeekD(*PointeurDebut)
*PointeurDebut+8
Constantes()\Type=#CT_Float_Double
Case #CT_Float_Simple_Res3 ; c'est un flottant simple précision
*PointeurDebut+1
Constantes()\ValeurF=PeekF(*PointeurDebut)
*PointeurDebut+4
Constantes()\Type=#CT_Float_Simple_Res3
Case #CT_Byte
*PointeurDebut+1
Constantes()\ValeurL=PeekB(*PointeurDebut)
*PointeurDebut+1 ; on arrive sur la nouvelle chaine
Constantes()\Type=#CT_Byte
Case #CT_Word
*PointeurDebut+1
Constantes()\ValeurL=PeekW(*PointeurDebut)
*PointeurDebut+2 ; on arrive sur la nouvelle chaine
Constantes()\Type=#CT_Word
Case #CT_Quad
*PointeurDebut+1
Constantes()\ValeurQ=PeekQ(*PointeurDebut)
*PointeurDebut+8 ; on arrive sur la nouvelle chaine
Constantes()\Type=#CT_Quad
EndSelect
EndIf
Wend
ProcedureReturn *PointeurDebut
EndProcedure
Procedure Extraction_Structure_Interface(ResType.l,*PointeurDebut.l)
Protected TotalCaracteresToutesStructures.l,*DernierSymbol.l
Protected NomStructure_Interface.s,TailleStructure_Interface.l,Nb_Elements.l
Protected TypeStructure_Interface.l,Nom_Element.s,k.l,i.l
; on commence par des structure ou interfaces; Le pointeur *PointeurDebut est sur la longueur de la zone
; *PointeurDebut + 12 ;
TotalCaracteresToutesStructures=PeekL(*PointeurDebut)
If TotalCaracteresToutesStructures=0
ProcedureReturn *PointeurDebut
EndIf
*PointeurDebut+4 ; saut de la longueur de la zone Structures_Interfaces
*DernierSymbol=*PointeurDebut+TotalCaracteresToutesStructures-1
Repeat
NomStructure_Interface=PeekS(*PointeurDebut)
*PointeurDebut+Len(NomStructure_Interface)+1
TailleStructure_Interface=PeekL(*PointeurDebut)
Nb_Elements=PeekW(*PointeurDebut+4)
*PointeurDebut+6
TypeStructure_Interface=PeekB(*PointeurDebut)
If TypeStructure_Interface & 4
;******************************************************************************************************************************************
; INTERFACES
; c'est une interface
;- Debut Interface
;******************************************************************************************************************************************
If AddElement(Nom_ListeInterfaces())=0
Break
EndIf
With Nom_ListeInterfaces()
\Nom_Interface$=NomStructure_Interface
\FichierOrigine$=DirectoryEntryName(0)
\TailleInterface=4*Nb_Elements
\Nb_Methodes=Nb_Elements
EndWith
*PointeurDebut+9
ClearList(Methode())
For k=1 To Nb_Elements
If AddElement(Methode())=0
Break
EndIf
Methode()\NbParameters=PeekB(*PointeurDebut)
*PointeurDebut+16
Next k
FirstElement(Methode())
*PointeurDebut-8 ; début du nom de la 1ere méthode
For k=1 To Nb_Elements
AddElement(Interfaces())
If Nom_ListeInterfaces()\IndexInterfaceDansListe=0
Nom_ListeInterfaces()\IndexInterfaceDansListe=@Interfaces()
EndIf
Interfaces()\NomMethode$=PeekS(*PointeurDebut)
*PointeurDebut+Len(Interfaces()\NomMethode$)+1
If Methode()\NbParameters>0
Interfaces()\Nb_Args=Methode()\NbParameters
Interfaces()\ArgsMethode=""
For i=1 To Methode()\NbParameters
Select PeekB(*PointeurDebut)
Case 1 ; byte
Interfaces()\ArgsMethode+"b"
Case 3 ; word
Interfaces()\ArgsMethode+"w"
Case 5 ; long
Interfaces()\ArgsMethode+"l"
Case 8 ; string
Interfaces()\ArgsMethode+"s"
Case 9 ; float
Interfaces()\ArgsMethode+"f"
Case 11 ; char
Interfaces()\ArgsMethode+"c"
Case 12 ; double
Interfaces()\ArgsMethode+"d"
Case 13 ; quad
Interfaces()\ArgsMethode+"q"
EndSelect
*PointeurDebut+1
Next i
ElseIf Methode()\NbParameters<0
roui.l=MessageRequester("Erreur","Methode()\NbParameters < 0 -->"+Str(Methode()\NbParameters)+#LFCR$+"Interface non Purebasic 4xx"+#LFCR$+"Voulez vous Sortir du Programme",#PB_MessageRequester_YesNo)
If roui=6
End 2
EndIf
EndIf
NextElement(Methode())
Next k
Else
;******************************************************************************************************************************************
; STRUCTURES
; c'est une structure
;- Debut Structures
;******************************************************************************************************************************************
If AddElement(Nom_Structure())
With Nom_Structure()
\Nom_Structure$=NomStructure_Interface ; stocke le nom de la structure
\FichierOrigine$=DirectoryEntryName(0) ; le nom du fichier res ou est déclarée la structure
\TailleStructure=TailleStructure_Interface ; la taille de la structure
\Nb_ElementsStructure=Nb_Elements ; le nombre d’éléments de la structure
EndWith
If ResType=#res1
*PointeurDebut+1
EndIf
; lecture de la structure
For i=1 To Nb_Elements
If AddElement(Structures()) ; lecture des éléments de la structure
If Nom_Structure()\IndexStructureDansListe=0
Nom_Structure()\IndexStructureDansListe=@Structures()
EndIf
; on passe le long qui donne la taille à partir de là jusqu'à
; la fin de la chaîne
; on passe 2 long qui correspondent à (?)
; on arrive sur un long qui donne l'offset de l'élément
If ResType=#res1
*PointeurDebut+6
ElseIf ResType=#res2
*PointeurDebut+6+4
Else
*PointeurDebut+10
EndIf
With Structures()
Select PeekB(*PointeurDebut)
Case 1 ; c'est un pointeur
\Type_Variable | #ST_Pointeur
Default ; ce n'est pas un pointeur
\Type_Variable | #ST_NonPointeur
EndSelect
*PointeurDebut+3
; If RES = #res2::EndIf
Select ResType
Case #res2
*PointeurDebut-4
\TailleTableau=PeekW(*PointeurDebut+10)
\offset=PeekW(*PointeurDebut+4) ; déplacement par rapport au début structure
\TailleElement=PeekW(*PointeurDebut+6) ; Taille de l'élément courant en octets
Case #res1
\TailleTableau=PeekW(*PointeurDebut+10)
\offset=PeekW(*PointeurDebut+4) ; déplacement par rapport au début structure
\TailleElement=PeekW(*PointeurDebut+6) ; Taille de l'élément courant en octets
Default
\TailleTableau=PeekL(*PointeurDebut+8)
\offset=PeekW(*PointeurDebut) ; déplacement par rapport au début structure
\TailleElement=PeekL(*PointeurDebut+4) ; Taille de l'élément courant en octets
EndSelect
Select \TailleTableau
Case -1
\Type_Variable | #ST_Non_tableau
; dans le cas #ST_Non_tableau, \TailleTableau n'est pas utilisé
Default
\Type_Variable | #ST_tableau
EndSelect
*PointeurDebut+16
\Element$=PeekS(*PointeurDebut) ; l'élément courant
*PointeurDebut+Len(\Element$)+1
\Type_Variable$=PeekS(*PointeurDebut)
Select \Type_Variable$
Case "b"
\Type_Variable | #ST_Byte
Case "w"
\Type_Variable | #ST_Word
Case "l"
\Type_Variable | #ST_Long
Case "q"
\Type_Variable | #ST_Quad
Case "f"
\Type_Variable | #ST_Float
Case "d"
\Type_Variable | #ST_Double
Case "s"
\Type_Variable | #ST_String
Case "c"
\Type_Variable | #ST_Char
; Default ; le nom de la structure ou interface
; toutes les structures ou interfaces ne sont pas encore chargé, on ne
; peut pas affecter tout de suite le type structure ou interface à
; l'élément , on le fera après la lecture des résidents
EndSelect
*PointeurDebut+Len(\Type_Variable$)+1-1
EndWith
EndIf
Next i
*PointeurDebut+1
EndIf
; ; ; *PointeurDebut+TailleStructure_Interface ; a retirer si structure fonctionne
EndIf
Until *PointeurDebut> =*DernierSymbol
ProcedureReturn *PointeurDebut
EndProcedure
Procedure ExtractionMACRO(ResType.l,*PointeurDebut.l)
Protected *MacrosEnd,Type.b,LONG_TOT_MACRO.l
Protected CT_String.b,CT_Long.b
; ici, le pointeur doit être sur le 1er caractère qui suit le long 'MACR'
LONG_TOT_MACRO=PeekL(*PointeurDebut)
If LONG_TOT_MACRO=0
ProcedureReturn *PointeurDebut+4
EndIf
*MacrosEnd=*PointeurDebut+LONG_TOT_MACRO+4
*PointeurDebut+4
While *PointeurDebut<*MacrosEnd
; Debug "****************************** MACROS ************************************************"
If AddElement(Macros())
; db_h(*pointeurdebut,32,1)
*deb_MACRO=*PointeurDebut
; db_h(*PointeurDebut,32,1)
Macros()\Nom_Macro$=PeekS(*PointeurDebut) ; lecture nom constante
macrom(Macros()\Nom_Macro$)\Nom_Macro$=Macros()\Nom_Macro$
Macros()\FichierResident$=DirectoryEntryName(0)
*PointeurDebut+Len(Macros()\Nom_Macro$)+1 ; déplacement du pointeur
Type.b=PeekB(*PointeurDebut)
Macrom()\type=Type
; ; Type.b 0 ; codage des types de Macrostockée dans le res
; ; Type.b 1 Macro avec paramétre
; ; Type.b 2
; ; Type.b 3 macro sans paramétre
; ;
If type=3
*PointeurDebut+5
ElseIf type=1
*PointeurDebut+4
EndIf
Nb_param=PeekB(*PointeurDebut)
Macrom()\NB_PARAM=Nb_param
; *********************************** debut paramétre ****************************************
*PointeurDebut+1
;************************************ Il y a 1 paramètre ou plus ********************************
If nb_param>0
For i=0 To Nb_param-1
macrom()\PARAM$[i]=PeekS(*PointeurDebut)
*pointeurDebut+Len(macrom()\PARAM$[i])+1
Next
nb_param_eg=PeekB(*PointeurDebut)
;******************* paramètre égal = __nn=8 *****************
If nb_param_eg<32
*PointeurDebut+1
dif_indice=nb_param-nb_param_eg
For i=0 To nb_param_eg-1
macrom()\PARAM$[dif_indice+i]+"="+PeekS(*PointeurDebut)
*pointeurDebut+Len(PeekS(*PointeurDebut))+1
Next
Else
*PointeurDebut+1
EndIf
EndIf
Ligne_macro$=PeekS(*PointeurDebut)
macrom()\Ligne_macro$=Ligne_macro$
*pointeurDebut+Len(Ligne_macro$)+1
EndIf
Wend
ProcedureReturn *PointeurDebut
EndProcedure
Procedure LectureResident()
Protected CheminDir.l,TailleFichier.l
Shared *ConstantsHeader.l,*SymbolCourant.l,*ConstantsEnd.l,RES.l,*PARTRESEND,l
Protected TotalCaracteresToutesStructures.l,*DernierSymbol.l
Protected NomStructure_Interface.s,TailleStructure_Interface.l,Nb_Elements.l
Protected TypeStructure_Interface.l,Nom_Element.s
Protected i.l,k.l,LongueurInfos.l
Protected Symbole$
titre$="Choisissez le répertoire des Résidents de PureBasic 4xx"+#LF$
PbConstantFolder$=""
Repeat
PbConstantFolder$=PathRequester(titre$,PbConstantFolder$)
Position.l=FindString(PbConstantFolder$,"\Resident",4)
titre$=titre$+" Le chemin doit se terminer par Residents"+#LF$
If Len(titre$)>256
roui.l=MessageRequester("Sortie du Programme","Voulez vous Sortir du Programme",#PB_MessageRequester_YesNo)
If roui=6
End 2
EndIf
EndIf
Until Position>0
; PbConstantFolder$ = #PB_Compiler_Home + "Residents\"
If ExamineDirectory(0,PbConstantFolder$,"*.res")
ClearList(Nom_Structure()) :ClearList(Structures())
ClearList(Nom_ListeInterfaces()) :ClearList(Interfaces())
ClearList(Methode()) :ClearList(Constantes())
CheminDir=NextDirectoryEntry(0)
While CheminDir
If CheminDir
If ReadFile(0,PbConstantFolder$+DirectoryEntryName(0))
TailleFichier=Lof(0)
*ConstantsHeader=AllocateMemory(TailleFichier)
ReadData(0,*ConstantsHeader,TailleFichier)
CloseFile(0)
*ConstantsEnd=*ConstantsHeader+TailleFichier
*SymbolCourant=*ConstantsHeader
If CompareMemory(*SymbolCourant,?Fichier_Res5,12)
RES=#res5
*SymbolCourant+12; deb+12
While *SymbolCourant<*ConstantsEnd
Tres.l=PeekL(*SymbolCourant)
*SymbolCourant+4
Select Tres
Case 'CNST' ; c'est les cosntantes seules
; Debug _nl+_h(*symbolCourant)+_h(*symbolCourant-*ConstantsHeader)
*SymbolCourant=ExtractionConstantes(RES,*SymbolCourant)
; Debug _nl+_h(*symbolCourant)+_h(*symbolCourant-*ConstantsHeader)
Case 'RCAM' ; c'est les macros
; Debug _nl+_h(*symbolCourant)+_h(*symbolCourant-*ConstantsHeader)
*SymbolCourant=ExtractionMACRO(RES,*SymbolCourant)
; Debug _nl+_h(*symbolCourant)+_h(*symbolCourant-*ConstantsHeader)
Case 'TORP' ; c'est les prototypes
; Debug _nl+_h(*symbolCourant)+_h(*symbolCourant-*ConstantsHeader)
Case 'SRCT' ; C'est les srtuctures et interfaces
; Debug _nl+_h(*symbolCourant)+_h(*symbolCourant-*ConstantsHeader)
*SymbolCourant=Extraction_Structure_Interface(RES,*SymbolCourant) ; a debloquer*******************
; Debug _nl+_h(*symbolCourant)+_h(*symbolCourant-*ConstantsHeader)
EndSelect
Wend
EndIf
Else
roui.l=MessageRequester("Erreur","Le fichier "+DirectoryEntryName(0)+" n'est pas au format resident PureBasic"+#LFCR$+"Voulez vous Sortir du Programme",#PB_MessageRequester_YesNo)
If roui=6
End 2
EndIf
EndIf
EndIf
FreeMemory(*ConstantsHeader)
CheminDir=NextDirectoryEntry(0)
Wend
FinishDirectory(0)
EndIf
; Tri des interfaces
Nb_Interfaces=ListSize(Nom_ListeInterfaces())
If Nb_Interfaces>0
SortStructuredList(Nom_ListeInterfaces(),2,OffsetOf(Nom_ListeInterfaces\Nom_Interface$),#PB_Sort_String)
Else
Nb_Interfaces=0
EndIf
; Tri des structures
Nb_Structures=ListSize(Nom_Structure())
If Nb_Structures>0
SortStructuredList(Nom_Structure(),2,0,#PB_Sort_String)
Else
Nb_Structures=0
EndIf
; Tri des constantes
Nb_Constantes=ListSize(Constantes())
If Nb_Constantes>0
; SortStructuredList(Constantes(), 2, OffsetOf(Constante\Nom_Constante$), #PB_Sort_String)
Else
Nb_Constantes=0
EndIf
ClearList(Methode())
; ************* Pas de tri sur les macros l'ordre d'apparition est important pour le compilateur en une lecture
EndProcedure
DataSection
Fichier_Res5 :
Data .b $45,$52,$55,$50,$00,$00,$00,$00,$35,$53,$45,$52
Fichier_Res4 :
Data .b $45,$52,$55,$50,$00,$00,$00,$00,$34,$53,$45,$52
Fichier_Res3 :
Data .b $45,$52,$55,$50,$00,$00,$00,$00,$33,$53,$45,$52
Fichier_Res2 :
Data .b $45,$52,$55,$50,$00,$00,$00,$00,$32,$53,$45,$52
Fichier_Res1 :
Data .b $45,$52,$55,$50,$00,$00,$00,$00,$31,$53,$45,$52
EndDataSection
Code: Select all
Global ListIcon_0,ListIcon_2,Button_0,Button_1,Text_0
Procedure InitWindow_0()
Window_0 = OpenWindow(#PB_Any, 0, 0, 835, 460, "", #PB_Window_SystemMenu)
ListIcon_0 = ListIconGadget(#PB_Any, 10, 35, 435, 355, "Macros", 100, #PB_ListIcon_MultiSelect | #PB_ListIcon_GridLines | #PB_ListIcon_AlwaysShowSelection)
; ListIcon_0 = ListIconGadget(#PB_Any, 10, 35, 435, 355, "Macros", 100, #PB_ListIcon_GridLines )
AddGadgetColumn(ListIcon_0, 1, "Paramètres", 150)
AddGadgetColumn(ListIcon_0, 2, "Fichier résident", 350)
; SetGadgetColor(ListIcon_0, #PB_Gadget_BackColor,RGB(255,255,255))
ListIcon_2 = ListIconGadget(#PB_Any, 455, 35, 370, 355, "Détail de la macro", 400)
Button_1 = ButtonGadget(#PB_Any, 535, 405, 195, 30, " Dans Clipboard")
Button_0 = ButtonGadget(#PB_Any, 125, 405, 195, 30, " Dans Clipboard")
nb_macro=ListSize(Macros())
Text_0 = TextGadget(#PB_Any, 195, 5, 455, 20, " "+ Str(nb_macro)+" Macros (Cliquez dans la colonne macros pour obtenir le détail de la macro)")
; Text_0 = TextGadget(#PB_Any, 355, 5, 170, 20," "+ Str(nb_macro)+" Macros ")
ResetList(Macros()) ; Reset the list index before the first element.
While NextElement(Macros()) ; Process all the elements..
PREM_lg$=""
LG_PARM$=""
If FindMapElement(macrom(),macros()\Nom_Macro$)
nb_param=macrom()\NB_PARAM
If NB_PARAM>0
LG_PARM$+" ("
For p=0 To nb_param-1
LG_PARM$+macrom()\PARAM$[p]
If p<nb_param-1
LG_PARM$+","
EndIf
Next
LG_PARM$+")"
EndIf
macros()\Ligne_param$=LG_PARM$
AddGadgetItem(listIcon_0,-1,macros()\Nom_Macro$+Chr(10)+macros()\Ligne_param$+Chr(10)+macros()\FichierResident$)
Liste_MACR$+macros()\Nom_Macro$+" "+LG_PARM$+#LF$
EndIf
Wend
EndProcedure
Procedure Window_0_Events(event)
Static flagx.b,hld0,hld1,hld2,Elem_m,Elem_m$
Select event
Case #PB_Event_CloseWindow
ProcedureReturn #False
Case #PB_Event_Gadget
Select EventGadget()
Case listIcon_0
PREM_lg$=""
ClearGadgetItems(listIcon_2)
Elem_m=GetGadgetState(listIcon_0)
Elem_m$=GetGadgetItemText(listIcon_0,Elem_m)
If FindMapElement(macrom(),Elem_m$)
ClearGadgetItems(listIcon_2)
PREM_lg$="Macro "+macrom()\Nom_Macro$
nb_param=macrom()\NB_PARAM
If NB_PARAM>0
prem_lg$+" ("
For p=0 To nb_param-1
prem_lg$+macrom()\PARAM$[p]
If p<nb_param-1
prem_lg$+","
EndIf
Next
prem_lg$+")"
EndIf
AddGadgetItem(listIcon_2,-1,prem_lg$)
prem_lg$+#LF$
; **************** ANALYSE DU CORPS DE LA MACRO chaque ligne est terminée par $01 *************************
Dim __resultat$(0)
If __flagx=0
__hld0=CreateRegularExpression(#PB_Any,"[^\x01]+") ; structure [+-]n[nnnnn].n[n] Pour un nombre réel quelconque
__flagx=2
EndIf
__nb_z=ExtractRegularExpression(__hld0,macrom()\Ligne_macro$,__resultat$());
For __termi=0 To __nb_z-1
AddGadgetItem(listIcon_2,-1,__resultat$(__termi))
prem_lg$+__resultat$(__termi)+#LF$
Next
AddGadgetItem(listIcon_2,-1,"EndMacro")
prem_lg$+"EndMacro"
Else
Elem_mm=0
MessageRequester ("ATTENTION" , Elem_m$+" n'est pas dans la liste des macros.")
EndIf
; Debug _nl+_N(elem_m)+_s(Elem_m$)+_n(Elem_mm)
Case ListIcon_2
Case Button_0
If Elem_m>0
ElPar_m$=GetGadgetItemText(listIcon_0,Elem_m,1)
SetClipboardText(Elem_m$+" "+ElPar_m$)
Else
SetClipboardText(Liste_MACR$)
EndIf
; MessageRequester("Liste de (s) Macros)",Liste_MACR$)
Case Button_1
SetClipboardText(Prem_lg$)
; MessageRequester("Liste de la Macro)",Prem_lg$)
EndSelect
EndSelect
ProcedureReturn #True
EndProcedure
InitWindow_0()
Repeat
event=WaitWindowEvent()
Until Window_0_Events(event)=#False
fin:
