Compétition PurePunch Numéro 3

[PAPIPP]

Merci à Flype et à DOBRO
Voici le code modifié

Code : Tout sélectionner

;*****************************************************************************
;*
;* PurePunch Contest #3
;*
;* Name     : "Help MSDOS Normal" Aide Msdos Double cliquez sur une ligne
;* Author   : PAPIPP
;* Category : UTIL
;* Date     : 15 / 07 / 09
;*
;*****************************************************************************
;----0---_____1____----2-----_____3____-----4----_____5____-----6----_____7____-
;2345678901234567890123456789012345678901234567890123456789012345678901234567890
Macro M: Macro : EndMacro:M AGI:AddGadgetItem:EndMacro :#W0=0:#L0=0: #L1=1
M RPS :ReadProgramString:EndMacro:Procedure OW0():
If OpenWindow(#W0, 0, 0, 800, 600, "Dbl Clic")
ListViewGadget(#L0, 0, 0, 800, 300):ListViewGadget(#L1, 0, 300, 800, 300)
GadgetToolTip(#L0, "Double Cliquez sur une des ligne pour une aide")::EndIf
EndProcedure:Procedure AFCH(Gd,Cm$)
prg=RunProgram("cmd"," /A /C  help "+CM$,"",30)
As$ = Space(99):an$=Space(99):ClearGadgetItems(Gd):If prg:As$=RPS(prg)
OemToChar_(@as$,@an$):   AGI(gd,-1, "Help "+Cm$+" :"+an$)
While ProgramRunning(prg):As$ =RPS(prg):OemToChar_(@as$,@an$):AGI(Gd,-1, an$)
Wend:EndIf:EndProcedure:OW0():Font1 = LoadFont(#PB_Any, "Courier New",8)
SetGadgetFont(#L0, FontID(Font1)):SetGadgetFont(#L1, FontID(Font1))
AFCH(#L0,""):Repeat: WWE = WaitWindowEvent():Select WWE:Case #PB_Event_Gadget
EG = EventGadget():ET = EventType():If EG = #L0:If ET=2:EL.l=GetGadgetState(#L0)
EL$= GetGadgetItemText(#L0, El):Pos= FindString(el$, " ", 1):
CMD$=Mid(el$,1,pos-1):AFCH(#L1, CMD$):EndIf:EndIf:Case #PB_Event_CloseWindow
EW = EventWindow():If EW = #W0:CloseWindow(#W0):Break:EndIf: EndSelect
ForEver

Dans un prochain prg j'ai l'intention en plus le l'aide d'exécuter à la demande certaines commandes comme FTYPE ou DIR ou ASSOC etc..

[Ar-S]

Bien utile PAPIPP, bravo

[PAPIPP]

Bonjour à tous
Comme promis voici en punch un prg qui donne pour une commande MSDOS
Soit de l’aide avec un seul clic gauche
ou qui exécute la command DOS avec un double clic gauche sur la ligne

Certaines fonctions bloquent le prg. Elles sont donc interdites automatiquement
Mais on peut malgré tout les exécuter cherchez et vous trouverez (plusieurs méthodes)
Ces fonctions sont CMD COMP DATE LABEL MORE PAUSE SORT TIME

Par contre d’autres fonctions très dangereuses sont à votre disposition
Comme par exemple FORMAT DEL ERASE etc..
Faites-en bon usage

Code : Tout sélectionner

;*****************************************************************************
;*
;* PurePunch Contest #3
;* Pour l'Aide cliquez une fois pour executer Double cliquez sur une ligne
;* Name     : "Help EXE MSDOS Normal"
;* Author   : PAPIPP
;* Category : UTIL
;* Date     : 17 / 07 / 09
;*
;*****************************************************************************
;----0---_____1____----2-----_____3____-----4----_____5____-----6----_____7____-
;2345678901234567890123456789012345678901234567890123456789012345678901234567890
Ci$="CMD COMP DATE LABEL":Macro M:Macro:EndMacro:M AGI:AddGadgetItem:EndMacro
:#W0=0:#L0=0:#L1=1:#G=2:M MR:MessageRequester:EndMacro::M RPS:ReadProgramString
 EndMacro:ci$+"MORE PAUSE SORT TIME" :Procedure OW0():
 If OpenWindow(#W0, 0, 0, 800, 600, "Dbl Clic"):ListViewGadget(#L0,0,0,800,300)
:EditorGadget(#L1,0,300,800,300,2048):EndIf:EndProcedure:Procedure AF(Gd,Cm$)
:prg=RunProgram("cmd","/C "+CM$,"",30):As$=Space($FFFF):ClearGadgetItems(Gd)
:If prg:As$=RPS(prg):OemToChar_(@as$,@as$):AGI(gd,-1,Cm$+":"+As$)
:While ProgramRunning(prg):As$ =RPS(prg):OemToChar_(@as$,@as$):AGI(Gd,-1, As$)
:Wend:EndIf:EndProcedure:OW0():Font1 = LoadFont(#PB_Any, "Courier New",8)
:SetGadgetFont(#L0, FontID(Font1)):SetGadgetFont(#L1, FontID(Font1))
:AF(#L0,"Help "):Repeat:WWE = WaitWindowEvent():Select WWE:Case 13100
:EG=EventGadget():ET=EventType():If EG = #L0:EL.l=GetGadgetState(#L0)
:EL$= GetGadgetItemText(#L0, El):Ps= FindString(el$," ", 1):CMD$=Mid(el$,1,ps-1)
If ET=0:cmd$="Help "+CMD$:AF(#L1,CMD$):EndIf:If ET=2:If FindString(Ci$,cmd$,0)=0
 :AF(#L1, "HELP "+CMD$):rs=MR ("EXECUTION DE "+CMD$,"Exécutez-vous cette Cmd",4)
 If rs=6:T$=InputRequester("EXEC "+cmd$,"Complétez la commande",cmd$+" ")
 cmd$=T$ :AF(#L1,CMD$):EndIf:Else: MR("Interdit",cmd$+" bloque le prg",0)
 EndIf:EndIf:EndIf:Case 16:EW = EventWindow():If EW = #W0:CloseWindow(#W0)
:Break:EndIf:EndSelect:ForEver 

[djes]

J'ai mis à jour le premier post.

[TazNormand]

Comme tu l'indiques dans le 1er post, je ne me suis pas creusé la tête pour cause de vacances, en tout cas bravo aux 4 participants.

Ce qui m'inquiète, c'est la démo de MrVain, à ce niveau, ça va être difficile pour le PurePunch #4 !!!

m'enfin, faut(dra) essayer !!!

Merci encore Djes

[bombseb]

Il est prévu pour quand le prochain purepunch ?

[djes]

Pas de date arrêtée. Je pensais en faire un spécial pour la version 4.60, mais il semble ne pas y avoir beaucoup de volontaires...

[bombseb]

sisi moi je veux bien en être

[gildev]

J'y pensais aussi mais en ce moment j'aménage mon jardin car le style Bagdad après un raid aérien ça fait pas très glamour. Donc ce n'est pas l'envie qui me manque, juste le temps.