Option Compare Database
Option Explicit

' === 模块级变量 ===
Private m_IsNewRecord As Boolean
Private m_DeletedIDs As New Collection

' === 安全的字符串转义 ===
Private Function SafeSQL(txt As String) As String
    SafeSQL = Replace(txt, "'", "''")  ' SQL标准转义
End Function

' === 获取窗体数据源表名 (修复版) ===
Private Function GetFormTableName() As String
    On Error Resume Next
    Dim tableName As String
    
    ' 方法 1: 【最推荐】直接检查主键字段的来源表
    ' 既然你的查询里有 "缺件记录.ID"，那么 ID 字段的 SourceTable 属性就是 "缺件记录"
    ' 这比解析字符串准确得多，也不怕查询改名
    tableName = Me.Recordset.Fields("ID").SourceTable
    
    ' 如果方法1成功，直接返回
    If Len(tableName) > 0 Then
        GetFormTableName = tableName
        Exit Function
    End If
    
    ' 方法 2: 检查窗体的 UniqueTable 属性
    ' Access 经常在属性表中设置这个值来指定多表查询中哪个表可更新
    tableName = Me.UniqueTable
    If Len(tableName) > 0 Then
        GetFormTableName = tableName
        Exit Function
    End If
    
    ' 方法 3: (保底方案) 解析 RecordSource 字符串
    ' 只有当上面都失败时，才尝试去解析 SQL
    Dim recordSource As String
    recordSource = Trim(Me.recordSource & "")
    
    ' 如果是保存的查询名（不含SELECT），需要先获取查询的SQL
    If InStr(UCase(recordSource), "SELECT") = 0 Then
        ' 检查是否为查询对象
        Dim qdf As DAO.QueryDef
        Set qdf = CurrentDb.QueryDefs(recordSource)
        If Not qdf Is Nothing Then
            recordSource = qdf.sql ' 获取查询背后的真实 SQL
        Else
            ' 既不是SELECT又不是查询，那只能是直接的表名了
            GetFormTableName = recordSource
            Exit Function
        End If
        Set qdf = Nothing
    End If
    
    ' 解析 SQL: 提取 FROM 之后、JOIN 之前的第一个词
    Dim fromPos As Long
    fromPos = InStr(1, UCase(recordSource), " FROM ", vbTextCompare)
    
    If fromPos > 0 Then
        Dim tempStr As String
        tempStr = Mid(recordSource, fromPos + 6) ' 跳过 " FROM "
        tempStr = Trim(tempStr)
        
        ' 截断点：遇到 JOIN, WHERE, ORDER BY, GROUP BY 或逗号时停止
        Dim stopChars As Variant
        Dim i As Integer, minPos As Long, p As Long
        stopChars = Array(" LEFT ", " RIGHT ", " INNER ", " OUTER ", " JOIN ", " WHERE ", " ORDER ", " GROUP ", ",")
        
        minPos = Len(tempStr) + 1
        
        For i = LBound(stopChars) To UBound(stopChars)
            p = InStr(1, UCase(tempStr), stopChars(i), vbTextCompare)
            If p > 0 And p < minPos Then minPos = p
        Next i
        
        tableName = Trim(Left(tempStr, minPos - 1))
        
        ' 清理括号
        tableName = Replace(tableName, "[", "")
        tableName = Replace(tableName, "]", "")
    End If
    
    ' 默认值
    If Len(tableName) = 0 Then tableName = "UnknownTable"
    
    GetFormTableName = tableName
    On Error GoTo 0
End Function

' === 获取表地址(连接字符串或本地路径) ===
Private Function GetTableAddress(tableName As String) As String
    On Error Resume Next
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim address As String
    
    Set db = CurrentDb
    Set tdf = db.TableDefs(tableName)
    
    If Not tdf Is Nothing Then
        If Len(Trim(tdf.Connect & "")) > 0 Then
            ' 链接表:返回连接字符串
            address = tdf.Connect
        Else
            ' 本地表:返回当前数据库路径
            address = "LOCAL:" & CurrentDb.Name
        End If
    Else
        address = "UNKNOWN"
    End If
    
    ' 清理过长的连接字符串(可选)
    If Len(address) > 500 Then
        address = Left(address, 500) & "..."
    End If
    
    GetTableAddress = address
    
    Set tdf = Nothing
    Set db = Nothing
    On Error GoTo 0
