PureBasic

Forums PureBasic - Français
https://www.purebasic.fr/french/

E-CQCM

https://www.purebasic.fr/french/viewtopic.php?t=17525

Page 1 sur 1

E-CQCM

Publié : sam. 22/déc./2018 23:56
par Ollivier
Est-ce que ça marche.

Ce code source permet de créer et d'exécuter un code source, en écrivant n'importe quel caractère dans les noms de labels, procédures et variables.

Code : Tout sélectionner

;******************************************************************************************************************************
CompilerIf 0

EnableExplicit

Define.I Fenêtre_Id
Define.I Fenêtre_X
Define.I Fenêtre_Y
Define.I Fenêtre_Largeur
Define.I Fenêtre_Hauteur
Define.I Fenêtre_Options
Define.S Fenêtre_Titre
Define.I Fenêtre_Evènement

Define.I Canvas_Id
Define.I Canvas_X
Define.I Canvas_Y
Define.I Canvas_Largeur
Define.I Canvas_Hauteur
Define.I Canvas_Souris_Boutons
Define.I Canvas_Souris_X
Define.I Canvas_Souris_Y

Define.I Gadget_Concerné

Define.I Evènement_Type

Define.I Action_Pointage
Define.I Action_Tracé

Define.I Dessin_Couleur


Fenêtre_X = 0
Fenêtre_Y = 0
Fenêtre_Largeur = 220
Fenêtre_Hauteur = 220
Fenêtre_Titre = "Canvas"
Fenêtre_Options = #PB_Window_SystemMenu | #PB_Window_ScreenCentered

Canvas_X = 10
Canvas_Y = 10
Canvas_Largeur = 200
Canvas_Hauteur = 200

Fenêtre_Id = OpenWindow(#PB_Any,
                        Fenêtre_X,
                        Fenêtre_Y,
                        Fenêtre_Largeur,
                        Fenêtre_Hauteur,
                        Fenêtre_Titre,
                        Fenêtre_Options)
