[Gambas-user] wait and stack overflow

olinux olinux at ...289...
Sat Oct 28 11:31:08 CEST 2006


here it is:

module routines:

' Gambas module file

PUBLIC actflnb AS Integer
PUBLIC maxflnb AS Integer
PUBLIC prc AS Process
PUBLIC hfile AS File


'routine de restauration
PUBLIC SUB GB_restaure(fildir AS String[], filsrc AS String, repdest AS 
String, maxfic AS Integer)
DIM i AS Short
actflnb = 0
maxflnb = maxfic
GBackup.msgsysrst.Text = "Restauration en cours..."

'pour chaque sélection à restaurer
FOR i = 0 TO fildir.Count - 1
  prc = EXEC ["gtar", "-xvf", Left(filsrc, -4), "-C", repdest, 
Right(fildir[i], -1)] FOR READ AS "Rst"
WHILE prc.state = 1
  WAIT
WEND
NEXT 

END

'routine de lecture de commande restaure
PUBLIC SUB Rst_Read()
DIM sLine AS String

LINE INPUT #LAST, sLine
  'si pas un répertoire
  'IF NOT IsDir(sLine) THEN
    'INC actflnb
    'GBackup.pgbr.Value = (1 / maxflnb) * actflnb
    PRINT sline
END

'routine de backup simple
PUBLIC SUB GB_norm_bkp(fildir AS String[], filedest AS String, maxfile 
AS Integer)

DIM i AS Short
actflnb = 0
maxflnb = maxfile

'création du fichier vide (génère une erreur mais on ne la voit pas)
EXEC ["gtar", "-cf", filedest, "null"] FOR READ
hfile = OPEN filedest & ".bkf" FOR OUTPUT CREATE
PRINT #hfile, maxfile
  'pour chaque répertoire
  FOR i = 0 TO fildir.Count - 1
    prc = EXEC ["gtar", "-rvf", filedest, fildir[i]] FOR READ AS "Bkp"
    'ne sort de cette routine que quand la commande est arrêtée
    WHILE prc.State = 1
      WAIT
    WEND
    CLOSE #hfile
   
  NEXT

END

'routine de lecture des évènements de commande externe
PUBLIC SUB Bkp_Read()
  DIM sLine AS String

  LINE INPUT #LAST, sLine
  'si pas un répertoire
  'IF NOT IsDir(sLine) THEN
    INC actflnb
    GBackup.pgb.Value = (1 / maxflnb) * actflnb
    GBackup.ficnbr.text = actflnb & " / " & maxflnb & " fichiers"
    PRINT #hfile, sLine
   
  'ENDIF
END


'routine de comptage des répertoires et fichiers
PUBLIC SUB GB_dir(fildir AS String[]) AS Integer[]
 
  'lecture d'une suite de répertoire avec les résultats
  DIM File AS String
  DIM I AS Integer
  DIM infos AS NEW Integer[] 'taille/nbre globals a sauvegarder
 
  infos.Add(0)
  infos.Add(0)
 
  FOR i = 0 TO fildir.Count - 1
 
    FOR EACH File IN RDir(fildir[i])
    'si pas un répertoire
    'IF NOT IsDir(File) THEN
          INC infos[0]
    'ENDIF
    NEXT 
   
  NEXT
 
GBackup.ficnbr.text = "0 / " & CStr(infos[0]) & " fichiers"


RETURN infos
 
END

and here is my main form:

' Gambas class file

' Déclarations des variables communes à toute la classe

PUBLIC varsrclst AS NEW String[]
PUBLIC varrstlst AS NEW String[]
PUBLIC strrstlst AS String
PUBLIC idxsrclst AS Integer
PUBLIC picselectnodir AS NEW Picture
PUBLIC picselectyesdir AS NEW Picture
PUBLIC maxfic AS Integer



STATIC PUBLIC FUNCTION Run() AS Boolean

  DIM hForm AS Form

  hForm = NEW GBackup
  RETURN hForm.ShowModal()

END


PUBLIC SUB Form_Open()
  'Initialisations diverses
  'chemin de la racine du disque
  varsrclst.add("/")
  idxsrclst = 0
 
  'images pour les répertoires à lister
  picselectnodir = picture["selectnodir.png"]
  picselectyesdir = picture["selectyesdir.png"]


 
  'Lance la première lecture du répertoire
  SrcLst_Refresh(varsrclst[idxsrclst])
END

PUBLIC SUB Quitter_Click()
  slpachquit.Show
  slpachquit.Center
  WAIT 0.1
  ficlstsrc.clear
  slpachquit.Close(TRUE)
  ME.Close(TRUE)

END
PUBLIC SUB SrcLst_Refresh(rep AS String)
 
  DIM sFile AS String
  'Routine de rafraichissement et de lecture des répertoires dans la 
