Capture event / information of file dropped into OLE Browser Control 1

[1DMF]

Hi,

I have a browser control on a form that points to a location via the file:// protocol, so users can drag/drop emails from outlook onto a special location.

This works great, but I don't seem to be able to capture via an event when a file is dropped.

Is this possible?

I'd like to capture the fact a file/email was dropped and possibly information about the file, though the first event will suffice.

All help is appreciated.

Regards,
1DMF

"In complete darkness we are all the same, it is only our knowledge and wisdom that separates us, don't let your eyes deceive you."

"If a shortcut was meant to be easy, it wouldn't be a shortcut, it would be the way!"

Free Dance Music Downloads

 

[strongm]

thread222-1568282 might be of interest

 

[1DMF]

Thanks Mike,

Seem like it's what I want but I don't know if it will work as the code won't compile?

All I get is

Invalid use of AddressOf property operator

For the following line

        ' set up the async call
        ReadAsync hFolder, cBuffer(0), 1024, False, nFilter, nReturned, OL, AddressOf FileIOCompletionRoutine  ' 0&

Your help is appreciated.
1DMF



"In complete darkness we are all the same, it is only our knowledge and wisdom that separates us, don't let your eyes deceive you."

"If a shortcut was meant to be easy, it wouldn't be a shortcut, it would be the way!"

Free Dance Music Downloads

 

[1DMF]

OK, my bad, I'm trying to wrap it up as a class and have found this

You tried to use AddressOf with the name of a class method. Only the names of Visual Basic procedures in a .bas module can be modified with AddressOf. You can't specify a class method.

... back to the drawing board!

"In complete darkness we are all the same, it is only our knowledge and wisdom that separates us, don't let your eyes deceive you."

"If a shortcut was meant to be easy, it wouldn't be a shortcut, it would be the way!"

Free Dance Music Downloads

 

[strongm]

Not at all ...
Mind you I am away from the computer and in a pub right now, so it may be a while before I can illustrate why

 

[1DMF]

well I put some stuff in a module -> Enum , UDT's and some API declarations as they won't work in a class module.

So I have what I can in a class object and some in a global module, however, I now have an issue where the second I call

Call oFileWatcher.FileWatch(cMemDrive & "EmailDrop", "test.msg")

everything just hangs and I have to end the MSAccess process with task manager?

here is what I have...

FileWatcher Module

Option Compare Database
Option Explicit

' watcher object
Global oFileWatcher As clsFileWatcher

' enums
Public Enum FileAction
    FILE_ACTION_ADDED = &H1
    FILE_ACTION_REMOVED = &H2
    FILE_ACTION_MODIFIED = &H3
    FILE_ACTION_RENAMED_OLD_NAME = &H4
    FILE_ACTION_RENAMED_NEW_NAME = &H5
End Enum

' UDT's
Public Type OVERLAPPED
        Internal As Long
        InternalHigh As Long
        Offset As Long
        OffsetHigh As Long
        hEvent As Long
End Type

Public Type FILE_NOTIFY_INFORMATION
    NextEntryOffset As Long
    Action As Long
    FileNameLength As Long
    FileName(255) As Byte
End Type

' public vars
Public cBuffer(1024) As Byte
Public OL As OVERLAPPED

' Windows API
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public Sub FileIOCompletionRoutine(ByVal dwErrorCode As Long, ByVal dwNumberofBytes As Long, lpOverlapped As OVERLAPPED)

    Dim wombat As FILE_NOTIFY_INFORMATION ' the infamous wombat!
    Dim strFilename As String
    
    If dwNumberofBytes Then  ' did we get anything?
        CopyMemory wombat, cBuffer(0), dwNumberofBytes
        strFilename = Left(CStr(wombat.FileName), wombat.FileNameLength / 2)
    
        Select Case wombat.Action
            Case FILE_ACTION_ADDED
                MsgBox strFilename & " added to monitored folder"
                If strFilename = oFileWatcher.sFileWatch Then
                    MsgBox strFilename & " added to monitored folder"
                    oFileWatcher.CancelWatcher = True
                End If
            'Case FILE_ACTION_MODIFIED
            'Case FILE_ACTION_REMOVED
            'Case FILE_ACTION_RENAMED_NEW_NAME
            'Case FILE_ACTION_RENAMED_OLD_NAME
            'Case Else
        End Select
    End If

End Sub

clsFileWatcher Class

Option Compare Database
Option Explicit

' Declaration for async version of ReadDirectoryChangesW
Private Declare Function ReadAsync Lib "kernel32" Alias "ReadDirectoryChangesW" (ByVal hHandle As Long, lpBuffer As Any, ByVal nBufferLen As Long, ByVal bWatchSubtree As Long, ByVal dwNotifyFilter As Long, lpBytesReturned As Long, lpOverlapped As OVERLAPPED, ByVal lpCompletionRoutine As Long) As Long

Private Declare Function CreateEvent Lib "kernel32" Alias "CreateEventA" (ByVal lpEventAttributes As Long, ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpName As String) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, 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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
Private Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
Private Declare Function WaitForSingleObjectEx Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long, ByVal bAlertable As Long) As Long

