vfp如何创建windows服务？上次没说清，再发一帖

mhxcy 2013-11-09 07:05:15

我想用vfp写一个windows服务，监视一个文件夹，如文件夹内文件增加，将新增的文件复制另一个文件夹内。不知道用vfp9.0和win7或winxp如何实现监视一个文件夹，如文件夹内文件增加，将新增的文件复制另一个文件夹内？？我用VFP命令复制文件，调试正确，作为服务运行时没反应，是不是VFP命令在windows服务中不能用？请各位大侠指教，如何实现这个功能。最好有代码，谢谢！

...全文

211 6 打赏收藏转发到动态举报

写回复

用AI写文章

6 条回复

切换为时间正序

请发表友善的回复…

发表回复

十豆三 2013-11-11

打赏
举报

把你的红色部分代码换为：

If Lower(JustPath(lcPath))='d:\back'
	Copy File (lcPath) To 'e:\bak'
Endif

这样只是增加文件时好用，如果更改文件名或删除文件，就无法 COPY 了。除非整个目录操作，如下为整个目录操作：

If Lower(JustPath(lcPath))='d:\back'
	*Erase 'e:\bak\*.*'		&& Copy 前先清空
	Copy File 'd:\back\*.*' To 'e:\bak'
Endif

mhxcy 2013-11-11

打赏
举报

各位大侠，我要监视文件夹 d:\back ，如文件夹内文件增加，将新增的文件复制到文件夹 e:\bak ,我在别人代码的基础上改的（红色部分），请各位看看如何改。 Public ShcneForm ShcneForm=CreateObject("Form1") ShcneForm.show RETURN DEFINE CLASS Form1 AS form Top = 32 Left = 261 Height = 216 Width = 624 ShowWindow = 2 DoCreate = .T. Caption = "文件夹监视-行者示例" Name = "Form1" PROCEDURE Init&&VFP应用程式算法群:12787940 行者孙:310727570 this.AddObject("List1","_classname4") declare integer SHGetPathFromIDList in shell32 ; integer nItemList, string @szPath declare integer SHChangeNotifyRegister in shell32 ; integer hWnd, integer fSources, integer fEvents, ; integer wMsg, integer cEntries, string @SEntry declare integer SHChangeNotifyDeregister in shell32 ; integer PUBLIC nShNotify,shcne_renameitem,shcne_create,shcne_delete,shcne_mkdir,shcne_rmdir,; shcne_mediainserted,shcne_mediaremoved,shcne_driveadd,shcne_netshare,; shcne_netunshare,shcne_attributes,shcne_updatedir,shcne_updateitem,; shcne_serverdisconnect,shcne_updateimage,shcne_driveaddgui,shcne_renamefolder,; shcne_freespace,shcne_assocchanged,shcne_diskevents,shcne_globalevents,; shcne_allevents,shcne_interrupt,SHCNE_DISKEVENTS,WM_USER_SHNOTIFY,SHCNE_DRIVEREMOVED shcne_renameitem =0x1 shcne_create = 0x2 shcne_delete = 0x4 shcne_mkdir = 0x8 shcne_rmdir = 0x10 shcne_mediainserted = 0x20 shcne_mediaremoved = 0x40 shcne_driveremoved = 0x80 shcne_driveadd = 0x100 shcne_netshare = 0x200 shcne_netunshare = 0x400 shcne_attributes = 0x800 shcne_updatedir = 0x1000 shcne_updateitem = 0x2000 shcne_serverdisconnect = 0x4000 shcne_updateimage = 0x8000 shcne_driveaddgui = 0x10000 shcne_renamefolder = 0x20000 shcne_freespace = 0x40000 shcne_assocchanged = 0x8000000 shcne_diskevents = 0x2381F shcne_globalevents = 0xC0581E0 shcne_allevents = 0x7FFFFFFF shcne_interrupt = 0x80000000 SHCNE_DRIVEREMOVED=128 SHCNE_DISKEVENTS=0x2381F lcSEntry = replicate(chr(0),8) WM_USER_SHNOTIFY=0x401 SHCNE_Reume=; shcne_renameitem+; shcne_create+; shcne_delete+; shcne_mkdir+; shcne_rmdir+; shcne_mediainserted+; shcne_mediaremoved+; shcne_driveremoved+; shcne_driveadd+; shcne_netshare+; shcne_netunshare+; shcne_attributes+; shcne_updatedir+; shcne_updateitem+; shcne_serverdisconnect+; shcne_updateimage+; shcne_driveaddgui+; shcne_renamefolder+; shcne_freespace+; shcne_assocchanged nShNotify = SHChangeNotifyRegister(this.hWnd,SHCNE_DISKEVENTS,SHCNE_Reume,WM_USER_SHNOTIFY,1,@lcSEntry) bindevent(this.hWnd,WM_USER_SHNOTIFY,This,'EventsPro') ENDPROC PROCEDURE EventsPro lparameters hWnd,Msg,wParam,lParam local lcCaption, lnParm,lcPath WM_USER_SHNOTIFY=0x401 IF Msg=WM_USER_SHNOTIFY DO CASE CASE lParam = SHCNE_RENAMEITEM MsgStr='更改标题：' CASE lParam = SHCNE_CREATE MsgStr='创建新文件：' CASE lParam = SHCNE_DELETE MsgStr='删除文件：' CASE lParam = SHCNE_MKDIR MsgStr='建立新文件夹：' CASE lParam = SHCNE_RMDIR MsgStr='移除文件夹：' CASE lParam = SHCNE_MEDIAINSERTED MsgStr='插入媒体：' CASE lParam = SHCNE_MEDIAREMOVED MsgStr='移除媒体：' CASE lParam = SHCNE_DRIVEADD MsgStr='增加驱动器：' CASE lParam = SHCNE_DRIVEREMOVED MsgStr='移除驱动器：' CASE lParam = SHCNE_NETSHARE MsgStr='共享网络：' CASE lParam = SHCNE_NETUNSHARE MsgStr='移除网络共享：' CASE lParam = SHCNE_ATTRIBUTES MsgStr='属性更改：' CASE lParam = SHCNE_UPDATEDIR MsgStr='更新目录：' CASE lParam = SHCNE_UPDATEITEM MsgStr='更改标题：' CASE lParam = SHCNE_DRIVEADDGUI MsgStr='添加设备：' CASE lParam = SHCNE_RENAMEFOLDER MsgStr='重命名文件夹：' CASE lParam = SHCNE_FREESPACE MsgStr='磁盘空间大小改变：' CASE lParam = SHCNE_ASSOCCHANGED MsgStr='改变文件关联：' CASE lParam = SHCNE_DISKEVENTS MsgStr='接收磁盘事件：' CASE lParam = SHCNE_GLOBALEVENTS MsgStr='接收全局事件：' CASE lParam = SHCNE_ALLEVENTS MsgStr='接收全部事件：' CASE lParam = SHCNE_INTERRUPT MsgStr='系统中断的结果：' CASE lParam = SHCNE_SERVERDISCONNECT MsgStr='断开服务器连接：' CASE lParam = SHCNE_UPDATEIMAGE MsgStr='系统图像列表中的一个图像被改变：' OTHERWISE MsgStr='未知操作：' ENDC ENDIF lnParm = ctobin(sys(2600,wParam,4),'4rs') lcPath = space(256) SHGetPathFromIDList(lnParm,@lcPath) lcPath = left(lcPath, at(chr(0),lcPath)-1) mmpath=SUBSTR(lcPath,1,8) mpath=lcpath mzfc='d:\bac\'+SUBSTR(mpath,9,LEN(mpath)-8) IF mmpath='D:\back\' COPY FILE &mpath TO &mzfc ENDIF thisform.list1.additem( MsgStr + ALLTRIM(lcPath)) ENDPROC PROCEDURE Unload SHChangeNotifyDeregister(nShNotify) ENDPROC ENDDEFINE DEFINE CLASS _classname4 AS listbox Visible=.T. Height = 216 Left = 0 Top = 0 Width = 624 Name = "List1" ENDDEFINE

回马枪 2013-11-10

打赏
举报

我不用 Windows 服务响应事件因为防火墙或杀软或干掉这些服务还有如果发生了事件很难及时回馈到 VFP 的窗口中我采用 FOCUS.FLL 动态库监测目录或文件的事件很及时不怎么耗资源


Set Library To FOCUS.FLL
Clear

Local nHandle

If ( NOT_HandlesFree() > 0 )
    NOT_Frequency( 1000 )  && 间隔 1 秒内将报告该目录的任何变化。
    nHandle = NOT_Set( "C:\Temp\aaa", "WarnMe", .T., 24 )

    If ( nHandle != -1 )
        ? NOT_info( nHandle,1 )       && "C:\Temp\aaa"
        ? NOT_info( nHandle,2 )       && "WarnMe"
        ? NOT_info( nHandle,3 )       && .T.
        ? NOT_info( nHandle,4 )       && 24
    Else
        =Messagebox( "无法设置通知", 48, "通知" )
    Endif
Else
    =Messagebox( "无法设置通知，可能不存在 [C:\Temp\aaa] 目录。请释放某些句柄。", 48, "通知" )
Endif

Procedure WarnMe( nHandle )  && 发出警告
    =Messagebox( "有人在动我的 C 盘", 64, "通知" )
    Return

回马枪 2013-11-10

打赏
举报

如果用 Notification 的 API 做大概是这样子的


* 监控指定文件夹中的文件增删状态

Public oForm
Clear
* oForm = CREATEOBJECT("Tform", SYS(2023)) && 监控 TEMP 目录
oForm = Createobject("Tform", "C:\Temp") && 监控 C:\Temp 目录
oForm.Visible = .T.
* 结束主程序

Define Class Tform As Form
    #Define FILE_NOTIFY_CHANGE_FILE_NAME 1
    #Define FILE_NOTIFY_CHANGE_DIR_NAME 2
    #Define FILE_NOTIFY_CHANGE_ATTRIBUTES 4
    #Define FILE_NOTIFY_CHANGE_SIZE 8
    #Define FILE_NOTIFY_CHANGE_LAST_WRITE 16
    #Define FILE_NOTIFY_CHANGE_LAST_ACCESS 32
    #Define FILE_NOTIFY_CHANGE_CREATION 64
    #Define FILE_NOTIFY_CHANGE_SECURITY 128
    #Define INVALID_HANDLE_VALUE -1
    #Define WAIT_OBJECT_0 0
    #Define WATCHING_INTERVAL 1000  && 间隔时间，单位：毫秒

    Protected hNotify, PathBeingWatched

    Width = 400
    Height = 150
    MaxButton = .F.
    BorderStyle = 2
    AutoCenter = .T.
    Caption = "正在监控目录"

    hNotify = INVALID_HANDLE_VALUE
    PathBeingWatched = ""

    Add Object lblTarget As Label With Left = 10, Top = 7, AutoSize = .T.
    Add Object tm As Timer With Interval = 0

    Add Object lblAlert As Label With Left = 10, Top = 30, ;
        Autosize = .T., Caption = "通知 : "

    Function Init(cPath)
        This.Declare
        This.PathBeingWatched = Fullpath(m.cPath)

        If Not This.StartWatching()
            = Messagebox("通知句柄错误，可能不存在该目录。")
            Return .F.
        Endif

    Procedure Destroy
        This.StopWatching

    Protected Function StartWatching
        Local lResult

        * 监控的目录不存在
        This.hNotify = FindFirstChangeNotification(;
            THIS.PathBeingWatched, 0,;
            FILE_NOTIFY_CHANGE_FILE_NAME +;
            FILE_NOTIFY_CHANGE_LAST_WRITE )

        lResult = (This.hNotify <> INVALID_HANDLE_VALUE)

        If lResult
            This.lblTarget.Caption = "监控目录 : " +;
                THIS.PathBeingWatched
            This.tm.Interval = WATCHING_INTERVAL
        Endif
        Return  lResult

    Protected Procedure ContinueWatching
        If FindNextChangeNotification(This.hNotify) = 0
            This.StopWatching
            = Messagebox("响应错误.")
            This.Release
        Endif
        This.tm.Interval = WATCHING_INTERVAL

    Protected Function StopWatching
        This.tm.Interval = 0
        If This.hNotify <> INVALID_HANDLE_VALUE
            = FindCloseChangeNotification(This.hNotify)
        Endif

    Function _signaled        && 返回信号状态
        Return (WaitForSingleObject(This.hNotify, 0) = WAIT_OBJECT_0)

    Procedure _notify         && 触发事件
        Local cMessage
        cMessage = "通知 : " + Ttoc(Datetime()) + " 该目录的文件有增删！"
        This.lblAlert.Caption = cMessage
        Activate Screen
        ? cMessage
        This.ContinueWatching

    Procedure tm.Timer
        If Thisform._signaled()
            Thisform._notify
        Endif

    Protected Procedure Declare
        Declare SHORT FindNextChangeNotification In kernel32;
            INTEGER hChangeHandle

        Declare SHORT FindCloseChangeNotification In kernel32;
            INTEGER hChangeHandle

        Declare Integer FindFirstChangeNotification In kernel32;
            STRING lpPathName, Integer bWatchSubtree,;
            INTEGER dwNotifyFilter

        Declare Integer WaitForSingleObject In kernel32;
            INTEGER hHandle, Integer dwMilliseconds

Enddefine

dywfada 2013-11-09