Malicious Office (OOXML) — malware analysis report

Attribute VB_Name = "ThisWorkbook"
Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Private Sub Workbook_Open()
    'Login
    'Dim SchedRecalc As Date
    'Workbooks.Open AddIns("Shareexcel").path & "\upgrade.xla"
    'SchedRecalc = Now + TimeValue("00:00:01")
    'Application.OnTime SchedRecalc, "upgrade.xla!UpgradeShareExcel"
    
    
End Sub

'Sub ChangeVersion()

    'Workbooks("ShareExcel.xlam").Sheets("ShareExcel").Range("A1") = 1.55
'End Sub

Attribute VB_Name = "Sheet1"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "TimeZone"
Option Explicit
#If VBA7 Then
    Public Declare PtrSafe Function SystemTimeToFileTime Lib _
      "kernel32" (lpSystemTime As SYSTEMTIME, _
      lpFileTime As FILETIME) As Long
    
    Public Declare PtrSafe Function LocalFileTimeToFileTime Lib _
      "kernel32" (lpLocalFileTime As FILETIME, _
      lpFileTime As FILETIME) As Long
    
    Public Declare PtrSafe Function FileTimeToSystemTime Lib _
      "kernel32" (lpFileTime As FILETIME, lpSystemTime _
      As SYSTEMTIME) As Long
#Else
    Public Declare Function SystemTimeToFileTime Lib _
      "kernel32" (lpSystemTime As SYSTEMTIME, _
      lpFileTime As FILETIME) As Long
    
    Public Declare Function LocalFileTimeToFileTime Lib _
      "kernel32" (lpLocalFileTime As FILETIME, _
      lpFileTime As FILETIME) As Long
    
    Public Declare Function FileTimeToSystemTime Lib _
      "kernel32" (lpFileTime As FILETIME, lpSystemTime _
      As SYSTEMTIME) As Long
#End If

Public Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Public Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type

Public Function LocalTimeToUTC(dteTime As Date) As Date
    Dim dteLocalFileTime As FILETIME
    Dim dteFileTime As FILETIME
    Dim dteLocalSystemTime As SYSTEMTIME
    Dim dteSystemTime As SYSTEMTIME

    dteLocalSystemTime.wYear = CInt(Year(dteTime))
    dteLocalSystemTime.wMonth = CInt(Month(dteTime))
    dteLocalSystemTime.wDay = CInt(Day(dteTime))
    dteLocalSystemTime.wHour = CInt(Hour(dteTime))
    dteLocalSystemTime.wMinute = CInt(Minute(dteTime))
    dteLocalSystemTime.wSecond = CInt(Second(dteTime))

    Call SystemTimeToFileTime(dteLocalSystemTime, _
      dteLocalFileTime)
    Call LocalFileTimeToFileTime(dteLocalFileTime, _
      dteFileTime)
    Call FileTimeToSystemTime(dteFileTime, dteSystemTime)

    LocalTimeToUTC = CDate(dteSystemTime.wMonth & "/" & _
      dteSystemTime.wDay & "/" & _
      dteSystemTime.wYear & " " & _
      dteSystemTime.wHour & ":" & _
      dteSystemTime.wMinute & ":" & _
      dteSystemTime.wSecond)
End Function




Attribute VB_Name = "ribbonCommands"
Sub OpSeries(control As IRibbonControl)
On Error Resume Next
'
' OpGet Macro
'

'
    Application.Calculation = xlManual
    Dim WshShell As Object
    Dim currDir As String
    Dim workbookname As String
    Dim workbooktitle As String
    Dim secretKey As String
    Dim path As String
    'Dim drive As String
    'Dim dummy
    If Application.ActiveWorkbook.path = "" Then
        path = ""
    Else
        'path = Replace(Application.ActiveWorkbook.path, "\", "\\") & "\"
        path = Application.ActiveWorkbook.path & "\"
    End If
    'MsgBox path
    'If Left(path, 2) = "\\\\" Then
    '    drive = getAvailableDrive()
    '    dummy = mapDrive(drive, Application.ActiveWorkbook.path)
    'Else
    '    drive = path
    'End If
    workbookname = path & Application.ActiveWorkbook.name
    
    
    
    workbooktitle = Application.Caption
    secretKey = "XetgbcccX"
    Set WshShell = CreateObject("WScript.Shell")
    
    currDir = GetNamePath
    'WshShell.Run "java -cp " _
    '& currDir & "\excel4J.jar;" _
    '& currDir & "\org.apache.commons.logging-1.1.1.jar;" _
    '& currDir & "\jna-4.2.2.jar;" _
    '& currDir & "\jna-platform-4.2.2.jar;" _
    '& currDir & "\jnativehook-2.0.3.jar;" _
    '& currDir & "\com4j.jar;" _
    '& currDir & "\bin -Djava.library.path=" & currDir & "\bin curveseries.FrmDownload """ & workbookname & """ """ & workbooktitle & """ ""False"" """ & secretKey & """ """ & CurosrXY_Pixels & """", 0, False
    '#If Mac Then
    '    MacScript ("do shell script """ & currDir & "/dload """ & URLEncodes(workbookname) & """ """ & URLEncodes(workbooktitle) & """ ""False"" """ & secretKey & """ """ & CurosrXY_Pixels & """""")
    '#Else
    
        WshShell.Run """" & currDir & "/curveseries.exe"" ""FrmDownload"" """ & URLEncodes(workbookname) & """ """ & URLEncodes(workbooktitle) & """ ""False"" """ & secretKey & """ """ & CurosrXY_Pixels & """"
    '#End If
    Application.Calculation = xlAutomatic
End Sub

Sub OpUpload(control As IRibbonControl)
On Error Resume Next
' OpUpload Macro
'

'
    'Application.Calculation = xlManual
    
    Dim WshShell As Object
    Dim currDir As String
    Dim workbookname As String
    Dim workbooktitle As String
    Dim secretKey As String
    Dim path As String
    If Application.ActiveWorkbook.path = "" Then
        path = ""
    Else
        'path = Replace(Application.ActiveWorkbook.path, "\", "\\") & "\\"
        path = Application.ActiveWorkbook.path & "\"
    End If
    workbookname = path & Application.ActiveWorkbook.name
    workbooktitle = Application.Caption
    secretKey = "XetgbcccX"
    Set WshShell = CreateObject("WScript.Shell")
    

    currDir = GetNamePath

    'WshShell.Run "java -cp " _
    '& currDir & "\excel4J.jar;" _
    '& currDir & "\org.apache.commons.logging-1.1.1.jar;" _
    '& currDir & "\jna-4.2.2.jar;" _
    '& currDir & "\jna-platform-4.2.2.jar;" _
    '& currDir & "\jnativehook-2.0.3.jar;" _
    '& currDir & "\com4j.jar;" _
    '& currDir & "\bin -Djava.library.path=" & currDir & "\bin curveseries.FrmUpload """ & workbookname & """ """ & workbooktitle & """ """ & secretKey & """ """ & CurosrXY_Pixels & """", 0, False
    WshShell.Run """" & currDir & "/curveseries.exe"" ""FrmUpload"" """ & URLEncodes(workbookname) & """ """ & URLEncodes(workbooktitle) & """ """ & secretKey & """ """ & CurosrXY_Pixels & """"
    'Application.Calculation = xlAutomatic
End Sub

Sub OpCurve(control As IRibbonControl)
On Error Resume Next
' OpGet Macro
'

'
    'Application.Calculation = xlManual
    Dim WshShell As Object
    Dim currDir As String
    Dim workbookname As String
    Dim workbooktitle As String
    Dim secretKey As String
    Dim path As String
    If Application.ActiveWorkbook.path = "" Then
        path = ""
    Else
        'path = Replace(Application.ActiveWorkbook.path, "\", "\\") & "\\"
        path = Application.ActiveWorkbook.path & "\"
    End If
    workbookname = path & Application.ActiveWorkbook.name
    workbooktitle = Application.Caption
    secretKey = "XetgbcccX"
    Set WshShell = CreateObject("WScript.Shell")
    
    currDir = GetNamePath

    'WshShell.Run "java -cp " _
    '& currDir & "\excel4J.jar;" _
    '& currDir & "\org.apache.commons.logging-1.1.1.jar;" _
    '& currDir & "\jna-4.2.2.jar;" _
    '& currDir & "\jna-platform-4.2.2.jar;" _
    '& currDir & "\jnativehook-2.0.3.jar;" _
    '& currDir & "\com4j.jar;" _
    '& currDir & "\bin -Djava.library.path=" & currDir & "\bin curveseries.FrmDownload """ & workbookname & """ """ & workbooktitle & """ ""True"" """ & secretKey & """ """ & CurosrXY_Pixels & """", 0, False
    WshShell.Run """" & currDir & "/curveseries.exe"" ""FrmDownload"" """ & URLEncodes(workbookname) & """ """ & URLEncodes(workbooktitle) & """ ""True"" """ & secretKey & """ """ & CurosrXY_Pixels & """"
    'Application.Calculation = xlAutomatic
End Sub

Sub OpRTD(control As IRibbonControl)
On Error Resume Next
' OpGet Macro
'

'
    Application.Calculation = xlManual
    Dim WshShell As Object
    Dim currDir As String
    Dim workbookname As String
    Dim workbooktitle As String
    Dim secretKey As String
    Dim path As String
    'Dim drive As String
    'Dim dummy
    If Application.ActiveWorkbook.path = "" Then
        path = ""
    Else
        'path = Replace(Application.ActiveWorkbook.path, "\", "\\") & "\"
        path = Application.ActiveWorkbook.path & "\"
    End If
    'MsgBox path
    'If Left(path, 2) = "\\\\" Then
    '    drive = getAvailableDrive()
    '    dummy = mapDrive(drive, Application.ActiveWorkbook.path)
    'Else
    '    drive = path
    'End If
    workbookname = path & Application.ActiveWorkbook.name
    
    
    
    workbooktitle = Application.Caption
    secretKey = "XetgbcccX"
    Set WshShell = CreateObject("WScript.Shell")
    
    currDir = GetNamePath
    'WshShell.Run "java -cp " _
    '& currDir & "\excel4J.jar;" _
    '& currDir & "\org.apache.commons.logging-1.1.1.jar;" _
    '& currDir & "\jna-4.2.2.jar;" _
    '& currDir & "\jna-platform-4.2.2.jar;" _
    '& currDir & "\jnativehook-2.0.3.jar;" _
    '& currDir & "\com4j.jar;" _
    '& currDir & "\bin -Djava.library.path=" & currDir & "\bin curveseries.FrmDownload """ & workbookname & """ """ & workbooktitle & """ ""False"" """ & secretKey & """ """ & CurosrXY_Pixels & """", 0, False
    '#If Mac Then
    '    MacScript ("do shell script """ & currDir & "/dload """ & URLEncodes(workbookname) & """ """ & URLEncodes(workbooktitle) & """ ""False"" """ & secretKey & """ """ & CurosrXY_Pixels & """""")
    '#Else
        WshShell.Run """" & currDir & "/curveseries.exe"" ""FrmRTD"" """ & URLEncodes(workbookname) & """ """ & URLEncodes(workbooktitle) & """ ""False"" """ & secretKey & """ """ & CurosrXY_Pixels & """"
    '#End If
    Application.Calculation = xlAutomatic
End Sub

Sub OpRefreshDown(control As IRibbonControl)
On Error Resume Next
' OpRefreshDown Macro
'
    'Dim dummy
    'Application.Calculation = xlManual
    'dummy = updateAllLocs("getCSeries")
    'dummy = updateAllLocs("getCCurves")
    'Application.Calculation = xlAutomatic

    Application.Calculation = xlManual
    Dim WshShell As Object
    Dim currDir As String
    Dim workbookname As String
    Dim workbooktitle As String
    Dim secretKey As String
    Dim path As String
    If Application.ActiveWorkbook.path = "" Then
        path = ""
    Else
        'path = Replace(Application.ActiveWorkbook.path, "\", "\\") & "\\"
        path = Application.ActiveWorkbook.path & "\"
    End If
    workbookname = path & Application.ActiveWorkbook.name
    workbooktitle = Application.Caption
    secretKey = "XetgbcccX"
    Set WshShell = CreateObject("WScript.Shell")
    
    currDir = GetNamePath
    'WshShell.Run "java -cp " _
    '& currDir & "\excel4J.jar;" _
    '& currDir & "\com4j.jar;" _
    '& currDir & "\bin -Djava.library.path=" & currDir & "\bin curveseries.ExcelDownload """ & workbookname & """ """ & secretKey & """", 0, False

    
    WshShell.Run """" & currDir & "/curveseries.exe"" ""ExcelDownload"" """ & URLEncodes(workbookname) & """ """ & secretKey & """"

    'Application.Calculation = xlAutomatic
    
End Sub
 
Public Function URLEncodes(StringVal As Variant, Optional SpaceAsPlus As Boolean = False) As String

  Dim bytes() As Byte, b As Byte, i As Integer, space As String

  If SpaceAsPlus Then space = "+" Else space = "%20"

  If Len(StringVal) > 0 Then
    With New ADODB.Stream
      .mode = adModeReadWrite
      .Type = adTypeText
      .Charset = "UTF-8"
      .Open
      .WriteText StringVal
      .Position = 0
      .Type = adTypeBinary
      .Position = 3 ' skip BOM
      bytes = .Read
    End With

    ReDim result(UBound(bytes)) As String

    For i = UBound(bytes) To 0 Step -1
      b = bytes(i)
      Select Case b
        Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
          result(i) = Chr(b)
        Case 32
          result(i) = space
        Case 0 To 15
          result(i) = "%0" & Hex(b)
        Case Else
          result(i) = "%" & Hex(b)
      End Select
    Next i

    URLEncodes = Join(result, "")
  End If
End Function

Sub OpRefreshUp(control As IRibbonControl)
On Error Resume Next
' OpRefreshUp Macro
'
    'Dim dummy
    'Application.Calculation = xlManual
    'Debug.Print (Now())
    'dummy = updateAllLocs("CUpload")
    'Debug.Print (Now())
    'Application.Calculation = xlAutomatic
    'Debug.Print (Now())
'

    Application.Calculation = xlManual
    Dim WshShell As Object
    Dim currDir As String
    Dim workbookname As String
    Dim workbooktitle As String
    Dim secretKey As String
    Dim path As String
    If Application.ActiveWorkbook.path = "" Then
        path = ""
    Else
        'path = Replace(Application.ActiveWorkbook.path, "\", "\\") & "\\"
        path = Application.ActiveWorkbook.path & "\"
    End If
    workbookname = path & Application.ActiveWorkbook.name
    workbooktitle = Application.Caption
    secretKey = "XetgbcccX"
    Set WshShell = CreateObject("WScript.Shell")
    
    currDir = GetNamePath
    'WshShell.Run "java -cp " _
    '& currDir & "\excel4J.jar;" _
    '& currDir & "\com4j.jar;" _
    '& currDir & "\bin -Djava.library.path=" & currDir & "\bin curveseries.ExcelUpload """ & workbookname & """ """ & secretKey & """", 1, True
    
    WshShell.Run """" & currDir & "/curveseries.exe"" ""ExcelUpload"" """ & URLEncodes(workbookname) & """ """ & secretKey & """"
    'Application.Calculation = xlAutomatic
    
End Sub


Sub OpChart(control As IRibbonControl)
On Error Resume Next
' OpRefreshUp Macro
'
    'Dim dummy
    'Application.Calculation = xlManual
    'Debug.Print (Now())
    'dummy = updateAllLocs("CUpload")
    'Debug.Print (Now())
    'Application.Calculation = xlAutomatic
    'Debug.Print (Now())
'

    Application.Calculation = xlManual
    Dim WshShell As Object
    Dim currDir As String
    Dim workbookname As String
    Dim workbooktitle As String
    Dim secretKey As String
    Dim path As String
    If Application.ActiveWorkbook.path = "" Then
        path = ""
    Else
        'path = Replace(Application.ActiveWorkbook.path, "\", "\\") & "\\"
        path = Application.ActiveWorkbook.path & "\"
    End If
    workbookname = path & Application.ActiveWorkbook.name
    workbooktitle = Application.Caption
    secretKey = "XetgbcccX"
    Set WshShell = CreateObject("WScript.Shell")
    
    currDir = GetNamePath
    'WshShell.Run "java -cp " _
    '& currDir & "\excel4J.jar;" _
    '& currDir & "\com4j.jar;" _
    '& currDir & "\bin -Djava.library.path=" & currDir & "\bin curveseries.ExcelUpload """ & workbookname & """ """ & secretKey & """", 1, True
    
    WshShell.Run """" & currDir & "/curveseries.exe"" ""FrmCreateChart"" """ & URLEncodes(workbookname) & """ """ & URLEncodes(workbooktitle) & """ ""False"" """ & secretKey & """ """ & CurosrXY_Pixels & """"
    'Application.Calculation = xlAutomatic
    
End Sub

Sub test()
    Setup.Show
End Sub

Sub OpExcelChart(control As IRibbonControl)
On Error Resume Next
    CSCharts.Show
    
End Sub

