The windows special folders
*The Begining was with this MSDN link:ShellSpecialFolderConstants enumeration:
*https://msdn.microsoft.com/ru-RU/library/windows/desktop/bb774096%28v=vs.85%29.aspx
*the code builds the folders names and the folders paths for the system special folders.
*add readonly,system,hidden ,folder size (octets). as
*Special folders are also named known folders and their physic locations on disc depends of windows version.
*1*
*Begin code
Local m.myvar
TEXT to m.myvar noshow
ssfALTSTARTUP 0x1d
ssfAPPDATA 0x1a
ssfBITBUCKET 0x0a
ssfCOMMONALTSTARTUP 0x1e
ssfCOMMONAPPDATA 0x23
ssfCOMMONDESKTOPDIR 0x19
ssfCOMMONFAVORITES 0x1f
ssfCOMMONPROGRAMS 0x17
ssfCOMMONSTARTMENU 0x16
ssfCOMMONSTARTUP 0x18
ssfCONTROLS 0x03
ssfCOOKIES 0x21
ssfDESKTOP 0x00
ssfDESKTOPDIRECTORY 0x10
ssfDRIVES 0x11
ssfFAVORITES 0x06
ssfFONTS 0x14
ssfHISTORY 0x22
ssfINTERNETCACHE 0x20
ssfLOCALAPPDATA 0x1c
ssfMYPICTURES 0x27
ssfNETHOOD 0x13
ssfNETWORK 0x12
ssfPERSONAL 0x05
ssfPRINTERS 0x04
ssfPRINTHOOD 0x1b
ssfPROFILE 0x28
ssfPROGRAMFILES 0x26
ssfPROGRAMFILESx86 0x30
ssfPROGRAMS 0x02
ssfRECENT 0x08
ssfSENDTO 0x09
ssfSTARTMENU 0x0b
ssfSTARTUP 0x07
ssfSYSTEM 0x25
ssfSYSTEMx86 0x29
ssfTEMPLATES 0x15
ssfWINDOWS 0x24
ENDTEXT
Create Cursor ycurs (num i, cslIDName c(30) , csIDL c(10),folder c(85),folderName c(30) ,yhidden c(12), ysystem c(12),yreadonly c(14),ysize i) &&,EnvstringPath c(70)) to do ?
Local m.x1,m.x2,m.oo
For i=1 To Memlines(m.myvar)
m.oo =Mline(m.myvar,i)
m.x1 =Getwordnum(m.oo,1)
m.x2 =Getwordnum(m.oo,2)
Insert Into ycurs Values(i ,Allt(m.x1) ,Allt(m.x2),'','','','','',0)
Endfor
#Define ssfALTSTARTUP 0x1d
#Define ssfAPPDATA 0x1a
#Define ssfBITBUCKET 0x0a
#Define ssfCOMMONALTSTARTUP 0x1e
#Define ssfCOMMONAPPDATA 0x23
#Define ssfCOMMONDESKTOPDIR 0x19
#Define ssfCOMMONFAVORITES 0x1f
#Define ssfCOMMONPROGRAMS 0x17
#Define ssfCOMMONSTARTMENU 0x16
#Define ssfCOMMONSTARTUP 0x18
#Define ssfCONTROLS 0x03
#Define ssfCOOKIES 0x21
#Define ssfDESKTOP 0x00
#Define ssfDESKTOPDIRECTORY 0x10
#Define ssfDRIVES 0x11
#Define ssfFAVORITES 0x06
#Define ssfFONTS 0x14
#Define ssfHISTORY 0x22
#Define ssfINTERNETCACHE 0x20
#Define ssfLOCALAPPDATA 0x1c
#Define ssfMYPICTURES 0x27
#Define ssfNETHOOD 0x13
#Define ssfNETWORK 0x12
#Define ssfPERSONAL 0x05
#Define ssfPRINTERS 0x04
#Define ssfPRINTHOOD 0x1b
#Define ssfPROFILE 0x28
#Define ssfPROGRAMFILES 0x26
#Define ssfPROGRAMFILESx86 0x30
#Define ssfPROGRAMS 0x02
#Define ssfRECENT 0x08
#Define ssfSENDTO 0x09
#Define ssfSTARTMENU 0x0b
#Define ssfSTARTUP 0x07
#Define ssfSYSTEM 0x25
#Define ssfSYSTEMx86 0x29
#Define ssfTEMPLATES 0x15
#Define ssfWINDOWS 0x24
Sele ycurs
Local objShell
Scan
objShell = Createobject("Shell.Application")
objFolder = objShell.Namespace(Eval(csIDL))
objFolderItem = objFolder.Self
Repl folder With objFolderItem.Path,folderName With objFolderItem.Name
objShell=Null
objFolder=Null
objFolderItem=Null
Local filesys, demofolder
filesys = Createobject("Scripting.FileSystemObject")
Try
demofolder = filesys.GetFolder(folder)
Repl ysize With demofolder.Size &&octets
If demofolder.Attributes= 1
Repl yreadonly With "Yes"
Else
Repl yreadonly With "No"
Endi
Try
If demofolder.Attributes=2
Repl yhidden With "Yes"
Else
Repl yhidden With "No"
Endi
Catch
Endtry
Try
If demofolder.Attributes=4
Repl ysystem With "Yes"
Else
Repl ysystem With "No"
Endi
Catch
Endtry
Catch
Endtry
demofolder=Null
filesys=Null
If Empty(yreadonly) And Empty(ysystem) And Empty(yhidden)
Repl ysystem With "yes"
Endi
Endscan
*brow
Locate
Browse Name ybrow Title Trans(Reccount())+" Special Folders on system )" Nowait &&window as oop object
With ybrow
.DeleteMark=.F.
.GridLines=0
.FontBold=.T.
.Themes=.F.
.RecordMark=.F.
.SetAll("forecolor",255,"header")
.SetAll("backcolor",Rgb(0,255,0),"header")
.Columns(1).DynamicBackColor="RGB(128,128,128)"
.Columns(2).DynamicBackColor="RGB(100,140,240)"
.Columns(3).DynamicBackColor="RGB(201,239,180)"
.Columns(4).DynamicBackColor="RGB(120,140,40)"
.Columns(5).DynamicBackColor="RGB(240,200,190)"
.HeaderHeight=24
For i=1 To .ColumnCount
.Columns(i).header1.FontSize=14
Endfor
Endwith
Retu
*end code
*the browse windows is a vfp data browse window one and its manipulated as object (form) with its name.It not have all form properties.
*The Attributes property sets or retrieves the attributes of a folder. The following lists the values of the files/folders attributes.
*Value Stands For Description
*0 Normal Normal folder with no attributes set
*1 Read Only Read-only folder with read/write attribute
*2 Hidden Hidden folder with read/write attribute
*4 System System folder with read/write attribute
*8 Volume Disk drive volume label with read-only attribute
*16 Directory Folder or directory with read-only attribute
*32 Archive Folder has changed since last backup with read/write attribute
*64 Alias Link or shortcut to a folder with read-only attribute
*128 Compressed Compressed folder with read-only attribute
Notes
*2* Special folders can also be obtained with APIs like
DECLARE INTEGER SHGetSpecialFolderLocation IN shell32;
INTEGER hwndOwner,;
INTEGER nFolder,;
INTEGER @ppidl
*3* To obtain the windows and system32 directories can use these APIs :
DECLARE INTEGER GetWindowsDirectory IN kernel32 STRING @lpBuffer, INTEGER nSize
DECLARE INTEGER GetSystemDirectory IN kernel32 STRING @ lpBuffer, INTEGER nSize
LOCAL lpBuffer, nSizeRet
lpBuffer = SPACE (250)
nSizeRet = GetSystemDirectory(@lpBuffer, Len(lpBuffer))
lpBuffer1 = SUBSTR (lpBuffer, 1, nSizeRet)
lpBuffer = SPACE (250)
nSizeRet = GetWindowsDirectory(@lpBuffer, Len(lpBuffer))
lpBuffer2 = SUBSTR (lpBuffer, 1, nSizeRet)
messagebox("windows directory="+lpBuffer2+chr(13)+"windows system directory="+lpbuffer1)
*these last can be also reached with very simple visual foxpro function getEnv():
messagebox ( " With getenv() function: windows dir="+getenv("windir")+" "+addbs(getenv('windir'))+"system32")
Select code and type CTRL+C to copy and paste into a prg.
warning the provider editor have some problems with comas and end lines.please correct if the case.
*4* Updated on dimanche 29 mars 2015; 15:31:01
*Begin code
Declare Integer SHGetSpecialFolderPath In Shell32.Dll Integer, String @lcPath, Integer, Integer
Create Cursor ycurs( cPath c(150))
N=200 && can be reevaluated/adjusted after running the code
For i=1 To N
lcPath = Space(255)
If SHGetSpecialFolderPath(0, @lcPath, i, 0) = 1
lcPath = Alltrim(lcPath)
lcPath = Addbs(Trim(lcPath,1,Chr(0)))
* WAIT WINDOW lcPath
Insert Into ycurs Values (lcPath)
Endif
Endfor
Locate
Browse Name ybrow Title Trans(Reccount())+" special folders on system" Nowait
With ybrow
.DeleteMark=.F.
.GridLines=0
.FontSize=12
.FontBold=.T.
.RecordMark=.F.
.SetAll("DynamicBackColor","IIF(MOD(RECNO( ), 2)=0, RGB(255,255,255) , RGB(200,205,180))", "Column")
Endwith
Retu
*End code
Click on code to select [then copy] -click outside to deselect
*5*
*!*added on Friday 18 march 2016; 11:00:13
*!*this code hides any folder (dont see in explorer or any dialog box)
*!* it can be a some secure folder for personal data.it dont give a hight level security but is good for local use only.
*;* for hight security level must use a crypt folder (or disc) application.
*!* *create project and make this prg as main(change secret password)
*!* *add a config.fpw screen=off resource=off
*!* *and compile ylocker.exe (+crypted option)
*!* *retain only the exe to put beside the secure folder created.
*!* *put project folder in sure location
*!* *run the exe -hidding folder recquires only ('y'=yes)-for restoring folder recquires secret password
*!* dos code is from the web
*!*http://operating-systems.wonderhowto.com/how-to/lock-folder-without-any-software-with-password-0150639/
On Shutdown Quit
Local m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
Set Defa To (yrep)
Local m.ypassword
m.ypassword="benameuryousfi1@gmail.com" &&to customize here your secret password
Local m.myvar
TEXT to m.myvar textmerge noshow
@ECHO OFF
if EXIST "Control Panel.{21EC2020-3AEA-1069-A2DD-08002B30309D}" goto UNLOCK
if NOT EXIST MyFolder goto MDMyFolder
:CONFIRM
echo Are you sure to lock this folder? (Y/N)
set/p "cho=>"
if %cho%==Y goto LOCK
if %cho%==y goto LOCK
if %cho%==n goto END
if %cho%==N goto END
echo Invalid choice.
goto CONFIRM
:LOCK
ren MyFolder "Control Panel.{21EC2020-3AEA-1069-A2DD-08002B30309D}"
attrib +h +s "Control Panel.{21EC2020-3AEA-1069-A2DD-08002B30309D}"
echo Folder locked
goto End
:UNLOCK
echo Enter password to Unlock Your Secure Folder
set/p "pass=>"
if NOT %pass%== <<m.ypassword>> goto FAIL
attrib -h -s "Control Panel.{21EC2020-3AEA-1069-A2DD-08002B30309D}"
ren "Control Panel.{21EC2020-3AEA-1069-A2DD-08002B30309D}" MyFolder
echo Folder Unlocked successfully
goto End
:FAIL
echo Invalid password
goto end
:MDMyFolder
md MyFolder
echo MyFolder created successfully
goto End
:End
ENDTEXT
Set Safe Off
Local m.lcdest
m.lcdest=Addbs(Sys(2023))+"yl.bat"
Strtofile(m.myvar,m.lcdest)
Local oshell
oshell=Newobject("wscript.shell")
oshell.Run(m.lcdest,1,.T.) &&run cmd and wait to password
Dele File (m.lcdest) &&clean traces
*****
Local m.xx
If !Directory("myfolder")
m.xx="Private folder Myfolder was hidden"
Else
m.xx="Private folder MyFolder was restored"
Endi
Messagebox(m.xx,0+32+4096,'yLocker',1500)
Quit
*end of main
Click on code to select [then copy] -click outside to deselect
As said above this method dont give high security level.
if the folder name is known (assuming E:\____ytests\_toTest\yfolder_secure) with this code can recover the hidden folder with its contents(code changes attribut an renames the folder)
make this DOS code in bat file and execute:
***
cd E:\____ytests\_toTest\yfolder_secure
attrib -s -h "Control Panel.{21EC2020-3AEA-1069-A2DD-08002B30309D}"
ren "Control Panel.{21EC2020-3AEA-1069-A2DD-08002B30309D}" myNewnameFolder
****
running this code in cmd.exe (as administrator) and exploring the folder can see the myNewNameFolder visible with all its data.
no need to any password to get the hidden contents and this method is at the bottom of security level.
Conclusion: to secure data embed in a folder need mandatory to encrypt this folder.
Click on code to select [then copy] -click outside to deselect
*6*
*created on 27 of january 2017
*recurse on disc folders
*List all "bmpjpggifpngtiffemf" files and gather in a cursor .
*this recurse on folders and subfolders.returns the count and the ellpased calculation time
*this code can be applied to extract any extension file as this prototype
Clea All
Local m.yrep
m.yrep=Addbs(GETDIR("c:\", "Select a folder", "Directories",32 ))
If Empty(m.yrep)
Return .F.
Endi
Publi m.nrep,m.searched
m.searched="bmpjpggifpngtiffemf" &&all images types here.can search any file extension (ex: xls,doc,...)
m.nrep=0
Local m.ltStart
m.ltStart = Datetime()
Create Cursor tempfiles ( cFilename c(150), nSize N(10), dMod d )
=RecurseFolder( yrep )
Messagebox(Trans(Reccount())+" files "+Trans( Datetime() - ltStart)+" sec répertoires="+Trans(nrep),0+32+4096,'',1300)
*browse nowait
Locate
Browse Name ybrow Title Trans(Reccount())+" found. - Recurse folders for any extension file " Nowait &&window as oop object
With ybrow
.DeleteMark=.F.
.GridLines=0
.RecordMark=.F.
.SetAll("DynamicBackColor","IIF(MOD(RECNO( ), 2)=0, RGB(255,228,196) , RGB(144,238,140))", "Column")
Endwith
*clean publi variables
m.nrep=Null
m.searched=Null
Retu
Function RecurseFolder( lcDir )
Local i,N, laFiles[1]
m.nrep=m.nrep+1
N = Adir( laFiles, lcDir + "*.*", "shd" )
For i = 1 To N
If ( Left( laFiles[i,1], 1 ) != '.' )
If ( "D" $ laFiles[i,5] )
RecurseFolder( lcDir + laFiles[i,1] + "\" )
Else
If Lower(Justext(laFiles[i,1])) $ m.searched
Insert Into tempfiles Values( lcDir + laFiles[i,1], laFiles[i,2], laFiles[i,3] )
Endi
Endif
Endif
Endfor
Return
can extract any file extension.if want only folders use at the end: justpathc(cfilename)
Click on code to select [then copy] -click outside to deselect
*7*
*changing current attributes of file or folder.
*Just use the WinApi function SetFileAttributes;
*However, be careful to get the current attributes first, so that you can preserve any attributes you're not changing!
*adapted from http://www.tek-tips.com/faqs.cfm?fid=3327 Author function : William GC Steinford 2003.
local pcfile,pcAttr
pcFile=getfile()
* a,A - Archive
* s,S - System
* h,H - Hidden
* r,R - Read Only
* i,I - Not Content-Indexed
* t,T - Temporary Storage (try to keep in memory)
* N - Normal (clear all other attributes)
pcAttr=inputbox("Change attribute to (can concatenate):A,S,H,R,I,T,N","","A")
if !inlist(pcAttr,"a","A","s","S","h","H","r","R","i","I","t","T","n","N")
messagebox("Attributes are normalized as :a,A,s,S,h,H,r,R,i,I,t,T,n,N",16+4096,"Error...cancelling!")
return .f.
endi
=SetFileAttr( pcFile, pcAttr )
=yreadprop(pcfile) &&to view the new file attributes
PROCEDURE SetFileAttr( pcFile, pcAttr )
* Author: William GC Steinford 2003
* Takes a file and a list of attributes to change on the file, and does the change
*
* pcFile : either just the file name or the full path to the file.
* Either way, the full path will be resolved using FULLPATH()
* pcAttrs : a list of attributes to change on the file
* if the attribute character is Uppercase it will be turned on,
* Lowercase, it will be turned off,
* Not listed, it will be left alone.
* a,A - Archive
* s,S - System
* h,H - Hidden
* r,R - Read Only
* i,I - Not Content-Indexed
* t,T - Temporary Storage (try to keep in memory)
* N - Normal (clear all other attributes)
*!* BOOL SetFileAttributes(
*!* LPCTSTR lpFileName, // file name
*!* DWORD dwFileAttributes // attributes
*!* )
*!* DWORD GetFileAttributes(
*!* LPCTSTR lpFileName // name of file or directory
*!* )
DECLARE INTEGER GetFileAttributes IN kernel32;
STRING lpFileName
DECLARE SHORT SetFileAttributes IN kernel32;
STRING lpFileName,;
INTEGER dwFileAttributes
#define FILE_ATTRIBUTE_READONLY 0x00000001
#define FILE_ATTRIBUTE_HIDDEN 0x00000002
#define FILE_ATTRIBUTE_SYSTEM 0x00000004
#define FILE_ATTRIBUTE_DIRECTORY 0x00000010
#define FILE_ATTRIBUTE_ARCHIVE 0x00000020
#define FILE_ATTRIBUTE_ENCRYPTED 0x00000040
#define FILE_ATTRIBUTE_NORMAL 0x00000080
#define FILE_ATTRIBUTE_TEMPORARY 0x00000100
#define FILE_ATTRIBUTE_SPARSE_FILE 0x00000200
#define FILE_ATTRIBUTE_REPARSE_POINT 0x00000400
#define FILE_ATTRIBUTE_COMPRESSED 0x00000800
#define FILE_ATTRIBUTE_OFFLINE 0x00001000
#define FILE_ATTRIBUTE_NOT_CONTENT_INDEXED 0x00002000
LOCAL lcFile, lnAttr, lcAttr, laDir[1]
lcFile = FULLPATH(pcFile)
* File() doesn't see Hidden or system files: if NOT FILE(pcFile)
IF adir(laDir,lcFile,'DHS')=0
RETURN .F.
endif
lcAttr = upper(pcAttr)
if 'N' $ pcAttr
* "NORMAL" must be used alone.
lnRes = SetFileAttributes(lcFile,FILE_ATTRIBUTE_NORMAL)
RETURN (lnRes<>0)
endif
lnAttr = GetFileAttributes( lcFile )
* These attributes Can't be set using SetFileAttributes:
lnAttr = BitAnd( lnAttr, BitNot( FILE_ATTRIBUTE_COMPRESSED ;
+ FILE_ATTRIBUTE_DIRECTORY + FILE_ATTRIBUTE_ENCRYPTED ;
+ FILE_ATTRIBUTE_REPARSE_POINT ;
+ FILE_ATTRIBUTE_SPARSE_FILE ) )
if 'A' $ lcAttr
if 'A' $ pcAttr
lnAttr = BitOr( lnAttr, FILE_ATTRIBUTE_ARCHIVE )
else
lnAttr = BitAnd( lnAttr, BitNot(FILE_ATTRIBUTE_ARCHIVE) )
endif
endif
if 'R' $ lcAttr
if 'R' $ pcAttr
lnAttr = BitOr( lnAttr, FILE_ATTRIBUTE_READONLY )
else
lnAttr = BitAnd( lnAttr, BitNot(FILE_ATTRIBUTE_READONLY) )
endif
endif
if 'H' $ lcAttr
if 'H' $ pcAttr
lnAttr = BitOr( lnAttr, FILE_ATTRIBUTE_HIDDEN )
else
lnAttr = BitAnd( lnAttr, BitNot(FILE_ATTRIBUTE_HIDDEN) )
endif
endif
if 'S' $ lcAttr
if 'S' $ pcAttr
lnAttr = BitOr( lnAttr, FILE_ATTRIBUTE_SYSTEM )
else
lnAttr = BitAnd( lnAttr, BitNot(FILE_ATTRIBUTE_SYSTEM) )
endif
endif
if 'I' $ lcAttr
if 'I' $ pcAttr
lnAttr = BitOr( lnAttr, FILE_ATTRIBUTE_NOT_CONTENT_INDEXED )
else
lnAttr = BitAnd( lnAttr, BitNot(FILE_ATTRIBUTE_NOT_CONTENT_INDEXED) )
endif
endif
if 'T' $ lcAttr
if 'S' $ pcAttr
lnAttr = BitOr( lnAttr, FILE_ATTRIBUTE_TEMPORARY )
else
lnAttr = BitAnd( lnAttr, BitNot(FILE_ATTRIBUTE_TEMPORARY) )
endif
endif
if 'N' $ lcAttr
lnAttr = iif('N'$pcAttr, FILE_ATTRIBUTE_NORMAL, lnAttr )
endif
lnRes = SetFileAttributes(lcFile,lnAttr)
RETURN (lnRes<>0)
FUNCTION GetFileAttrib( tcFName )
*GetFileAttrib( cFName ) Return the File Attributes (RSHA)
*!* DWORD GetFileAttributes(
*!* LPCTSTR lpFileName // name of file or directory
*!* )
DECLARE LONG GetFileAttributes IN Win32Api AS util_GetFileAttributes ;
STRING LPCTSTR_lpFileName
LOCAL lnAttr, lcAttr
lnAttr = util_GetFileAttributes( tcFName )
CLEAR DLLS util_GetFileAttributes
if lnAttr=0xFFFF
RETURN 'error'
ENDIF
lcAttr = iif( BITAND(lnAttr,util_FILE_ATTRIBUTE_READONLY )>0, 'R', '' ) ;
+ iif( BITAND(lnAttr,util_FILE_ATTRIBUTE_HIDDEN )>0, 'H', '' ) ;
+ iif( BITAND(lnAttr,util_FILE_ATTRIBUTE_SYSTEM )>0, 'S', '' ) ;
+ iif( BITAND(lnAttr,util_FILE_ATTRIBUTE_ARCHIVE )>0, 'A', '' ) ;
+ iif( BITAND(lnAttr,util_FILE_ATTRIBUTE_DIRECTORY)>0, 'D', '' )
RETURN lcAttr
ENDFUNC
FUNCTION YREADprop()
*CAN BE manually RIGHT CLICK ON FILE AND SEE PROPERTIES.....
lparameters lcfile
loShell = Createobject("Shell.Application")
loFolder = loShell.Namespace(JUSTPATH(m.lcFile))
loItem = loFolder.ParseName(JUSTFNAME(m.lcFile))
local cr
cr=chr(13)+chr(10)
x=""
If !Isnull(loItem)
IF loItem.IsLink
objLink = loItem.GetLink()
x=x+ "Link properties of shortcut:"+cr
x=x+ "-------------------------------------"+cr
x=x+ "Description:", objLink.Description+cr
x=x+ "Path:", objLink.Path+cr
x=x+ "Arguments:", objLink.Arguments+cr
x=x+ "WorkingDirectory:", objLink.WorkingDirectory+cr
x=x+ "-------------------------------------"+cr
ENDI
messagebox(lcfile+" New Attributes="+loFolder.GetDetailsOf(loItem, 6),0+32+4096) &&retrieve here only column6 needed
ENDI
Return
Click on code to select [then copy] -click outside to deselect
*8*
*how to pin any application on the taskbar ?
*simply crete a shortcut for the application and copy it in the specified windows folder
*no need to run vfp with elevated proveleges (as administrator)
*here an ex for pining mspaint.exe in teh taskbar
local oShell
oShell=CreateObject("WScript.Shell")
local m.sLink
m.sLink = addbs(sys(2023))+"msPaint.lnk" &&in temp folder
local oLink
oLink = oShell.CreateShortcut(sLink)
oLink.TargetPath = addbs(getEnv('windir'))+"system32\mspaint.exe" &&c:\windows\system32\mspaint.exe
oLink.WorkingDirectory=addbs(getEnv('windir'))+"System32"
oLink.Save
copy file (sLink) to (addbs(getenv("AppData"))+"Microsoft\Internet Explorer\Quick Launch\User Pinned\TaskBar")
dele file (sLink)
oLink=null
oShell=null
*my folder of pinned shortcuts is : C:\Users\User\AppData\Roaming\Microsoft\Internet Explorer\Quick Launch\User Pinned\TaskBar
In win10 it seems that have a bug ! the link is reallly created in the specific folder but dont show on taskbar !
Click on code to select [then copy] -click outside to deselect
*9* created on sunday 18 of june 2017
*this code set any of the 8 explorer views programmatly.
*its done by sending a key ctrl+shift+1-8 to the explorer window having the focus.
publi yform
yform=newobject("yexplorer_views")
yform.show
read events
retu
*
DEFINE CLASS yexplorer_views AS form
BorderStyle = 0
Top = 0
Left = 0
Height = 43
Width = 341
ShowWindow = 2
Caption = "Setting any explorer view (8)"
MaxButton = .F.
AlwaysOnTop = .F.
Name = "Form1"
ADD OBJECT combo1 AS combobox WITH ;
RowSourceType = 6, ;
RowSource = "ycurs.Xview", ;
Height = 37, ;
Left = 1, ;
Top = 3, ;
Width = 335, ;
BorderStyle = 0, ;
Name = "Combo1"
PROCEDURE Init
_screen.windowstate=1
ENDPROC
PROCEDURE Destroy
clea events
ENDPROC
PROCEDURE combo1.Init
create cursor ycurs (xview c(40))
insert into ycurs values("Ctrl + Shift + 1.....Extra Large Icons")
insert into ycurs values("Ctrl + Shift + 2..... Large Icons")
insert into ycurs values("Ctrl + Shift + 3..... Medium Icons")
insert into ycurs values("Ctrl + Shift + 4..... Small Icons")
insert into ycurs values("Ctrl + Shift + 5..... List")
insert into ycurs values("Ctrl + Shift + 6..... Details")
insert into ycurs values("Ctrl + Shift + 7..... Tiles")
insert into ycurs values("Ctrl + Shift + 8..... Content")
*brow
with this
.listindex=1
.value=1
.style=2
endwith
ENDPROC
PROCEDURE combo1.Click
run/n explorer /select
inkey(1)
local oshell
oshell=newobject("wscript.shell")
do case
case this.value=1
oshell.sendkeys("^+1")
case this.value=2
oshell.sendkeys("^+2")
case this.value=3
oshell.sendkeys("^+3")
case this.value=4
oshell.sendkeys("^+4")
case this.value=5
oshell.sendkeys("^+5")
case this.value=6
oshell.sendkeys("^+8")
case this.value=7
oshell.sendkeys("^+7")
case this.value=8
oshell.sendkeys("^+8")
endcase
ENDPROC
ENDDEFINE
*
*-- EndDefine: yexplorer_views
Click on code to select [then copy] -click outside to deselect
*10*
*special folders tested on windows10 version 1703 (latest).
*created on 26 of october 2017
*note: maybe all special folders exist on PC, if yes the explorer point to "documents" folder (not found).
publi yform
yform=newObject("yspecialFolders")
yform.show
read events
retu
*
DEFINE CLASS yspecialFolders AS form
BorderStyle = 3
Height = 383
Width = 753
AutoCenter = .T.
ShowWindow=2
Caption = "Some special folders"
Name = "Form1"
ADD OBJECT grid1 AS grid WITH ;
Anchor = 15, ;
Height = 385, ;
Left = 2, ;
Top = 6, ;
Width = 754, ;
Name = "Grid1"
PROCEDURE my
LPARAMETERS nButton, nShift, nXCoord, nYCoord
sele ycurs
messagebox(xcommand,0+32+4096,'command line',1000)
try
ShellExecute(0, "open","explorer.exe",xcommand,"",1)
catch
messagebox("An error was occured!",16+4096,"Error",1200)
*note : if explorer fails to open destination it opens the documents folder also
endtry
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
set memowidth to 8192
LOCAL M.MYVAR
TEXT TO M.MYVAR PRETEXT 7 NOSHOW
shell:AccountPictures ,Account Pictures
shell:AddNewProgramsFolder ,Add New Programs folder
shell:Administrative Tools ,Administrative Tools
shell:AppData ,C:\Users\user\AppData\Roaming
shell:Application Shortcuts ,C:\Users\user\AppData\Local\Microsoft\Windows\Application Shortcuts
shell:AppsFolder ,The virtual folder which stores all installed Modern apps
shell:AppUpdatesFolder ,The "Installed Updates" Control panel item
shell:Cache ,IE's cache folder (Temporary Internet Files)
shell:Camera Roll ,Camera Roll
shell:CD Burning ,Temporary Burn Folder
shell:ChangeRemoveProgramsFolder ,The "Uninstall a program" Control panel item
shell:Common Administrative Tools ,The Administrative Tools folder for all users
shell:Common AppData ,The C:\ProgramData folder (%ProgramData%)
shell:Common Desktop ,Public Desktop
shell:Common Documents ,Public Documents
shell:Common Programs ,All Users Programs, which are part of Start menu. Still used by the Start screen
shell:Common Start ,Menu All Users Start Menu folder, same as above
shell:Common Startup ,The Startup folder, used for all users
shell:Common Templates ,Same as above, but used for new documents templates, e.g. by Microsoft Office
shell:CommonDownloads ,Public Downloads
shell:CommonMusic ,Public Music
shell:CommonPictures ,Public Pictures
shell:CommonRingtones ,CommonRingtones
shell:CommonVideo ,Public Videos
shell:ConflictFolder ,The Control Panel\All Control Panel Items\Sync Center\Conflicts item
shell:ConnectionsFolder ,The Control Panel\All Control Panel Items\Network Connections item
shell:Contacts ,Contacts folder (Address book)
shell:ControlPanelFolder ,Control Panel
shell:Cookies ,The folder with IE's cookies
shell:CredentialManager ,C:\Users\<username>\AppData\Roaming\Microsoft\Credentials
shell:CryptoKeys ,C:\Users\<username>\AppData\Roaming\Microsoft\Crypto
shell:CSCFolder ,This folder is broken in Windows 8/7, provides access to the Offline files item
shell:Desktop ,Desktop
shell:Device ,Metadata Store C:\ProgramData\Microsoft\Windows\DeviceMetadataStore
shell:DocumentsLibrary ,Documents library
shell:Downloads ,Downloads folder
shell:DpapiKeys ,C:\Users\<username>\AppData\Roaming\Microsoft\Protect
shell:Favorites ,Favorites
shell:Fonts ,C:\Windows\Fonts
shell:Games ,The Games Explorer item
shell:GameTasks, C:\Users\<username>\AppData\Local\Microsoft\Windows\GameExplorer
shell:History ,C:\Users\<username>\AppData\Local\Microsoft\Windows\History, IE's browsing history
shell:HomeGroupCurrentUserFolder ,The Home Group folder for the current user
shell:HomeGroupFolder ,The Home Group root folder
shell:ImplicitAppShortcuts ,C:\Users\<username>\AppData\Roaming\Microsoft\Internet Explorer\Quick Launch\User Pinned\ImplicitAppShortcuts
shell:InternetFolder ,This shell command will start Internet Explorer
shell:Libraries, Libraries
shell:Links ,The "Favorites" folder from the Explorer navigation pane.
shell:Local AppData ,C:\Users\<username>\AppData\Local
shell:LocalAppDataLow ,C:\Users\<username>\AppData\LocalLow
shell:LocalizedResourcesDir, This shell folder is broken since Windows 8 RTM
shell:MAPIFolder ,Represents the Microsoft Outlook folder
shell:MusicLibrary ,Music Library
shell:My Music ,The "My Music" folder (not the Library)
shell:My Pictures ,The "My Pictures" folder (not the Library)
shell:My Video ,The "My Videos" folder (not the Library)
shell:MyComputerFolder ,Computer/Drives view
shell:NetHood ,C:\Users\<username>\AppData\Roaming\Microsoft\Windows\Network Shortcuts
shell:NetworkPlacesFolder ,The Network Places folder which shows computers and devices on your network
shell:OEM Links ,This shell command does nothing on my Windows 8.1 RTM
shell:Original Images ,Same as above
shell:Personal ,The "My Documents" folder (not the Library)
shell:PhotoAlbums ,Saved slideshows, seems to have not been implemented yet
shell:PicturesLibrary ,Pictures Library
shell:Playlists ,Stores WMP Playlists
shell:PrintersFolder ,The classic "Printers" folder (not 'Devices and Printers')
shell:PrintHood ,C:\Users\<username>\AppData\Roaming\Microsoft\Windows\Printer Shortcuts
shell:Profile ,The User profile folder
shell:ProgramFiles ,Program Files
shell:ProgramFilesCommon ,C:\Program Files\Common Files
shell:ProgramFilesCommonX64, C:\Program Files\Common Files - for Windows x64
shell:ProgramFilesCommonX86, C:\Program Files (x86)\Common Files - for Windows x64
shell:ProgramFilesX64 ,C:\Program Files - for Windows x64
shell:ProgramFilesX86 ,C:\Program Files (x86) - for Windows x64
shell:Programs ,C:\Users\<username>\AppData\Roaming\Microsoft\Windows\Start Menu\Programs (Per-user Start Menu Programs folder)
shell:Public ,C:\Users\Public
shell:PublicAccountPictures ,C:\Users\Public\AccountPictures
shell:PublicGameTasks ,C:\ProgramData\Microsoft\Windows\GameExplorer
shell:PublicLibraries ,C:\Users\Public\Libraries
shell:Quick Launch ,C:\Users\<username>\AppData\Roaming\Microsoft\Internet Explorer\Quick Launch
shell:Recent ,The "Recent Items" folder (Recent Documents)
shell:RecordedTVLibrary ,The "Recorded TV" Library
shell:RecycleBinFolder ,The Recycle Bin folder
shell:ResourceDir ,C:\Windows\Resources where visual styles are stored
shell:Ringtones ,C:\Users\<username>\AppData\Local\Microsoft\Windows\Ringtones
shell:Roamed Tile Images ,Does not work. Probably reserved for future.
shell:Roaming Tiles ,C:\Users\<username>\AppData\Local\Microsoft\Windows\RoamingTiles
shell:SavedGames ,Saved Games
shell:Screenshots ,The folder for Win+Print Screen screenshots
shell:Searches ,Saved Searches
shell:SearchHistoryFolder, C:\Users\<username>\AppData\Local\Microsoft\Windows\ConnectedSearch\History
shell:SearchHomeFolder ,Windows Search UI
shell:SearchTemplatesFolder, C:\Users\winaero\AppData\Local\Microsoft\Windows\ConnectedSearch\Templates
shell:SendTo ,The folder with items that you can see in the "Send to" menu
shell:SkyDrive ,The SkyDrive folder
shell:SkyDriveCameraRoll ,The Camera Roll images folder inside the SkyDrive folder
shell:SkyDriveDocuments ,The Documents folder inside the SkyDrive folder
shell:SkyDrivePictures ,The Pictures folder inside the SkyDrive folder
shell:Start Menu ,C:\Users\<username>\AppData\Roaming\Microsoft\Windows\Start Menu (Per-user Start Menu folder)
shell:Startup ,Per-user Startup folder
shell:SyncCenterFolder ,Control Panel\All Control Panel Items\Sync Center
shell:SyncResultsFolder ,Control Panel\All Control Panel Items\Sync Center\Sync Results
shell:SyncSetupFolder ,Control Panel\All Control Panel Items\Sync Center\Sync Setup
shell:System ,C:\Windows\System32
shell:SystemCertificates ,C:\Users\<username>\AppData\Roaming\Microsoft\SystemCertificates
shell:SystemX86 ,C:\Windows\SysWOW64 -Windows x64 only
shell:Templates ,C:\Users\<username>\AppData\Roaming\Microsoft\Windows\Templates
shell:ThisPCDesktopFolder ,The Desktop folder
shell:User Pinned ,Pinned items for Taskbar and Start screen, C:\Users\<username>\AppData\Roaming\Microsoft\Internet Explorer\Quick Launch\User Pinned
shell:UserProfiles ,C:\Users, the users folder where the user profiles are stored
shell:UserProgramFiles ,C:\Users\winaero\AppData\Local\Programs
shell:UserProgramFilesCommon ,C:\Users\winaero\AppData\Local\Programs\Common
shell:UsersFilesFolder ,The current user profile
shell:UsersLibrariesFolder ,Libraries
shell:VideosLibrary Videos ,library
shell:Windows ,C:\Windows
ENDTEXT
create cursor ycurs (xcommand c(50), xtitle c(120))
local m.x,m.y
for i=1 to memlines(m.myvar)
m.x=allt(getwordnum( mline(m.myvar,i),1,","))
m.y=allt(getwordnum( mline(m.myvar,i),2,","))
insert into ycurs values (m.x ,m.y )
endfor
sele ycurs
*brow
ENDPROC
PROCEDURE Init
this.caption="some special folders ("+trans(reccount())+") - click on any row to run the destination."
ENDPROC
PROCEDURE Destroy
clea events
ENDPROC
PROCEDURE grid1.Init
with this
.recordsource="ycurs"
.recordsourcetype=1
.themes=.f.
.gridlines=0
.deletemark=.f.
.rowHeight=23
.column1.visible=.f.
.mousepointer=15
.SetAll("DynamicBackColor","IIF(MOD(RECNO( ), 2)=0,RGB(200,206,180),RGB(255,255,255))", "Column")
.fontbold=.t.
.SetAll("fontbold",.T.,"header")
.SetAll("fontsize",14,"header")
.column2.header1.forecolor=rgb(255,128,0)
.headerHeight=28
locate
.refresh
bindevent(.column2.text1,"mousedown",thisform,"my")
endwith
ENDPROC
ENDDEFINE
*
*-- EndDefine: uspecialFolders
Click on code to select [then copy] -click outside to deselect
*11* created on 06 of december 2017 (for an UT user)
*change attribut of a file,folder...
*the old DOS attrib command can work also on the file attributes.
**note : for attrib help can redirect the dos window in a txt file by adding to the command line ">yourfileTXT"
*Adir() can retrieve the attribut of any file or folder (in column 5: A,H,R,S,D)
Local m.lcfile
m.lcfile=Getfile()
If Empty(m.lcfile)
Return .F.
Endi
*+R readonly attribut -R read/write attribut
*best way to run with dos is to build a bat file to make operation success.
Local m.myvar
TEXT to m.myvar textmerge noshow
ATTRIB +R "<<m.lcfile>>"
del asup.bat
ENDTEXT
Strtofile(m.myvar,"asup.bat")
&&shellexecute
Declare Integer ShellExecute In shell32.Dll ;
INTEGER hndWin, ;
STRING cAction, ;
STRING cFileName, ;
STRING cParams, ;
STRING cDir, ;
INTEGER nShowWin
Local m.result
m.result=ShellExecute(0,"open","asup.bat","","",0)
Messagebox("Result="+Trans(m.result),0+32+4096,'',1200)
If m.result>32
Messagebox("Successfull...Rightclick on the selected file and see properties at below (read only..hidden)",0+32+4096,3000)
Local m.o
m.o=Justpath(m.lcfile)
Run/N explorer &o
Local m.x
m.x=Inputbox("Want help on attrib command ?","","yes")
If lower(allt(m.x))=="yes"
Run/N cmd.Exe Attrib /?
Endi
Else
Messagebox("An error was occured! result="+Trans(m.result),16+4096)
Endi
Click on code to select [then copy] -click outside to deselect
*12* created on friday 12 of january 2018
*this code plays exactly the role of windows explorer.its based on internet explorer (vfp browser)
*instead of navigating to web urls its used here to navigate to local files on disc.
*i guess this interface and windows explorer are the same interface.
*very easy to implement.it can as explorerdoes set 8 views(big ico,large icon,small icons,list,detail,mosaique)
*warning: the contextuel menu (right click) is the same as explorer.can rename,cut,copy.....
Public oform
oform=Newobject("yExplorer")
oform.Show
Read Events
Return
*
Define Class yExplorer As Form
Top = 31
Left = 217
Height = 491
Width = 684
ShowWindow = 2
Caption = "A custom vfp explorer with vfp oBrowser"
Name = "Form1"
Add Object obrowser As OleControl With ;
oleclass="shell.explorer.2", ;
Top = 0, ;
Left = 0, ;
Height = 408, ;
Width = 685, ;
Anchor = 15, ;
Name = "oBrowser"
Add Object ycnt As ycnt0 With ;
Anchor = 0, ;
Top = 438, ;
Left = 70, ;
Width = 540, ;
Height = 49, ;
BackStyle = 0, ;
BorderWidth = 0, ;
Name = "yCNT"
Procedure Destroy
Clea Events
Endproc
Procedure Resize
With Thisform.ycnt
.Left=(Thisform.Width-.Width)/4
.Top=Thisform.obrowser.Top+Thisform.obrowser.Height+10
Endwith
Endproc
Procedure Init
This.Resize
Endproc
Procedure Init
This.obrowser.Navigate(Home(1))
Thisform.ycnt.text1.Value=Home(1)
With Thisform.ycnt
.combo1.Value=6 &&set detail view
.combo1.Click
Endwith
Endproc
Enddefine
*
*-- EndDefine: yexplorer
Define Class ycnt0 As Container
Anchor = 0
Top = 438
Left = 70
Width = 540
Height = 49
BackStyle = 0
BorderWidth = 0
Name = "yCNT"
Add Object command1 As CommandButton With ;
Top = 15, ;
Left = 8, ;
Height = 25, ;
Width = 72, ;
Caption = "Any dir ...", ;
MousePointer = 15, ;
Name = "Command1"
Add Object label1 As Label With ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "8 Views", ;
Height = 17, ;
Left = 404, ;
Top = 21, ;
Width = 45, ;
Name = "Label1"
Add Object combo1 As ComboBox With ;
Height = 25, ;
Left = 455, ;
Top = 16, ;
Width = 73, ;
Name = "Combo1"
Add Object text1 As TextBox With ;
Height = 25, ;
Left = 87, ;
ReadOnly = .T., ;
Top = 17, ;
Width = 299, ;
Name = "Text1"
Procedure command1.Click
Local m.yrep
m.yrep=Getdir("","","",32)
If !Empty(m.yrep)
Thisform.obrowser.Navigate(m.yrep)
This.Parent.text1.Value=m.yrep
Inke(1)
This.Parent.combo1.Value=6 &&positioned on details view
This.Parent.combo1.Click
Endi
Endproc
Procedure combo1.Init
With This
.AddItem("View 1")
.AddItem("View 2")
.AddItem("View 3")
.AddItem("View 4")
.AddItem("View 5")
.AddItem("View 6")
.AddItem("View 7")
.AddItem("View 8")
.Style=2
.ListIndex=1
.Value=1
Endwith
Endproc
Procedure combo1.Click
Local m.xval,m.o
m.xval=This.Value
Local oshell
oshell=Newobject("wscript.shell")
Thisform.obrowser.SetFocus
m.o="^"+Trans(m.xval)
oshell.sendkeys(m.o)
oshell=Null
Endproc
Enddefine
*
*-- EndDefine: ycnt0
