See File-change at run-time 2

[HydraNL]

Hi,

I have 2 Forms one with a button and one with a textbox. I open both forms.

When I write a value to the textfile with the button on Form1 I instantely want to show the value of the textfile in Form2 (while active/open). "Somekind of read_when_change_textfile"

I hope someone understands what I'm trying to do.

 

[HarleyQuinn]

Why not just have the click event on the first form update the second form when it has written to the text file???

Hope this helps

HarleyQuinn
---------------------------------
Help us to help you,
read FAQ222-2244 before posting.

 

[HydraNL]

Well I want to create a little shoutbox for passing information. Pressing the button and passing the code to the next form is an easy option, but nicer when it goes autom.

 

[mattKnight]

To clarify,

Are you trying to communicate between forms or between programs?

Take Care

Matt
If at first you don't succeed, skydiving is not for you.

 

[AndyLee100]

When the button is clicked call a sub in the other form with the text as a parameter and change the text this way.

You could also have a play with events but I couldnt get it to work for some reason, (may have to sub class for this)

In first form
Private Sub Command1_Click()
s = Text1.Text
Form2.ChangeText s
End Sub


in Form 2
Sub ChangeText(ss As String)
Text2.Text = ss
End Sub

Andy

 

[HydraNL]

Matt... It will become a programm with one form, but I'm trying to understand how it works by starting simple.

Thanks for the reply Andy. Will check that one out.

 

[HydraNL]

What I want is, when I send a message (to the textfile) it is automaticaly updated in the other form without using a Click_Event.

 

[HarleyQuinn]

You could have a timer on the second form to see if the size or modified date of the file have changed and then if it has update the text on the form??

HarleyQuinn
---------------------------------
Help us to help you,
read FAQ222-2244 before posting.

 

[HydraNL]

Wouldn't that use a lot of memory? 'cause it has to check for meassage every second. Pref instantly.

 

[MakeItSo]

You could try with an API call.
The following function will fire, if any file in the folder is being renamed, moved, deleted or modified:

Option Explicit
Public Xx As Integer

' 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
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public 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

Public 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


Public Type OVERLAPPED
        Internal As Long
        InternalHigh As Long
        Offset As Long
        OffsetHigh As Long
        hEvent As Long
End Type

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

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

Public 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

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

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

Public cBuffer(1024) As Byte
Public Cancelled As Boolean
Public hEvent As Long
Public OL As OVERLAPPED
Public strFileWatch As String
Public hFolder As Long
Public meld As String


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
    Dim a As Integer, actn As String, pat As String
    Dim fso, meld As String
    'pat = Right(Form2.SrcPath, 9)
    a = FreeFile
    Set fso = CreateObject("Scripting.FileSystemObject")
    If dwNumberofBytes Then  ' did we get anything?
        CopyMemory wombat, cBuffer(0), dwNumberofBytes
        strFilename = Left(CStr(wombat.Filename), wombat.FileNameLength / 2)
        If Right(strFilename, 15) <> "Folderwatch.txt" Then
        meld = "Checkin für " & strFilename
            Open strFileWatch For Append As a
            Select Case wombat.Action
                Case FILE_ACTION_REMOVED
                     Print #a, strFilename & " removed" & vbCrLf
                CASE FILE_ACTION_CHANGED
                     'Add code here
'...
            End Select
            Close a
        End If
    End If
    

End Sub

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
    Form1.Hide
    strFileWatch = strFile
    Cancelled = False
    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 (countr >= UBound(Procs))
    Loop Until Cancelled Or (countr >= UBound(Procs))
    
    ' Clean up as we go
    CloseHandle hEvent
    CloseHandle OL.hEvent
    CloseHandle hFolder
    hFolder = 0
End Sub

You can then call the watch routine from e.g. a button_click event like this:

FileWatch File2.Path, "C:\" & Format(Day(Date), "00") & Format(Month(Date), "00") & Right(Year(Date), 2) & "_Folderwatch.txt"
'***************************

with the second option being the path to a log file.

I once copied this code from some thread here, but I can't remember who wrote it. So credits to the unknown TT - whiz!
;o)

I've been using it since 2 years now, and it works just fine...

Greetz,
Andy



[blue]Speak out against Human Rights violations in China/Tibet

http://www.thepetitionsite.com/takeaction/323661827

[/blue]

 

[HarleyQuinn]

Just out of interest could you tell us why you don't want to update the second form when you click the button on the first please?

HarleyQuinn
---------------------------------
Help us to help you,
read FAQ222-2244 before posting.

 

[strongm]

MakeItSo, if you are going to use my code please at least attribute it

 

[MakeItSo]

Oh that was you, strongm?
I didn't remember, whose it was. Sorry.


[blue]Speak out against Human Rights violations in China/Tibet

http://www.thepetitionsite.com/takeaction/323661827

[/blue]

 

[strongm]

The wombat is the giveaway

 

[HydraNL]

MakeItSo & StrongM many thanx I will check this one out. For this piece of code you realy deserve a shiny. Have one.