PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

List macros directory RESIDENTS

https://www.purebasic.fr/english/viewtopic.php?t=57131

Page 1 of 1

List macros directory RESIDENTS

Posted: Thu Oct 24, 2013 7:31 am
by PAPIPP
Hello to all

PureBasic team allows us to see and use 3 items stored in the directory RESIDENTS are ::
1 ) the structures
2 ) interfaces
3 ) the constants
Prototypes and macros are not available
Moreover, the structure of the files in RESIDENTS often changes
We are today with the PB520LTS 7em Version ( RES7 )

Here is a prg that lists the remaining macros or macros that you place yourself
RESIDENTS in the directory
We can recover the body of the macro and edit locally (Change his name to avoid an error)

It covers RESIDENTS for prg PB431 to PB520
Default directory prg seeks RESIDENTS # PB_Compiler_Home + " Residents \
If you wish to search another directory RESIDENTS Place any parameter in the performance of such prg.exe aaa or :
compiler option _ Compile / run _ Settings executable (type one or more characters , for example a xxx or abc )

Code: Select all

; 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:
By

Re: List macros directory RESIDENTS

Posted: Thu Oct 24, 2013 5:35 pm
by jassing
I had to rename getfontname as it collided with progui.. but, after renaming it; it ran, but crashed on line 216 with "Structure Array index out of bounds"

Code: Select all

               macrom()\PARAM$[i]=PeekS(*PointeurDebut)

Re: List macros directory RESIDENTS

Posted: Thu Oct 24, 2013 10:05 pm
by PAPIPP
Hello Jassing

The table seems too small increase of 15 to 25 for example.
and if erreuir still give me the macro on which it crashes.

Code: Select all

Structure Macrom
  Nom_Macro$
  type.b
  NB_PARAM.l                    
  PARAM${26}[25]
  Ligne_macro$                   
EndStructure
To be sure it covers RESIDENTS for prg PB431 to PB520
Correction in the previous prg

by
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited