如何检查VBA模块何时被修改？

时间：2016-11-22 19:06:22

标签： vba ms-access access-vba

我写了一个版本控制模块。每当我或其他维护者登录时，AutoExec宏就会启动它。它查找自上次更新以来创建或修改的数据库对象，然后向Versions表添加一个条目，然后打开表（过滤到最后一条记录）所以我可以输入我执行的更改的摘要。

它适用于表格，查询，表单，宏等，但我无法让它在模块中正常工作。

我找到了两个不同的属性，表明上次修改日期...... 

CurrentDB.Containers("Modules").Documents("MyModule").Properties("LastUpdated").Value
CurrentProject.AllModules("MyModule").DateModified

第一个（CurrentDB）总是显示＆＃34; LastUpdated＆＃34;作为创建日期，除非您修改模块的描述或界面中的某些内容。这告诉我这个属性纯粹是为了容器对象 - 而不是它中的内容。

第二个效果更好。它准确显示了我修改和编译/保存模块的日期。唯一的问题是，当您保存或编译模块时，它会再次保存/编译所有模块，因此将DateModified字段设置为全面的相同日期。它有点违背了在各个模块上使用DateModified属性的目的吗？

所以我的下一步行动会更加激烈。我想我需要维护所有模块的列表，并使用VBA Extensions计算每个模块中的代码行。然后，如果代码行与列表记录的内容不同 - 那么我知道模块已被修改 - 我只是知道什么时候，除了＆＃34;自上次我检查＆＃34;

有没有人有更好的方法？我宁愿不做我的下一步行动，因为我可以看到它显着影响数据库性能（以糟糕的方式）

3 个答案:

答案 0 :(得分：4)

模块修改时无法知道。 VBIDE API甚至没有告诉你是否模块被修改了，所以你必须自己解决这个问题。

VBIDE API让你感到非常痛苦 - 正如你所注意到的那样。

Rubberduck还没有处理特定于主机的组件（例如表，查询等），但是它的解析器在判断自上次解析后模块是否被修改方面做得非常好。

“自上次检查后修改”实际上是您需要知道的全部内容。但是你不能依赖行数，因为：

Option Explicit

Sub DoSomething
    'todo: implement
End Sub

与此相同：

Option Explicit

Sub DoSomething
    DoSomethingElse 42
End Sub

显然，您希望获取并跟踪该更改。比较每一行代码中的每个字符都可行，但有更快的方法。

一般的想法是获取CodeModule的内容，哈希，然后与之前的内容哈希进行比较 - 如果有任何修改，我们正在查看“脏”模块。它是C＃，我不知道是否有一个COM库可以很容易地从VBA中散列字符串，但最糟糕的情况是你可以在.NET中编译一个小的实用程序DLL来暴露一个COM可见的函数，该函数需要{{1并且为它返回一个哈希值，不应该太复杂。

以下是来自Rubberduck.VBEditor.SafeComWrappers.VBA.CodeModule的相关代码，如果有任何帮助的话：

String

这里private string _previousContentHash; public string ContentHash() { using (var hash = new SHA256Managed()) using (var stream = Content().ToStream()) { return _previousContentHash = new string(Encoding.Unicode.GetChars(hash.ComputeHash(stream))); } } public string Content() { return Target.CountOfLines == 0 ? string.Empty : GetLines(1, CountOfLines); } public string GetLines(Selection selection) { return GetLines(selection.StartLine, selection.LineCount); } public string GetLines(int startLine, int count) { return Target.get_Lines(startLine, count); } 是一个Target对象 - 如果你在VBA领域，那么这只是Microsoft.Vbe.Interop.CodeModule，来自VBA可扩展性库;像这样的东西：

CodeModule

所以是的，你的“激烈”解决方案几乎是唯一可行的方法。要记住几件事：

  • “保留所有模块的列表”将起作用，但如果您只存储模块名称，并且模块已重命名，则您的缓存过时，您需要一种方法使其无效。
  • 如果存储每个模块对象的Public Function IsModified(ByVal target As CodeModule, ByVal previousHash As String) As Boolean Dim content As String If target.CountOfLines = 0 Then content = vbNullString Else content = target.GetLines(1, target.CountOfLines) End If Dim hash As String hash = MyHashingLibrary.MyHashingFunction(content) IsModified = (hash <> previousHash) End Function 而不是它们的名称，我不确定它在VBA中是否可靠，但我可以告诉你，通过COM互操作，COM对象的哈希码不会出现在调用之间保持一致 - 所以你也会有一个过时的缓存和一种使它失效的方法。可能不是100％VBA解决方案的问题。

我会使用ObjPtr将模块的对象指针存储为键，并将其内容哈希值存储为值。

作为Rubberduck项目的管理员，我更愿意看到你加入我们并帮助我们将全功能的源代码控制（即具有主机特定功能）直接集成到VBE中=）

Rubberduck's Source Control panel

答案 1 :(得分：4)

这是一个更简单的建议：

  1. 计算每个模块的MD5哈希值。
  2. 将其存储在Versions表中。
  3. 在AutoExec期间为每个模块重新计算它，并将其与Versions表中的模块进行比较。如果它有所不同，您可以认为它已被更改（虽然MD5对安全性有害，但它的完整性仍然很可靠）。

    4. 要使用VBE Extensibility从模块获取文本，您可以执行

    Dim oMod As CodeModule
Dim strMod As String
Set oMod = VBE.ActiveVBProject.VBComponents(1).CodeModule
strMod = oMod.Lines(1, oMod.CountOfLines)

    然后您可以使用this answer中的以下修改后的MD5哈希函数，如下所示，您可以将每个模块的哈希值存储起来，然后在AutoExec中进行比较。

    Public Function StringToMD5Hex(s As String) As String
    Dim enc
    Dim bytes() As Byte
    Dim outstr As String
    Dim pos As Integer
    Set enc = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
    'Convert the string to a byte array and hash it
    bytes = StrConv(s, vbFromUnicode)
    bytes = enc.ComputeHash_2((bytes))
    'Convert the byte array to a hex string
    For pos = 0 To UBound(bytes)
        outstr = outstr & LCase(Right("0" & Hex(bytes(pos)), 2))
    Next
    StringToMD5Hex = outstr
    Set enc = Nothing
End Function

答案 2 :(得分：3)

我以为我会为哈希/校验和生成模块添加我想出的最终代码，因为那真的是我缺少的那部分。感谢@BlackHawk通过展示你可以延迟绑定.NET类来填补空白的答案 - 这将为我现在开辟很多可能性。

我已完成编写版本检查程序。我遇到了一些警告，这使得很难依赖LastUpdated日期。

  1. 调整表或查询中的列的大小会更改LastUpdated日期。
  2. 编译任何模块编译所有模块，从而更新所有模块的LastUpdated日期（已经指出）
  3. 在“查看”模式下向表单添加过滤器会导致更新表单的“过滤器”字段，从而更新LastUpdated日期。
  4. 在表单或报表上使用SaveAsText时，更改打印机或显示驱动程序会影响PrtDevMode编码，因此在计算校验和之前必须将其删除

    5. 对于Tables，我构建了一个字符串，它是表名的串联，所有字段名都有它们的大小和数据类型。然后我计算了那些哈希。

    对于查询，我只是计算了SQL的哈希值。

    对于模块，宏，表单和报表我使用Application.SaveAsText将其保存到临时文件中。然后，我将该文件读入字符串并计算其上的哈希值。对于表单和报表，我没有开始添加到字符串，直到＆＃34;开始＆＃34;线路过去了。

    现在似乎正在工作，我还没有遇到任何情况，如果事情没有实际改变，它会提示进行版本修订。

    为了计算校验和或散列，我构建了一个名为CryptoHash的类模块。以下是完整的来源。我将字节数组优化为十六进制字符串转换为更快。

    Option Compare Database
Option Explicit

Private objProvider As Object          ' Late Bound object variable for MD5 Provider
Private objEncoder As Object           ' Late Bound object variable for Text Encoder
Private strArrHex(255) As String       ' Hexadecimal lookup table array

Public Enum hashServiceProviders
  MD5
  SHA1
  SHA256
  SHA384
  SHA512
End Enum

Private Sub Class_Initialize()
  Const C_HEX = "0123456789ABCDEF"
  Dim intIdx As Integer               ' Our Array Index Iteration variable

  ' Instantiate our two .NET class objects
  Set objEncoder = CreateObject("System.Text.UTF8Encoding")
  Set objProvider = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")

  ' Initialize our Lookup Table (array)
  For intIdx = 0 To 255
    ' A byte is represented within two hexadecimal digits.
    ' When divided by 16, the whole number is the first hex character
    '                     the remainder is the second hex character
    ' Populate our Lookup table (array)
    strArrHex(intIdx) = Mid(C_HEX, (intIdx \ 16) + 1, 1) & Mid(C_HEX, (intIdx Mod 16) + 1, 1)
  Next

End Sub

Private Sub Class_Terminate()
  ' Explicity remove the references to our objects so Access can free memory
  Set objProvider = Nothing
  Set objEncoder = Nothing
End Sub

Public Property Let Provider(NewProvider As hashServiceProviders)

  ' Switch our Cryptographic hash provider
  Select Case NewProvider
    Case MD5:
      Set objProvider = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
    Case SHA1:
      Set objProvider = CreateObject("System.Security.Cryptography.SHA1CryptoServiceProvider")
    Case SHA256:
      Set objProvider = CreateObject("System.Security.Cryptography.SHA256Managed")
    Case SHA384:
      Set objProvider = CreateObject("System.Security.Cryptography.SHA384Managed")
    Case SHA512:
      Set objProvider = CreateObject("System.Security.Cryptography.SHA512Managed")
    Case Else:
      Err.Raise vbObjectError + 2029, "CryptoHash::Provider", "Invalid Provider Specified"
  End Select

End Property

' Converts an array of bytes into a hexadecimal string
Private Function Hash_BytesToHex(bytArr() As Byte) As String
  Dim lngArrayUBound As Long         ' The Upper Bound limit of our byte array
  Dim intIdx As Long                 ' Our Array Index Iteration variable

  ' Not sure if VBA re-evaluates the loop terminator with every iteration or not
  ' When speed matters, I usually put it in its own variable just to be safe
  lngArrayUBound = UBound(bytArr)

  ' For each element in our byte array, add a character to the return value
  For intIdx = 0 To lngArrayUBound
    Hash_BytesToHex = Hash_BytesToHex & strArrHex(bytArr(intIdx))
  Next
End Function

' Computes a Hash on the supplied string
Public Function Compute(SourceString As String) As String
  Dim BytArrData() As Byte           ' Byte Array produced from our SourceString
  Dim BytArrHash() As Byte           ' Byte Array returned from our MD5 Provider

  ' Note:
  ' Because some languages (including VBA) do not support method overloading,
  ' the COM system uses "name mangling" in order to allow the proper method
  ' to be called.  This name mangling appends a number at the end of the function.
  ' You can check the MSDN documentation to see how many overloaded variations exist

  ' Convert our Source String into an array of bytes.
  BytArrData = objEncoder.GetBytes_4(SourceString)

  ' Compute the MD5 hash and store in an array of bytes
  BytArrHash = objProvider.ComputeHash_2(BytArrData)

  ' Convert our Bytes into a hexadecimal representation
  Compute = Hash_BytesToHex(BytArrHash)

  ' Free up our dynamic array memory
  Erase BytArrData
  Erase BytArrHash

End Function
相关问题
最新问题