It is currently Wed Jul 17, 2019 10:09 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 4 posts ] 
Author Message
 Post subject: List of macros, and other information in the resident
PostPosted: Sun Nov 11, 2012 4:28 pm 
Offline
User
User

Joined: Mon Aug 17, 2009 10:48 pm
Posts: 49
Location: France
Hello to all.
Denis was in 2006 with the help of an analysis of the file FRED residents.
http://www.purebasic.fr/english/viewtopic.php?f=7&t=23431&hilit=resident
Comtois and asked the list of macros:http://www.purebasic.fr/english/viewtopic.php?f=18&t=45688&hilit=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:
; 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


Second PRG fitness macros extracted

Code:
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:


The third PRG in the following post


Top
 Profile  
Reply with quote  
 Post subject: Re: List of macros, and other information in the resident
PostPosted: Sun Nov 11, 2012 4:42 pm 
Offline
User
User

Joined: Mon Aug 17, 2009 10:48 pm
Posts: 49
Location: France
Third PRG checks if there is no duplication in constants structures or interfaces.

Code:
;***************************************************************************************************************************

Procedure.l Boutoncouleur(TextBouton$)
   ImageBouton = CreateImage(#PB_Any, 180, 30)
   If ImageBouton And StartDrawing(ImageOutput(ImageBouton))
      Box(0, 0, 180, 30, $840AA9)
      ;DrawingFont(Font)
      FrontColor(RGB(#White, #White, #White))
      DrawingMode(1)
      DrawText((180-TextWidth(TextBouton$))/2, 7, TextBouton$)
      StopDrawing()
   EndIf
   ProcedureReturn ImageBouton
EndProcedure

Procedure.l SetListPos(Gadget.l, Position.l)
   Protected Pos.POINT
   SendMessage_(GadgetID(Gadget), #LVM_GETITEMPOSITION, Position-1, Pos)
   SendMessage_(GadgetID(Gadget), #LVM_SCROLL, 0, Pos\y)
EndProcedure

Procedure.l rech_dicho(typlist.l)
   a$ = GetGadgetText(#StringGadgetCst)
   la.l = Len(a$)
   posmin.l = 0
   Select typlist
      Case #ListIconConstantes
         nbelem.l = ListSize(Constantes())
         posmax.l = nbelem
      Case #ListIconStructures
         ;ForEach Nom_Structure() ; Affichage des structures
         ;AddGadgetItem(#ListIconStructures, -1, Nom_Structure()\Nom_Structure$
         nbelem.l = ListSize(Nom_Structure())
         posmax.l = nbelem
      Case #ListIconInterfaces
         ;ForEach Nom_ListeInterfaces() ; Affichage des interfaces
         ;AddGadgetItem(#ListIconInterfaces, -1, Nom_ListeInterfaces()\Nom_Interface$
         nbelem.l = ListSize(Nom_ListeInterfaces())
         posmax.l = nbelem
      Default
         posmax = 0
         ; Message liste inconnue
   EndSelect
   While posmin< = posmax
      poscour.l = (posmin + posmax)/2
      Select typlist
         Case #ListIconConstantes
            SelectElement(Constantes(), poscour)
            acour$ = Constantes()\Nom_Constante$
         Case #ListIconStructures
            SelectElement(Nom_Structure() , poscour)
            acour$ = Nom_Structure()\Nom_Structure$
         Case #ListIconInterfaces
            SelectElement(Nom_ListeInterfaces(), poscour)
            acour$ = Nom_ListeInterfaces()\Nom_Interface$
      EndSelect
      ; acour_$=Mid(acour$+Space(la),1,la)
      If a$ = acour$
         posmin = poscour + 1
         posmax = poscour
      Else
         If a$<acour$
            posmax = poscour-1
         Else
            posmin = poscour + 1
         EndIf
      EndIf
   Wend
   ; If posmin>nbelem
   ; posmin=nbelem
   ; posmax=nbelem
   ; Else
   ; If posmin=posmax And poscour <posmin
   ; poscour=posmin
   ; EndIf
   ; EndIf
   SetListPos(typlist, poscour)
   SetGadgetItemState(typlist, poscour, #PB_ListIcon_Selected)
   
   ProcedureReturn poscour
EndProcedure

;________________________________________________________________________________________________________________________________________________________

If OpenWindow(#Fenetre_Principale, 0, 0, 800, 600, "Lecture des fichiers résidents PureBasic dans " + PbConstantFolder$, #PB_Window_MinimizeGadget | #PB_Window_Invisible | #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
   If CreateGadgetList(WindowID(#Fenetre_Principale))
      Nb_Structures = 0
      ;======================================================== Début exploitation des constantes =================================================================
      ; 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 ; 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
      If ListIconGadget(#ListIconConstantes, 00, 00, 690, 300, " Constantes (" + Str(ListSize(Constantes())) + " références)", 260, #PB_ListIcon_FullRowSelect | #PB_ListIcon_AlwaysShowSelection)
         AddGadgetColumn(#ListIconConstantes, 1, " Valeur", 80) ; d<260 f>80+260=340
         AddGadgetColumn(#ListIconConstantes, 2, " Type", 45) ; d240 f>285
         AddGadgetColumn(#ListIconConstantes, 3, " Fichier résident", 140-25) ; D>285 f>410
         ;          SortStructuredList(Constantes(), 0, 0, #PB_Sort_String) ; [, Debut, Fin])
         HideGadget(#ListIconConstantes, 0)
         GadgetToolTip(#ListIconConstantes, "les entités en jaune sur fond rouge sont des doublons. Cliquer sur une tête de colonne pour trier dans un sens ou dans l'autre")
         mnomc$=""
         Couleur.l = GetGadgetColor(#ListIconConstantes, #PB_Gadget_FrontColor)
         nbdcst.l=0
         prem_posd_cst.l=0
         ForEach Constantes()
            Select Constantes()\Type
               Case 0,1,2,3
                  valq$ =Hex(Constantes()\ValeurQ)
                  Select Constantes()\Type
                     Case 0
                        typ$="B=1"
                        val$="$"+Hex(Constantes()\ValeurL)
                     Case 1
                        typ$="W=2"
                        val$="$"+Hex(Constantes()\ValeurL)
                     Case 2
                        typ$="L=4"
                        val$="$"+Hex(Constantes()\ValeurL)
                     Case 3
                        typ$="Q=8"
                        val$="$"+Hex(Constantes()\ValeurQ)
                  EndSelect
               Case 4
                  val$= StrF(Constantes()\ValeurF)
                  typ$="F=4"
               Case 5
                  val$=StrD(Constantes()\ValeurD)
                  typ$="D=8"
               Case 6
                  val$= Constantes()\ValeurS
                  typ$="S=?"
            EndSelect
            AddGadgetItem(#ListIconConstantes, -1, Constantes()\Nom_Constante$ + Chr(10) + val$ + Chr(10)+typ$ + Chr(10)+Constantes()\FichierResident$ )
            ;________________________________________________________Recherche des doublons dans les constantes_______________________________________________________________________
            If mnomc$=Constantes()\Nom_Constante$
               posc.l=ListIndex(Constantes())
               SetGadgetItemColor(#ListIconConstantes, posc, #PB_Gadget_BackColor , RGB(255,0,0),-1) ; [, Colonne])
               SetGadgetItemColor(#ListIconConstantes, posc, #PB_Gadget_FrontColor , RGB(255,255,0),-1) ; [, Colonne])
               nbdcst+1
               If prem_posd_cst=0
                  prem_posd_cst.l=posc
                  dern_posd_cst.l=posc
               Else
                  dern_posd_cst.l=posc
               EndIf
            Else
               ;SetGadgetColor(#ListIconConstantes, #PB_Gadget_FrontColor,-1)
            EndIf
            mnomc$=Constantes()\Nom_Constante$
         Next
         HideGadget(#ListIconConstantes, 0)
      EndIf
      SendMessage_(GadgetID(#ListIconConstantes), #LVM_SETBKCOLOR, 0, $F2D9E8)
      SendMessage_(GadgetID(#ListIconConstantes), #LVM_SETTEXTBKCOLOR, 0, $F2D9E8)
      Font = LoadFont(#PB_Any,"Times New Roman", 8, #PB_Font_HighQuality)
      ;        If PureLVSORT_SelectGadgetToSort(#ListIconConstantes, #PureLVSORT_ShowClickedHeader_IconLeft) = #PureLVSORT_Ok
      ;          PureLVSORT_SetColumnType(#ListIconConstantes, 0, #PureLVSORT_String_CaseSensitive) ; default, not necessary
      ;          PureLVSORT_SetColumnType(#ListIconConstantes, 1, #PureLVSORT_String) ; default, not necessary
      ;          PureLVSORT_SetColumnType(#ListIconConstantes, 2, #PureLVSORT_String) ; default, not necessary
      ;          PureLVSORT_SetColumnType(#ListIconConstantes, 3, #PureLVSORT_String) ; default, not necessary
      ;          PureLVSORT_SetColumnType(#ListIconConstantes, 4, #PureLVSORT_String_CaseSensitive) ; default, not necessary
      ;        EndIf
      ; PureLVSORT_SetColumnType(#ListIconConstantes, 0, #PureLVSORT_String) ; default, not necessary
      ; PureLVSORT_SetColumnType(#ListIconConstantes, 1, #PureLVSORT_Numeric)
      ; PureLVSORT_SetColumnType(#ListIconConstantes, 2, #PureLVSORT_Float)
      ; PureLVSORT_SetColumnType(#ListIconConstantes, 3, #PureLVSORT_DateDDMMYYYY)
      ; PureLVSORT_SetColumnType(#ListIconConstantes, 4, #PureLVSORT_DateMMDDYYYY)
      
      ;======================================================== Fin exploitation des constantes =================================================================
      ;======================================================== début boutons de Recherche=================================================================
      If ContainerGadget(#Container1, 0, 0, 270, 204, #PB_Container_Flat)
         StringGadget(#StringGadgetCst, 10, 05, 240, 20, "")
         GadgetToolTip(#StringGadgetCst, "Pour rechercher tapez les premiers caractères et attention à la casse"+#LF$+" Ensuite appuyez sur l'un des trois boutons" )
         
         ButtonImageGadget(#BoutonRechercherCst, 10, 30, 80, 20, ImageID(Boutoncouleur("Constante")))
         ButtonImageGadget(#BoutonRechercherStruc, 90, 30, 80, 20, ImageID(Boutoncouleur("Structure")))
         ButtonImageGadget(#BoutonRechercherInterface, 170, 30, 80, 20, ImageID(Boutoncouleur("Interface")))
         
         CloseGadgetList()
      EndIf
      
      SplitterGadget(#gadSplitter, 0, 0, 800, 300, #Container1, #ListIconConstantes, #PB_Splitter_Vertical | #PB_Splitter_Separator)
      SetGadgetState(#gadSplitter, 270)
      Dim cst.s(0)
      ;======================================================== Début exploitation des structures =================================================================
      
      ;_____________________________________________________ début Fenêtre des structures__________________________________________________________________________________
      
      ;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
      
      If ListIconGadget(#ListIconStructures, 0, 300, WindowWidth(#Fenetre_Principale)-350, WindowHeight(#Fenetre_Principale)/2-10, " Structures (" + Str(ListSize(Nom_Structure())) + " références)", WindowWidth(#Fenetre_Principale)/2-190, #PB_ListIcon_FullRowSelect | #PB_ListIcon_AlwaysShowSelection)
         HideGadget(#ListIconStructures, 1)
         GadgetToolTip(#ListIconStructures, "les entités en jaune sur fond rouge sont des doublons. Cliquer sur une tête de colonne pour trier dans un sens ou dans l'autre")
         
         AddGadgetColumn(#ListIconStructures, 1, " Fichier résident", 130)
         AddGadgetColumn(#ListIconStructures, 2, " Taille", 50)
         AddGadgetColumn(#ListIconStructures, 3, " Nb élém.", 40)
         SendMessage_(GadgetID(#ListIconStructures), #LVM_SETBKCOLOR, 0, $E3E5D9)
         SendMessage_(GadgetID(#ListIconStructures), #LVM_SETTEXTBKCOLOR, 0, $E3E5D9)
         SortStructuredList(Nom_Structure(), 0, 0, #PB_Sort_String ) ; [, Debut, Fin])
         If ListIndex(Structures()) > 0
            nbdstr.l=0
            prem_posd_str.l=0
            ForEach Nom_Structure() ; Affichage des structures
               AddGadgetItem(#ListIconStructures, -1, Nom_Structure()\Nom_Structure$ + Chr(10)+ Nom_Structure()\FichierOrigine$+ Chr(10) +Str(Nom_Structure()\TailleStructure)+ Chr(10)+ Str(Nom_Structure()\Nb_ElementsStructure)+ Chr(10)+Str(Nom_Structure()\IndexStructureDansListe) )
               ;Debug Str(nom_Structure()\IndexStructureDansListe);
               ; )
               ;________________________________________________________Recherche des doublons dans les structures_______________________________________________________________________
               
               If mnomc$=Nom_Structure()\Nom_Structure$
                  posc.l=ListIndex(Nom_Structure())
                  SetGadgetItemColor(#ListIconStructures, posc, #PB_Gadget_BackColor , RGB(255,0,0),-1) ; [, Colonne (-1 toute la ligne)])
                  SetGadgetItemColor(#ListIconStructures, posc, #PB_Gadget_FrontColor , RGB(255,255,0),-1) ; [, Colonne])
                  nbdstr+1
                  If prem_posd_str=0
                     prem_posd_str.l=posc
                     dern_posd_str.l=posc
                  Else
                     dern_posd_str.l=posc
                  EndIf
                  
               Else
                  ;SetGadgetColor(#ListIconConstantes, #PB_Gadget_FrontColor,-1)
               EndIf
               mnomc$=Nom_Structure()\Nom_Structure$
               
            Next
            HideGadget(#ListIconConstantes, 0)
         EndIf
      EndIf
      
      HideGadget(#ListIconStructures, 0)
   EndIf
   ;              If PureLVSORT_SelectGadgetToSort(#ListIconStructures, #PureLVSORT_ShowClickedHeader_IconLeft) = #PureLVSORT_Ok
   ;                PureLVSORT_SetColumnType(#ListIconStructures, 0, #PureLVSORT_String_CaseSensitive) ; default, not necessary
   ;                PureLVSORT_SetColumnType(#ListIconStructures, 1, #PureLVSORT_String_CaseSensitive) ; default, not necessary
   ;                PureLVSORT_SetColumnType(#ListIconStructures, 2, #PureLVSORT_String) ; default, not necessary
   ;                PureLVSORT_SetColumnType(#ListIconStructures, 3, #PureLVSORT_String) ; default, not necessary
   ;                ;PureLVSORT_SetColumnType(#ListIconStructures, 4, #PureLVSORT_String_CaseSensitive) ; default, not necessary
   ;              EndIf
   ;=================================================== Début exploitation des interfaces ====================================================
   
   ; 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()
   ; 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
   
   If ListIconGadget(#ListIconInterfaces, WindowWidth(#Fenetre_Principale)/2+50, 300, WindowWidth(#Fenetre_Principale)-450, WindowHeight(#Fenetre_Principale)/2-10, " Interfaces (" + Str(ListSize(Nom_ListeInterfaces())) + " références)", WindowWidth(#Fenetre_Principale)/2-190, #PB_ListIcon_FullRowSelect | #PB_ListIcon_AlwaysShowSelection)
      HideGadget(#ListIconInterfaces, 1)
      AddGadgetColumn(#ListIconInterfaces, 1, " Fichier résident", 120)
      SendMessage_(GadgetID(#ListIconInterfaces), #LVM_SETBKCOLOR, 0, $CBE2CD)
      SendMessage_(GadgetID(#ListIconInterfaces), #LVM_SETTEXTBKCOLOR, 0, $CBE2CD)
      GadgetToolTip(#ListIconInterfaces, "LES entités en jaune sur fond rouge sont des doublons. Cliquer sur une tête de colonne pour trier dans un sens ou dans l'autre")
      SortStructuredList(Nom_ListeInterfaces(), 0, OffsetOf(Nom_ListeInterfaces\Nom_Interface$), #PB_Sort_String ) ; [, Debut, Fin])
      
      If ListIndex(Nom_ListeInterfaces()) > 0
         nbdint=0
         prem_posd_int.l=0
         ForEach Nom_ListeInterfaces() ; Affichage des interfaces
            AddGadgetItem(#ListIconInterfaces, -1, Nom_ListeInterfaces()\Nom_Interface$+Chr(10)+Nom_ListeInterfaces()\FichierOrigine$)
            ;________________________________________________________Recherche des doublons dans les interfaces_______________________________________________________________________
            If mnomc$=Nom_ListeInterfaces()\Nom_Interface$
               posc.l=ListIndex(Nom_ListeInterfaces())
               SetGadgetItemColor(#ListIconInterfaces, posc, #PB_Gadget_BackColor , RGB(255,0,0),-1) ; [, Colonne])
               SetGadgetItemColor(#ListIconInterfaces, posc, #PB_Gadget_FrontColor , RGB(255,255,0),-1) ; [, Colonne])
               nbdint+1
               If prem_posd_int=0
                  prem_posd_int.l=posc
                  dern_posd_int.l=posc
               Else
                  dern_posd_int.l=posc
               EndIf
            Else
               ;SetGadgetColor(#ListIconConstantes, #PB_Gadget_FrontColor,-1)
               
            EndIf
            mnomc$=Nom_ListeInterfaces()\Nom_Interface$
            
         Next
      EndIf
      HideGadget(#ListIconInterfaces, 0)
   EndIf
EndIf
;              If PureLVSORT_SelectGadgetToSort(#ListIconInterfaces, #PureLVSORT_ShowClickedHeader_IconLeft) = #PureLVSORT_Ok
;                PureLVSORT_SetColumnType(#ListIconInterfaces, 0, #PureLVSORT_String_CaseSensitive) ; default, not necessary
;                PureLVSORT_SetColumnType(#ListIconInterfaces, 1, #PureLVSORT_String_CaseSensitive) ; default, not necessary
;                ;PureLVSORT_SetColumnType(#ListIconInterfaces, 2, #PureLVSORT_String) ; default, not necessary
;                ;PureLVSORT_SetColumnType(#ListIconInterfaces, 3, #PureLVSORT_String) ; default, not necessary
;                ;PureLVSORT_SetColumnType(#ListIconInterfaces, 4, #PureLVSORT_String_CaseSensitive) ; default, not necessary
;              EndIf

;____________________________________________________ Position des premiers éléments en double __________________________________________________________________

SetListPos (#ListIconConstantes, prem_posd_cst)
SetListPos (#ListIconStructures, prem_posd_str)
SetListPos (#ListIconInterfaces, prem_posd_int)

; ForEach Constantes()
; AddGadgetItem(#ListIconConstantes, -1, Constantes()\Nom_Constante$

;ForEach Nom_Structure() ; Affichage des structures
;AddGadgetItem(#ListIconStructures, -1, Nom_Structure()\Nom_Structure$

;ForEach Nom_ListeInterfaces() ; Affichage des interfaces
;AddGadgetItem(#ListIconInterfaces, -1, Nom_ListeInterfaces()\Nom_Interface$
;____________________________________________________ Messages des Constantes structures ou interfaces en double __________________________________________________________________
If nbdcst>0
   ; StringGadget(#StringGadgetCst, 10, 05, 240, 20, "")
   SelectElement(Constantes(), prem_posd_cst)
   prem$= Constantes()\Nom_Constante$
   SelectElement(Constantes(), dern_posd_cst)
   dern$=Constantes()\Nom_Constante$
   TextGadget(#mess_cst,10, 70, 240,50,Str(nbdcst)+ " Constantes en Double Début//Fin : " +#LFCR$+" " +prem$+#LFCR$+" "+dern$,#PB_Text_Center)
   SetGadgetColor(#mess_cst, #PB_Gadget_FrontColor, RGB(255,255,0))
   SetGadgetColor(#mess_cst, #PB_Gadget_BackColor, RGB(255,0,0))
Else
   TextGadget(#mess_cst,10,90, 240,20, " Les Constantes n'ont aucun Double",#PB_Text_Center )
   SetGadgetColor(#mess_cst, #PB_Gadget_FrontColor, RGB(255,255,0))
   SetGadgetColor(#mess_cst, #PB_Gadget_BackColor, RGB(0,0,$FF))
   
EndIf
If nbdstr>0
   ; StringGadget(#StringGadgetCst, 10, 05, 240, 20, "")
   SelectElement(Nom_Structure() , prem_posd_str)
   prem$= Nom_Structure()\Nom_Structure$
   SelectElement(Constantes(), dern_posd_str)
   dern$=Nom_Structure()\Nom_Structure$
   TextGadget(#mess_str,10, 125, 240,50,Str(nbdstr)+ " Structures en Double Début//Fin : " +#LFCR$+" " +prem$+#LFCR$+" "+dern$,#PB_Text_Center)
   SetGadgetColor(#mess_str, #PB_Gadget_FrontColor, RGB(255,255,0))
   SetGadgetColor(#mess_str, #PB_Gadget_BackColor, RGB(255,0,0))
Else
   TextGadget(#mess_str,10,145, 240,20, " Les Structures n'ont aucun Double",#PB_Text_Center )
   SetGadgetColor(#mess_str, #PB_Gadget_FrontColor, RGB(255,255,0))
   SetGadgetColor(#mess_str, #PB_Gadget_BackColor, RGB(0,0,$FF))
   
EndIf
If nbdint>0
   ; StringGadget(#StringGadgetCst, 10, 05, 240, 20, "")
   SelectElement(Nom_ListeInterfaces() , prem_posd_int)
   prem$= Nom_ListeInterfaces()\Nom_Interface$
   SelectElement(Nom_ListeInterfaces(), dern_posd_int)
   dern$=Nom_ListeInterfaces()\Nom_Interface$
   TextGadget(#mess_int,10, 180, 240,50,Str(nbdint)+ " Interfaces en Double Début//Fin :" +#LFCR$+" " +prem$+#LFCR$+" "+dern$,#PB_Text_Center)
   SetGadgetColor(#mess_int, #PB_Gadget_FrontColor, RGB(255,255,0))
   SetGadgetColor(#mess_int, #PB_Gadget_BackColor, RGB(255,0,0))
Else
   TextGadget(#mess_int,10,200, 240,20, " Les Interfaces n'ont aucun Double",#PB_Text_Center )
   SetGadgetColor(#mess_int, #PB_Gadget_FrontColor, RGB(255,255,0))
   SetGadgetColor(#mess_int, #PB_Gadget_BackColor, RGB(0,0,$FF))
   
EndIf

If nbdcst+nbdstr+nbdint=0
   TextGadget(#mess_int+1,10,250, 240,20, " AUCUN DOUBLON TOUT EST OK",#PB_Text_Center )
   SetGadgetColor(#mess_int+1, #PB_Gadget_FrontColor, RGB(255,255,0))
   SetGadgetColor(#mess_int+1, #PB_Gadget_BackColor, RGB(0,0,$FF))
EndIf
HideWindow(#Fenetre_Principale, 0)
;Les évènements suivants sont supportés par EventType():
; #PB_EventType_LeftClick : Clic avec le bouton gauche de la souris, ou une Case à cocher a été utilisée.
; #PB_EventType_LeftDoubleClick : Double-clic avec le bouton gauche de la souris
; #PB_EventType_RightClick : Clic avec le bouton droit de la souris
; #PB_EventType_RightDoubleClick : Double-clic avec le bouton droit de la souris
; #PB_EventType_Change : l'élément sélectionné a été changé
;=========================================================== Boucle des événements Windows ================================================
flag_tri_cst.l=1
flag_tri_str.l=1
flag_tri_int.l=1
Repeat
   event = WaitWindowEvent()
   Select event
      Case #PB_Event_CloseWindow
         quit + 1
         
      Case #PB_Event_Gadget
         Select EventGadget()
            Case #BoutonRechercherCst
               ;                          flag_tri_cst.l=PureLVSORT_GetSortingDirection(#ListIconConstantes)
               ;                          If flag_tri_cst=1
               ;                            If PureLVSORT_GetClickedColumn(#ListIconConstantes)<>0
               ;                              ; il faut trier sur le NOM
               ;                              PureLVSORT_SortListIconNow(#ListIconConstantes, 0, 1)
               ;                            EndIf
               ;                          Else
               ;                            If flag_tri_cst<>0
               ;                              ; il faut trier sur le NOM
               ;                              PureLVSORT_SortListIconNow(#ListIconConstantes, 0, 1)
               ;                            EndIf
               ;                          EndIf
               
               rech_dicho(#ListIconConstantes)
               flag_tri_cst.l=1
            Case #BoutonRechercherStruc
               ;                          flag_tri_str.l=PureLVSORT_GetSortingDirection(#ListIconStructures)
               ;                          If flag_tri_str=1
               ;                            If PureLVSORT_GetClickedColumn(#ListIconStructures)<>0
               ;                              ; il faut trier sur le NOM
               ;                              PureLVSORT_SortListIconNow(#ListIconStructures, 0, 1)
               ;                            EndIf
               ;                          Else
               ;                            If flag_tri_str<>0
               ;                              ; il faut trier sur le NOM
               ;                              PureLVSORT_SortListIconNow(#ListIconStructures, 0, 1)
               ;                            EndIf
               ;                          EndIf
               rech_dicho(#ListIconStructures)
               flag_tri_str.l=1
            Case #BoutonRechercherInterface
               ;                          flag_tri_int.l=PureLVSORT_GetSortingDirection(#ListIconInterfaces)
               ;                          If flag_tri_int=1
               ;                            If PureLVSORT_GetClickedColumn(#ListIconInterfaces)<>0
               ;                              ; il faut trier sur le NOM
               ;                              PureLVSORT_SortListIconNow(#ListIconInterfaces, 0, 1)
               ;                            EndIf
               ;                          Else
               ;                            If flag_tri_int<>0
               ;                              ; il faut trier sur le NOM
               ;                              PureLVSORT_SortListIconNow(#ListIconInterfaces, 0, 1)
               ;                            EndIf
               ;                          EndIf
               
               rech_dicho(#ListIconInterfaces)
               flag_tri_int.l=1
            Default
         EndSelect
         ;;Debug EventGadget()
         ; If EventType() = #PB_EventType_LeftDoubleClick
         ; PureLVSORT_ClearGadget(#ListIconConstantes)
         ; PureLVSORT_ClearGadget(#ListIconStructures)
         ; PureLVSORT_ClearGadget(#ListIconInterfaces)
         ; flag_tri_cst.l=PureLVSORT_GetSortingDirection(#ListIconConstantes)
         ; flag_tri_str.l=PureLVSORT_GetSortingDirection(#ListIconStructures)
         ; flag_tri_int.l=PureLVSORT_GetSortingDirection(#ListIconInterfaces)
         ; Debug "ef_cst"+Str(flag_tri_cst)
         ; Debug "ef_str"+Str(flag_tri_str)
         ; Debug "ef_int"+Str(flag_tri_int)
         ; EndIf
         ; flag_tri_cst.l=PureLVSORT_GetSortingDirection(#ListIconConstantes)
         ; flag_tri_str.l=PureLVSORT_GetSortingDirection(#ListIconStructures)
         ; flag_tri_int.l=PureLVSORT_GetSortingDirection(#ListIconInterfaces)
         ; Debug "f_cst"+Str(flag_tri_cst)
         ; Debug "f_str"+Str(flag_tri_str)
         ; Debug "f_int"+Str(flag_tri_int)
      Case #WM_KEYDOWN
         Select EventwParam()
            Case #PB_Shortcut_Return
               If GetFocus_() = GadgetID(#StringGadgetCst)
                  rech_dicho(#ListIconConstantes)
                  flag_tri_cst.l=1
               ElseIf GetFocus_() = GadgetID(#StringGadgetCst)
                  rech_dicho(#ListIconStructures)
                  flag_tri_str.l=1
               ElseIf GetFocus_() = GadgetID(#StringGadgetCst)
                  rech_dicho(#ListIconInterfaces)
                  flag_tri_int.l=1
               EndIf
            Default
         EndSelect
         
   EndSelect
Until quit



Top
 Profile  
Reply with quote  
 Post subject: Re: List of macros, and other information in the resident
PostPosted: Sun Nov 11, 2012 5:27 pm 
Offline
Addict
Addict
User avatar

Joined: Wed Dec 23, 2009 10:14 pm
Posts: 2966
Location: Boston, MA
Thanks very much PAPIPP :!: :shock:

_________________
The nice thing about standards is there are so many to choose from. ~ Andrew Tanenbaum


Top
 Profile  
Reply with quote  
 Post subject: Re: List of macros, and other information in the resident
PostPosted: Mon Nov 12, 2012 6:13 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4461
Location: Lyon - France
Very usefull, thanks a lot 8)

_________________
ImageThe happiness is a road...
Not a destination


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 4 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: GoodNPlenty and 4 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye