[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