PureBasic

Forums PureBasic - Français
http://forums.purebasic.com/french/

Interpréteur pour Kiosque

http://forums.purebasic.com/french/viewtopic.php?t=12025

Page 1 sur 1

Interpréteur pour Kiosque

Publié : lun. 27/juin/2011 23:20
par Droopy
Bonsoir,

Ce petit interpréteur de script permet de :
- Créer un menu
- Télécharger
- Exécuter des exe
- Exécuter des commandes Batch
- Afficher des messages
- Saisir des informations
- Effectuer des sauts inconditionnels / conditionnels
- ... et j'en oublie

Pensez à modifier le chemin du script dans la ligne suivante
Global NewList Script.st(),NewList Var.v(),ScriptEnd,Accu.S,Script.S="D:\Script.txt"

Code : Tout sélectionner

Enumeration
  #WIDTH=320
  #HEIGHT=80
  #TEXT
  #STATUS
EndEnumeration

#CENTRAL_TEXT="Launch programs and Links"

Structure st
  Type.S
  First.S
  Second.S
EndStructure

Structure v
  CallId.l
  Name.S
  Value.S
EndStructure

Global NewList Script.st(),NewList Var.v(),ScriptEnd,Accu.S
Global Script.S="D:\Script.txt"

Procedure.S Replace2(Text.S) ; Replace ² by #CRLF$
  ProcedureReturn ReplaceString(Text,"²",#crlf$)
EndProcedure

Procedure GetLabelPtr(Name.S)
  
  Name=UCase(Name)
  
  ForEach Script()
    If Script()\Type="Label" And UCase(Script()\First)=Name
      ProcedureReturn ListIndex(Script())
    EndIf
  Next
  MessageRequester(Name,"Label not found",#MB_ICONERROR)
  End
EndProcedure

Procedure.S GetVar(CallId,Name.S) ; Read Var from LList Var()
  
  Name=UCase(Name)
  
  ForEach Var()
    If Var()\Name=Name And Var()\CallId=CallId
      ProcedureReturn Var()\Value
    EndIf
  Next
  
EndProcedure

Procedure SetVar(CallId,Name.S,Value.S) ; Write Var to LList Var()
  
  Name=UCase(Name)
  
  ; Search & Set Var
  ForEach Var()
    If Var()\Name=Name And Var()\CallId=CallId
      Var()\Value=Value
      find=#true
    EndIf
  Next
  
  ; Add Var if not exist
  If find=#False
    AddElement(Var())
    Var()\CallId=CallId
    Var()\Name=Name
    Var()\Value=Value
  EndIf
  
EndProcedure

Procedure CheckVar(CallId,Name.S) ; Check if Var is not empty
  If GetVar(CallId,Name)=""
    MessageRequester(Name+Str(CallId) ,"Not defined !",#MB_ICONERROR)
    ProcedureReturn
  EndIf
EndProcedure

Procedure.S ReplaceEnvVar(CallId,Name.S) ; Replace environnement variable (%Windir%) by real path
  
  ; Var is updated by real path
   
  Repeat
    
    temp.S=GetVar(CallId,Name)
    
    p1=FindString(temp,"%",1)
    p2=FindString(temp,"%",p1+1)
    
    If p1=0 Or p2=0
      ProcedureReturn
    Else
      V.S=Mid(temp,p1+1,p2-p1-1)
      EV.S=GetEnvironmentVariable(V)
      If EV=""
        MessageRequester("EnvironmentVariable","Not found : "+V)
        End
      EndIf
      Part1.S=Left(temp,p1-1) 
      Part2.S=Right(temp,Len(temp)-p2)
      SetVar(CallId,Name,Part1+EV+Part2)
    EndIf
  ForEver
  
EndProcedure

Procedure.S ReplaceVar(CallId,Name.S) ; Replace £NomVar£ by the Value of the Var
  
  Repeat
    
    temp.S=GetVar(CallId,Name)
    
    p1=FindString(temp,"£",1)
    p2=FindString(temp,"£",p1+1)
    
    If p1=0 Or p2=0
      ProcedureReturn
    Else
      V.S=Mid(temp,p1+1,p2-p1-1)
      
      EV.S=GetVar(CallId,V)
      
      If EV=""
        MessageRequester("Variable","Not found : "+V)
        End
      EndIf
      Part1.S=Left(temp,p1-1)  
      Part2.S=Right(temp,Len(temp)-p2)
      SetVar(CallId,Name,Part1+EV+Part2)
    EndIf
  ForEver
  
EndProcedure

Procedure Call(CallId,Label.S)
  
  Debug Label
  
  ;/ Goto Label
  GetLabelPtr(Label)
  
  For n=ListIndex(Script()) To ListSize(Script())-1
    
    If ScriptEnd : ProcedureReturn : EndIf
    
    SelectElement(Script(),n)
    Debug "ptr "+Str(n)
    Debug Script()\Type+" "+ Script()\First + " "+Script()\Second
    
    If Script()\Type="Var"
      ;/ Set Var
      SetVar(CallId,Script()\First,Script()\Second)
    ElseIf Script()\Type="Cmd"
      ;-
      ;- Commands
      ;-
      Commande.S=UCase(Script()\First)
      If Commande="SHOWTEXT"
        ;- ShowText
        ReplaceVar(CallId,"Text")
        MessageRequester(GetVar(CallId,"Title"),Replace2(GetVar(CallId,"Text")))
      ElseIf Commande="END"
        ;- End
        ScriptEnd=1
      ElseIf Commande="RETURN"
        ;- Return
        ProcedureReturn
      ElseIf Commande="RUN"
        ;- Run
        CheckVar(CallId,"File")
        ReplaceEnvVar(CallId,"File")
        Option=0
        If GetVar(CallId,"Hide")="1" : Option=#PB_Program_Hide : EndIf
        If GetVar(CallId,"Wait")="1" : Option=Option | #PB_Program_Wait : EndIf
        RunProgram(GetVar(CallId,"File"),GetVar(CallId,"Parameter"),GetVar(CallId,"WorkingDir"),Option)
      ElseIf Commande="GOSUB"
        ;- Gosub
        Call(CallId+1,Script()\Second)
      ElseIf Commande="GOTO"
        ;- Goto
        temp.S=Script()\Second
        n=GetLabelPtr(temp)
      ElseIf Commande="DOWNLOAD"
        ;- Download
        CheckVar(CallId,"Url")
        CheckVar(CallId,"File")
        ReplaceEnvVar(CallId,"File")
        DeleteUrlCacheEntry_(GetVar(CallId,"Url"))
        URLDownloadToFile_(0,GetVar(CallId,"Url"),GetVar(CallId,"File"), 0, 0)
      ElseIf Commande="RUNLINK"
        ;- RunLink
        CheckVar(CallId,"Url")
        temp.S=UCase(GetVar(CallId,"Parameter"))
        Option=0
        If GetVar(CallId,"Hide")="1" : Option=#PB_Program_Hide : EndIf
        If GetVar(CallId,"Wait")="1" : Option=Option | #PB_Program_Wait : EndIf
        If temp="FIREFOX"
          RunProgram(GetEnvironmentVariable("PROGRAMFILES")+"\Mozilla Firefox\Firefox.exe",GetVar(CallId,"Url"),"",Option)
        ElseIf temp="IE"
          RunProgram(GetEnvironmentVariable("PROGRAMFILES")+"\Internet Explorer\Iexplore.exe",GetVar(CallId,"Url"),"",Option)
        Else
          RunProgram(GetVar(CallId,"Url"),"","",Option)
        EndIf
      ElseIf Commande="CMD"
        ;- Cmd
        CheckVar(CallId,"Parameter")
        ReplaceEnvVar(CallId,"Parameter")
        Option=0
        If GetVar(CallId,"Hide")="1" : Option=#PB_Program_Hide : EndIf
        If GetVar(CallId,"Wait")="1" : Option=Option | #PB_Program_Wait : EndIf
        RunProgram("cmd.exe","/c "+GetVar(CallId,"Parameter"),"",Option)
      ElseIf Commande="YESNO"
        ;- YesNo
        CheckVar(CallId,"Text")
        ret=MessageRequester(GetVar(CallId,"Title"),Replace2(GetVar(CallId,"Text")),#PB_MessageRequester_YesNo)
        If ret=6 : Accu="1" : Else :  Accu="0" : EndIf
      ElseIf Commande="SKIPIT"
        ;- SkipIt
        If Accu=Script()\Second
          n+1
        EndIf
      ElseIf Commande="INPUT"
        ;- Input
        CheckVar(CallId,"Text")
        ReplaceVar(CallId,"Text")
        SetVar(CallId,Script()\Second,InputRequester(GetVar(CallId,"Title"),Replace2(GetVar(CallId,"Text")),""))
      ElseIf Script()\First="="
        ;- =
        If Accu=Script()\Second : Accu="1" : Else : Accu="0" : EndIf
      ElseIf Script()\First="<>"
        ;- <>
        If Accu<>Script()\Second : Accu="1" : Else : Accu="0" : EndIf
      ElseIf Commande="LIKE"
        ;- Like
        If FindString(Accu,Script()\Second,1) : Accu="1" : Else : Accu="0" : EndIf
      ElseIf Commande="DELETE"
        ;- Delete
        CheckVar(CallId,"File")
        ReplaceEnvVar(CallId,"File")
        DeleteFile(GetVar(CallId,"File"))
      ElseIf Commande="VAR2ACCU"
        ;- Var2Accu
        Accu=GetVar(CallId,Script()\Second)
      ElseIf Commande="ACCU2VAR"
        ;- Accu2Var
        SetVar(CallId,Script()\Second,Accu)
      ElseIf Commande="QUIT"
        End
      EndIf
    EndIf
  Next
  
EndProcedure

Procedure Run(*Label)
  DisableWindow(0,#true)
  ScriptEnd=0
  ClearList(Var())
  SetGadgetText(#TEXT,PeekS(*Label))
  StatusBarText(#STATUS,0," Please wait ...")
  Call(0,PeekS(*Label))
  SetGadgetText(#TEXT,#CENTRAL_TEXT)
  StatusBarText(#STATUS,0,"")
  MessageRequester(PeekS(*Label),"Execution finished",#MB_ICONINFORMATION) 
  DisableWindow(0,#False)
EndProcedure

;{/ Script2LList
If ReadFile(0,Script)
  
  While Not Eof(0)
    ligne.S=LTrim(ReadString(0))
    
    If ligne="" Or Left(ligne,1)=";" Or Left(ligne,1)="'"
      ;/ On ne traite pas cette ligne car vide ou commentaire
    Else
      ;/ Décompose la ligne [1] [2...
      First.S=StringField(ligne,1," ")
      If FindString(ligne," ",1)
        Second.S=Mid(ligne,FindString(ligne," ",1)+1,Len(ligne))
      Else
        Second=""
      EndIf
      
      If First="----"
        ;/ Label
        AddElement(Script())
        Script()\Type="Label"
        Script()\First=Second
      ElseIf First="===="
        ;/ Label
        AddElement(Script())
        Script()\Type="Label"
        Script()\First=Second
        Script()\Second="1"
      ElseIf First="&&&&" Or First=">>>>" Or First="<<<<" Or First="____"
        ;/ Menu
        AddElement(Script())
        Script()\Type="Menu"
        Script()\First=First
        Script()\Second=Second
      ElseIf UCase(First)="RUN" Or UCase(First)="CMD" Or UCase(First)="DOWNLOAD" Or UCase(First)="RUNLINK" Or UCase(First)="SHOWTEXT" Or UCase(First)="END" Or UCase(First)="RETURN" Or UCase(First)="GOSUB" Or UCase(First)="GOTO" Or UCase(First)="YESNO" Or UCase(First)="SKIPIT" Or First="=" Or First="<>" Or UCase(First)="LIKE" Or UCase(First)="INPUT" Or UCase(First)="DELETE" Or UCase(First)="VAR2ACCU" Or UCase(First)="ACCU2VAR" Or UCase(First)="QUIT"
        ;/ Commande
        AddElement(Script())
        Script()\Type="Cmd"
        Script()\First=First
        Script()\Second=Second
      Else
        ;/ Variables
        AddElement(Script())
        Script()\Type="Var"
        Script()\First=First
        Script()\Second=Second
      EndIf
      
    EndIf
  Wend
  CloseFile(0)
EndIf
;}

;{/ Visual
OpenWindow(0,0,0,#WIDTH,#HEIGHT,"Kiosque",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
CreateImageMenu(0,WindowID(0),#PB_Menu_ModernLook)
TextGadget(#TEXT,10,10,#WIDTH-20,20,#CENTRAL_TEXT,#PB_Text_Center)
CreateStatusBar(#STATUS,WindowID(0))
AddStatusBarField(#WIDTH)
;}

;{/ Create the Menu
ForEach Script()
  If Script()\Type="Menu"
    Select Script()\First
      Case "&&&&"
        MenuTitle(Script()\Second)
      Case ">>>>"
        OpenSubMenu(Script()\Second)
        Case "<<<<"
        CloseSubMenu()
      Case "____"
        MenuBar()
    EndSelect
    
  ElseIf Script()\Type="Label" And Script()\Second="1"
    MenuItem(ListIndex(Script()),Script()\First)
  EndIf
Next
;}

;{/ Manage Events
Repeat
  evt=WindowEvent()
  Delay(1)
  If evt=#PB_Event_Menu
    temp.S=GetMenuItemText(0,EventMenu())
    Tid=CreateThread(@Run(),@temp)
  EndIf
Until evt=#PB_Event_CloseWindow
;}
Et voici un exemple de script

Code : Tout sélectionner

&&&& Debug

==== Your Name ?
Text What's your name ?
Input Name
Text Hello £Name£, how are you ?
ShowText
End

==== Notepad (Gosub test)
Gosub NotepadCall
Text Gosub End
ShowText
End

==== Write (Goto test)
Text Test
ShowText
Goto WriteFunction
File %WinDir%\write.exe
Run
---- WriteFunction
End

---- Notepadcall
Wait 1
Parameter C:\aaa.txt
File %WinDir%\notepad.exe
Run
Return

==== Install PureBasic Demo x86
Url http://purebasic.com/download/PureBasic_Demo.exe
File %systemdrive%\PureBasic_Demo.exe
Download
Var2Accu File
Accu2Var Text
Title Downloaded
ShowText
Wait 1
Run
Delete
End

==== Ping
Wait 1
Parameter Ping localhost
Cmd
End

==== Défrag (YesNo)
Text Do you want to defrag your hard drive ?
YesNo
Wait 1
Parameter Defrag C: 
SkipIt 0
Cmd
End

==== Password
Text Please type the password ?
Input Password
Var2Accu Password
= 1234
Text correct Password
SkipIt 0
ShowText
Text incorrect Password
SkipIt 1
ShowText
End

&&&& PureBasic
>>>> Forum
==== French (Default browser)
Wait 1
Url http://www.purebasic.fr/french/
RunLink
End
==== English (Firefox)
Parameter Firefox
Wait 1
Url http://forums.purebasic.com/english/
RunLink
End
==== German (IE)
Parameter IE
Wait 1
Url http://forums.purebasic.com/german/
RunLink
End
<<<<
J'essaierais de lister les commandes en détail si ça interesse quelqu'un

Re: Interpréteur pour Kiosque

Publié : mar. 28/juin/2011 6:05
par Thyphoon
très sympa !! :)

Re: Interpréteur pour Kiosque

Publié : mar. 28/juin/2011 9:00
par Kwai chang caine
Cool !!!! :D
Reste plus qu'a pouvoir envoyer ce script sur un serveur, et on aurait une belle télécommande a distance :mrgreen:

Merci beaucoup du partage DROOPY 8)

Re: Interpréteur pour Kiosque

Publié : mar. 28/juin/2011 9:45
par Droopy
Maj code et exemple + Passage en anglais :oops:

Re: Interpréteur pour Kiosque

Publié : mar. 28/juin/2011 12:29
par flaith
Merci Droopy :D

Re: Interpréteur pour Kiosque

Publié : mer. 29/juin/2011 22:35
par Droopy
Voici la syntaxe en détail

Code : Tout sélectionner

[1] [2...]

-- Commentaires --------------------

Ligne commençant par ' ou ;

-- Labels --------------------------

==== Label --> Ajouté au menu
---- Label

* Non sensibles à la casse

-- Menu ----------------------------

&&&& 	MenuTitle
>>>> 	MenuItem
<<<< 	CloseSubMenu
____ 	MenuBar

-- Sauts / Fonctions ---------------

Gosub Label	Call Label
Goto Label	Déplacement pointeur au Label

-- Tests ---------------------------

= <> Like

-- Affectation ---------------------

Var2Accu	Accu=Var
Accu2Var	Var=Accu

-- Sauts conditionnels -------------

SkipIf X	N'exécute pas la ligne suivante si condition remplie

-- Interaction ---------------------

YesNo		Text --> Réponse dans ACCU (0/1)	£²
Input	Var	Text --> Var = Saisie			²£

-- Fonctions -----------------------

Run File,Parameter,Admin,Hide,Wait			*
Cmd Parameter,admin,hide,wait				*
Download url,file					*
RunLink url,parameter (vide = default browser) / IE / Firefox
ShowText Title,Text					£²
Delete File						*
Quit Quitte le programme
Clipboard Var	--> Le presse papier est transféré dans le presse papier


* Met à jour %Var% dans la variable 'File' par la valeur de la variable d'environnement
£ Insère dans la variable la valeur de la variable £NomVar£
² ² remplacé dans Text par #CRLF$

-- Fin -----------------------------

End	ScriptEnd(global)=1 --> Dans boucle Call = ProcedureReturn dans ce cas à la prochaine ligne
Return	ProcedureReturn

-- Variables -------------------------------------------

GetVar(NomVar) si jamais défini renvoie '0'
SetVar(NomVar,Value)

* Non sensibles à la casse
Fuseau horaire sur UTC+01:00
Page 1 sur 1

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

Traduction française officielle © Qiaeru