Forum AtoutFox : Re: un timer qui ne compte pas   

mar. 14 avril 2015, 10h36
Gregory
atoutfox.public.association

Re: un timer qui ne compte pas

C'est nouveau, ca ?



LIKEC( ) is designed for expressions containing double-byte characters. If
the expression contains only single-byte characters, LIKEC( ) is equivalent
to LIKE( ).

This function is useful for manipulating double-byte character sets for
languages such as Hiragana and Katakana.


______
Gregory
______
"eddymaue" wrote in message news:mggrn9$7rh$1@news.niouzes.net...

Bonjour,

J'ai un soucis avec le temer dans le code qui suit. Lorsque j'exécute
le code avec le debugger, le timer s'exécute et losque s'exécute le
code sans le débugger , le timer refuse de s'exécuter

bref il y a quelque chose qui ne tourne pas rond

alors voilà

merci de vos sugestions

Lparameters
tlAutoRefresh,tcTargetFolder,tcFolderDataSource,tcDbfSourceName
Clear

* Set Step On
Set Safety Off
Set Confirm Off
Set Console Off
Set Development Off
Set Escape On

*set step on

#Define TEST_DEV .T.
#Define TEST_DEV_AutoRefresh .F.

#Define debug_trace .T.

#If debug_trace
Strtofile(Chr(13)+"-----------------------------------------------------debug_1/"+Chr(13),"c:\debug_ffd.txt",.T.)
#Endif

* je ne suis pas sure que ce soit le bon contexte
* pour utiliser sys(3050...

Sys(3050, 1, Min(536870912,Val(Sys(3050, 1, 0))))
Sys(3050, 2, Min(536870912,Val(Sys(3050, 1, 0))))

*
******************************************************************************
#If .F.

#If .F.

ffd.config
* important, il faut paremetrer correctement le fichier
*            ffd.config pour que ca fonctionne bien

rien de compliqué dans ça et voilà ce qu'il y a dedans

* à séparer par une virgule les disque ou dossiers que vous
* voulez qui insserré dans la table ffd.dbf

pcScanDir = "c:\,e:\" && chez moi j'ai 3 disques donc j'ignore le
d(cd/dvd) et le f(sauvegarde)

* localisation de la table ffd.dbf
pcDbfDir = "E:\OWNER\EDDY\VFPMESPRJETS\"

* les attributs (voir adir())
* j'ai choisi d'ignorer S pour systeme
pcAttribut = "ARD"

* voir flag de adir()
pnFlag = 1 && tiens compte de la capitalisation

* période de rafraîchissement
pnTimeRefresh = 1000*60 && 1 minute


pcAttribut = "AHRD"
A Archive – Read/Write
H Hidden
R Read-Only
S System
D Directory

pnFlag = 1
0 (Default) Display represents the Full File Name In uppercase
1 Display represents original Case In names
2 Display follows Dos 8+3 naming convention



* definition de ffd.exe
Find Files & Directories

Après ca faites les requêtes Sql qui vous plaises à la volontées.

les champs sont les suivants
============================
cFiles c(254) : le nom des fichiers, répertoires et leurs
chemins
filesize i :
DateModif D :
HeureModif c(8) :
Attributes c(5) :
lRep l : .F. fichier, .T. un répertoire

Exemple D'utilisation :

Select All Juststem(cFiles) As Item ,cFiles From ffd.Dbf;
WHERE Likec("*.txt",Alltrim(cFiles))

vous l'aurez noté, il y a Like() et LikeC()
et le 'C' c'est pour capitals. Likec() ne tient pas
compte des majuscules ou des miniscules

Important toujours mettre  Alltrim(cFiles) si non
un résultat nul vous attends

chez moi ffd.config est paramétré avec
--> pcScanDir = "c:\,e:\"
A vous de parametrer ce que vous voulez balayer

toutes les requêtes imaginables sont possibles puisque
les requêtes sont exécuté sur une Table avec du Sql

wow tout simplement wow On est loin de Adir()

donc des exemples un peu plus poussé

je veux trouver tous les programmes que Gregory nous A
données en exemples et que j'ai téléchargés

* avec $
Select All Juststem(cFiles) As Item ,cFiles From ffd.Dbf;
WHERE ;
Likec("*.prg",Alltrim(cFiles)) ;
and Lower("OLEPUBLIC") $ Lower(Filetostr(cFiles))

* avec LikeC()
Select All Juststem(cFiles) As Item ,cFiles From ffd.Dbf;
WHERE ;
Likec("*.prg",Alltrim(cFiles)) ;
and Likec("*Greg*", Filetostr(cFiles))


* teste de rapidité
t1 = Seconds()
Select All Juststem(cFiles) As Item ,cFiles From ffd.Dbf;
WHERE Likec("*.prg",Alltrim(cFiles)) And "greg" $
Lower(Filetostr(cFiles)) Into Cursor greglist
_Cliptext = Transform( Seconds()-t1)+" secondes
"+Transform(Reccount("greglist")) "fichiers"

2.085 secondes 31 fichiers

bon un teste avec Francis F.
t1 = Seconds()
Select All Juststem(cFiles) As Item ,cFiles From ffd.Dbf;
WHERE Likec("*.prg",Alltrim(cFiles)) And "francis" $
Lower(Filetostr(cFiles)) Into Cursor francislist
_Cliptext = Transform( Seconds()-t1)+" secondes
"+Transform(Reccount("francislist")) +" fichiers"
2.183 secondes et le nombre de fichiers ben j'vais gardé ca pour moi
;o)

et pourquoi pas unire les 2 recherches

t1 = Seconds()

Select All Juststem(cFiles) As Item ,cFiles From ffd.Dbf;
WHERE Likec("*.prg",Alltrim(cFiles)) And "greg" $
Lower(Filetostr(cFiles)) ;
union Select All Juststem(cFiles) As Item ,cFiles From ffd.Dbf;
WHERE Likec("*.prg",Alltrim(cFiles)) And "francis" $
Lower(Filetostr(cFiles)) Into Cursor francislist

_Cliptext = Transform( Seconds()-t1)+" secondes
"+Transform(Reccount("francislist")) +" fichiers"
4.254 secondes 33 fichiers


en un peu plus de 4 secondes j'ai trouvé 33 fichiers dans une marre de
104000 fichiers

voilà On peut faire ce que l'on veut avec une table et du sql


#Endif
*
******************************************************************************
#Endif


*Set Step On

Createobject("FFDclss",tlAutoRefresh,tcTargetFolder,tcFolderDataSource,m.tcDbfSourceName)


If tlAutoRefresh

Read Events

Endif

Define Class FFDclss As Form

* DataSession= 2
repertoire = ""
cDbfFile = ""
cTable = "FFD"
ScanDir = "c:\,l:\"    && par defaut si ffd.config n'existe pas
Attribute = "ARD"
TimeRefresh = 1000*60 && 1 minute
Flag = 1

Dimension p_aResultat(1)


Procedure Load
Set Safety Off


#If debug_trace
Strtofile("debug_2/","c:\debug_ffd.txt",.T.)
#Endif


* Auteur Eddy Maue ;o)

Local lcGetPath && le chemin de ce fichier
lcGetPath = Justpath(Substr(Sys(16),At(":",Sys(16))-1))
lcGetPath= Iif( _vfp.StartMode>0,lcGetPath,Justpath(lcGetPath))

Set Default To (lcGetPath)
Set Path To "Data,fichier" Additive && avec la contribution Jean de
Grenoble aussi dit Jean Maurice
Set Console Off
Set Talk Off

Endproc

Procedure Init
Lparameters tlAutoRefresh,
tcTargetFolder,tcFolderDataSource,tcDbfResultat


#If debug_trace
Strtofile("debug_3/","c:\debug_ffd.txt",.T.)
#Endif


Do Case
Case Not tlAutoRefresh

Case Type("_Screen.oFFD")=="U"

_Screen.AddProperty("oFFD",This)


Otherwise
_Screen.oFFD= This

Endcase


With This
* fichier de configuration
Local i , lnRepertoirTab ,laRepertoirTab(1)

If Vartype(tcTargetFolder)=="L" And tcTargetFolder And
File("ffd.config")

Public pcScanDir, pcDbfDir,  pcAttribut, pnFlag , pnTimeRefresh
Execscript(Filetostr("ffd.config"))

..ScanDir = Iif( Vartype(pcScanDir )=="L" Or Empty(pcScanDir )    ;
,    This.ScanDir    ;
,    pcScanDir    ;
)


..cDbfFile = Iif(Vartype(pcDbfDir)=="C" And Directory(pcDbfDir) ;
,    Addbs(pcDbfDir)     ;
,    lcGetPath    ;
)


..Attribute = Iif(Vartype(pcAttribut)=="C" ;
,    pcAttribut    ;
,    .Attribute    ;
)


..Flag = Iif(Vartype(pnFlag)=="N"    ;
,    pnFlag    ;
,    .Flag    ;
)


..TimeRefresh  = Iif(TEST_DEV,1000,Iif(Vartype(pnTimeRefresh) == "N"
And pnTimeRefresh > 1000    ;
,    pnTimeRefresh    ;
,     .TimeRefresh    ;
))


Release pcScanDir, pcDbfDir,  pcAttribut, pnFlag , pnTimeRefresh
Else

* le(s) répertoire(s) à ballayer
..ScanDir = Iif( Vartype(tcTargetFolder)=="L" Or
Empty(tcTargetFolder)    ;
,    This.ScanDir    ;
,    Addbs(tcTargetFolder)    ;
)


* le repertoire hote de FFD.DBF
..cDbfFile = Iif(Vartype(tcFolderDataSource)=="C" And
Directory(tcFolderDataSource) ;
,    Addbs(tcFolderDataSource)    ;
,    Addbs(Justpath(Substr(Sys(16),At(":",Sys(16))-1)))    ;
)

If Vartype(m.tcDbfResultat)="C" And Not Empty(m.tcDbfResultat)
..cTable = Forceext(m.tcDbfResultat,"") && pas d'extension
Endif


Endif
lnRepertoirTab = Alines(laRepertoirTab,.ScanDir,1,",")

* tableau
Local lcRepertoir
lcRepertoir = ""
For i = 1 To lnRepertoirTab
* lcRepertoir = "c:\,l:\,,,n:\"
lcRepertoir = lcRepertoir + Iif(Vartype(laRepertoirTab(i))=="C" And
Directory(laRepertoirTab(i)) ;
,    Addbs(laRepertoirTab(i)) + Iif(i<lnRepertoirTab,",","");
,    ""    ;
)
Endfor

..ScanDir = Strtran(lcRepertoir,",,",",")
..cDbfFile = Addbs(.cDbfFile)+This.cTable+".dbf"

..AddObject("RefreshTimer1","RefreshTimer")


* .RefreshTimer1.Interval = .TimeRefresh
..Start()


Endwith



Endproc

Procedure Start


#If debug_trace
Strtofile("debug_4/","c:\debug_ffd.txt",.T.)
#Endif


* première tentative
*!* This.RefreshTimer1.Enabled = .T.
*=Inkey(.001)
This.RefreshTimer1.interval=.0001


#If debug_trace
Strtofile("debug_4.1 /","c:\debug_ffd.txt",.T.)
#Endif


Endproc


Procedure stop

#If debug_trace
Strtofile("debug_4/","c:\debug_ffd.txt",.T.)
#Endif


This.RefreshTimer1.Enabled = .F.

Endproc

Procedure Refresh


#If debug_trace
Strtofile("debug_5/","c:\debug_ffd.txt",.T.)
#Endif

This.RefreshTimer1.Enabled = .F.
This.RefreshTimer1.Interval = .TimeRefresh
Local lcDir

Set Step On

lnDir = AdirRecursif(This.ScanDir) &&, lcDir, "AHRSD", 1)

Try
* si FFD.dbf n'est pas ouvert dans une autre application , il
* n'y aura pas d'errreur.
* donc important, faire la requête SQL et fermer immédiatement
*      la table FFD.dbf pour permettre le rafraîchissement de FFD

Select * From csrFD Into Table (.cTable)
* pour une raison que j'ignore il faut flusher la table
* avant de la refermer. Si non j'ai noté un problème de
* rafrachissement *** pas sûre mais ca ne coute qu'une ligne
* de code et ça me rassure ****
Flush In (.cTable)
Use In (.cTable)


Catch To oe

* si la table est ouverte ailleur une erreur est catché et il n'y
* a pas de rafraîchissement.

* donc important faites votre requete et fermer du même coup la
table ffd comme suivant
Select cFiles From ("ou est ffd.dbf") Where "se que vous voulez avec
cfiles, filesSize,"

Endtry

Use In csrFD

Modify Files ( "OuEnSuige.txt") Nowait



This.RefreshTimer1.interval = Iif(TEST_DEV And Not
TEST_DEV_AutoRefresh    ,    0    ,    0.0001    )

Endproc

Enddefine

Define Class RefreshTimer As Timer
Interval = 0  && 1 min
Enabled = .t.

Procedure Timer

This.Interval = 0

#If debug_trace
Strtofile("debug_5/","c:\debug_ffd.txt",.T.)
#Endif


With Thisform

Private gcAlias, gcDBF, gcAttribute, giFlag
gcAlias = .cTable
gcDBF = .cDbfFile
gcAttribute = .Attribute
giFlag = .Flag
..Refresh()


Endwith

Endproc


Enddefine

Function AdirRecursif(;
tcTargetFolder As String ;
)


#If debug_trace
Strtofile("debug_7/","c:\debug_ffd.txt",.T.)
#Endif


Create Cursor  csrFD ( cFiles c(254),filesize i,DateModif D,HeureModif
c(8),Attributes c(5) ,lRep l)
Local lnRepertoirTab, lnDir, laRepertoirTab(1)

lnRepertoirTab = Alines(laRepertoirTab,.ScanDir,1,",")
lnDir = 0

For Each lcRepertoir In  laRepertoirTab
t1 = Seconds()
lnDir = lnDir + AdirRecursif_1(lcRepertoir) &&,tcAttribute,tiFlag)
t2 = Seconds()-t1
TEXT to myText TEXTMERGE NOSHOW
Dossier traité : <<lcRepertoir>>
        <<DateTime()>>    items ajoutés  : <<Transform(lnDir)>> Durée
du traitement :<<Str(t2/60,4,2)>>

ENDTEXT

Strtofile(Chr(13)+Chr(10)+myText, "OuEnSuige.txt",1)

Endfor

Return lnDir

Endfunc

Function AdirRecursif_1(;
tcTargetFolder As String ;
)

Local i, lnT ,oe As Exception
Local Array laFiles(1)

#If debug_trace
Strtofile("debug_8/","c:\debug_ffd.txt",.T.)
#Endif



lnT = Adir(laFiles, tcTargetFolder + "*.*", gcAttribute, giFlag)

Try

For i= Iif(laFiles(1,1)==".",1,0)+Iif(laFiles(2,1)=="..",1,0)+1 To
lnT

Insert Into csrFD Values ;
(;
tcTargetFolder + laFiles[i,1] ; && + Iif("D" $ laFiles[i,5] ,"\"
,"" )
,    laFiles[i,2]  ;
,    laFiles[i,3]  ;
,    laFiles[i,4]  ;
,    laFiles[i,5]  ;
,    "D" $ laFiles[i,5] ;
)



Iif(Occurs("D",laFiles[i,5])=0 ;
,    0 ;
,    AdirRecursif_1( tcTargetFolder + laFiles[i,1]+"\")    ;
)

Next
Catch To oe
If oe.ErrorNo = 107


=Strtofile;
(    "ignoré : ErrNo 107 :: Le répertoire ou le fichier" ;
+    tcTargetFolder ;
+
Iif(Type("laFiles[i,1]")=="U","",Iif(Vartype(laFiles[i,1])=="C",laFiles[i,1],""))
;
, "OuEnSuige.txt" ,1    ;
)

Else

TEXT to MyText textmerge noshow
        ErrorNo      :<< oe.ErrorNo >>
        Details      :<< oe.Details >>
        LineContents :<< oe.LineContents >>
        LineNo       :<< oe.LineNo >>
        Message      :<< oe.Message >>
        StackLevel   :<< oe.StackLevel >>

ENDTEXT

Strtofile(Chr(13)+Chr(10)+myText, "Error.log",1)
Endif
Endtry

Return Reccount("csrFD")
Endfunc && AdirRecursif



--
Merci de partager avec moi votre immense savoir que je me ferai plaisir
d'absorber...
il va de soi que je vais vous en laisser un peu
Politesse et savoir vivre oblige ;0)
Permalink : http://www.atoutfox.org/nntp.asp?ID=0000016282