Sub OpSettings(control As IRibbonControl)
On Error Resume Next
' OpSettings Macro
'
    Application.Calculation = xlManual
    Dim WshShell As Object
    Dim currDir As String
    Dim workbookname As String
    Dim workbooktitle As String
    Dim secretKey As String
    Dim path As String
    If Application.ActiveWorkbook.path = "" Then
        path = ""
    Else
        'path = Replace(Application.ActiveWorkbook.path, "\", "\\") & "\\"
        path = Application.ActiveWorkbook.path & "\"
    End If
    workbookname = path & Application.ActiveWorkbook.name
    workbooktitle = Application.Caption
    secretKey = "XetgbcccX"
    
    
    currDir = GetNamePath
    'WshShell.Run "java -cp " _
    '& currDir & "\excel4J.jar;" _
    '& currDir & "\com4j.jar;" _
    '& currDir & "\bin -Djava.library.path=" & currDir & "\\bin curveseries.FrmUsersAndPermissions """ & workbookname & """ """ & secretKey & """ """ & CurosrXY_Pixels & """", 0, False
    #If Mac Then
        'MacScript ("do shell script ""/usr/bin/java -jar "" & quoted form of POSIX path of (path to desktop folder) & ""/autoproxy.jar""")
        dummy = AppleScriptTask("javatest.scpt", "autoproxy", "")
    #Else
        Set WshShell = CreateObject("WScript.Shell")
        WshShell.Run """" & currDir & "/curveseries.exe"" ""FrmUsersAndPermissions"" """ & URLEncodes(workbookname) & """ """ & secretKey & """ """ & CurosrXY_Pixels & """"
    #End If
    
    '& currDir & "\excel4J.jar;" _
    Application.Calculation = xlAutomatic
End Sub






Attribute VB_Name = "CustomRibbonButtons"
Option Explicit

Dim Rib As IRibbonUI
Public MyTag As String

'Callback for customUI.onLoad
Sub RibbonOnLoad(ribbon As IRibbonUI)
    Set Rib = ribbon
    'If you want to run a macro below when you open the workbook
    'you can call the macro like this :
    LoginOnLoad
End Sub

Sub GetEnabledMacro(control As IRibbonControl, ByRef Enabled)
    If MyTag = "Enable" Then
        Enabled = True
    Else
        If control.Tag Like MyTag Then
            Enabled = True
        Else
            Enabled = False
        End If
    End If
End Sub

Sub RefreshRibbon(Tag As String)
    MyTag = Tag
    If Rib Is Nothing Then
        'MsgBox "Error, Save/Restart your workbook" & vbNewLine & _
        '"Visit this page for a solution: http://www.rondebruin.nl/ribbonstate.htm"
    Else
        Rib.Invalidate
    End If
End Sub

'Note: Do not change the code above



Function DisableAllControls()
'Disable all controls
    Call RefreshRibbon(Tag:="")
End Function

Function EnableAllControls()
    Call RefreshRibbon(Tag:="*")
End Function

Function EnableReadOnly()
    Call RefreshRibbon(Tag:="*Read*")
    
End Function

Function EnableSettings()

    Call RefreshRibbon(Tag:="*Settings*")
End Function


Public Sub CheckLoginStatus(usertype As String)
    If usertype = "" Then
        EnableSettings
    ElseIf usertype = "Error" Then
        EnableSettings
    ElseIf usertype = "Read Only" Then
        EnableReadOnly
    Else
        EnableAllControls
    End If
End Sub






Attribute VB_Name = "clsMD5"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Option Explicit

'*******************************************************************************
' MODULE:       CMD5
' FILENAME:     C:\My Code\vb\md5\CMD5.cls
' AUTHOR:       Phil Fresle
' CREATED:      16-Feb-2001
' COPYRIGHT:    Copyright 2001 Frez Systems Limited. All Rights Reserved.
'
' DESCRIPTION:
' Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm,
' as set out in the memo RFC1321.
'
' This class is used to generate an MD5 'digest' or 'signature' of a string. The
' MD5 algorithm is one of the industry standard methods for generating digital
' signatures. It is generically known as a digest, digital signature, one-way
' encryption, hash or checksum algorithm. A common use for MD5 is for password
' encryption as it is one-way in nature, that does not mean that your passwords
' are not free from a dictionary attack. If you are using the
' routine for passwords, you can make it a little more secure by concatenating
' some known random characters to the password before you generate the signature
' and on subsequent tests, so even if a hacker knows you are using MD5 for
' your passwords, the random characters will make it harder to dictionary attack.
'
' *** CAUTION ***
' See the comment attached to the MD5 method below regarding use on systems
' with different character sets.
'
' This is 'free' software with the following restrictions:
'
' You may not redistribute this code as a 'sample' or 'demo'. However, you are free
' to use the source code in your own code, but you may not claim that you created
' the sample code. It is expressly forbidden to sell or profit from this source code
' other than by the knowledge gained or the enhanced value added by your own code.
'
' Use of this software is also done so at your own risk. The code is supplied as
' is without warranty or guarantee of any kind.
'
' Should you wish to commission some derivative work based on this code provided
' here, or any consultancy work, please do not hesitate to contact us.
'
' Web Site:  http://www.frez.co.uk
' E-mail:    sales@frez.co.uk
'
' MODIFICATION HISTORY:
' 1.0       16-Feb-2001
'           Phil Fresle
'           Initial Version
'*******************************************************************************

Private Const BITS_TO_A_BYTE  As Long = 8
Private Const BYTES_TO_A_WORD As Long = 4
Private Const BITS_TO_A_WORD  As Long = BYTES_TO_A_WORD * BITS_TO_A_BYTE

Private m_lOnBits(0 To 30) As Long
Private m_l2Power(0 To 30) As Long

'*******************************************************************************
' Class_Initialize (SUB)
'
' DESCRIPTION:
' We will usually get quicker results by preparing arrays of bit patterns and
' powers of 2 ahead of time instead of calculating them every time, unless of
' course the methods are only ever getting called once per instantiation of the
' class.
'*******************************************************************************
Private Sub Class_Initialize()
    ' Could have done this with a loop calculating each value, but simply
    ' assigning the values is quicker - BITS SET FROM RIGHT
    m_lOnBits(0) = 1            ' 00000000000000000000000000000001
    m_lOnBits(1) = 3            ' 00000000000000000000000000000011
    m_lOnBits(2) = 7            ' 00000000000000000000000000000111
    m_lOnBits(3) = 15           ' 00000000000000000000000000001111
    m_lOnBits(4) = 31           ' 00000000000000000000000000011111
    m_lOnBits(5) = 63           ' 00000000000000000000000000111111
    m_lOnBits(6) = 127          ' 00000000000000000000000001111111
    m_lOnBits(7) = 255          ' 00000000000000000000000011111111
    m_lOnBits(8) = 511          ' 00000000000000000000000111111111
    m_lOnBits(9) = 1023         ' 00000000000000000000001111111111
    m_lOnBits(10) = 2047        ' 00000000000000000000011111111111
    m_lOnBits(11) = 4095        ' 00000000000000000000111111111111
    m_lOnBits(12) = 8191        ' 00000000000000000001111111111111
    m_lOnBits(13) = 16383       ' 00000000000000000011111111111111
    m_lOnBits(14) = 32767       ' 00000000000000000111111111111111
    m_lOnBits(15) = 65535       ' 00000000000000001111111111111111
    m_lOnBits(16) = 131071      ' 00000000000000011111111111111111
    m_lOnBits(17) = 262143      ' 00000000000000111111111111111111
    m_lOnBits(18) = 524287      ' 00000000000001111111111111111111
    m_lOnBits(19) = 1048575     ' 00000000000011111111111111111111
    m_lOnBits(20) = 2097151     ' 00000000000111111111111111111111
    m_lOnBits(21) = 4194303     ' 00000000001111111111111111111111
    m_lOnBits(22) = 8388607     ' 00000000011111111111111111111111
    m_lOnBits(23) = 16777215    ' 00000000111111111111111111111111
    m_lOnBits(24) = 33554431    ' 00000001111111111111111111111111
    m_lOnBits(25) = 67108863    ' 00000011111111111111111111111111
    m_lOnBits(26) = 134217727   ' 00000111111111111111111111111111
    m_lOnBits(27) = 268435455   ' 00001111111111111111111111111111
    m_lOnBits(28) = 536870911   ' 00011111111111111111111111111111
    m_lOnBits(29) = 1073741823  ' 00111111111111111111111111111111
    m_lOnBits(30) = 2147483647  ' 01111111111111111111111111111111
    
    ' Could have done this with a loop calculating each value, but simply
    ' assigning the values is quicker - POWERS OF 2
    m_l2Power(0) = 1            ' 00000000000000000000000000000001
    m_l2Power(1) = 2            ' 00000000000000000000000000000010
    m_l2Power(2) = 4            ' 00000000000000000000000000000100
    m_l2Power(3) = 8            ' 00000000000000000000000000001000
    m_l2Power(4) = 16           ' 00000000000000000000000000010000
    m_l2Power(5) = 32           ' 00000000000000000000000000100000
    m_l2Power(6) = 64           ' 00000000000000000000000001000000
    m_l2Power(7) = 128          ' 00000000000000000000000010000000
    m_l2Power(8) = 256          ' 00000000000000000000000100000000
    m_l2Power(9) = 512          ' 00000000000000000000001000000000
    m_l2Power(10) = 1024        ' 00000000000000000000010000000000
    m_l2Power(11) = 2048        ' 00000000000000000000100000000000
    m_l2Power(12) = 4096        ' 00000000000000000001000000000000
    m_l2Power(13) = 8192        ' 00000000000000000010000000000000
    m_l2Power(14) = 16384       ' 00000000000000000100000000000000
    m_l2Power(15) = 32768       ' 00000000000000001000000000000000
    m_l2Power(16) = 65536       ' 00000000000000010000000000000000
    m_l2Power(17) = 131072      ' 00000000000000100000000000000000
    m_l2Power(18) = 262144      ' 00000000000001000000000000000000
    m_l2Power(19) = 524288      ' 00000000000010000000000000000000
    m_l2Power(20) = 1048576     ' 00000000000100000000000000000000
    m_l2Power(21) = 2097152     ' 00000000001000000000000000000000
    m_l2Power(22) = 4194304     ' 00000000010000000000000000000000
    m_l2Power(23) = 8388608     ' 00000000100000000000000000000000
    m_l2Power(24) = 16777216    ' 00000001000000000000000000000000
    m_l2Power(25) = 33554432    ' 00000010000000000000000000000000
    m_l2Power(26) = 67108864    ' 00000100000000000000000000000000
    m_l2Power(27) = 134217728   ' 00001000000000000000000000000000
    m_l2Power(28) = 268435456   ' 00010000000000000000000000000000
    m_l2Power(29) = 536870912   ' 00100000000000000000000000000000
    m_l2Power(30) = 1073741824  ' 01000000000000000000000000000000
End Sub

'*******************************************************************************
' LShift (FUNCTION)
'
' PARAMETERS:
' (In) - lValue     - Long    - The value to be shifted
' (In) - iShiftBits - Integer - The number of bits to shift the value by
'
' RETURN VALUE:
' Long - The shifted long integer
'
' DESCRIPTION:
' A left shift takes all the set binary bits and moves them left, in-filling
' with zeros in the vacated bits on the right. This function is equivalent to
' the << operator in Java and C++
'*******************************************************************************
Private Function LShift(ByVal lValue As Long, _
                        ByVal iShiftBits As Integer) As Long
    ' NOTE: If you can guarantee that the Shift parameter will be in the
    ' range 1 to 30 you can safely strip of this first nested if structure for
    ' speed.
    '
    ' A shift of zero is no shift at all.
    If iShiftBits = 0 Then
        LShift = lValue
        Exit Function
        
    ' A shift of 31 will result in the right most bit becoming the left most
    ' bit and all other bits being cleared
    ElseIf iShiftBits = 31 Then
        If lValue And 1 Then
            LShift = &H80000000
        Else
            LShift = 0
        End If
        Exit Function
        
    ' A shift of less than zero or more than 31 is undefined
    ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
        Err.Raise 6
    End If
    
    ' If the left most bit that remains will end up in the negative bit
    ' position (&H80000000) we would end up with an overflow if we took the
    ' standard route. We need to strip the left most bit and add it back
    ' afterwards.
    If (lValue And m_l2Power(31 - iShiftBits)) Then
    
        ' (Value And OnBits(31 - (Shift + 1))) chops off the left most bits that
        ' we are shifting into, but also the left most bit we still want as this
        ' is going to end up in the negative bit marker position (&H80000000).
        ' After the multiplication/shift we Or the result with &H80000000 to
        ' turn the negative bit on.
        LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * _
            m_l2Power(iShiftBits)) Or &H80000000
    
    Else
    
        ' (Value And OnBits(31-Shift)) chops off the left most bits that we are
        ' shifting into so we do not get an overflow error when we do the
        ' multiplication/shift
        LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * _
            m_l2Power(iShiftBits))
        
    End If
End Function

'*******************************************************************************
' RShift (FUNCTION)
'
' PARAMETERS:
' (In) - lValue     - Long    - The value to be shifted
' (In) - iShiftBits - Integer - The number of bits to shift the value by
'
' RETURN VALUE:
' Long - The shifted long integer
'
' DESCRIPTION:
' The right shift of an unsigned long integer involves shifting all the set bits
' to the right and in-filling on the left with zeros. This function is
' equivalent to the >>> operator in Java or the >> operator in C++ when used on
' an unsigned long.
'*******************************************************************************
Private Function RShift(ByVal lValue As Long, _
                        ByVal iShiftBits As Integer) As Long
    
    ' NOTE: If you can guarantee that the Shift parameter will be in the
    ' range 1 to 30 you can safely strip of this first nested if structure for
    ' speed.
    '
    ' A shift of zero is no shift at all
    If iShiftBits = 0 Then
        RShift = lValue
        Exit Function
        
    ' A shift of 31 will clear all bits and move the left most bit to the right
    ' most bit position
    ElseIf iShiftBits = 31 Then
        If lValue And &H80000000 Then
            RShift = 1
        Else
            RShift = 0
        End If
        Exit Function
        
    ' A shift of less than zero or more than 31 is undefined
    ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
        Err.Raise 6
    End If
    
    ' We do not care about the top most bit or the final bit, the top most bit
    ' will be taken into account in the next stage, the final bit (whether it
    ' is an odd number or not) is being shifted into, so we do not give a jot
    ' about it
    RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)
    
    ' If the top most bit (&H80000000) was set we need to do things differently
    ' as in a normal VB signed long integer the top most bit is used to indicate
    ' the sign of the number, when it is set it is a negative number, so just
    ' deviding by a factor of 2 as above would not work.
    ' NOTE: (lValue And  &H80000000) is equivalent to (lValue < 0), you could
    ' get a very marginal speed improvement by changing the test to (lValue < 0)
    If (lValue And &H80000000) Then
        ' We take the value computed so far, and then add the left most negative
        ' bit after it has been shifted to the right the appropriate number of
        ' places
        RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
    End If
End Function

'*******************************************************************************
' RShiftSigned (FUNCTION)
'
' PARAMETERS:
' (In) - lValue     - Long    -
' (In) - iShiftBits - Integer -
'
' RETURN VALUE:
' Long -
'
' DESCRIPTION:
' The right shift of a signed long integer involves shifting all the set bits to
' the right and in-filling on the left with the sign bit (0 if positive, 1 if
' negative. This function is equivalent to the >> operator in Java or the >>
' operator in C++ when used on a signed long integer. Not used in this class,
' but included for completeness.
'*******************************************************************************
Private Function RShiftSigned(ByVal lValue As Long, _
                              ByVal iShiftBits As Integer) As Long
    
    ' NOTE: If you can guarantee that the Shift parameter will be in the
    ' range 1 to 30 you can safely strip of this first nested if structure for
    ' speed.
    '
    ' A shift of zero is no shift at all
    If iShiftBits = 0 Then
        RShiftSigned = lValue
        Exit Function
    
    ' A shift of 31 will clear all bits if the left most bit was zero, and will
    ' set all bits if the left most bit was 1 (a negative indicator)
    ElseIf iShiftBits = 31 Then
        
        ' NOTE: (lValue And  &H80000000) is equivalent to (lValue < 0), you
        ' could get a very marginal speed improvement by changing the test to
        ' (lValue < 0)
        If (lValue And &H80000000) Then
            RShiftSigned = -1
        Else
            RShiftSigned = 0
        End If
        Exit Function
    
    ' A shift of less than zero or more than 31 is undefined
    ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
        Err.Raise 6
    End If
    
    ' We get the same result by dividing by the appropriate power of 2 and
    ' rounding in the negative direction
    RShiftSigned = Int(lValue / m_l2Power(iShiftBits))
End Function

'*******************************************************************************
' RotateLeft (FUNCTION)
'
' PARAMETERS:
' (In) - lValue     - Long    - Value to act on
' (In) - iShiftBits - Integer - Bits to move by
'
' RETURN VALUE:
' Long - Result
'
' DESCRIPTION:
' Rotates the bits in a long integer to the left, those bits falling off the
' left edge are put back on the right edge
'*******************************************************************************
Private Function RotateLeft(ByVal lValue As Long, _
                            ByVal iShiftBits As Integer) As Long
    RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits))
End Function

'*******************************************************************************
' AddUnsigned (FUNCTION)
'
' PARAMETERS:
' (In) - lX - Long - First value
' (In) - lY - Long - Second value
'
' RETURN VALUE:
' Long - Result
'
' DESCRIPTION:
' Adds two potentially large unsigned numbers without overflowing
'*******************************************************************************
Private Function AddUnsigned(ByVal lX As Long, _
                             ByVal lY As Long) As Long
    Dim lX4     As Long
    Dim lY4     As Long
    Dim lX8     As Long
    Dim lY8     As Long
    Dim lResult As Long
 
    lX8 = lX And &H80000000
    lY8 = lY And &H80000000
    lX4 = lX And &H40000000
    lY4 = lY And &H40000000
 
    lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)
 
    If lX4 And lY4 Then
        lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
    ElseIf lX4 Or lY4 Then
        If lResult And &H40000000 Then
            lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
        Else
            lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
        End If
    Else
        lResult = lResult Xor lX8 Xor lY8
    End If
 
    AddUnsigned = lResult
End Function

'*******************************************************************************
' F (FUNCTION)
'
' DESCRIPTION:
' MD5's F function
'*******************************************************************************
Private Function F(ByVal X As Long, _
                   ByVal Y As Long, _
                   ByVal z As Long) As Long
    F = (X And Y) Or ((Not X) And z)
End Function

'*******************************************************************************
' G (FUNCTION)
'
' DESCRIPTION:
' MD5's G function
'*******************************************************************************
Private Function G(ByVal X As Long, _
                   ByVal Y As Long, _
                   ByVal z As Long) As Long
    G = (X And z) Or (Y And (Not z))
End Function
…