[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 306
  • Last Modified:

Define event and detecting event by VB6 program (No GUI form, an exe program running in the background all tiime)

I want to use a vb6 program (simple program, no GUI, no form), that is constantly
run in the background (use scheduler to run).  that will wait for 1 event to occur.

The event means if certain 'file' in a given folder is occured. (either being just created,
or something is appended to it).  OS will trigger a event notification to my program

(e.g. wait when file = "c:\inetpub\ftproot\abc_xxx.txt"   is created by ftp process)

my program. (in a pudo code format:)

1: Option explicit
2:
3: sub main()
4:
5:   set event_to_listen = event_file_created("c:\inetpub\ftproot\abc_xxx.txt")
6:       ' I assume event_to_listen is defined here first, ...
7: next_event:
8:      call listen_event  
9:      msgbox  " get it, wait for next event "
10:    go to next_event
11:  end sub
12:
13: sub listen_event
14:
15:   ' listing to a defined event x --> associated to a file (created, appended, or just touched by reading it
16:   ' then do some actions, wait for next event (same event).
17:       on change event_to_list then
18:              debug.print " event detected at " & now()
19:                 ' do someting with it  when finished, delete the file
20:               kill "c:\inetpub\ftproot\abc_xxx.txt"
21:         exit sub
21:       endif
22:
23:   end sub  ' /*sub listen_event */

Q:  How do you accomplish above logic without using the 'sleep' function that wait for fixed
number of seconds, then go back to wait again?

A completed sample code will appreciate.
(I believe many people may have the similar questions on how to get a control mechanism for this type of
 situations.  Please give me some clear path and suggestions....  )

thanks
0
mshox1
Asked:
mshox1
  • 3
  • 2
1 Solution
 
Mike TomlinsonMiddle School Assistant TeacherCommented:
Take a look at the internals of this project:
http://www.thescarms.com/vbasic/FolderSpy.asp
0
 
mshox1Author Commented:
Thank you.  I will study it and let you know if this works well.  I think it will.
0
 
nffvrxqgrcfqvvcCommented:
If you don't want any GUI and you want to keep polling the folder than you won't be able to close the application normally. If you just want it to wait for 1 event to occur than it will wait and then unload. This is only when using Sub Main (no gui) this means that if you use recursive in sub main it will poll endlessly unless you set up a couple procedures to go active and deactivate at specific times.

'Here is example

'Add the following to standard module, run the application and Add,Remove files from the monitoring folder.




Option Explicit
 
    Private Type OVERLAPPED
        Internal                    As Long
        InternalHigh                As Long
        Offset                      As Long
        OffsetHigh                  As Long
        hEvent                      As Long
    End Type
   
    Private Type FILE_NOTIFY_INFORMATION
       NextEntryOffset  As Long
       Action           As Long
       FileNameLength   As Long
       FileName(512)    As Byte
    End Type
   
    Private Const ADDED = &H1&
    Private Const REMOVED = &H2&
    Private Const MODIFIED = &H3&
    Private Const OLDNAME = &H4&
    Private Const NEWNAME = &H5&

    Private Const FILE_NOTIFY_CHANGE_FILE_NAME& = &H1


     Private Const GENERIC_READ& = &H8000000
     Private Const FILE_LIST_DIRECTORY& = &H1
     Private Const FILE_SHARE_READ& = &H1&
     Private Const FILE_SHARE_WRITE& = &H2
     Private Const FILE_SHARE_DELETE& = &H4
     Private Const OPEN_EXISTING = 3
     Private Const FILE_FLAG_BACKUP_SEMANTICS& = &H2000000
     Private Const FILE_FLAG_OVERLAPPED = &H40000000
 
    Private Declare Function ReadDirectoryChangesW Lib "Kernel32.dll" ( _
        ByVal hDirectory As Long, _
        ByVal lpBuffer As Long, _
        ByVal nBufferLength As Long, _
        ByVal bWatchSubtree As Long, _
        ByVal dwNotifyFilter As Long, _
        lpBytesReturned As Long, _
        ByRef lpOverlapped As OVERLAPPED, _
        ByRef lpCompletionRoutine As Long) As Boolean
   
    Private Declare Function CreateFileW Lib "Kernel32.dll" ( _
        ByVal lpFileName As Long, _
        ByVal dwDesiredAccess As Long, _
        ByVal dwShareMode As Long, _
        ByVal lpSecurityAttributes As Long, _
        ByVal dwCreationDisposition As Long, _
        ByVal dwFlagsAndAttributes As Long, _
        ByVal hTemplateFile As Long) As Long

    Private Declare Function CreateEventA Lib "kernel32" ( _
        lpEventAttributes As Any, _
        ByVal bManualReset As Long, _
        ByVal bInitialState As Long, _
        ByVal lpName As String) As Long
   
    Private Declare Function AtlWaitWithMessageLoop Lib "ATL.DLL" ( _
        ByVal hEvent As Long) As Long

    Private Declare Sub RtlMoveMemory Lib "kernel32" ( _
        Destination As Any, _
        Source As Any, _
        ByVal Length As Long)
       
    Private Declare Sub RtlZeroMemory Lib "Kernel32.dll" ( _
        ByRef Destination As Any, _
        ByVal Length As Long)
       
    Private Declare Function CloseHandle Lib "kernel32" ( _
        ByVal hObject As Long) As Long

    Dim OL                              As OVERLAPPED
    Dim FN                              As FILE_NOTIFY_INFORMATION
    Dim Warrior(1024)                   As Byte
    Dim Handles                         As Long
    Dim Dummy                           As Long
    Dim FileNames                       As String
   
Public Sub Main()

     If DirectorySessionHandle("C:\") Then  'Proceed
        WaitIOEvent False, True
     Else
        MsgBox "Failed"
     End If
     
End Sub

Public Function DirectorySessionHandle( _
    ByVal DirName As String) As Long
   
    If Handles > 0 Then
        Debug.Print "Session handle already active"
        Exit Function
    End If
   
    'Create handle to the directory
    Handles = CreateFileW( _
            StrPtr("\\?\" & DirName), _
            FILE_LIST_DIRECTORY, _
            FILE_SHARE_READ Or _
            FILE_SHARE_WRITE Or _
            FILE_SHARE_DELETE, _
            ByVal 0&, _
            OPEN_EXISTING, _
            FILE_FLAG_BACKUP_SEMANTICS Or _
            FILE_FLAG_OVERLAPPED, _
            ByVal 0&)
   
    If Handles > 0 Then
        DirectorySessionHandle = Handles
    End If
   
End Function

Public Function WaitIOEvent( _
    Optional SubDir As Boolean = False, _
    Optional Recursive As Boolean = False) As Long
   
    RtlZeroMemory OL, Len(OL)
   
    ' Setup Overlapped event
    OL.hEvent = CreateEventA(ByVal 0&, _
        Abs(False), Abs(True), vbNullString)
       
    ' Monitor folder activity
    Call ReadDirectoryChangesW(Handles, _
        ByVal VarPtr(Warrior(0)), 1024, SubDir, _
        FILE_NOTIFY_CHANGE_FILE_NAME, Dummy, OL, ByVal 0&)
   
    ' Wait until event is triggered
    AtlWaitWithMessageLoop OL.hEvent
    ' Event occured
    WaitIOEventReleased
    ' Close event
    CloseHandle OL.hEvent
    ' Recursive
    If Recursive Then
        WaitIOEvent SubDir, Recursive
        Else
        ForceRemoveAllHandles
    End If
   
End Function

Public Function WaitIOEventReleased() As Long
   
    ' Clear memory type
    RtlZeroMemory FN, Len(FN)
    ' Offset Action
    FN.Action = Warrior(4)
    ' Offset FileLength
    RtlMoveMemory FN.FileNameLength, Warrior(8), _
        ByVal 4
    ' Offset Filename
    RtlMoveMemory FN.FileName(0), Warrior(12), _
        ByVal FN.FileNameLength
    ' Offset byte to string
    FileNames = Left$(FN.FileName, InStr(FN.FileName, Chr$(0)) - 1)
    ' The action the file took in the directory
    Select Case FN.Action
        Case ADDED
            MsgBox "File was added: " & FileNames
        Case REMOVED
            MsgBox "File was removed: " & FileNames
        Case MODIFIED
            MsgBox "File was modified: " & FileNames
    End Select
   
End Function

Public Sub ForceRemoveAllHandles()
    CloseHandle OL.hEvent
    CloseHandle Handles
End Sub
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
mshox1Author Commented:
Egl1044:

Thank you for the code.  I have a quick questions:
1. where I 'insert' the folder-name, and path-name that I want to 'monitor'?  in your
   sub main?

2. Is this 'constant polling' take a lot of cpu?

3. I can add logic in the program, to have this process 'quit' itself , say before midlight
   or add some 'speical token' in the filename that I need to monitor.  Once the filename
   that I 'monitor' is there, I can read to see if it contain this 'token'. it true, then it will
   exit the program.

If you can help me to clearify the 1 and 2, that will be very helpful.

thanks

mshox1
0
 
nffvrxqgrcfqvvcCommented:
Yes in sub main.. You can also monitor subfolders if you set the SubDir to true for WaitIOEvent which has 2 optional arguments. One is to monitor subfolders and the Two is to recursively poll the directory, if you set recursive False then it will unload your exe after the first event is triggered meaning a file that was added,remove etc.. otherwise it will keep polling if recursive is set to true


Public Sub Main()

     If DirectorySessionHandle("c:\inetpub\ftproot\") Then  'Proceed
        WaitIOEvent False, True
     Else
        MsgBox "Failed"
     End If
     
End Sub
0
 
nffvrxqgrcfqvvcCommented:
To be honest it would be better to use a form and make it invisible then whenever you need to start, or pause the directory changes you can use a hotkey to display the forms gui. This would be a better solution than using submain.

<<< Does this constant polling take alot of CPU

No. It won't use much CPU for the monitoring alone.

I just threw out the basic steps to monitor the files in the folder the above can and should be edited for better performance. You could throw a Sleep(0) statement right before the AtlWaitWithMessageLoop for better performance.
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now