Private Enum WaitState
    WAIT_FAILED = -1
    WAIT_OBJECT_0 = 0
    WAIT_ABANDONED = &H80
    WAIT_IO_COMPLETION = &HC0
    WAIT_TIMEOUT = &H102
End Enum

Private Enum NotificationFilters
    FILE_NOTIFY_CHANGE_FILE_NAME = 1
    FILE_NOTIFY_CHANGE_DIR_NAME = &H2
    FILE_NOTIFY_CHANGE_ATTRIBUTES = &H4
    FILE_NOTIFY_CHANGE_SIZE = &H8
    FILE_NOTIFY_CHANGE_LAST_WRITE = &H10
    FILE_NOTIFY_CHANGE_LAST_ACCESS = &H20
    FILE_NOTIFY_CHANGE_CREATION = &H40
    FILE_NOTIFY_CHANGE_SECURITY = &H100
End Enum


Const FILE_LIST_DIRECTORY = 1
Const GENERIC_WRITE = &H40000000
Const GENERIC_READ = &H80000000
Const FILE_SHARE_DELETE = 4
Const FILE_SHARE_READ = 1
Const OPEN_EXISTING = 3
Const FILE_FLAG_BACKUP_SEMANTICS = &H2000000
Const FILE_FLAG_OVERLAPPED = &H40000000

Private Cancelled As Boolean
Private hEvent As Long

Private strFileWatch As String
Private hFolder As Long
Public Property Get CancelWatcher() As Boolean
    CancelWatcher = Cancelled
End Property
Public Property Let CancelWatcher(aValue As Boolean)
    Cancelled = aValue
End Property
Public Property Get WatchFolder() As Long
    WatchFolder = hFolder
End Property
Public Property Get sFileWatch() As String
    sFileWatch = strFileWatch
End Property

Public Sub FileWatch(ByVal cFolder As String, ByVal strFile As String)

    Dim nFilter As Long
    Dim nReturned As Long
    Dim WaitResult As Long
    Dim mykey As Long
    Dim ByteCount As Long

    strFileWatch = strFile
    Cancelled = False
    ' Create our own event, and stick it in the OVERLAPPED structure so that
    ' we can link it to our asynch ReadDirectoryChagesW
    hEvent = CreateEvent(0&, False, False, "vbReadAsyncEvent")
    OL.hEvent = hEvent
    
    ' Get handle to nominated folder
    hFolder = CreateFile(cFolder, FILE_LIST_DIRECTORY, FILE_SHARE_READ + FILE_SHARE_DELETE, 0&, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS + FILE_FLAG_OVERLAPPED, 0)
    ' Filter the type of file events we want to monitor
    nFilter = FILE_NOTIFY_CHANGE_FILE_NAME + FILE_NOTIFY_CHANGE_LAST_WRITE + FILE_NOTIFY_CHANGE_CREATION
    
    ' Keep looping until user cancels
    Do
        ' set up the async call
        ReadAsync hFolder, cBuffer(0), 1024, False, nFilter, nReturned, OL, AddressOf FileIOCompletionRoutine  ' 0&
        Do
            ' Wait for event or timeout to occur
            WaitResult = WaitForSingleObjectEx(hEvent, 100, True)
            DoEvents ' Yield to OS
        Loop Until (WaitResult = WAIT_IO_COMPLETION) Or (Cancelled = True)
    Loop Until Cancelled

    ' Clean up as we go
    CloseHandle hEvent
    CloseHandle OL.hEvent
    CloseHandle hFolder
    hFolder = 0

End Sub

I have a global object in the module

' watcher object
Global oFileWatcher As clsFileWatcher

Which I set when the form with the browser object is opened.

    Set oFileWatcher = New clsFileWatcher
 Call oFileWatcher.FileWatch(cMemDrive & "EmailDrop", "test.msg")

But when the form opens everything freezes and not even the browser object shows the folder content, the whole thing locks up and has to be killed!

What have I missed?

"In complete darkness we are all the same, it is only our knowledge and wisdom that separates us, don't let your eyes deceive you."

"If a shortcut was meant to be easy, it wouldn't be a shortcut, it would be the way!"

Free Dance Music Downloads

 

[strongm]

You might want to add the following declaration in the class:

[blue]Const FILE_SHARE_WRITE = 2[/blue]

and modify the CreateFile line to include it:

[blue]hFolder = CreateFile(cFolder, FILE_LIST_DIRECTORY, FILE_SHARE_READ + FILE_SHARE_DELETE [b]+ FILE_SHARE_WRITE[/b], 0&, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS + FILE_FLAG_OVERLAPPED, 0[/blue]

 

[1DMF]

Seems to be working grand, many thanks Mike, this is exactly what I needed!

1DMF

"In complete darkness we are all the same, it is only our knowledge and wisdom that separates us, don't let your eyes deceive you."

"If a shortcut was meant to be easy, it wouldn't be a shortcut, it would be the way!"

Free Dance Music Downloads