如何测试 .txt 文件是否已被任何人打开？

Question

我正在尝试测试 .txt 或 .ini 文件是否已被任何人打开。我有几个版本的 IsFileOpen。这是直接取自http://www.cpearson.com/excel/ISFILEOPEN.ASPX

Option Explicit
Option Compare Text
Public Function isfileopen_test(FileName As String, _
    Optional ResultOnBadFile As Variant) As Variant
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' IsFileOpen_test
' This function determines whether a the file named by FileName is
' open by another process. The fuction returns True if the file is open
' or False if the file is not open. If the file named by FileName does
' not exist or if FileName is not a valid file name, the result returned
' if equal to the value of ResultOnBadFile if that parameter is provided.xd
' If ResultOnBadFile is not passed in, and FileName does not exist or
' is an invalid file name, the result is False.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim FileNum As Integer
Dim ErrNum As Integer
Dim V As Variant

On Error Resume Next

''''''''''''''''''''''''''''''''''''''''''''
' If we were passed in an empty string,
' there is no file to test so return FALSE.
''''''''''''''''''''''''''''''''''''''''''''
If VBA.Trim(FileName) = vbNullString Then
    If IsMissing(ResultOnBadFile) = True Then
        isfileopen_test = False
    Else
        isfileopen_test = ResultOnBadFile
    End If
    Exit Function
End If

''''''''''''''''''''''''''''''''''''''''''''
' if the file doesn't exist, it isn't open
' so get out now
''''''''''''''''''''''''''''''''''''''''''''
V = Dir(FileName, vbNormal)
If IsError(V) = True Then
    ' syntactically bad file name
    If IsMissing(ResultOnBadFile) = True Then
        isfileopen_test = False
    Else
        isfileopen_test = ResultOnBadFile
    End If
    Exit Function
ElseIf V = vbNullString Then
    ' file doesn't exist.
    If IsMissing(ResultOnBadFile) = True Then
        isfileopen_test = False
    Else
        isfileopen_test = ResultOnBadFile
    End If
    Exit Function
End If

FileNum = FreeFile()
'''''''''''''''''''''''''''''''''''''''
' Attempt to open the file and lock it.
'''''''''''''''''''''''''''''''''''''''
Err.Clear
Open FileName For Input Lock Read As #FileNum
ErrNum = Err.Number
''''''''''''''''''''
' Close the file.
''''''''''''''''''''
Close FileNum
On Error GoTo 0

''''''''''''''''''''''''''''''''''''''
' Check to see which error occurred.
''''''''''''''''''''''''''''''''''''''
Select Case ErrNum
    Case 0
        ''''''''''''''''''''''''''''''''''''''''''''
        ' No error occurred.
        ' File is NOT already open by another user.
        ''''''''''''''''''''''''''''''''''''''''''''
        isfileopen_test = False
    Case 70
        ''''''''''''''''''''''''''''''''''''''''''''
        ' Error number for "Permission Denied."
        ' File is already opened by another user.
        ''''''''''''''''''''''''''''''''''''''''''''
        isfileopen_test = True
    Case Else
        ''''''''''''''''''''''''''''''''''''''''''''
        ' Another error occurred. Assume open.
        ''''''''''''''''''''''''''''''''''''''''''''
        isfileopen_test = True
End Select

End Function

我需要通过 VBA 执行此操作。我无法让它适用于 .txt 或 .ini 文件。如何检查 txt 或 ini 文件是否已被网络上的某个人打开？

编辑：无论txt和ini文件是否打开，它都会返回false。

如果您愿意，我正在尝试在客户端网络上构建分布式计算系统。我以前从未这样做过，我希望让它尽可能简单，所以我正在考虑通过 txt 文件进行通信。 MSMQ 看起来不错，但看起来学习曲线很长。我已经阅读了 stackoverflow 上关于分布式计算的所有帖子。

Answer 1

一种方法是尝试用相同的名称重命名文件：

Public Function IsFileLocked(file_path As String) As Boolean
  Dim num As Long

  On Error Resume Next
  Name file_path As file_path
  num = Err.Number
  On Error GoTo 0

  If num <> 0 And num <> 75 Then Error num
  IsFileLocked = num <> 0
End Function

Answer 2

OpenFiles 命令使用NetFileEnum

NetFileEnum 函数根据指定的参数返回有关服务器上部分或全部打开文件的信息。

NET_API_STATUS NetFileEnum(
  LMSTR servername,
  LMSTR basepath,
  LMSTR username,
  DWORD level,
  LPBYTE* bufptr,
  DWORD prefmaxlen,
  LPDWORD entriesread,
  LPDWORD totalentries,
  PDWORD_PTR resume_handle
);

它说它也支持本地计算机，但 Openfiles 需要为本地文件设置一个标志。运行GFlags并勾选为每种类型维护一个对象列表。

Note 记事本打开、读取和关闭文件。因此记事本不会打开任何文件。

对于本地计算机，您可以致电enumwindows，查看您的文件名是否在任何窗口的标题中。此示例使用GetWindow，但文档说EnumWindows 是首选。

Public Declare Function GetTopWindow Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
       Private Const GW_CHILD = 5
       Private Const GW_HWNDNEXT = 2
    Sub WindowList()
        Dim hwnd As Long
            hwnd = GetTopWindow(0)
            If hwnd <> 0 Then
                AddChildWindows hwnd, 0
            End If
    End Sub

    Private Function AddChildWindows(ByVal hwndParent As Long, ByVal Level As Long) As String
        Dim gwfnhwnd As Long, X As Long, WT As String, CN As String, Length As Long, hwnd As Long, TID As Long, PID As Long, MN As String, Ret As Long, Parenthwnd As Long
        Static Order As Long
        Static FirstTime As Long
        Parenthwnd = hwndParent
        If Level = 0 Then
                        hwnd = hwndParent
        Else
            hwnd = GetWindow(hwndParent, GW_CHILD)
        End If
        Do While hwnd <> 0
                  WT = Space(512)
                  Length = GetWindowText(hwnd, WT, 508)
                  WT = Left$(WT, Length)
                  If WT = "" Then WT = Chr(171) & "No Window Text " & Err.LastDllError & Chr(187)
                  CN = Space(512)
                  Length = GetClassName(hwnd, CN, 508)
                  CN = Left$(CN, Length)
                  If CN = "" Then CN = "Error=" & Err.LastDllError
                  MsgBox WT & " " & CN
                  hwnd = GetWindow(hwnd, GW_HWNDNEXT)
        Loop
    End Function

COM 可以跨计算机和进程进行通信。只需使用 Class 模块来构建进程之间的接口。