Liste des macros et autres infos dans les fichiers résidents

Partagez votre expérience de PureBasic avec les autres utilisateurs.
PAPIPP
Messages : 534
Inscription : sam. 23/févr./2008 17:58

Liste des macros et autres infos dans les fichiers résidents

Message par PAPIPP »

Bonjour à tous.
Denis avait réalisé en 2006 avec l’aide de FRED une analyse du fichier des résidents.
http://www.purebasic.fr/english/viewtop ... t=resident
Et pour Comtois qui demandait la liste des macros :http://www.purebasic.fr/english/viewtop ... ilit=macro
Les fichiers résidents du répertoire RESIDENTS sont des informations non compilées des 5 types d’objets nécessaires à PB.
Nous pouvons nous même installer un de ces types dans le fichier résident avec pbcompiler.exe option /RESIDENT voir doc.
Nous trouvons dans ces fichiers résidents:
Les Constantes.
Les Structures.
Les interfaces.
Les Macros.
Les Prototypes.
Depuis quelques années ce programme ne fonctionnait plus (passage à la structure RES5).
Par ailleurs ce PRG ne listait que 3 types (Constantes Structures et Interfaces).
Après quelques galères j’ai réussi à le faire fonctionner sur RES5.
J’en ai profité pour extraire aussi les Macros.
Il ne me reste plus que les prototypes à extraire, mais je n’ai pas encore vu une seule info stockée dans cette rubrique.
Pour fonctionner le PRG doit nécessairement être sur un répertoire RESIDENTS. Il ne démarre pas dans le cas contraire.

Il y a 3 PRG :
Le premier extrait les constantes les structures les interfaces et les macros.
Le deuxième remet en forme les macros extraites.
Le troisième vérifie s’il n’y a pas de doublon dans les constantes les structures ou les interfaces.
Chacun de ces PRG peu être accolé au premier soit physiquement soit par appel.
IncludeFile "NomFichier"
XIncludeFile "NomFichier"

Premier PRG d’extraction des CONSTANTES STRUCTURES INTERFACES ET MACROS.

Code : Tout sélectionner

; 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
;________________________________________________________________________________________________________________________________________________________
LectureResident()
Deuxième PRG de remise en forme des macros extraites

Code : Tout sélectionner

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:
Le troisième PRG dans le post suivant
A+
Dernière modification par PAPIPP le jeu. 01/nov./2012 23:44, modifié 3 fois.
Il est fort peu probable que les mêmes causes ne produisent pas les mêmes effets.(Einstein)
Et en logique positive cela donne.
Il est très fortement probable que les mêmes causes produisent les mêmes effets.
PAPIPP
Messages : 534
Inscription : sam. 23/févr./2008 17:58

Re: Liste des macros et autres infos dans les fichiers résid

Message par PAPIPP »

Troisième PRG vérifie s’il n’y a pas de doublon dans les constantes les structures ou les interfaces.

Code : Tout sélectionner

;***************************************************************************************************************************

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
A+
Il est fort peu probable que les mêmes causes ne produisent pas les mêmes effets.(Einstein)
Et en logique positive cela donne.
Il est très fortement probable que les mêmes causes produisent les mêmes effets.
PAPIPP
Messages : 534
Inscription : sam. 23/févr./2008 17:58

Re: Liste des macros et autres infos dans les fichiers résid

Message par PAPIPP »

Bonjour à tous

L’équipe de purebasic nous propose de voir et d’utiliser 3 éléments stockés dans le répertoire RESIDENTS ce sont :
1) les structures
2) les interfaces
3) les constantes
Les prototypes et les macros ne sont pas accessibles
Par ailleurs la structure des fichiers du répertoire RESIDENTS change souvent
Nous en sommes aujourd’hui avec PB520LTS à la 7em version (RES7)

Voici un prg qui permet de lister les macros résiduelles ou les macros que vous placerez vous-même
Dans le répertoire RESIDENTS
On peut récupérer le corps de la macro et la modifier localement (Changer son nom pour éviter une erreur)

Ce prg couvre les RESIDENTS depuis PB431 à PB520
Par défaut le prg cherche le répertoire RESIDENTS #PB_Compiler_Home+"Residents\
Si vous désirer rechercher une autre répertoire RESIDENTS Placez un paramètre quelconque dans l’exécution du prg.exe aaa par exemple ou dans :
option du compilateur _ Compiler/ exécuter _ Paramètres de l’exécutable (tapez un ou plusieurs caractères par exemple a ou abc xxx)

Code : Tout sélectionner