If Fenêtre_Id
        Canvas_Id = CanvasGadget(#PB_Any,
                                 Canvas_X,
                                 Canvas_Y,
                                 Canvas_Largeur,
                                 Canvas_Hauteur)
        If Canvas_Id
                Repeat
                        Fenêtre_Evènement = WaitWindowEvent()
                        If Fenêtre_Evènement = #PB_Event_Gadget
                                Gadget_Concerné = EventGadget()
                                If Gadget_Concerné = Canvas_Id 
                                        
                                        Evènement_Type = EventType()
                                        Canvas_Souris_Boutons = GetGadgetAttribute(Canvas_Id, #PB_Canvas_Buttons)
                                        Canvas_Souris_X = GetGadgetAttribute(Canvas_Id, #PB_Canvas_MouseX)
                                        Canvas_Souris_Y = GetGadgetAttribute(Canvas_Id, #PB_Canvas_MouseY)
                                        
                                        Action_Tracé = Bool(Evènement_Type = #PB_EventType_MouseMove)
                                        Action_Tracé & Bool(Canvas_Souris_Boutons & #PB_Canvas_LeftButton)
                                        
                                        Action_Pointage = Bool(Evènement_Type = #PB_EventType_LeftButtonDown)
                                        
                                        If Action_Pointage Or Action_Tracé
                                                If StartDrawing(CanvasOutput(Canvas_Id))
                                                        Dessin_Couleur = RGB(Random(255), Random(255), Random(255) )
                                                        Circle(Canvas_Souris_X, Canvas_Souris_Y, 10, Dessin_Couleur)
                                                        StopDrawing()
                                                EndIf
                                        EndIf
                                EndIf    
                        EndIf
                Until Fenêtre_Evènement = #PB_Event_CloseWindow
        EndIf
EndIf
End

CompilerEndIf



EnableExplicit

Procedure.S Convert(A.I)
        Define.S Result
        Result = Hex(A)
        ProcedureReturn Result
EndProcedure

Procedure.S SourceReplaceNonAscii(LineIn.S)
        Define.S LineOut = ""
        Define.I I
        Define.I LineLength = Len(LineIn)
        Define.I A
        Define.I DoubleQuoteFlag
        Define.I SingleQuoteFlag
        Define.I CommentFlag
        Define.S LineMid
        For I = 1 To LineLength
                A = Asc(Mid(LineIn, I, 1) )
                LineMid = Chr(A)
                If CommentFlag = 0 And DoubleQuoteFlag = 0
                        If A = 39
                                SingleQuoteFlag ! 1
                        EndIf
                EndIf
                If CommentFlag = 0 And SingleQuoteFlag = 0
                        If (A = 34)
                                DoubleQuoteFlag ! 1
                        Else
                                If DoubleQuoteFlag = 0
                                        If 1
                                                If A > 127
                                                        LineMid = "_" + LCase(Convert(A) )
                                                EndIf
                                        Else
                                                ProcedureReturn " "
                                        EndIf
                                EndIf
                        EndIf
                EndIf
                If DoubleQuoteFlag = 0 And SingleQuoteFlag = 0
                        If A = 59
                                CommentFlag = 1
                        EndIf
                EndIf
                LineOut + LineMid
        Next
        ProcedureReturn LineOut
EndProcedure


Procedure CompilerExecuteFile(ProgramParameter.S, ProgramOutputFlag.I = 0)
        Define.S ProgramName = "PBCOMPILER.EXE"
        Define.S ProgramDirectory = #PB_Compiler_Home + "/COMPILERS/"
        Define.I ProgramOption = #PB_Program_Open | #PB_Program_Read | #PB_Program_Hide
        Define.I ProgramId = RunProgram(ProgramName, ProgramParameter, ProgramDirectory, ProgramOption)
        Define.S ProgramOutput
        Define.I ProgramExitCode
        Define.S ProgramString
        Define.S NextLineChar = Chr(13)
        If ProgramId 
                While ProgramRunning(ProgramId)
                        If AvailableProgramOutput(ProgramId)
                                ProgramString = ReadProgramString(ProgramId)
                                ProgramOutput + ProgramString + NextLineChar
                        EndIf
                Wend
                ProgramExitCode = ProgramExitCode(ProgramId)
                CloseProgram(ProgramId)
        EndIf
        If ProgramOutputFlag Or ProgramExitCode
                MessageRequester(ProgramName, ProgramOutput)
        EndIf
EndProcedure


Procedure SourceExtractHeader(OutputFileName.S)
        Define.I InputFileId = OpenFile(#PB_Any, #PB_Compiler_File)
        Define.S InputFileString
        Define.I InputFileReading
        Define.I InputFileBom
        Define.I OutputFileId = CreateFile(#PB_Any, OutputFileName)
        Define.S FileString
        Define.I InputFileLevel
        If InputFileId
                InputFileBom = ReadStringFormat(InputFileId)
                If OutputFileId
                        While Not Eof(InputFileId)
                                InputFileString = ReadString(InputFileId)
                                FileString = UCase(Trim(InputFileString) )
                                If Left(FileString, 13) = "COMPILERENDIF"
                                        InputFileLevel - 1
                                        If InputFileLevel = 0
                                                InputFileReading = 0
                                                Break
                                        EndIf
                                EndIf
                                If Left(FileString, 10) = "COMPILERIF"
                                        InputFileLevel + 1
                                EndIf
                                If InputFileReading
                                        InputFileString = SourceReplaceNonAscii(InputFileString)
                                        WriteStringN(OutputFileId, InputFileString)
                                EndIf
                                If InputFileString = "CompilerIf 0"
                                        WriteStringN(OutputFileId, "")
                                        InputFileReading = 1
                                EndIf
                                If Not InputFileReading
                                        WriteStringN(OutputFileId, "")
                                EndIf
                        Wend
                        CloseFile(OutputFileId)
                EndIf
                CloseFile(InputFileId)
        EndIf
EndProcedure


Define.S TransitFileName = #PB_Compiler_Home + "TRANSIT.PB"
SourceExtractHeader(TransitFileName)
CompilerExecuteFile(TransitFileName)

Re: E-CQCM

Publié : ven. 11/janv./2019 23:26
par El Papounet
Comme tu me l'a demandé ici, voici ton code avec les quelques modifications apportées.
Ligne 146: ProgramName = #PB_Compiler_Home + "Compilers\" + "PBCOMPILER.EXE"
Ligne 147: ProgramDirectory = #PB_Compiler_Home + "Compilers\"
Ligne 149: ProgramId = RunProgram(ProgramName, #DQUOTE$ + ProgramParameter + #DQUOTE$, "", ProgramOption)
Ligne 213: Define.S TransitFileName = GetTemporaryDirectory() + "TRANSIT.PB"

Code : Tout sélectionner

;******************************************************************************************************************************
CompilerIf 0
  
  EnableExplicit
  
  Define.I Fenêtre_Id
  Define.I Fenêtre_X
  Define.I Fenêtre_Y
  Define.I Fenêtre_Largeur
  Define.I Fenêtre_Hauteur
  Define.I Fenêtre_Options
  Define.S Fenêtre_Titre
  Define.I Fenêtre_Evènement
  
  Define.I Canvas_Id
  Define.I Canvas_X
  Define.I Canvas_Y
  Define.I Canvas_Largeur
  Define.I Canvas_Hauteur
  Define.I Canvas_Souris_Boutons
  Define.I Canvas_Souris_X
  Define.I Canvas_Souris_Y
  
  Define.I Gadget_Concerné
  
  Define.I Evènement_Type
  
  Define.I Action_Pointage
  Define.I Action_Tracé
  
  Define.I Dessin_Couleur
  
  
  Fenêtre_X = 0
  Fenêtre_Y = 0
  Fenêtre_Largeur = 220
  Fenêtre_Hauteur = 220
  Fenêtre_Titre = "Canvas"
  Fenêtre_Options = #PB_Window_SystemMenu | #PB_Window_ScreenCentered
  
  Canvas_X = 10
  Canvas_Y = 10
  Canvas_Largeur = 200
  Canvas_Hauteur = 200
  
  Fenêtre_Id = OpenWindow(#PB_Any,
                          Fenêtre_X,
                          Fenêtre_Y,
                          Fenêtre_Largeur,
                          Fenêtre_Hauteur,
                          Fenêtre_Titre,
                          Fenêtre_Options)
  If Fenêtre_Id
    Canvas_Id = CanvasGadget(#PB_Any,
                             Canvas_X,
                             Canvas_Y,
                             Canvas_Largeur,
                             Canvas_Hauteur)
    If Canvas_Id
      Repeat
        Fenêtre_Evènement = WaitWindowEvent()
        If Fenêtre_Evènement = #PB_Event_Gadget
          Gadget_Concerné = EventGadget()
          If Gadget_Concerné = Canvas_Id
            
            Evènement_Type = EventType()
            Canvas_Souris_Boutons = GetGadgetAttribute(Canvas_Id, #PB_Canvas_Buttons)
            Canvas_Souris_X = GetGadgetAttribute(Canvas_Id, #PB_Canvas_MouseX)
            Canvas_Souris_Y = GetGadgetAttribute(Canvas_Id, #PB_Canvas_MouseY)
            
            Action_Tracé = Bool(Evènement_Type = #PB_EventType_MouseMove)
            Action_Tracé & Bool(Canvas_Souris_Boutons & #PB_Canvas_LeftButton)
            
            Action_Pointage = Bool(Evènement_Type = #PB_EventType_LeftButtonDown)
            
            If Action_Pointage Or Action_Tracé
              If StartDrawing(CanvasOutput(Canvas_Id))
                  Dessin_Couleur = RGB(Random(255), Random(255), Random(255) )
                  Circle(Canvas_Souris_X, Canvas_Souris_Y, 10, Dessin_Couleur)
                
                StopDrawing()
              EndIf
            EndIf
          EndIf   
        EndIf
      Until Fenêtre_Evènement = #PB_Event_CloseWindow
    EndIf
  EndIf
  End
  
CompilerEndIf



EnableExplicit

Procedure.S Convert(A.I)
  Define.S Result
  Result = Hex(A)
  ProcedureReturn Result
EndProcedure

Procedure.S SourceReplaceNonAscii(LineIn.S)
  Define.S LineOut = ""
  Define.I I
  Define.I LineLength = Len(LineIn)
  Define.I A
  Define.I DoubleQuoteFlag
  Define.I SingleQuoteFlag
  Define.I CommentFlag
  Define.S LineMid
  For I = 1 To LineLength
    A = Asc(Mid(LineIn, I, 1) )
    LineMid = Chr(A)
    If CommentFlag = 0 And DoubleQuoteFlag = 0
      If A = 39
        SingleQuoteFlag ! 1
      EndIf
    EndIf
    If CommentFlag = 0 And SingleQuoteFlag = 0
      If (A = 34)
        DoubleQuoteFlag ! 1
      Else
        If DoubleQuoteFlag = 0
          If 1
            If A > 127
              LineMid = "_" + LCase(Convert(A) )
            EndIf
          Else
            ProcedureReturn " "
          EndIf
        EndIf
      EndIf
    EndIf
    If DoubleQuoteFlag = 0 And SingleQuoteFlag = 0
      If A = 59
        CommentFlag = 1
      EndIf
    EndIf
    LineOut + LineMid
  Next
  ProcedureReturn LineOut
EndProcedure


Procedure CompilerExecuteFile(ProgramParameter.S, ProgramOutputFlag.I = 0)
  Define.S ProgramName = #PB_Compiler_Home + "Compilers\" + "PBCOMPILER.EXE"
  Define.S ProgramDirectory = #PB_Compiler_Home + "Compilers\"
  Define.I ProgramOption = #PB_Program_Open | #PB_Program_Read | #PB_Program_Hide
  Define.I ProgramId = RunProgram(ProgramName, #DQUOTE$ + ProgramParameter + #DQUOTE$, "", ProgramOption)
  Define.S ProgramOutput
  Define.I ProgramExitCode
  Define.S ProgramString
  Define.S NextLineChar = Chr(13)
  If ProgramId
    While ProgramRunning(ProgramId)
      If AvailableProgramOutput(ProgramId)
        ProgramString = ReadProgramString(ProgramId)
        ProgramOutput + ProgramString + NextLineChar
      EndIf
    Wend
    ProgramExitCode = ProgramExitCode(ProgramId)
    CloseProgram(ProgramId)
  EndIf
  If ProgramOutputFlag Or ProgramExitCode
    MessageRequester(ProgramName, ProgramOutput)
  EndIf
EndProcedure


Procedure SourceExtractHeader(OutputFileName.S)
  Define.I InputFileId = OpenFile(#PB_Any, #PB_Compiler_File)
  Define.S InputFileString
  Define.I InputFileReading
  Define.I InputFileBom
  Define.I OutputFileId = CreateFile(#PB_Any, OutputFileName)
  Define.S FileString
  Define.I InputFileLevel
  If InputFileId
    InputFileBom = ReadStringFormat(InputFileId)
    If OutputFileId
      While Not Eof(InputFileId)
        InputFileString = ReadString(InputFileId)
        FileString = UCase(Trim(InputFileString) )
        If Left(FileString, 13) = "COMPILERENDIF"
          InputFileLevel - 1
          If InputFileLevel = 0
            InputFileReading = 0
            Break
          EndIf
        EndIf
        If Left(FileString, 10) = "COMPILERIF"
          InputFileLevel + 1
        EndIf
        If InputFileReading
          InputFileString = SourceReplaceNonAscii(InputFileString)
          WriteStringN(OutputFileId, InputFileString)
        EndIf
        If InputFileString = "CompilerIf 0"
          WriteStringN(OutputFileId, "")
          InputFileReading = 1
        EndIf
        If Not InputFileReading
          WriteStringN(OutputFileId, "")
        EndIf
      Wend
      CloseFile(OutputFileId)
    EndIf
    CloseFile(InputFileId)
  EndIf
EndProcedure


Define.S TransitFileName = GetTemporaryDirectory() + "TRANSIT.PB"

SourceExtractHeader(TransitFileName)
CompilerExecuteFile(TransitFileName)

Re: E-CQCM

Publié : sam. 12/janv./2019 2:09
par Ollivier
Je te remercie pour le retour, et l'en-tête de synthèse qui me facilite la tâche.

Mais quelle erreur as-tu eu à l'exécution? Et si c'était une erreur, sous quel OS? Et quelle version : X86 ou X64 ?

Re: E-CQCM

Publié : sam. 12/janv./2019 11:11
par El Papounet
Je suis sous Windows 10 x64.

Raison des modifications:

ProgramName = #PB_Compiler_Home + "Compilers\" + "PBCOMPILER.EXE"
Parce que le chemin du compilateur n'est pas dans le path (variables d'environnement).

ProgramDirectory = #PB_Compiler_Home + "/COMPILERS/" => C:\Program Files (x86)\PureBasic 5.62\/COMPILERS/
Ça n'empêche pas le programme de s'exécuter mais j'ai préféré corriger"Compilers\"

RunProgram(ProgramName, #DQUOTE$ + ProgramParameter + #DQUOTE$, "", ProgramOption)
Les doubles quotes ajoutées à cause des noms longs (paramètre passé au compilateur)

TransitFileName = GetTemporaryDirectory() + "TRANSIT.PB"
Message Après la boucle While ProgramRunning(ProgramId) (condition If ProgramOutputFlag Or ProgramExitCode).
Tout simplement à cause des restrictions de windows 10 (impossibilité d'écrire dans les répertoires Program Files (x86) ou Program Files)

Image

Re: E-CQCM

Publié : sam. 12/janv./2019 13:53
par Ollivier
(numéros rajoutés pour repères)
El Papounet a écrit :1:
ProgramName = #PB_Compiler_Home + "Compilers\" + "PBCOMPILER.EXE"
Parce que le chemin du compilateur n'est pas dans le path (variables d'environnement).

2:
ProgramDirectory = #PB_Compiler_Home + "/COMPILERS/" => C:\Program Files (x86)\PureBasic 5.62\/COMPILERS/
Ça n'empêche pas le programme de s'exécuter mais j'ai préféré corriger"Compilers\"

3:
RunProgram(ProgramName, #DQUOTE$ + ProgramParameter + #DQUOTE$, "", ProgramOption)
Les doubles quotes ajoutées à cause des noms longs (paramètre passé au compilateur)

4:
TransitFileName = GetTemporaryDirectory() + "TRANSIT.PB"
Message Après la boucle While ProgramRunning(ProgramId) (condition If ProgramOutputFlag Or ProgramExitCode).
Tout simplement à cause des restrictions de windows 10 (impossibilité d'écrire dans les répertoires Program Files (x86) ou Program Files)
Dans un 1er temps :

Le 1er : je n'ai pas encore compris. Mais je vais tâcher de me débrouiller un peu tout de même.

Le 2nd : c'est une tolérance qu'a ajouté Fred. C'est plus pratique pour le cross-platform. On peut cumuler slash et anti-slash. Je n'ai pas ce cumul sous Win8 par exemple, donc le cumul toléré permet la compatibilité.

Le 3ème : Alors là, celui-là, j'ai compris la cause (nom longs) et l'effet (balisage au double quote) mais je n'ai pas compris les mécanismes (quand et où il faut les mettre), donc à bien tester.

Le 4ème : Par contre, à grand regret, il faut que je trouve autre chose. Un code source, ce n'est pas sa place le dossier temporaire.

Le (3) ne me semble pas utile dans ce cas précis, mais j'apprends quelquechose qui sera nécessaire s'il y a besoin d'ajouter un suffixe.

Je risque de mettre quelques jours avant de mettre à jour le code source correctement. Vraiment merci pour le temps consacré à l'analyse de ce code (partie non commentée) et les explications respectives.

Re: E-CQCM

Publié : sam. 12/janv./2019 16:29
par El Papounet
1:
Tu as certainement raison, le simple nom de l'exécutable doit suffire. Habitude de vieux, j'ai toujours indiqué le chemin complet des programmes que j'exécute avec la commande Runprogram.
Quand je parle de la variable d'environnement "Path", c'est celle du système.

2:
J'aurais appris quelque chose que je ne savais pas (comme beaucoup d'autres choses).

3:
Tout dépend du programme auquel tu fais appel. Mais en général quand celui-ci nécessite plusieurs options sur la ligne de commande, le balisage du nom de fichier par des doubles quotes est quasiment systématique.

4:
J'ai opté pour le dossier temporaire car ce n'était qu'un test, rien n'empêche de le mettre ailleurs, si toute fois Windows y autorise l'écriture.

Re: E-CQCM

Publié : dim. 13/janv./2019 6:59
par Ollivier
Tu t'es déjà servi de l'option "/commented" ?

(exemple de RunProgram de la doc : explication pour l'option "/commented")

ça génère un ASM. C'est le chemin où le compilateur le stocke sous W10 qui m'intéresse pour le (4). Normalement, il est dans ".....\COMPILERS\"

Code : Tout sélectionner

; Executes the PB compiler with the /? option and displays the output (windows version)
; For Linux/MacOS change the "/?" to "-h".
;
Compiler = RunProgram (#PB_Compiler_Home +"/Compilers/pbcompiler", "/?", "", #PB_Program_Open | #PB_Program_Read ) Output$ = ""
If Compiler
While ProgramRunning (Compiler)
If AvailableProgramOutput (Compiler) Output$ + ReadProgramString(Compiler) + Chr (13)
EndIf
Wend
Output$ + Chr (13) + Chr (13) Output$ + "Exitcode: " + Str ( ProgramExitCode (Compiler))
CloseProgram (Compiler) ; Close the connection to the program
EndIf
MessageRequester ("Output", Output$)
Fuseau horaire sur UTC+01:00
Page 1 sur 1

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru