Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Instantaneous file search tool
Message
De
04/05/2018 10:54:35
 
 
À
02/05/2018 14:43:20
Information générale
Forum:
Visual FoxPro
Catégorie:
Gestionnaire d'écran & Écrans
Versions des environnements
Visual FoxPro:
VFP 9 SP2
OS:
Windows 10
Divers
Thread ID:
01659693
Message ID:
01659748
Vues:
61
for all:
this is the second part of the application we talk on in this thread.
that suppose the first aleady working (to test) on PC it works fine on windows task scheduler and periodically updated with the real state of all filles on workstation.
the table built allfiles.dbf ~630.000 records and size=159 Moctets in my PC
note in the recursivefolder() method i used only the SHD directories ( see Adir() function),
build a proj with thie ysearch.prg add a config.fpw [screen=off resource=off safe=off] and compile ysearch.exe.put it in same folder with the table allfiles.dbf and run.
make any file search...
as a prg +config.fpw this exe is ~30 Koctets only (no debug and crypted).
some filckers appear with textbox.inetractiveChange()....can use only a button at valid event of textbox instead( enable it before and cut the code in textbox interactiveChange).
test and give me a feedback please.
If !_vfp.StartMode=0
	On Shutdown Quit
Endi
Set Defa To Addbs(Justpath(Sys(16,1)))
Close Data All
*****************
*manage updates form yrecursive.exe(-if allfiles.dbf in use the update is copied to allfiles_attente.dbf)
Local t1,t2
If  File("allfiles.dbf") And File("allfiles_attente.dbf")
	t1=Fdate("allfiles.dbf",1)
	t2=Fdate("allfiles_attente.dbf",1)
	If t2>t1  && allfiles_attente is most recent
		Copy File allfiles_attente.Dbf  To allfiles.Dbf
		Erase allfiles_attente.Dbf
	Else
		Erase allfiles-attente.Dbf
	Endi
Endi

If !File("allfiles.dbf")
	Messagebox("allfiles.dbf is nolonger",16+4096,'',1300)
	Return .F.
Endi
******************
Local m.myvar
TEXT to m.myvar noshow
this app ysearch.exe uses the table allfiles.dbf built periodically in scheduler all 1 hour(to adjust).
then its slighly asynchrone and dont reflect exactly the system files state.
ENDTEXT
Messagebox(m.myvar,0+32+4096,'',3000)

Public oform
oform=Newobject("ysearch")
oform.Show
Read Events
Return
*end of main
*

*form class
Define Class ysearch As Form
	DataSession = 2
	Height = 464
	Width = 1012
	ShowWindow = 2
	AutoCenter = .T.
	Caption = "A special filer"
	Name = "Form1"

	Add Object grid1 As Grid With ;
		FontSize = 8, ;
		Anchor = 15, ;
		Height = 396, ;
		Left = 12, ;
		ReadOnly = .T., ;
		RowHeight = 17, ;
		Top = 60, ;
		Width = 996, ;
		HighlightBackColor = Rgb(223,223,255), ;
		HighlightForeColor = Rgb(0,0,170), ;
		HighlightStyle = 2, ;
		Name = "Grid1"

	Add Object text1 As TextBox With ;
		Anchor = 0, ;
		Height = 25, ;
		Left = 24, ;
		Top = 6, ;
		Width = 576, ;
		Name = "Text1"
	Add Object ylab As Label With Anchor=0,BackStyle=0,Caption="dblClick cDir or filename to run the file with win associated application",Left=24,Top=36,AutoSize=.T.,ForeColor=Rgb(128,0,64),Name="ylab"

	Add Object command1 As CommandButton With ;
		Top = 6, ;
		Left = 661, ;
		Height = 25, ;
		Width = 25, ;
		Anchor = 0, ;
		Caption = "Go", ;
		Enabled = .F., ;
		Name = "Command1"

	Add Object Label1 As Label With ;
		Anchor = 0, ;
		BackStyle = 0, ;
		Caption = "", ;
		Height = 25, ;
		Left = 736, ;
		Top = 5, ;
		Width = 241, ;
		ForeColor = Rgb(255,0,0), ;
		Name = "Label1"

	Procedure yrmenu
	Define Popup raccourci SHORTCUT Relative From Mrow(),Mcol()
	Define Bar _Med_slcta Of raccourci Prompt "Sélec\<tionner tout" ;
		KEY CTRL+A, "Ctrl+A" ;
		MESSAGE "Sélectionne tout le texte ou tous les éléments de la fenêtre active"
	Define Bar _Med_cut Of raccourci Prompt "\<Couper" ;
		KEY CTRL+X, "Ctrl+X" ;
		MESSAGE "Enlève la sélection et la place dans le Presse-papiers"
	Define Bar _Med_paste Of raccourci Prompt "C\<oller" ;
		KEY CTRL+V, "Ctrl+V" ;
		MESSAGE "Place le contenu du Presse-papiers au point d'insertion"
	Define Bar _Med_copy Of raccourci Prompt "Co\<pier" ;
		KEY CTRL+C, "Ctrl+C" ;
		MESSAGE "Copie la sélection et la place dans le Presse-papiers"
	Define Bar _Med_undo Of raccourci Prompt "\<Annuler" ;
		KEY CTRL+Z, "Ctrl+Z" ;
		MESSAGE "Annule la dernière modification"
	Define Bar _Med_redo Of raccourci Prompt "\<Rétablir" ;
		KEY CTRL+R, "Ctrl+R" ;
		MESSAGE "Rétablit la dernière opération annulée"
	Activate Popup raccourci
	Endproc

	Procedure yrun
	Sele ycurs
	result = ShellExecute(0, "open", Allt(cdir)+Allt(cfilename),"","",1)
	If result<=32
		Messagebox("An error was occured with window associated application",16+4096,'',1300)
	Endi
	Endproc

	Procedure Destroy
	Close Data All
	Clea Events
	Endproc

	Procedure Resize
	With Thisform.grid1
		.column1.Width=0.4*.Parent.Width -20
		.column2.Width=0.2*.Parent.Width -20
		.column3.Width=0.1*.Parent.Width -20
		.column4.Width=0.1*.Parent.Width -20
		.column5.Width=0.1*.Parent.Width -20
		.column6.Width=0.1*.Parent.Width -20
	Endwith
	Endproc

	Procedure Load
&&shellexecute
	Declare Integer ShellExecute In SHELL32.Dll Integer nWinHandle,;
		STRING cOperation,;
		STRING cFileName,;
		STRING cParameters,;
		STRING cDirectory,;
		INTEGER nShowWindow
	Close Data All
	Sele * From allfiles.Dbf  Into Cursor ycurs
	Endproc

	Procedure Init
	Thisform.text1.SetFocus
	Thisform.Label1.Caption=Trans(Reccount())+" records"
	Endproc

	Procedure grid1.Init
	With This
		.RecordSource="ycurs"
		.RecordSourceType=1
		.GridLines=0
		.DeleteMark=.F.
		.column2.FontBold=.T.
		.column1.Width=0.4*.Parent.Width -20
		.column2.Width=0.2*.Parent.Width -20
		.column3.Width=0.1*.Parent.Width -20
		.column4.Width=0.1*.Parent.Width -20
		.column5.Width=0.1*.Parent.Width -20
		.column6.Width=0.1*.Parent.Width -20
		.SetAll("DynamicBackColor","IIF(MOD(RECNO(), 2)=0, rgb(220,220,220)  , rgb(255,255,255))", "Column")
		Locate
		.Refresh

		For i=1 To .ColumnCount
			Bindevent(.Columns(i).text1,"rightclick",Thisform,"yrmenu")
		Endfor
		Bindevent(.column1.text1,"dblclick",Thisform,"yrun")
		Bindevent(.column2.text1,"dblclick",Thisform,"yrun")
	Endwith
	Endproc

	Procedure text1.InteractiveChange
	Thisform.Label1.Caption=""
	Sele * From allfiles.Dbf Where Lower(Allt(Thisform.text1.Value)) $ Lower(Allt(cfilename)) Into Cursor ycurs
	Sele ycurs
	With Thisform.grid1
		.RecordSource=""
		.RecordSource="ycurs"
		.column2.FontBold=.T.
		.column1.Width=0.4*.Parent.Width -20
		.column2.Width=0.2*.Parent.Width -20
		.column3.Width=0.1*.Parent.Width -20
		.column4.Width=0.1*.Parent.Width -20
		.column5.Width=0.1*.Parent.Width -20
		.column6.Width=0.1*.Parent.Width -20
		.SetAll("DynamicBackColor","IIF(MOD(RECNO(), 2)=0,rgb(220,220,220)  , rgb(255,255,255))", "Column")
		Locate
		.Refresh
		.Parent.Label1.Caption=Trans(Reccount())+" occurs"
		For i=1 To .ColumnCount
			Bindevent(.Columns(i).text1,"rightclick",Thisform,"yrmenu")
		Endfor
		Bindevent(.column1.text1,"dblclick",Thisform,"yrun")
		Bindevent(.column2.text1,"dblclick",Thisform,"yrun")
	Endwith
	Endproc

	Procedure text1.RightClick
	Thisform.yrmenu()
	Endproc

	Procedure command1.Click
	Thisform.Label1.Caption=""
	Sele * From allfiles.Dbf Where Lower(Allt(Thisform.text1.Value)) $ Lower(Allt(cfilename)) Into Cursor ycurs
	Sele ycurs
	With Thisform.grid1
		.RecordSource=""
		.RecordSource="ycurs"
		.column2.FontBold=.T.
		.column1.Width=0.4*.Parent.Width -20
		.column2.Width=0.2*.Parent.Width -20
		.column3.Width=0.1*.Parent.Width -20
		.column4.Width=0.1*.Parent.Width -20
		.column5.Width=0.1*.Parent.Width -20
		.column6.Width=0.1*.Parent.Width -20
		.SetAll("DynamicBackColor","IIF(MOD(RECNO(), 2)=0,rgb(220,220,220)  , rgb(255,255,255))", "Column")
		Locate
		.Refresh
		.Parent.Label1.Caption=Trans(Reccount())+" occurs"
		For i=1 To .ColumnCount
			Bindevent(.Columns(i).text1,"rightclick",Thisform,"yrmenu")
		Endfor

		Bindevent(.column1.text1,"dblclick",Thisform,"yrun")
		Bindevent(.column2.text1,"dblclick",Thisform,"yrun")
	Endwith
	Endproc
Enddefine
*
*-- EndDefine: ysearch
note: application is in 2 exe only+allfiles.dbf table [yrecursive.axe (26ko),ysearch.exe (30ko),allfiles.dbf (159 mo)]
the great advantage here is to compare results with what everything.exe returns.
Précédent
Suivant
Répondre
Fil
Voir

Click here to load this message in the networking platform