How to check when the VBA module was changed?

I wrote a version control module. The AutoExec macro runs it every time I, or one of the other maintainers, enters the system. It searches for database objects that have been created or changed since the last update, and then adds the record to the Versions table and then opens the table (the last record is filtered out), so I can enter a summary of the changes that I made.

It works great for tables, queries, forms, macros, etc., but I can't get it to work correctly for modules.

I discovered two different properties that offer the date of the last modification ...

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

The first (CurrentDB) always shows "LastUpdated" as the date it was created, unless you change the description of the module or something in the interface. This tells me that this property is intended solely for the container object, not what is in it.

The second one works much better. It accurately shows the date when I modify and compile / save the module. The only problem is that when saving or compiling a module, it again saves / compiles ALL modules and therefore sets the DateModified field to the same date throughout the board. This just strikes the goal of having the DateModified property on individual modules, right?

, . , VBA Extensions. , , , - , - โ€‹โ€‹ , , " "

- ? , , ( )

+4
3

:

  • MD5 .
  • .
  • AutoExec Versions. , , ( MD5 , - ).

VBE Extensibility,

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

- 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

, . API VBIDE , , .


API VBIDE - .

Rubberduck (, , ..), , , .

", , ", , . , :

Option Explicit

Sub DoSomething
    'todo: implement
End Sub

:

Option Explicit

Sub DoSomething
    DoSomethingElse 42
End Sub

, , , . , .

, CodeModule, hash it, - - , "" . #, , COM, VBA, DLL .NET, COM- , String , .

Rubberduck.VBEditor.SafeComWrappers.VBA.CodeModule, :

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 - Microsoft.Vbe.Interop.CodeModule - VBA, a CodeModule, VBA; - :

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

, "" - . :

  • " " , , , .
  • ObjPtr , , , VBA, , COM- - COM- - . , 100% VBA.

Dictionary, , .


Rubberduck, , (.. ) VBE =)

Rubberduck's Source Control panel

+4

, , / , , . @BlackHawk, , , .NET - .

. , , LastUpdated.

  • LastUpdated.
  • , , LastUpdated date ( )
  • , , , LastUpdated.
  • SaveAsText PrtDevMode,

, , . .

SQL.

, , Application.SaveAsText, . . , "".

It seems to be working now, and I did not encounter situations where he requested a version, when something was not really changed.

To calculate a checksum or hash, I built a Class Module called CryptoHash. Below is the full source. I optimized the conversion of Bytes Array to Hex String for speed.

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
+2
source

Source: https://habr.com/ru/post/1661627/


All Articles