End Function

' === 获取表类型 ===
Private Function GetTableType(tableName As String) As String
    On Error Resume Next
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim connectStr As String
    Dim tableType As String
    
    Set db = CurrentDb
    Set tdf = db.TableDefs(tableName)
    
    If Not tdf Is Nothing Then
        connectStr = UCase(Trim(tdf.Connect & ""))
        
        If Len(connectStr) = 0 Then
            ' 本地表
            tableType = "LOCAL"
        ElseIf InStr(connectStr, "ODBC;") > 0 Then
            ' ODBC链接表
            If InStr(connectStr, "SQL SERVER") > 0 Then
                tableType = "LINKED_SQLSERVER"
            ElseIf InStr(connectStr, "MYSQL") > 0 Then
                tableType = "LINKED_MYSQL"
            ElseIf InStr(connectStr, "ORACLE") > 0 Then
                tableType = "LINKED_ORACLE"
            Else
                tableType = "LINKED_ODBC"
            End If
        ElseIf InStr(connectStr, "MS ACCESS") > 0 Or InStr(connectStr, ".ACCDB") > 0 Or InStr(connectStr, ".MDB") > 0 Then
            ' Access链接表
            tableType = "LINKED_ACCESS"
        ElseIf InStr(connectStr, "EXCEL") > 0 Or InStr(connectStr, ".XLS") > 0 Then
            ' Excel链接表
            tableType = "LINKED_EXCEL"
        ElseIf InStr(connectStr, "TEXT;") > 0 Or InStr(connectStr, ".TXT") > 0 Or InStr(connectStr, ".CSV") > 0 Then
            ' 文本/CSV链接表
            tableType = "LINKED_TEXT"
        Else
            ' 其他类型链接表
            tableType = "LINKED_OTHER"
        End If
    Else
        tableType = "UNKNOWN"
    End If
    
    GetTableType = tableType
    
    Set tdf = Nothing
    Set db = Nothing
    On Error GoTo 0
End Function

