Run your code in response to a new drive being inserted

Article
11/16/2004

At the Las Vegas Devcon last month I used a digital camera to take a picture, then I plugged the camera media into my Tablet PC which was running the Visual Foxpro code below.

The pictures on the media were automatically detected by the event handler and they were read into a table and displayed in a grid.

This feature was made possible by the new capabilities of the BINDEVENTS function (which was added to VFP9 after the public beta), so you won’t be able to run the code below until you get a later version).

The code below uses the SHChangeNotifyRegister WinAPI function to register an event handler with the Windows Shell.

As long as the public variable oDriveDetect contains the object for this class, the handler will exist to react to drive changes.

As you can see from the code, there are other shell events to which user code can respond like file/folder renaming.

There is more sample code in the Task Pane: Start the Task Pane, navigate to Solution Samples, New in Visual Foxpro 9, “Binding to Windows Message Events”

(blog about the Las Vegas Screen Saver demo: https://blogs.msdn.com/calvin_hsia/archive/2004/10/04/237723.aspx)

#define GWL_WNDPROC (-4)

#define WM_USER 0x0400

#define WM_USER_SHNOTIFY WM_USER+10

#define SHCNE_RENAMEITEM 0x00000001

#define SHCNE_CREATE 0x00000002

#define SHCNE_DELETE 0x00000004

#define SHCNE_MKDIR 0x00000008

#define SHCNE_RMDIR 0x00000010

#define SHCNE_MEDIAINSERTED 0x00000020

#define SHCNE_MEDIAREMOVED 0x00000040

#define SHCNE_DRIVEREMOVED 0x00000080

#define SHCNE_DRIVEADD 0x00000100

#define SHCNE_NETSHARE 0x00000200

#define SHCNE_NETUNSHARE 0x00000400

#define SHCNE_ATTRIBUTES 0x00000800

#define SHCNE_UPDATEDIR 0x00001000

#define SHCNE_UPDATEITEM 0x00002000

#define SHCNE_SERVERDISCONNECT 0x00004000

#define SHCNE_UPDATEIMAGE 0x00008000

#define SHCNE_DRIVEADDGUI 0x00010000

#define SHCNE_RENAMEFOLDER 0x00020000

#define SHCNE_FREESPACE 0x00040000

#define SHCNE_DISKEVENTS 0x0002381F

#define SHCNE_GLOBALEVENTS 0x0C0581E0 // Events that dont match pidls first

#define SHCNE_ALLEVENTS 0x7FFFFFFF

#define SHCNE_INTERRUPT 0x80000000 // The presence of this flag indicates

#define CSIDL_DESKTOP 0x0000 &&// <desktop>

#define CSIDL_INTERNET 0x0001 &&// Internet Explorer (icon on desktop)

#define CSIDL_PROGRAMS 0x0002 &&// Start Menu\Programs

#define CSIDL_CONTROLS 0x0003 &&// My Computer\Control Panel

#define CSIDL_PRINTERS 0x0004 &&// My Computer\Printers

#define CSIDL_PERSONAL 0x0005 &&// My Documents

#define CSIDL_FAVORITES 0x0006 &&// <user name>\Favorites

#define CSIDL_STARTUP 0x0007 &&// Start Menu\Programs\Startup

#define CSIDL_RECENT 0x0008 &&// <user name>\Recent

#define CSIDL_SENDTO 0x0009 &&// <user name>\SendTo

#define CSIDL_BITBUCKET 0x000a &&// <desktop>\Recycle Bin

#define CSIDL_STARTMENU 0x000b &&// <user name>\Start Menu

#define CSIDL_MYDOCUMENTS 0x000c &&// logical "My Documents" desktop icon

#define CSIDL_MYMUSIC 0x000d &&// "My Music" folder

#define CSIDL_MYVIDEO 0x000e &&// "My Videos" folder

PUBLIC oDriveDetect as DriveDetect

oDriveDetect=NEWOBJECT("DriveDetect")

DEFINE CLASS DriveDetect AS session

dwOrigWindProc=0

dwShNotify=0

PROCEDURE init

DECLARE integer GetWindowLong IN WIN32API ;

integer hWnd, ;

integer nIndex

DECLARE integer CallWindowProc IN WIN32API ;

integer lpPrevWndFunc, ;

integer hWnd,integer Msg,;

integer wParam,;

integer lParam

THIS.dwOrigWindProc =GetWindowLong(_VFP.HWnd,GWL_WNDPROC)

DECLARE integer SHChangeNotifyRegister IN shell32 ;

integer hWnd, ;

integer fSources, ;

integer fEvents, ;

integer wMsg,;

integer cEntries, ;

string @ SEntry

DECLARE integer SHChangeNotifyDeregister IN shell32 integer

DECLARE integer SHGetSpecialFolderLocation IN shell32 ;

integer hWnd,;

integer nFolder,;

string @ pItemList

DECLARE integer SHGetPathFromIDList IN shell32 ;

integer nItemList,;

string @cPath

cSEntry = REPLICATE(CHR(0),8)

this.dwShNotify = SHChangeNotifyRegister(_vfp.hWnd, ;

2,;

SHCNE_ALLEVENTS,;

WM_USER_SHNOTIFY,1,;

@cSEntry)

*!* this.dwShNotify = SHChangeNotifyRegister(_vfp.hWnd, ;

*!* 2,;

*!* SHCNE_MEDIAINSERTED + SHCNE_MEDIAREMOVED + SHCNE_DRIVEADD + SHCNE_DRIVEREMOVED,;

*!* WM_USER_SHNOTIFY,1,;

*!* @cSEntry)

BINDEVENT(_VFP.hWnd, WM_USER_SHNOTIFY,this,"HandleMsg")

WAIT WINDOW "Monitoring drive changes" nowait

PROCEDURE HandleMsg(hWnd as Integer, msg as Integer, wParam as Integer, lParam as Integer)

LOCAL nRetvalue

nRetvalue=0

?PROGRAM(),hwnd,"Media",TRANSFORM(wParam,"@0x"),TRANSFORM(lParam,"@0x")," "

pidl1=CTOBIN(SYS(2600,wParam,4),"4rs")

pidl2=CTOBIN(SYS(2600,wParam+4,4),"4rs")

cPath=SPACE(270)

SHGetPathFromIDList(pidl1,@cPath)

cPath=LEFT(cPath,AT(CHR(0),cPath)-1)

DO case

CASE lParam=SHCNE_DRIVEADD

??"Drive added "

ShowPix(cPath)

CASE lParam=SHCNE_DRIVEREMOVED

??"Drive removed"

CASE lParam=SHCNE_MEDIAINSERTED

??"Media inserted "

ShowPix(cPath)

CASE lParam=SHCNE_MEDIAREMOVED

??"Media removed "

ENDCASE

??" path=",cPath,TRANSFORM(pidl2,"@0x")

nRetvalue=CallWindowProc(this.dwOrigWindProc,hWnd,msg,wParam,lParam)

RETURN nRetvalue

PROCEDURE destroy

IF this.dwShNotify != 0

IF SHChangeNotifyDeregister(this.dwShNotify) = 0

?"Deregister ERRORd"

ENDIF

ENDDEFINE

* in a file called SHOWPIX.PRG

LPARAMETERS cPath as String

PUBLIC oShowPix

oShowPix=0

IF PCOUNT()=0

CLEAR

cPath=SYS(5)+CURDIR()

ENDIF

oShowPix=CREATEOBJECT("ShowPix",cPath)

oShowPix.show

DEFINE CLASS ShowPix as Form

left=100

height=600

width=900

DataSession=2

allowoutput=.f.

PROCEDURE LoadPix(cPath as String,lRecursive as Boolean)

LOCAL aFiles[1],n,i,fname

n=ADIR(aFiles,cPath+"*.*","D")

FOR i = 1 TO n

IF "D"$aFiles[i,5]

IF aFiles[i,1] != '.'

thisform.Loadpix(cPath+aFiles[i,1]+"\")

ENDIF

ELSE

fName=cPath+aFiles[i,1]

IF JUSTEXT(fName)$"JPG"

WAIT WINDOW NOWAIT fname

INSERT INTO pix VALUES (fname,FILETOSTR(fname),PicProps(fname))

ENDIF

ENDFOR

locate

PROCEDURE init(cPath,lRecursive)

CREATE CURSOR pix (name c(30),pic w, props m)

IF VARTYPE(cPath)='L'

cPath=SYS(5)+CURDIR()

ENDIF

cPath=ADDBS(cPath) && add a backslash if needed

thisform.LoadPix(cPath,lRecursive)

WAIT CLEAR

this.AddObject("grd","grid")

WITH this.grd as grid

.Visible=1

.ColumnCount=4

.Height=thisform.Height

.Width=thisform.Width

.RowHeight=200

.HeaderHeight=50

WITH this.grd.column1 as Column

.header1.caption="Filename"

.header1.fontsize=14

.Width=100

.AddObject("edtFname","editbox")

.CurrentControl="edtFname"

.Sparse=.f.

.edtFname.visible=1

ENDWITH

WITH this.grd.column2 as Column

.header1.caption="Picture"

.header1.fontsize=14

.Width=300

.AddObject("imgPic","MyImage")

.CurrentControl="imgPic"

.RemoveObject("text1")

.imgPic.pictureval="pix.pic"

.Sparse= .F.

ENDWITH

WITH this.grd.column3 as Column

.header1.caption="Pic Properties"

.header1.fontsize=14

.AddObject("edtProps","editbox")

.CurrentControl="EdtProps"

.RemoveObject("text1")

.Sparse= .F.

.Width=300

WITH .EdtProps as EditBox

.Visible=.t.

ENDWITH

WITH this.grd.column4 as Column

.header1.caption="Button"

.header1.fontsize=14

.AddObject("btn","mybtn")

.CurrentControl="btn"

.Sparse= .F.

.Width=100

WITH .btn as commandbutton

.Visible=.t.

ENDWITH

ENDDEFINE

DEFINE CLASS mybtn as commandbutton

Caption="Click me!"

PROCEDURE click

oShowPic=CREATEOBJECT("form")

WITH oShowpic as form

.Width=SYSMETRIC(1)

.Height=SYSMETRIC(2)

.Left=0

.Top=0

.AddObject("img","myimage")

WITH .img as image

.Stretch=2

.Width=thisform.width

.Height= thisform.height

.PictureVal =pix.pic

.Visible=1

ENDWITH

oShowPic.show(1)

ENDDEFINE

DEFINE CLASS myimage as Image

backstyle=0

stretch=1

PROCEDURE backstyle_access

this.PictureVal=pix.pic

RETURN this.backstyle

PROCEDURE click

this.RotateFlip=this.RotateFlip+1

PROCEDURE dblclick

?PROGRAM()

ENDDEFINE

43302

Run your code in response to a new drive being inserted

Additional resources