public
Created

Windows executable subsystem hack

  • Download Gist
gistfile1.lisp
Common Lisp
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56
(defpackage #:subsystem.hack
(:use #:cl)
(:export #:patch-subsystem)
(:import-from #:nibbles
#:read-ub16/le #:read-ub32/le #:write-ub16/le))
 
(in-package #:subsystem.hack)
 
(defun subsystem-position (stream)
(file-position stream 0)
(let ((mz (read-ub16/le stream)))
(unless (= mz #x5A4D)
(error "Not an MZ executable.")))
(file-position stream 60)
(let ((lfanew (read-ub32/le stream)))
(file-position stream lfanew)
(let ((pe (read-ub32/le stream)))
(unless (= pe #x4550)
(error "Not a PE executable.")))
(file-position stream (+ lfanew 24))
(let ((magic (read-ub16/le stream)))
(unless (= magic #x10B)
(error "Optional header magic gone bad.")))
(+ lfanew 92)))
 
(defvar *subsystem-symbols*
'((1 . :native)
(2 . :win-gui)
(3 . :win-cui)
(5 . :os2-cui)
(7 . :pos-cui)))
 
(defun subsystem (stream)
(file-position stream (subsystem-position stream))
(let ((x (read-ub16/le stream)))
(or (cdr (assoc x *subsystem-symbols*))
x)))
 
(defun (setf subsystem) (new-value stream)
(file-position stream (subsystem-position stream))
(let ((x (or (car (rassoc new-value *subsystem-symbols*))
new-value)))
(check-type x integer)
(write-ub16/le x stream))
new-value)
 
(defun patch-subsystem (filename &optional new-subsystem)
(with-open-file (stream filename
:direction :io
:element-type '(unsigned-byte 8)
:if-exists :overwrite
:if-does-not-exist :error)
(let ((old-subsystem (subsystem stream)))
(when new-subsystem
(setf (subsystem stream) new-subsystem))
(list :old old-subsystem :new new-subsystem))))

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.