; Auteur :  PAPIPP
; Version de PB : DE PB431 à PB520
; Date :19/10/2013
Procedure.l GetScreenDPI(horiz.b=#False)
  ; Get screen dots per inch vertically (default) or horizontally
  Protected hdc,dpi
  hdc=GetDC_(0) ; Desktop device context
  If horiz
    dpi=GetDeviceCaps_(hdc,#LOGPIXELSX)
  Else
    dpi=GetDeviceCaps_(hdc,#LOGPIXELSY)
  EndIf
  ReleaseDC_(0,hdc)
  ProcedureReturn dpi
EndProcedure

Procedure.l GetFontHeight(gadget)
  ; Get gadget font height in points (to the nearest integer)
  Protected fontid,finfo.LOGFONT,height
  fontid=SendMessage_(GadgetID(gadget),#WM_GETFONT,0,0)
  PoliceID=GetGadgetFont(gadget)
  ;   Debug _n(fontid)+_n(policeID) ; Les deux valeurs sont identiques
  
  GetObject_(fontid,SizeOf(LOGFONT),@finfo)
  height=finfo\lfHeight:If height<0:height=-height:EndIf
  ;               ; Must do floating point arithmetic on the next line to get the right result
  height*72.0/GetScreenDPI() ; Possibly the 72.0 is wrong and should be 72.27
  ProcedureReturn height ; Font size
EndProcedure

Procedure.s GetFontName(gadget)
  ; Get gadget font name
  Protected fontid,finfo.LOGFONT
  fontid=SendMessage_(GadgetID(gadget),#WM_GETFONT,0,0)
  GetObject_(fontid,SizeOf(LOGFONT),@finfo)
  ProcedureReturn PeekS(@finfo\lfFaceName[0]) ; Font name
EndProcedure

Procedure.s GetFontFlags(gadget)
  ; Get gadget font attributes as an uppercase text string
  Protected fontid,finfo.LOGFONT,flags$
  fontid=SendMessage_(GadgetID(gadget),#WM_GETFONT,0,0)
  GetObject_(fontid,SizeOf(LOGFONT),@finfo)
  flags$="" ; Font flags
  If finfo\lfWeight>#FW_NORMAL:flags$+"B":EndIf ; Bold
  If finfo\lfItalic:flags$+"I":EndIf ; Italic
  If finfo\lfQuality<>#DEFAULT_QUALITY:flags$+"Q":EndIf ; High Quality
  If finfo\lfStrikeOut:flags$+"S":EndIf ; StrikeOut
  If finfo\lfUnderline:flags$+"U":EndIf ; Underline
  ProcedureReturn flags$ ; Font attributes
EndProcedure
Procedure.l GetFontATT(gadget)
  ; Get gadget font attributes as an uppercase text string
  Protected fontid,finfo.LOGFONT,Attribut
  fontid=SendMessage_(GadgetID(gadget),#WM_GETFONT,0,0)
  GetObject_(fontid,SizeOf(LOGFONT),@finfo)
  Attribut=0 ; Font flags
  If finfo\lfWeight>#FW_NORMAL:Attribut+Attribut | #PB_Font_Bold:EndIf ; Bold
  If finfo\lfItalic:Attribut+Attribut | #PB_Font_Italic:EndIf ; Italic
  If finfo\lfQuality<>#DEFAULT_QUALITY:Attribut+Attribut | #PB_Font_HighQuality:EndIf ; High Quality
  If finfo\lfStrikeOut:Attribut+Attribut | #PB_Font_StrikeOut:EndIf ; StrikeOut
  If finfo\lfUnderline:Attribut+Attribut | #PB_Font_Underline:EndIf ; Underline
  ProcedureReturn Attribut ; Font attributes
EndProcedure


Declare Lecture_Resident()
#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
  #StringGadgetCst
  #StringGadgetStruc
  #StringGadgetInterface
  #Container1
  #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
  #res6
  #res7
  #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 Macros
  Nom_Macro$
  FichierResident$
  Ligne_param$                                  
EndStructure
Structure Macrom
  Nom_Macro$
  type.b
  NB_PARAM.l                    
  PARAM${26}[25]
  Ligne_macro$                   
EndStructure


;- ---  listes chaînées  -----------------
Global NewList Macros.Macros()
Global NewMap Macrom.Macrom()

Global PbConstantFolder$,Prem_lg$,Liste_MACR$
Global ListIcon_0,ListIcon_2,Button_0,Button_1,Text_0

Define posit.POINT



Procedure ExtractionMACRO(ResType.l,*PointeurDebut.long)
  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 "****************************** EXTRACTION DES MACROS ************************************************"
    If AddElement(Macros())
      *deb_MACRO=*PointeurDebut
      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 =  M_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 Lecture_Resident()
  Protected CheminDir.l,TailleFichier.l
  Protected *ConstantsHeader.long,*SymbolCourant.long,*ConstantsEnd.long,RES.l,*PARTRESEND,long
  Protected TotalCaracteresToutesStructures.l,*DernierSymbol.long
  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$
  ;***********************************************************************************************************************
  ;  Il suffit de placer n'importe quel caractère comme paramètre pour déclencher une recherche d'un répertoire RESIDENT
  ;***********************************************************************************************************************
  Nb_param=CountProgramParameters()
  ;   Dim Tparam.s{256}(Nb_param)
  ;   For param=0 To NB_PARAM
  ;     Tparam(param)=ProgramParameter(Param)
  ; ;     If Tparam(param)<>""
  ; ;       If LCase(Tparam(param))="/notepad"
  ; ;        xxxxxxxxxx
  ; ;       Else
  ; ;        xxxxxxxxxx
  ; ;       EndIf
  ;     EndIf
  ;   Next
  titre$="Choisissez le répertoire des Résidents de PureBasic xxx"+#LF$
  PbConstantFolder$=#PB_Compiler_Home+"Residents\"
  If Nb_param>0
    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
  Else
  EndIf
  ;***************************************************************************************************************
  ;;; ; PbConstantFolder$ = #PB_Compiler_Home + "Residents\"
  If ExamineDirectory(0,PbConstantFolder$,"*.res")
    ClearList(Macros()) :
    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
          RES=#res5
          If PeekC(*SymbolCourant+8)>52
            *SymbolCourant+12; deb+12
            While *SymbolCourant<*ConstantsEnd
              Tres.l=PeekL(*SymbolCourant)
              *SymbolCourant+4
              Select Tres
                  
                Case 'CNST' ; c'est les cosntantes seules
                  *SymbolCourant+PeekL(*SymbolCourant)
                Case 'RCAM' ; c'est les macros
                  *SymbolCourant=ExtractionMACRO(RES,*SymbolCourant)
                Case 'TORP' ; c'est les prototypes
                  *SymbolCourant+PeekL(*SymbolCourant)
                Case 'SRCT' ; C'est les srtuctures et interfaces
                  *SymbolCourant+PeekL(*SymbolCourant)
              EndSelect
            Wend
          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
          
        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
EndProcedure

;________________________________________________________________________________________________________________________________________________________

Procedure InitWindow_0()
  Window_0=OpenWindow(#PB_Any,0,0,835,460,"",#PB_Window_SystemMenu)
  ListIcon_0=ListIconGadget(#PB_Any,10,39,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,39,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,25,2,755,18,"Fichier :"+PbConstantFolder$); +"   "+Str(nb_macro)+" Macros(Cliquez dans la colonne macros pour obtenir le détail de la Macro)")
  Text_1=TextGadget(#PB_Any,25,21,755,18," "+Str(nb_macro)+" Macros(Cliquez sur le nom dans la colonne macros pour obtenir le détail de la Macro)",#PB_Text_Center)
  
  ;   Text_0 = TextGadget(#PB_Any, 355, 5, 170, 20,"   "+ Str(nb_macro)+"    Macros ")
  
  ResetList(Macros())               ; Reset the list index before the first element.
  ;************************************************************************************************************************
  ; Le tri sortstructuredlist est un tri stable c'est à dire que sur deux tris successifs sur des infos différentes
  ; il conserve le premier tri relatif dans le deuxième tri.
  ;************************************************************************************************************************
  SortStructuredList(Macros(),#PB_Sort_NoCase,OffsetOf(Macros\Nom_Macro$),TypeOf(Macros\Nom_Macro$))
  SortStructuredList(Macros(),#PB_Sort_NoCase,OffsetOf(Macros\FichierResident$),TypeOf(Macros\FichierResident$))
  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,Left(macros()\Nom_Macro$+Space(100),26)+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_mi=GetGadgetItemState(listIcon_0,0)
          ;           Elem_ma=GetGadgetItemState(listIcon_0,0)
          
          Elem_m$=Trim(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 M_resultat$(0)
            If M_flagx=0
              M_hld0=CreateRegularExpression(#PB_Any,"[^\x01]+") ; structure [+-]n[nnnnn].n[n] Pour un nombre réel quelconque
              M_flagx=2
            EndIf
            M_nb_z=ExtractRegularExpression(M_hld0,macrom()\Ligne_macro$,M_resultat$());
            For M_termi=0 To M_nb_z-1
              AddGadgetItem(listIcon_2,-1,M_resultat$(M_termi))
              prem_lg$+M_resultat$(M_termi)+#LF$
            Next
            AddGadgetItem(listIcon_2,-1,"EndMacro")
            prem_lg$+"EndMacro"
            SendMessage_(GadgetID(listIcon_2),#WM_SETFONT,FontID(00),1)
            
          Else
            
            Elem_mm=0
            Elem_m$=""
            ClearGadgetItems(listIcon_2)
            ;****************************** fonts *****************************************************************
            ;
            
            col_listIcon_2=GetGadgetItemColor(listIcon_2,-1,#PB_Gadget_FrontColor)
            SetGadgetItemColor(listIcon_2,-1,#PB_Gadget_FrontColor,RGB(255,0,0))
            
            AddGadgetItem(listIcon_2,-1,"Cliquez sur le nom de la macro ")
            AddGadgetItem(listIcon_2,-1,"        dans la colonne Macros")
            
            col_listIcon_2=GetGadgetItemColor(listIcon_2,-1,#PB_Gadget_FrontColor)
            SetGadgetItemColor(listIcon_2,-1,#PB_Gadget_FrontColor,RGB(255,0,0))
            SetGadgetFont(#PB_Default,FontID(10))
            ;  SendMessage_(GadgetID(listIcon_2),#WM_SETFONT,LoadFont(10,"",12,#PB_Font_Bold | #PB_Font_Italic|#PB_Font_Underline|#PB_Font_HighQuality),1)
            SendMessage_(GadgetID(listIcon_2),#WM_SETFONT,FontID(10),1)
            
            ;******* Modification de la police d'entête en police d'origine  *****************
            
            header=SendMessage_(GadgetID(listIcon_2),#LVM_GETHEADER,0,0)
            SendMessage_(header,#WM_SETFONT,FontID(00),1)
            
            ;******************************** fin font ********************************************************************
          EndIf
        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
Lecture_Resident()
InitWindow_0()
;************** sauvegarde des caractéristiques de la police d'origine *********************************
Taille_F00=GetFontHeight(listIcon_2)
Atts_F00.s=GetFontFlags(listIcon_2)
Name_F00.s=GetFontName(listIcon_2)
Att_F00=GetFontATT(listIcon_2)
LoadFont(00,Name_F00,Taille_F00,Att_F00)
; ******************* chargement en 10 d'une autre police ***************************
LoadFont(10,"Arial",12,#PB_Font_Bold | #PB_Font_Italic | #PB_Font_HighQuality)

Repeat
  event=WaitWindowEvent()
Until Window_0_Events(event)=#False
fin:

A+
Dernière modification par PAPIPP le ven. 25/oct./2013 7:54, modifié 1 fois.
Il est fort peu probable que les mêmes causes ne produisent pas les mêmes effets.(Einstein)
Et en logique positive cela donne.
Il est très fortement probable que les mêmes causes produisent les mêmes effets.
Avatar de l’utilisateur
kernadec
Messages : 1594
Inscription : ven. 25/avr./2008 11:14

Re: Liste des macros et autres infos dans les fichiers résid

Message par kernadec »

bonjour PAPIPP

Merci de partager tout ce travail de précision

Bonne journée
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Re: Liste des macros et autres infos dans les fichiers résid

Message par Backup »

oui, lorsque j'aurai compris a quoi ça sert , je m'en servirai peut etre :)
Avatar de l’utilisateur
Thyphoon
Messages : 2697
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Re: Liste des macros et autres infos dans les fichiers résid

Message par Thyphoon »

Dobro a écrit :oui, lorsque j'aurai compris a quoi ça sert , je m'en servirai peut etre :)
je suis un peu pareil ! Excusez mon ignorance mais ça sert a quoi ? :P
PAPIPP
Messages : 534
Inscription : sam. 23/févr./2008 17:58

Re: Liste des macros et autres infos dans les fichiers résid

Message par PAPIPP »

Bonjour Dobro et Thyphoon

Les macros ne sont pas indispensables à la programmation mais elles servent à décharger le code et de la sorte elles le rendent plus léger et plus claire.
On peut ainsi placer les macros devant tout code et les appeler au fur et à mesure de ses besoins
Certaines macros devront être placées dans chaque Prg, ou dans chaque module
Ceci multiplie les mêmes macros qui continuent à « polluer » le code
Enfin les macros peuvent être appelées par d’autres macros.
Et avec l’option modules dans PB520 les macros du prg principale ne sont pas vues dans les modules et réciproquement

Une solution simple est de les placer dans le répertoire RESIDENTS comme les structures et les constantes

Elles seront ainsi disponibles dans tout les prg et dans tous les modules sans polluer le code

Quelques exemples de macros dont je me sers pour débuguer ou programmer

Code : Tout sélectionner

Macro _q_t_ ; cette macro génère chr(34)
"
EndMacro

Macro _n (__n) ; cette macro associée à la précédente liste le nom de variable et son contenu en décimal
_q_t_#__n#=_q_t_+Str(__n)+" " ; 
EndMacro

Macro _B (__B,_pr="%") ; macro associée à la première liste le nom de variable et son contenu en binaire
_q_t_#__B#=_q_t_+_pr+Bin(__B)+" "
EndMacro

Macro _f (__F,__nv=8) ; cette macro liste le nom de la variable et son contenu en simple précision  
_q_t_#__F#=_q_t_+StrF(__f,__nv)+" "  
EndMacro

Macro _d (__D,__nv=8) ; ; macro associée à la première liste le nom de variable et son contenu en double précision  
_q_t_#__D#=_q_t_+StrD(__D,__nv)+" "
EndMacro

Macro _H (__H,__nv=#PB_Quad,_pr="$"); cette macro liste le nom de la variable et son contenu en Hexa  
_q_t_#__H#=_q_t_+_pr+RSet(Hex(__H,__nv),__nv*4,"0")+" "
EndMacro

Macro _s (__S) ; cette macro liste le nom de la variable et son contenu en alpha 
_q_t_#__S#=_q_t_+__S+" "
EndMacro

Macro _U (__U); cette macro liste le nom de la variable et son contenu en Unicode
_q_t_#__U#=_q_t_+StrU(__U)+" "
EndMacro

Macro _NL; cette macro donne le N° de ligne là où elle est appelée. elle peut servir de trace ou de repère ou même de N° d’erreur
"N°L=" + Str(#PB_Compiler_Line) + " ** "
EndMacro

Macro __nbc(__cc); cette macro recherché le nb de cycles machine pour optimiser le code
  __cc.q
  !RDTSC
  !PUSH edx
  !PUSH eax
  !POP dword[v_#__cc]
  !POP dword[v_#__cc+4]
EndMacro


Macro S_wap (a__,b__); cette macro swap les adresses de 2 tableaux identiques à partir de PB520 l car swap sur tableaux est KO
EnableASM
!pushd [a_#a__] [a_#b__]
!popd [a_#a__] [a_#b__]
DisableASM
EndMacro

Macro _AN_BIS (x); cette macro définie si une année x est bissextile ou non 
((Not((x%4)<>0)) & ((1-(Not((x%100)<>0)) ) | (Not(((x>>2)%100)<>0)) ) )
EndMacro
ETC.. je peux continuer comme cela et remplir 3 ou 4 pages vous pouvez vous même en développer.

Exemple d’utilisation

Code : Tout sélectionner

deb1.q
fin1.q
__nbc(deb1)
Debug _NL+_n(deb1)
__nbc(fin1)
Debug  _Nl+_n(fin1)+_n(Fin1-DEB1)+_n(DEB1) ; ici utilisée avec debug ou messagerequester() ou printn()

Or si vous avez une cinquantaine ou une centaine de macros dont vous vous servez continuellement
Il est bon de les placer dans le répertoire RESIDENTS

Principaux avantages des macros en RESIDENTS
1) disponibles dans tous les PRG sans être vues
2) Simplifie la programmation
3) Décharge le programmeur
4) Améliore la souplesse de programmation
5) Après compilation elles sont intégrées au Prg (seul inconvénient ne pas oublier de les donner avec la source)
Il est fort peu probable que les mêmes causes ne produisent pas les mêmes effets.(Einstein)
Et en logique positive cela donne.
Il est très fortement probable que les mêmes causes produisent les mêmes effets.
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Re: Liste des macros et autres infos dans les fichiers résid

Message par Backup »

ok , merci :)
Avatar de l’utilisateur
Thyphoon
Messages : 2697
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Re: Liste des macros et autres infos dans les fichiers résid

Message par Thyphoon »

Merci ! Effectivement je comprends mieux l’intérêt de la chose !! :)
Avatar de l’utilisateur
Ar-S
Messages : 9472
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: Liste des macros et autres infos dans les fichiers résid

Message par Ar-S »

L’intérêt des Macros est certain, celui de les mettre dans le rep Resident l'est aussi.
Désolé si ça vous parait bête mais pour ajouter un fichier de macros dedans, il ne suffit pas de mettre un simple .pbi dans le dossier residents vu l'extension .res ? Comment procède t on ?
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Re: Liste des macros et autres infos dans les fichiers résid

Message par Backup »

Ar-S a écrit :L’intérêt des Macros est certain, celui de les mettre dans le rep Resident l'est aussi.
Désolé si ça vous parait bête mais pour ajouter un fichier de macros dedans, il ne suffit pas de mettre un simple .pbi dans le dossier residents vu l'extension .res ? Comment procède t on ?
tu peux compiler un resident avec EPB ;) option "creer un résident"
un *.Res se compile :)

(rhooo , comment je la vend bien ma sauce :lol: )
Avatar de l’utilisateur
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: Liste des macros et autres infos dans les fichiers résid

Message par Kwai chang caine »

ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
PAPIPP
Messages : 534
Inscription : sam. 23/févr./2008 17:58

Re: Liste des macros et autres infos dans les fichiers résid

Message par PAPIPP »

Bonjour à tous

Pour vous faciliter le travail de placement dans le répertoire RESIDENTS voici un programme.

Code : Tout sélectionner

;{- Enumerations / DataSections
;{ Windows
Enumeration
  #Window_0
EndEnumeration
;}
;{ Gadgets
Enumeration
  #String_0
  #String_2
  #String_5
  #Text_0
  #Text_2
  #Text_5
  #Button_0
  #Button_2
  #Button_5
  #Editor_41
  #Button_11
  #Button_12
  #Button_13
  #Text_6
  
EndEnumeration
Dim fic${256}(20)
Dim res${256}(20)
;}
Define.l Event, EventWindow, EventGadget, EventType, EventMenu
;}
Procedure OpenWindow_Window_0()
  If OpenWindow(#Window_0, 398, 69, 800, 446, "Aide pour créer un résident", #PB_Window_SystemMenu|#PB_Window_SizeGadget|#PB_Window_MinimizeGadget|#PB_Window_TitleBar)
    StringGadget(#String_0, 145, 20, 520, 25, "")
    StringGadget(#String_2, 145, 65, 520, 25, "")
    StringGadget(#String_5, 145, 115, 520, 25, "")
    TextGadget(#Text_0, 10, 20, 125, 25, "LIB PB pour compiler", #PB_Text_Center|#SS_CENTERIMAGE)
    TextGadget(#Text_2, 10, 65, 125, 25, "NOM de la source", #PB_Text_Center|#SS_CENTERIMAGE)
    TextGadget(#Text_5, 10, 115, 125, 25, "PATH et NOM du résident", #PB_Text_Center|#SS_CENTERIMAGE)
    ButtonGadget(#Button_0, 690, 20, 100, 25, "Parcourir")
    ButtonGadget(#Button_2, 690, 65, 100, 25, "Parcourir")
    ButtonGadget(#Button_5, 690, 110, 100, 25, "Parcourir")
    EditorGadget(#Editor_41, 20, 205, 760, 235)
    ;     Font1 = LoadFont(#PB_Any, "Courier New"  ,  8, #PB_Font_Bold )
    Font1 = LoadFont(#PB_Any, "Courier New"  ,  8)
    SetGadgetFont(#Editor_41, FontID(Font1))
    TextGadget(#Text_6     , 10, 150, 430, 50, "",#PB_Text_Border);,#PB_Text_Border)
    ButtonGadget(#Button_11, 450, 155, 100, 30, "Création du Batch")
    ButtonGadget(#Button_12, 570, 155, 100, 30, "OK Créez")
    ButtonGadget(#Button_13, 690, 155, 100, 30, "Terminer")
    
  EndIf
EndProcedure

OpenWindow_Window_0()
Path_lib$="L:\program Files\purebasic"     ;;==> Path à corriger en fonction de votre environnement
;{- Event loop
Repeat
  Event = WaitWindowEvent()
  Select Event
      ; ///////////////////
    Case #PB_Event_Gadget
      EventGadget = EventGadget()
      EventType = EventType()
      Select  EventGadget
        Case #String_0
        Case #String_2
        Case #String_5
          PathFil_Res$=GetGadgetText(#String_5)
        Case #Text_0
        Case #Text_2
        Case #Text_5
          ;************************************************************** BOUTON  Parcourir LIB PB ***********************************************************      
          
        Case #Button_0  ; bouton recherche chemin principal de PB
          Path_lib$=PathRequester("Donnez la librairie PureBasic",Path_lib$)
          SetGadgetText(#String_0,Path_lib$+"compilers\")
          ;       SetGadgetText(#String_2, Path_lib$)
          If FileSize(GetGadgetText(#String_0))=-1
            SetGadgetText(#Text_6, Path_lib$ + Chr(10) +" N'est pas un répertoire PB")
            Coul_t = GetGadgetColor(#text_6, #PB_Gadget_FrontColor)
            Coul_f = GetGadgetColor(#text_6, #PB_Gadget_BackColor)
            
            SetGadgetColor(#Text_6, #PB_Gadget_BackColor, RGB(0,0,$CE))
            SetGadgetColor(#Text_6, #PB_Gadget_FrontColor,RGB(255,255,0))
           SetGadgetText(#String_0,"")
          Else
           RGB_A=GetGadgetColor(#Button_0,#PB_Gadget_BackColor)      
            SetGadgetText(#Text_6,"")
            SetGadgetColor(#Text_6, #PB_Gadget_BackColor, RGB_A)
            SetGadgetColor(#Text_6, #PB_Gadget_FrontColor,RGB(0,0,0))

          SetGadgetText(#String_5, Path_lib$+"RESIDENTS\")
          EndIf
          ;****************************************************** BOUTON  Parcourir du prg.pb qui va faire un résident ********************************      
          
        Case #Button_2  ; recherche prg.pb qui va faire un résident
          FichierParDefaut$ = "L:\program files\PB520\"; Répertoire et fichier par défaut qui seront affichés
          ;  Avec la chaîne suivante nous allons définir les filtres ("|" comme séparateur) pour l'affichage de fichier :
          ;  1er  : "Texte (*.txt)" comme nom, ".txt" et ".bat" comme extension autorisée
          ;  2ème : "PureBasic (*.pb)" comme nom, ".pb" comme extension autorisée
          ;  3ème : "Tous les fichiers (*.*)" comme nom, "*.*" comme extension autorisée, valide pour tous les fichiers
          Filtre$ = "PureBasic (*.pb)|*.pb|Tous les fichiers (*.*)|*.*"
          Filtre  = 0                   ; utiliser  par défaut le premier des trois filtres possibles
          Path_Src$ = OpenFileRequester("Choisissez un fichier source", FichierParDefaut$, Filtre$, Filtre)
          SetGadgetText(#String_2, Path_Src$)
          ;****************************************************** BOUTON  Parcourir pour donner le nom du résident ********************************      
          
        Case #Button_5
          ;          Path_Res$ = PathRequester("Donnez le Chemin et dans la zone ,le nom du résident ", GetGadgetText(#String_5))
          FichierParDefaut$ = Path_lib$+"RESIDENTS\*.res"; Répertoire et fichier par défaut qui seront affichés
          Filtre$ = "Pb résident (*.res)|*.res |Tous les fichiers (*.*)|*.*"
          Path_Res$ = OpenFileRequester("Donnez le Nom d'un résident existant ou pas ", FichierParDefaut$, Filtre$, Filtre)
          ;************************** tester la structure du fichier *******************************
          If UCase(Right(path_res$,4))<>".RES"
          path_res$+".res"
          EndIf
          Debug path_res$
          SetGadgetText(#String_5, Path_Res$)
          PathFil_Res$=GetGadgetText(#String_5)
          ;          If FileSize(PathFil_Res$)>0
          ;           If  MessageRequester("ATTENTION LE FICHIER EXISTE DEJA ", "Voulez vous l'écraser",  #PB_MessageRequester_YesNo) = #PB_MessageRequester_Yes
          ;           Else
          ;           PathFil_Res$=""
          ;           EndIf
          ;          EndIf
        Case #Editor_41
          ;            Debug event
          ;************************************************************** BOUTON  Création du Batch ***********************************************************      
        Case #Button_11
          ;       If FileSize(PathFil_Res$)>0
          ;           If  MessageRequester("ATTENTION FICHIER "+pathfil_res$+" EXISTE DEJA ", "Voulez vous l'écraser",  #PB_MessageRequester_YesNo) = #PB_MessageRequester_Yes
          ;           Else
          ;           PathFil_Res$=""
          ;           SetGadgetText(#String_5, Path_lib$+"RESIDENTS\")
          ;           EndIf
          ;       EndIf
          If Path_lib$<>"" And Path_Src$<>"" And GetFilePart(PathFil_Res$)<>""
            ft$=Space(255)
            mask$="%YY"+Str(DayOfYear(Date()))
            fp$="PB"+FormatDate(mask$,Date())
            fb$=Path_lib$+fp$+".BAT"
            ;             GetTempFileName_(@U$,@fp$,000,@ft$)
            asci$ = Space($FFF)
            ASCII$="ECHO off"+Chr(10)
            ;             ASCII$+"pushd "+Chr(34)+path_lib$+Chr(34)+Chr(10)
            ;             ASCII$+"If (%2+CHR(10)==() Goto erreurf")
            ASCII$+"If exist "+Chr(34)+PathFil_Res$+Chr(34)+ "  del  "+Chr(34)+ PathFil_Res$+Chr(34)+Chr(10)
            ASCII$+ Chr(34)+Path_lib$+"compilers\pbcompiler"+Chr(34)+" "+Chr(34)+Path_Src$+Chr(34) + " /RESIDENT " +Chr(34)+ PathFil_Res$+Chr(34)+Chr(10)
            ClearGadgetItems(#Editor_41)
            AddGadgetItem(#Editor_41,-1,"REM Fichier "+fb$)
            AddGadgetItem(#Editor_41,-1, ASCII$)
            AddGadgetItem(#Editor_41,-1, "ECHO TAPEZ EXIT TAPEZ EXIT TAPEZ EXIT TAPEZ EXIT TAPEZ EXIT TAPEZ EXIT TAPEZ EXIT TAPEZ EXIT")
          Else
            MessageRequester("ATTENTION l'une de ces zones n'est pas correcte  ", "Lib="+Path_lib$+Chr(10)+"Source="+Path_Src$+Chr(10)+"Resident="+PathFil_Res$)
          EndIf
          ;************************************************************** BOUTON OK ***********************************************************      
        Case #Button_12   ; Bouton OK
          Texte$ = GetGadgetText(#Editor_41)
          
          For k=1 To 20
            fic$(k)=StringField(Texte$, k, Chr(34))
            If Len(fic$)=0
              mf=k
            EndIf  
            If RTrim(LTrim(UCase(fic$(k-1))))="DEL"
              fic2$=fic$(k)
              If k>1
                fic1$=fic$(k-2)
              EndIf 
            EndIf
            If RTrim(LTrim(UCase(fic$(k-1))))="/RESIDENT"
              fic3$=fic$(k)
            EndIf
          Next
          fic1$=RTrim(LTrim(fic1$))
          fic2$=RTrim(LTrim(fic2$))
          fic3$=RTrim(LTrim(fic3$))
          ;            Debug f_s(fic2$)+f_s(fic3$)
          If FileSize(fic2$)>0
            If fic2$=fic3$
              If  MessageRequester("ATTENTION FICHIER "+fic2$+" EXISTE DEJA ", "Voulez vous l'écraser",  #PB_MessageRequester_YesNo) = #PB_MessageRequester_Yes
              Else
                PathFil_Res$=""
              EndIf
            Else
              If  MessageRequester("ATTENTION FICHIER "+fic2$+" EXISTE DEJA ", "Voulez vous le supprimer"+Chr(10)+"et créer "+fic3$,  #PB_MessageRequester_YesNo) = #PB_MessageRequester_Yes
              Else
                PathFil_Res$=""
              EndIf
            EndIf
          EndIf
          If fic2$<>fic1$
            ;                                                                                     123456789012345678901234567890123456  1234567890123456789012345678901234567890
            ;   SetGadgetColor(#Text_6, RGB(255, 0, 0), #PB_Gadget_FrontColor)
            SetGadgetText(#Text_6, "Fichier de controle différent du fichier à supprimer"+Chr(10)+" fichier Controle     "+fic1$+Chr(10)+" fichier à supprimer "+fic2$)
            Coul_t = GetGadgetColor(#text_6, #PB_Gadget_FrontColor)
            Coul_f = GetGadgetColor(#text_6, #PB_Gadget_BackColor)
            SetGadgetColor(#Text_6, #PB_Gadget_BackColor, RGB(0,0,$CE))
            SetGadgetColor(#Text_6, #PB_Gadget_FrontColor,RGB(255,255,0))
            
            
            ;   SetGadgetColor(#Text_6, RGB(255, 0, 0), #PB_Gadget_FrontColor)
            PathFil_Res$=""
          EndIf
          Texte$ = GetGadgetText(#Editor_41)
          If Texte$<>"" And  PathFil_Res$<>""
            FB.l=CreateFile(#PB_Any,fb$)
            WriteData(FB, @Texte$, Len(Texte$))
            CloseFile(FB)
            prg=RunProgram("cmd"," /C "+ Chr(34)+fb$+Chr(34) ,"",30)
            If prg
              AddGadgetItem(#Editor_41,-1,"******************************** R E S U L T A T S *******************************************")
              s_ascii$=ReadProgramString(prg)
              Texte$=s_ascii$
              OemToChar_(@s_ascii$,@s_ascii$)
              texte2$=s_acii$+Chr(10)
              Resultat=AddGadgetItem(#Editor_41,-1,s_ansi$)
              While ProgramRunning(prg)
                s_ascii$=ReadProgramString(prg)
                OemToChar_(@s_ascii$,@s_ascii$)
                Resultat=AddGadgetItem(#Editor_41,-1,s_ascii$)
                texte2$+s_ascii$+Chr(10)
              Wend
            EndIf
            For k=1 To 20
              res$(k)=StringField(texte2$,k,Chr(10))
              p_r=FindString(UCase(res$(k)),"RESIDENT",1)
              p_c=FindString(UCase(res$(k)),"CREATED",1)
              If p_r<>0
                mp_r=p_r
                If p_c<>0
                  mp_c=p_c
                  mk=k
                EndIf
              EndIf
            Next
          EndIf
        Case  #Button_13
          If mk>0 And mp_r>0 And mp_c>0
            Resultat=DeleteFile(fb$)
            CloseWindow(#Window_0)
            Break
          Else
            If MessageRequester("Vous n'avez pas réussi à créer "+Chr(10)+"Le résident ="+PathFil_Res$,"Voulez-vous continuer ? Oui ou Non",#PB_MessageRequester_YesNo)=#PB_MessageRequester_Yes
              ;       Coul_t = GetGadgetColor("text_6, #PB_Gadget_FrontColor)
              ;   Coul_f = GetGadgetColor("text_6, #PB_Gadget_backColor)
              SetGadgetText(#Text_6, "")
              SetGadgetColor(#Text_6, #PB_Gadget_BackColor, Coul_f)
              SetGadgetColor(#Text_6, #PB_Gadget_FrontColor,coul_t)
              
            Else
              Resultat=DeleteFile(fb$)
              CloseWindow(#Window_0)
              Break
            EndIf
            
          EndIf
      EndSelect
      ; ////////////////////////
    Case #PB_Event_CloseWindow
      EventWindow = EventWindow()
      If EventWindow = #Window_0
        CloseWindow(#Window_0)
        Break
      EndIf
  EndSelect
ForEver
;
A+
Il est fort peu probable que les mêmes causes ne produisent pas les mêmes effets.(Einstein)
Et en logique positive cela donne.
Il est très fortement probable que les mêmes causes produisent les mêmes effets.
Avatar de l’utilisateur
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: Liste des macros et autres infos dans les fichiers résid

Message par Kwai chang caine »

Merci PAPIPP ...
De ta grande connaissance et surtout de son partage durant toutes ces années 8)
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
PAPIPP
Messages : 534
Inscription : sam. 23/févr./2008 17:58

Re: Liste des macros et autres infos dans les fichiers résid

Message par PAPIPP »

Merci KCC

J'ai modifié le PRG qui liste les macros pour être certain d'utiliser des résidents pour les PB431 à PB520
A+
Il est fort peu probable que les mêmes causes ne produisent pas les mêmes effets.(Einstein)
Et en logique positive cela donne.
Il est très fortement probable que les mêmes causes produisent les mêmes effets.
Répondre