IsFileAlreadyOpen эту функцию нашел тут на форуме, она работает, а программка в целом нет.
не срабатывает событие eFile, хотя RaiseEvent eFile(bVal) выполняется.
подскажите пожайлуста что тут не так. вроде все должно работать, а не работает. ((
Форма:
- Код: Выделить всё
Option Explicit
Dim WithEvents cF As Cad.FSO1
Private Sub cF_eFile(bValue As Boolean)
Me.Caption = bValue
End Sub
Private Sub Form_Load()
Set cF = New Cad.FSO1
cF.FileName = "c:\файл.dwg"
cF.GoWatch Me.hWnd, 500
End Sub
Класс: название - FSO1
- Код: Выделить всё
Option Explicit
Dim ihwnd1 As Double
Public Event eFile(bValue As Boolean)
Public Sub GoWatch(ihwnd As Double, dTime As Integer)
ihwnd1 = ihwnd
SetTimer ihwnd1, 0, dTime, AddressOf aaa
End Sub
Public Sub StopWatch(ihwnd As Variant)
KillTimer ihwnd1, 0
End Sub
Public Property Get FileName() As Variant
FileName = sFileName
End Property
Public Property Let FileName(ByVal vNewValue As Variant)
sFileName = vNewValue
End Property
Friend Sub createEventFile(bVal As Boolean)
RaiseEvent eFile(bVal)
End Sub
Модуль:
- Код: Выделить всё
Public Declare Function lOpen Lib "kernel32" Alias "_lopen" (ByVal lpPathName As String, ByVal iReadWrite As Long) As Long
Public Declare Function lClose Lib "kernel32" Alias "_lclose" (ByVal hFile As Long) As Long
Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Public FSO11 As New FSO1
Public Function IsFileAlreadyOpen() As Boolean
Dim hFile As Long
Dim lastErr As Long
hFile = -1
lastErr = 0
hFile = lOpen(sFileName, &H10)
If hFile = -1 Then
lastErr = Err.LastDllError
Else
lClose (hFile)
End If
IsFileAlreadyOpen = (hFile = -1) And (lastErr = 32)
End Function
Public Sub aaa()
FSO11.createEventFile IsFileAlreadyOpen
End Sub
