PureBasic

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

[Done] Bug ou pas avec RunProgram

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

Page 1 sur 1

[Done] Bug ou pas avec RunProgram

Publié : mer. 15/juil./2009 9:57
par PAPIPP
Bonjour à tous
Voici une aide MSDOS pour les nostalgiques du système de base
Je l’ai réalisé en punch avec l’utilisation d’un fichier *.bat ou *.cmd au choix.

Code : Tout sélectionner


;***************************************************************************** 
;* 
;* PurePunch Contest #3 
;* 
;* Name     : "Help MSDOS " Aide Msdos avec file *.BAT et listicongadget 
;* Author   : PAPIPP 
;* Category : UTIL 
;* Date     : 15 / 07 / 09 
;* 
;***************************************************************************** 
#W0=0:#L0=0:#L1=1:Procedure afch(gdgt,f_t$,hlp$="HELP"):asci$ = Space(99):ansi$=Space(99):OF.l=OpenFile(#PB_Any,f_t$):If of<>0 
:asci$=ReadString(OF)+Chr(10):OemToChar_(@asci$,@ansi$):AddGadgetItem(gdgt,-1, hlp$+" :"+ansi$):eof1=Eof(OF):While Eof(of)=0 
:asci$ =ReadString(OF)+Chr(10):OemToChar_(@asci$,@ansi$):AddGadgetItem(gdgt,-1,ansi$):Wend:EndIf:CloseFile (OF):EndProcedure 
Procedure OW0():If OpenWindow(#W0, 0, 0, 800, 600, "HELP MSDOS",13107200|12845056|13238272|12582912):ListIconGadget(#L0, 0, 0, 800, 300, "CMD Dos Double cliquez sur une CMD", 800, 8|65536|1073741824) 
:ListIconGadget(#L1, 0, 300, 800, 300, "Help CMD", 800, 8|65536|1073741824): GadgetToolTip(#L0, "Double Cliquez sur une des ligne pour une aide") 
:EndIf::EndProcedure::U$="c:\":s$=".BAT":ft$=Space(255):mask$="%YY"+Str(DayOfYear(Date()))+"%ii%ss":fp$="PB"+FormatDate(mask$,Date()) 
:fb$=u$+fp$+s$:FB.l=CreateFile(#PB_Any,fb$):GetTempFileName_(@U$,@fp$,000,@ft$):WriteStringN(FB, "@ECHO OFF"):WriteStringN(FB, "help %1>"+ft$) 
:WriteString(FB,"Exit /B 233"):CloseFile(FB):OW0():F1=LoadFont(#PB_Any,"Courier New",8,256):SetGadgetFont(#L0, FontID(F1)):SetGadgetFont(#L1, FontID(F1)) 
:prg=RunProgram(fb$,"",".",1):afch(#L0,ft$):Repeat: WWE = WaitWindowEvent(): Select WWE: Case #PB_Event_Gadget: EG = EventGadget():ET = EventType() 
:If EG = #L0:If ET=2:ELEM.l = GetGadgetState(#L0):ELEM$= GetGadgetItemText(#L0, Elem):Pos= FindString(elem$, " ", 1):CMD$=Mid(elem$,1,pos-1) 
:prg=RunProgram(fb$,cmd$,".",1):ClearGadgetItems(#L1):afch(#L1,ft$,CMD$):DeleteFile(ft$):EndIf:EndIf:Case 16:EventWindow = EventWindow() 
:If EventWindow = #W0:CloseWindow(#W0): DeleteFile(FB$):DeleteFile(FT$):Break: EndIf:EndSelect:ForEver
OU celui-ci avec CMD et listviewgadget

Code : Tout sélectionner


;***************************************************************************** 
;* 
;* PurePunch Contest #3 
;* 
;* Name     : "Help MSDOS " Aide Msdos avec file *.CMD et listviewgadget 
;* Author   : PAPIPP 
;* Category : UTIL 
;* Date     : 15 / 07 / 09 
;* 
;***************************************************************************** 
#W0=0:#L0=0: #L1=1:Procedure afch(gdgt,f_t$,hlp$="HELP"):asci$ = Space(99):ansi$=Space(99):OF.l=OpenFile(#PB_Any,f_t$):If of<>0:asci$=ReadString(OF) 
:OemToChar_(@asci$,@ansi$): AddGadgetItem(gdgt,-1, hlp$+" :"+ansi$):eof1=Eof(OF):While Eof(of)=0:asci$ =ReadString(OF):OemToChar_(@asci$,@ansi$) 
:AddGadgetItem(gdgt,-1,ansi$):Wend:EndIf:CloseFile (OF):EndProcedure:Procedure OW0():If OpenWindow(#W0, 0, 0, 800, 600, "HELP MSDOS Double cliquez une ligne pour aide",13107200|12845056|13238272|12582912) 
: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:U$="c:\":s$=".CMD":ft$=Space(255):mask$="%YY"+Str(DayOfYear(Date()))+"%ii%ss":fp$="PB"+FormatDate(mask$,Date()):fb$=u$+fp$+s$ 
FB.l=CreateFile(#PB_Any,fb$):GetTempFileName_(@U$,@fp$,000,@ft$):WriteStringN(FB, "@ECHO OFF"):WriteStringN(FB, "help %1>"+ft$):WriteString(FB,"Exit /B 233") 
:CloseFile(FB):OW0():F1=LoadFont(#PB_Any,"Courier New",8,256):SetGadgetFont(#L0, FontID(F1)):SetGadgetFont(#L1, FontID(F1)):prg=RunProgram(fb$,"",".",1) 
:afch(#L0,ft$):Repeat:WWE = WaitWindowEvent():Select WWE:Case #PB_Event_Gadget:EG = EventGadget():ET = EventType():If EG = #L0:If ET=2 
ELEM.l = GetGadgetState(#L0):ELEM$= GetGadgetItemText(#L0, Elem):Pos= FindString(elem$, " ", 1):CMD$=Mid(elem$,1,pos-1):prg=RunProgram(fb$,cmd$,".",1) 
:ClearGadgetItems(#L1):afch(#L1,ft$,CMD$): DeleteFile(ft$):EndIf:EndIf:Case 16: EW = EventWindow():If EW = #W0:CloseWindow(#W0) 
: DeleteFile(FB$):DeleteFile(FT$):Break:EndIf:EndSelect:ForEver
La réalisation de ce prg m’a posé quelque pb comme le montre le prg développé ci-dessous
Les prg punch ci-dessus utilise un fichier *.bat ou*.cmd mais celui-ci-dessous n’utilise pas cette technique.
Ce prg fonctionne anormalement ainsi les commandes suivantes sont sans résultat :

********aucune aide pour les cmd suivantes dans ce prg alors qu’avec le prg punch c’est bon
CHCP
CHKDSK
COMP
CONVERT
FC
REPLACE
XCOPY

*********** Pour les cmd suivantes c’est beaucoup plus grave car une fenêtre d’erreur apparaît.

CHKNTFS
DOSKEY
FIND

Code : Tout sélectionner

;;{- Enumerations / DataSections
;{ Windows
Enumeration
  #Window_0
EndEnumeration
;}
;{ Gadgets
Enumeration
  #ListIcon_0
  #ListIcon_1

EndEnumeration
;}
Define.l Event, EventWindow, EventGadget, EventType, EventMenu
;}
Procedure OpenWindow_Window_0()
  If OpenWindow(#Window_0, 404, 120, 800, 600, "Window_0", #PB_Window_SystemMenu|#PB_Window_SizeGadget|#PB_Window_MinimizeGadget|#PB_Window_TitleBar)
   ListIconGadget(#ListIcon_0, 0, 0, 400, 600, "CMD Dos", 400, #PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
   ListIconGadget(#ListIcon_1, 400, 0, 400, 600, "Help CMD", 400, #PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
  EndIf
EndProcedure

OpenWindow_Window_0()
prg=RunProgram("cmd", " /A /C  help",".",#PB_Program_Open|#PB_Program_Read)
Font1 = LoadFont(#PB_Any, "Courier New"  ,  8, #PB_Font_Bold )
SetGadgetFont(#ListIcon_0, FontID(Font1))
SetGadgetFont(#ListIcon_1, FontID(Font1))
s_ascii$ = Space(64000)
s_ansi$=Space(64000)
Debug formn(@s_ascii$)

  If prg
   s_ascii$=ReadProgramString(prg)
   OemToChar_(@s_ascii$,@s_ansi$)
   Resultat = AddGadgetItem(#ListIcon_0,-1, s_ansi$)
    While ProgramRunning(prg)
      s_ascii$ =ReadProgramString(prg)
      OemToChar_(@s_ascii$,@s_ansi$)
      Resultat = AddGadgetItem(#ListIcon_0,-1, s_ansi$)
    Wend
  EndIf
;     CloseProgram(prg)
;     KillProgram(prg)


Repeat
  Event = WaitWindowEvent()
  Select Event
    ; ///////////////////
    Case #PB_Event_Gadget
      EventGadget = EventGadget()
      EventType = EventType()
      If EventGadget = #ListIcon_0
       If eventtype=#PB_EventType_LeftDoubleClick 
        ELEM.l = GetGadgetState(#ListIcon_0)
        ELEM$= GetGadgetItemText(#ListIcon_0, Elem)
        Pos= FindString(elem$, " ", 1)
        CMD$=Mid(elem$,1,pos-1)
;       Debug forms(CMD$)+formn(Len(cmd$))
        prg=RunProgram("cmd", " /A /C "+Chr(34)+"help "+CMD$+Chr(34),".",#PB_Program_Open|#PB_Program_Read)
        ClearGadgetItems(#ListIcon_1)
;       Debug formn(@s_ascii$)
          If prg
             s_ascii$=ReadProgramString(prg)
             OemToChar_(@s_ascii$,@s_ansi$)
             Resultat = AddGadgetItem(#ListIcon_1,0, CMD$+" : "+s_ansi$)
             While ProgramRunning(prg)
                s_ascii$ =ReadProgramString(prg)
                OemToChar_(@s_ascii$,@s_ansi$)
                Resultat = AddGadgetItem(#ListIcon_1,-1, s_ansi$)
             Wend
          EndIf
       EndIf
     EndIf
    ; ////////////////////////
    Case #PB_Event_CloseWindow
      EventWindow = EventWindow()
      If EventWindow = #Window_0
        CloseWindow(#Window_0)
        CloseProgram(prg)
        Break
      EndIf
 EndSelect
ForEver

Publié : mer. 15/juil./2009 16:47
par Ollivier
Au risque de te dire une bêtise, tu rajoutes |#PB_Program_Write dans l'argument des options de l'instruction RunProgram()!

Publié : jeu. 16/juil./2009 7:24
par PAPIPP
@Ollivier

Code : Tout sélectionner

Au risque de te dire une bêtise, tu rajoutes |#PB_Program_Write dans l'argument des options de l'instruction RunProgram()
Merci Ollivier c'était bien cela
Fuseau horaire sur UTC+01:00
Page 1 sur 1

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

Traduction française officielle © Qiaeru