treeview
  'effacement de la liste
  srclst.Clear
  'Racine du répertoire à visualiser
  srclst.Add(rep, rep)
 
  'Lecture du répertoire
  FOR EACH sFile IN Dir(rep)
    'Si l'objet lu n'est pas invisible
   
    IF NOT Stat(rep & sFile).Hidden THEN
      ' si l'objet lu est un répertoire, met le devant avec un espace
     
      IF IsDir(rep & sFile) THEN
        srclst.Add(sFile, sFile, picselectnodir, rep)
      ELSE 'sinon met le derrière sans espace
        'srclst.Add(sFile, sFile, picfic, rep)
      ENDIF
     
    ENDIF
   
  NEXT
  'afficher a plat tous le répertoire
  srclst.Current.Expanded = TRUE
 
END

PUBLIC SUB SrcLst_Click()

  'bascule sélection yes/no
  'pas de bascule si racine
  IF srclst.Current.key <> varsrclst[idxsrclst] THEN
 
    IF srclst.Current.Picture = picselectnodir THEN
      Srclst.Current.Picture = picselectyesdir
    ELSE IF srclst.Current.Picture = picselectyesdir THEN
      Srclst.Current.Picture = picselectnodir
    ENDIF
   
  ENDIF

END

PUBLIC SUB SelectAll_Click()

  'sélectionner tous
  srclst.MoveFirst
 
  WHILE NOT srclst.MoveBelow()

    srclst.item.Picture = picselectyesdir

  WEND
 
END

PUBLIC SUB DeSelectAll_Click()

  'désélectionner tous
  srclst.MoveFirst
  WHILE NOT srclst.MoveBelow()

    srclst.item.Picture = picselectnodir

  WEND
   

END

PUBLIC SUB SrcLst_DblClick()
  'seulement si repertoire
    'annule l'action click
    SrcLst_Click()
    'changement de repertoire
    IF srclst.Current.key = varsrclst[idxsrclst] THEN
      'sur racine
      'mais pas si déjà racine
      IF idxsrclst <> 0 THEN
        'remonte d'un niveau dans l'arbo
        DEC idxsrclst
        varsrclst.Remove(idxsrclst + 1, 1)
        SrcLst_Refresh(varsrclst[idxsrclst])
      ENDIF
    ELSE 
      'sur repertoire simple
      INC idxsrclst
      varsrclst.Add(varsrclst[idxsrclst - 1] & srclst.Current.key & "/")
      SrcLst_Refresh(varsrclst[idxsrclst])
    ENDIF
    srclst.Current.Expanded = TRUE 

END

PUBLIC SUB BtSelFic_Click()
'selection du fichier de destination
  dialog.path = "/"
  IF NOT dialog.SaveFile() THEN
    ficdest.text = dialog.path
  ENDIF

END

PUBLIC SUB BkpNow_Click()
'variable de liste des répertoires
DIM lstrep AS NEW String[]
'variable d'information sur le backup
'idx=1 => nbre de fichier
'idx=2 => taille globale en octets
DIM inforep AS NEW Integer[]
DIM i AS Integer
DIM hFile AS File

'création de la liste des répertoires sélectionnés
  srclst.MoveFirst
  'infos utilisateur
  MsgSys.Text = "Liste fichiers..."
  WHILE NOT srclst.MoveBelow()

   IF srclst.item.Picture = picselectyesdir THEN
    lstrep.Add(varsrclst[idxsrclst] & srclst.Item.Text)
   ENDIF

  WEND
  'cacul du nombre de fichiers (résultat dans inforep 0 et 1
  inforep = routines.GB_dir(lstrep)
  maxfic = inforep[0]
  'valeur progressbar = (1/maxfic)*valeuractuelle
 
  'vérification de l'existance d'un fichier backup destination
  IF ficdest.text <> "" THEN
  'Lancement du backup en fonction du mode choisi
 
    IF Sglsel.Value = TRUE THEN 'mode backup simple
   
      'le fichier existe-t-il déjà ?
      TRY hfile = OPEN ficdest.text FOR READ
      IF NOT ERROR THEN
        i = message.Warning("Attention, le fichier de destination existe 
déjà .\n Si vous continuez il va être écrasé.\n Souhaitez vous 
continuer?", "Oui", "Non")
        CLOSE #hfile
        IF i <> 2 THEN
        'l'utilisateur confirme
        'on lance la sauvegarde malgrès tout
        MsgSys.Text = "Backup en cours..."
        routines.GB_norm_bkp(lstrep, ficdest.text, maxfic)

        ELSE
        'l'utilisateur annule
        ficdest.text = ""
        ENDIF 
      ELSE 'le fichier n'existe pas on peut lancer la sauvegarde
        MsgSys.Text = "Backup en cours..."
        routines.GB_norm_bkp(lstrep, ficdest.text, maxfic)

      ENDIF

   
    ELSE IF Incsel.Value = TRUE THEN 'mode backup incrémentiel
   
    ELSE IF Cpysel.Value = TRUE THEN 'mode copie simple
   
    ENDIF
 
  ENDIF
  MsgSys.Text = "En attente..."
END


PUBLIC SUB selficsrc_Click()
'selection du fichier source
  dialog.path = "/"
  dialog.filter = ["*.bkf", "fichiers catalogues"]
  IF NOT dialog.OpenFile() THEN
    ficsrc.text = dialog.path
    refreshrest(dialog.path)
  ENDIF
END

PUBLIC SUB refreshrest(fpath AS String)
DIM hrfile AS File
DIM resline AS String
DIM mxf AS Integer
DIM actf AS Integer
DIM acts AS String
DIM linesplit AS NEW String[]
DIM tmppath1 AS String
DIM tmppath2 AS String
DIM i AS Integer

msgsysrst.text = "Catalogue en cours..."
WAIT
actf = 0
'efface la liste
ficlstsrc.Clear

'ouvre le fichier catalogue en lecture
hrfile = OPEN fpath FOR INPUT 
'li la valeur maximale du nbr de fichiers
LINE INPUT #hrfile, acts
mxf = Val(acts)

'lire chaque ligne
WHILE NOT Eof(hrfile)
  LINE INPUT #hrfile, resline
  'mise a jour de la pb
  pgbr.Value = (1 / mxf) * actf
  INC actf
  'separation des répertoires et fichiers dans la ligne
  linesplit = Split(resline, "/")
  'mise en place dans le treeview avec arbo
  tmppath1 = ""
  tmppath2 = ""
  'pour chaque élément du chemin 
  FOR i = 1 TO (linesplit.count - 2)
    tmppath2 = tmppath1
    tmppath1 = tmppath1 & "/" & linesplit[i]
   
    IF ficlstsrc.Exist(tmppath1) = FALSE THEN
      'si la clef n'existe pas, la créer
      ficlstsrc.Add(tmppath1, linesplit[i], picselectnodir, tmppath2)
    ENDIF
   
  NEXT
  IF linesplit[linesplit.count - 1] <> "" THEN
  'si c'est un fichier le créer
     ficlstsrc.Add(tmppath1 & "/" & linesplit[linesplit.count - 1], 
linesplit[linesplit.count - 1],, tmppath1)
  ENDIF
WEND  
pgbr.value = 1

ficlstsrc.MoveFirst
ficlstsrc.Current.Expanded = TRUE

CLOSE #hrfile 
msgsysrst.text = "En attente..."
pgbr.Value = 0

END


PUBLIC SUB ficlstsrc_Click()
  'bascule sélection yes/no
    IF ficlstsrc.Current.Picture = picselectnodir THEN
      ficlstsrc.Current.Picture = picselectyesdir
    ELSE IF ficlstsrc.Current.Picture = picselectyesdir THEN
      ficlstsrc.Current.Picture = picselectnodir
    ENDIF
END

PUBLIC SUB selrepdstrst_Click()

  'selection du repertoire de restauration destination
  dialog.path = "/"
  IF NOT dialog.SelectDirectory() THEN
    repdestdst.text = dialog.path
  ENDIF

END

PUBLIC SUB RestBtn_Click()
DIM maxfil AS Integer
'processus de restauration suivant sélection
'et comptage des fichiers a sélectionner
ficlstsrc.MoveFirst

DO
  IF ficlstsrc.Item.Children <> 0 THEN
    maxfil += ficlstsrc.Item.Children
    ficlstsrc.Item.Expanded = TRUE
    'création de la liste des sélections
    IF ficlstsrc.Item.Picture = picselectyesdir THEN
    varrstlst.add(ficlstsrc.Item.Key & "/")
    ENDIF
    IF ficlstsrc.Item.Picture = picselectyesdir OR 
ficlstsrc.Item.Picture = picselectnodir THEN DEC maxfil
   
  ENDIF
LOOP UNTIL ficlstsrc.MoveBelow()
routines.GB_restaure(varrstlst, ficsrc.text, repdestdst.Text, maxfil)
GBackup.msgsysrst.Text = "En attente..."
END


goof luck.....I programm like a pig....lol


regards
Olivier Coquet




Benoit Minisini a écrit :
> On Saturday 28 October 2006 11:06, olinux wrote:
>   
>> I have a possible start of answer...
>> here is the complete code:
>>
>> public sub launchrst(......)
>> for i= 0 to fildir.count-1
>> 	prc=exec ["gtar", "-xvf","fichier source","-C", repdest,fichierextract[i]]
>> for read as "rest"
>>
>> 	while prc.state = 1
>> 		wait
>> 	wend
>> next
>> endsub
>>
>> public sub rest_Read()
>> dim sline as string
>>
>> line input #last, sline
>> .....
>> ....
>>
>> print sline <================here is the start of answer
>>
>> end
>>
>>
>> if i put a print in the read subroutine, all work fine
>> if i don't put a print here, stack overflow is generated about 1200 read
>> events
>>
>> this work with print to the console or print to a file opened.
>>
>> an idee ??????
>>
>> regards
>> Olivier Coquet
>>
>>     
>
> Send your full source code please.
>
> Regards,
>
>   



-- 
No virus found in this outgoing message.
Checked by AVG Free Edition.
Version: 7.1.408 / Virus Database: 268.13.17/505 - Release Date: 27/10/2006





More information about the User mailing list