' === 获取本机IP地址(带超时保护) ===
Private Function GetLocalIPAddress() As String
    On Error Resume Next
    Dim objWMI As Object
    Dim colItems As Object
    Dim objItem As Object
    Dim ip As String
    Dim startTime As Double
    
    startTime = Timer
    Set objWMI = GetObject("winmgmts:\\.\root\cimv2")
    
    ' 超时保护:WMI查询最多等待2秒
    If Timer - startTime > 2 Then
        GetLocalIPAddress = "127.0.0.1"
        Exit Function
    End If
    
    Set colItems = objWMI.ExecQuery("SELECT IPAddress FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
    
    For Each objItem In colItems
        If Not IsNull(objItem.ipAddress) Then
            ip = objItem.ipAddress(0)
            If InStr(ip, ":") = 0 Then
                GetLocalIPAddress = ip
                Exit Function
            End If
        End If
    Next
    
    GetLocalIPAddress = "127.0.0.1"
    On Error GoTo 0
End Function

' === 异步日志写入(不阻塞用户操作) ===
Private Sub WriteLog(actionType As String, recordID As String)
    Dim sql As String
    Dim ipAddr As String
    Dim remoteTable As String
    Dim localTable As String
    Dim tableAddr As String
    Dim tableType As String
    Dim computerName As String ' 新增：计算机名称变量
    ' --- 配置区域 ---
    remoteTable = "dbo_TableChangeLog"
    ' ----------------
    
    ' 【关键1】立即返回,不等待耗时操作
    On Error Resume Next
    
    ' 【新增】动态获取窗体数据源表名
    localTable = GetFormTableName()
    
    ' 【新增】动态获取表地址
    tableAddr = GetTableAddress(localTable)
    
    ' 【新增】动态获取表类型
    tableType = GetTableType(localTable)
    
    ' 快速验证:表是否存在
    If IsNull(DLookup("Name", "MSysObjects", "Name='" & SafeSQL(remoteTable) & "'")) Then
        Debug.Print "Log Warning: 表 " & remoteTable & " 不存在,跳过日志"
        Exit Sub
    End If
    
    ' 【关键2】防止空值和特殊字符
    If Len(Trim(recordID & "")) = 0 Then recordID = "NULL"
    recordID = SafeSQL(recordID)
    
    ' 【关键3】快速获取IP(带缓存)
    Static cachedIP As String
    If cachedIP = "" Then cachedIP = GetLocalIPAddress()
    ipAddr = cachedIP
    
    '  获取当前电脑的【计算机名称】，替代原有的 Windows登录用户名
    computerName = Environ$("COMPUTERNAME")
    
    
    ' 【关键4】参数化查询(如果支持)或安全拼接
    ' 注意:不写 ChangeDate 字段,让 SQL Server 的 DEFAULT GETDATE() 自动填充
    sql = "INSERT INTO " & remoteTable & " " & _
          "(TableName, TableAddress, TableType, RecordID, ActionType, IPAddress, UserName, FilePath) " & _
          "VALUES ('" & SafeSQL(localTable) & "', " & _
          "'" & SafeSQL(tableAddr) & "', " & _
          "'" & SafeSQL(tableType) & "', " & _
          "'" & recordID & "', " & _
          "'" & SafeSQL(actionType) & "', " & _
          "'" & SafeSQL(ipAddr) & "', " & _
          "'" & SafeSQL(computerName) & "', " & _
          "'" & SafeSQL(CurrentDb.Name) & "')"
    
    ' 【关键5】静默执行,绝不影响用户
    CurrentDb.Execute sql  ' 移除 dbFailOnError!
    
    If Err.Number <> 0 Then
        ' 仅记录到立即窗口,不弹窗
        Debug.Print Now & " - Log Failed: " & Err.Description & " | SQL: " & sql
        ' 可选:写入本地备份表
        Call WriteLocalBackupLog(localTable, recordID, actionType)
    End If
    
    On Error GoTo 0
End Sub

' === 本地备份日志(防止远程失败) ===
Private Sub WriteLocalBackupLog(tblName As String, recID As String, actType As String)
    On Error Resume Next
    ' Access 本地表使用 Now() 函数
    CurrentDb.Execute "INSERT INTO LocalLogBackup (TableName, RecordID, ActionType, LogTime) " & _
                      "VALUES ('" & SafeSQL(tblName) & "', '" & SafeSQL(recID) & "', '" & SafeSQL(actType) & "', Now())"
    On Error GoTo 0
End Sub

' ==============================
'      窗体事件逻辑(增强版)
' ==============================

' 1. 保存前状态判断
Private Sub Form_BeforeUpdate(Cancel As Integer)
    On Error Resume Next  ' 【保护】防止日志逻辑影响保存
    m_IsNewRecord = Me.NewRecord
    On Error GoTo 0
End Sub

' 2. 修改保存后
Private Sub Form_AfterUpdate()
    On Error Resume Next
    If Not m_IsNewRecord Then
        Call WriteLog("UPDATE", Nz(Me.ID.Value, ""))
    End If
    On Error GoTo 0
End Sub

' 3. 新增确认后
Private Sub Form_AfterInsert()
    On Error Resume Next
    Call WriteLog("INSERT", Nz(Me.ID.Value, ""))
    m_IsNewRecord = False
    On Error GoTo 0
End Sub

' 4. 删除开始(收集ID)
Private Sub Form_Delete(Cancel As Integer)
    On Error Resume Next
    If Not IsNull(Me.ID.Value) Then
        m_DeletedIDs.Add CStr(Me.ID.Value)
    End If
    On Error GoTo 0
End Sub

' 5. 删除确认后(批量写入)
Private Sub Form_AfterDelConfirm(Status As Integer)
    On Error Resume Next
    Dim vID As Variant
    
    If Status = acDeleteOK Then
        For Each vID In m_DeletedIDs
            Call WriteLog("DELETE", CStr(vID))
        Next
    End If
    
    ' 清理集合
    Set m_DeletedIDs = Nothing
    Set m_DeletedIDs = New Collection
    On Error GoTo 0
End Sub

' === 窗体关闭时清理(可选) ===
Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    Set m_DeletedIDs = Nothing
    On Error GoTo 0
End Sub