Win32 Support Utilities for XLISP-STAT

This report presents a collection of Win32 utilities. They are contained in the WIN32 package. Each utility is described in its own section; each section starts with a subsection describing the interface and giving some examples; this is followed by the implementation.

Eventually these utilities will be folded into the standard distribution. For now, they are made available as a zip file, win32.zip. This file should be unpacked in the Autoload subdirectory of the Xlisp-Stat tree. This will insure that the utilities are loaded when they are used. Be sure to preserve the directory structure when unpacking the zip file.

This writeup still needs lots of work but is hopefully enough to get you started.

Error Handling

Interface

Function: format-message code: Returns the system error message corresponging to code.
Function: get-last-error: Returns the last error code on the curren thread. This function takes no arguments.
Condition: win32-error
Function: win32-error-code cond
Function: win32-error-source cond: The win32-error condition is signaled by internals of the Win32 interface. Contains a slot code that contains the error code and source that contains the name of the funciton signaling the error.

Implementation

<error handling>= (U->) [D->]
(wrap:c-lines "
static LVAL GetErrorMessage(DWORD hr)
{
  char *msg = NULL;
  LVAL val;
  DWORD count;

  count = FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER |
                        FORMAT_MESSAGE_FROM_SYSTEM |
                        FORMAT_MESSAGE_IGNORE_INSERTS,
                        NULL, hr, LOCALE_SYSTEM_DEFAULT,
                        (LPTSTR)&msg, 0, NULL);
  val = count > 0 && msg != NULL ? cvstring(msg) : NIL;
  if (msg != NULL) LocalFree(msg);
  return val;
}")
(wrap:c-function base-format-message "GetErrorMessage" (:unsigned) :lval)

Defines base-format-message, GetErrorMessage (links are to index).

<error handling>+= (U->) [<-D->]
(defun format-message (code)
  (let ((msg (base-format-message code)))
    (if msg
        (string-right-trim '(#\newline #\return #\space #\.) msg)
      nil)))
(export 'format-message)

Defines format-message (links are to index).

<error handling>+= (U->) [<-D->]
(wrap:c-function get-last-error "GetLastError" () :unsigned)
(export 'get-last-error)

Defines get-last-error (links are to index).

<error handling>+= (U->) [<-D->]
(define-condition win32-error (error)
  ((code :reader win32-error-code :initarg :code)
   (source :reader win32-error-source :initarg :source))
  (:report (lambda (cond stream)
             (let* ((code (win32-error-code cond))
                    (src (win32-error-source cond))
                    (msg (format-message code)))
               (if msg
                   (format stream "~@[~a: ~]~a" src msg)
                 (format stream "~@[~a: ~]code=~d" code))))))
(export '(win32-error win32-error-code win32-error-source))

Defines win32-error, win32-error-code, win32-error-source (links are to index).

<error handling>+= (U->) [<-D]
(defun raise-win32-error (&optional source (code (get-last-error)))
  (error (make-condition 'win32-error :code code :source source)))

Defines raise-win32-error (links are to index).

Operating System Information

Interface

Function: get-version: Returns six values: a symbol naming the OS, the platform ID, major version, minor version, and build numbers, and a string with additional information (such as the service pack on NT).

<operating system information example>=
> (win32:get-version)
:WIN-NT
2
4
0
1381
"Service Pack 5"

Implementation

<operating system information>= (U->)
(wrap:c-pointer "OSVERSIONINFO"
                (:make make-osverinfo)
                (:get get-osverinfo-extra "szCSDVersion" :string)
                (:get get-osverinfo-major-version "dwMajorVersion" :unsigned)
                (:get get-osverinfo-minor-version "dwMinorVersion" :unsigned)
                (:get get-osverinfo-build-number "dwBuildNumber" :unsigned)
                (:get get-osverinfo-platform-id "dwPlatformId" :unsigned))

(wrap:c-lines "
static BOOL MyGetVersion(OSVERSIONINFO *po)
{
  po->dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
  return GetVersionEx(po);
}")
(wrap:c-function base-get-version "MyGetVersion" ((:cptr "OSVERSIONINFO"))
                 :bool)

(wrap:c-constant VER_PLATFORM_WIN32_NT "VER_PLATFORM_WIN32_NT" :unsigned)
(wrap:c-constant VER_PLATFORM_WIN32_WINDOWS "VER_PLATFORM_WIN32_WINDOWS"
                 :unsigned)
(wrap:c-constant VER_PLATFORM_WIN32s "VER_PLATFORM_WIN32s" :unsigned)

;; Adapted from example on MS web site in GetVersionEx page.
(defun win32-os-type (platform-id major-version minor-version)
  (cond
   ((= platform-id VER_PLATFORM_WIN32_NT)
    (cond
     ((<= major-version 4) :win-nt)
     ((= major-version 5) :win-2k)
     (t :unknown)))
   ((= platform-id VER_PLATFORM_WIN32_WINDOWS)
    (if (or (> major-version 4)
            (and (= major-version 4) (> minor-version 0)))
        :win-98
      :win-95))
   ((= platform-id VER_PLATFORM_WIN32s) :win-32s)
   (t :unknown)))

(defun get-version ()
  (let ((osvi (make-osverinfo)))
    (unless (base-get-version osvi) (raise-win32-error "GetVersionEx"))
    (let ((id (get-osverinfo-platform-id osvi))
          (major (get-osverinfo-major-version osvi))
          (minor (get-osverinfo-minor-version osvi))
          (build (get-osverinfo-build-number osvi))
          (extra (get-osverinfo-extra osvi)))
      (values (win32-os-type id major minor) id major minor build extra))))
(export 'get-version)

Shell Functions

Interface

Function: shell-execute verb file &optional parameters &key window directory show: Executes a shell operation on a specified file. The operation is specified by verb, which can be a string or symbol. Supported verbs are edit, explore, open, print, and properties. Some file/verb combinations (such as open on a .exe file) use the optional parameters string argument. (:properties doesn't seem to work). The window argument is currently ignored. The directory argument specifies the default directory to use. The show argument should be a keyword specifying how the new window created by the command it so be displayed. Possible values are :hide, :maximize, :show, :show-default, etc. The default is :show-default.

<shell function examples>=
(win32:shell-execute :open "win32.html")
(win32:shell-execute :open "notepad.exe" "win32.c")
(win32:shell-execute :explore ".")

Implementation

<shell functions>= (U->)
(wrap:c-lines "
#define strornilp(x) (stringp(x)||null(x))
#define xlgastrornil() testarg(typearg(strornilp))
static LVAL MyShellExecute(void)
{
  LVAL arg;
  HWND hwnd;
  char *verb, *file, *params, *dir;
  int show;
  unsigned long res;

  arg = xlgetarg(); hwnd = NULL;
  arg = xlgastrornil(); verb = stringp(arg) ? getstring(arg) : NULL;
  file = getstring(xlgastring());
  arg = xlgastrornil(); params = stringp(arg) ? getstring(arg) : NULL;
  dir = getstring(xlgastring());
  show = getfixnum(xlgafixnum());
  xllastarg();

  res = (unsigned long) ShellExecute(hwnd, verb, file, params, dir, show);
  return ulong2lisp(res);
}")
(wrap:c-subr base-shell-execute "MyShellExecute")
  
#|
;;***** wouldn't need subr if could have nil for string
(wrap:c-function base-shell-execute "ShellExecute"
                 ((:cptr "void" t) :string :string :string :string :integer)
                 :unsigned)
|#

(defun shell-execute (verb file &optional parameters &key
                           window
                           (directory (get-working-directory))
                           (show :show-default))
  (let* ((skey (show-keyword-to-show-flag show))
         (res (base-shell-execute window (string verb) file parameters 
                                  directory skey)))
    (when (<= res 32) (raise-win32-error "ShellExecute" res))))
(export 'shell-execute)

(wrap:c-constant SW_HIDE "SW_HIDE" :unsigned)
(wrap:c-constant SW_MAXIMIZE "SW_MAXIMIZE" :unsigned)
(wrap:c-constant SW_MINIMIZE "SW_MINIMIZE" :unsigned)
(wrap:c-constant SW_RESTORE "SW_RESTORE" :unsigned)
(wrap:c-constant SW_SHOW "SW_SHOW" :unsigned)
(wrap:c-constant SW_SHOWDEFAULT "SW_SHOWDEFAULT" :unsigned)
(wrap:c-constant SW_SHOWMAXIMIZED "SW_SHOWMAXIMIZED" :unsigned)
(wrap:c-constant SW_SHOWMINIMIZED "SW_SHOWMINIMIZED" :unsigned)
(wrap:c-constant SW_SHOWMINNOACTIVE "SW_SHOWMINNOACTIVE" :unsigned)
(wrap:c-constant SW_SHOWNA "SW_SHOWNA" :unsigned)
(wrap:c-constant SW_SHOWNOACTIVATE "SW_SHOWNOACTIVATE" :unsigned)
(wrap:c-constant SW_SHOWNORMAL "SW_SHOWNORMAL" :unsigned)

(defun show-keyword-to-show-flag (key)
  (case key
        (:hide SW_HIDE)
        (:maximize SW_MAXIMIZE)
        (:minimize SW_MINIMIZE)
        (:restore SW_RESTORE)
        (:show SW_SHOW)
        (:show-default SW_SHOWDEFAULT)
        (:show-maximized SW_SHOWMAXIMIZED)
        (:show-minimized SW_SHOWMINIMIZED)
        (:show-min-no-activate SW_SHOWMINNOACTIVE)
        (:show-na SW_SHOWNA)
        (:show-no-activate SW_SHOWNOACTIVATE)
        (:show-normal SW_SHOWNORMAL)))

Registry Functions

Interface

Structure: registry-key: Structure used to represent opened registry keys.
Constant: hkey-classes-root
Constant: hkey-current-config
Constant: hkey-current-usert
Constant: hkey-local-machine
Constant: hkey-users: Standard registry keys.
Function: reg-open-key key subkey &optional access: Opens a specified subkey of key. The key must be open; subkey is a string naming the subkey. The optional access argument specifies the access mode to be used. This can be a keyword symbol or a list of keyword symbols chosen from :create-subkey, :enumerate-subkeys, :execute, :notify, :query-value, :set-value, :all-access, :read, and :write. The default is the access mode of key. The standard keys have accesmode (:read :write).
Function: reg-connect-registry machine key &optional access: Opens key on machine. key must be one of the standard keys hkey-local-machine or hkey-users (or maybe a few others depending on the OS).
Function: reg-close-key key: Closes an open registry key. A finalization function is registered for each open key that closes the key once it is no longer reachable, so it is not strictly necessary to call this function.
Function: reg-query-value key &optional name &key expand: Retrieves the value name from key. If value is not supplied it defaults to the empty string, cossesponding to the default value. Strings data are seturned as strings, multi-strings as lists of strings, DWORDS as integers; others are returned as binary data in typed vectors with element type c-uchar. The expand arbument is ignored except for values specified to contain unexpanded environment variables; for those this argument determines whether the environment variables are expanded or not.
Function: reg-query-value-type key &optional name: Retrieves the type of the value name in key. The type is one of the keywords :binary, :dword, :dword-little-endian, :dword-big-endian, :expand-string, :multi-string, :none, :resource-list, or :string.
Function: reg-query-value-size key &optional name: Retrieves the size of the value name in key. Useful mostly for binary data.
Function: reg-query-value-into key buf &opitonal name: Retrieves the value name in key into the buffer buf. The buffer must be a typed vector. Useful mainly for binary data.
Function: reg-subkey-names key
Function: reg-value-names key: Return lists of the names of subkeys or values of key.
Function: reg-map-subkey-names fun key
Function: reg-map-value-names fun key: Call fun with the name of each subkey or value of key.
Function: reg-set-value key name value &optional typespec: Sets the value name of key to value. A type can be specified with typespec; otherwise, an atteempt is made to infer a reasonable type.
Function: reg-delete-value key &optional name: Deletes the value name from key.
Function: reg-create-subkey key subkey &optional access: Creates subkey named by the string subkey under the open key key. Access priviledges can be specified with access; the default is :all-access.
Function: reg-delete-subkey key subkey: Deletes the subkey named by the string subkey from the open key key. The subkey must not contain any subkeys of its own.

<registry examples>=
> (win32:reg-connect-registry "192.168.1.3" win32:hkey-local-machine)
#<REGISTRY-KEY: \\192.168.1.3\HKEY_LOCAL_MACHINE>

> (win32:reg-subkey-names win32:hkey-local-machine)
("HARDWARE" "SAM" "SECURITY" "SOFTWARE" "SYSTEM")

> (setf syskey (win32:reg-open-key win32:hkey-local-machine "System" :read))
#<REGISTRY-KEY: HKEY_LOCAL_MACHINE\System>
> (win32:reg-subkey-names syskey)
("ControlSet001" "ControlSet002" "DISK" "Select" "Setup" "Clone" "CurrentControlSet")

> (setf setupkey (win32:reg-open-key syskey "Setup" :read))
#<REGISTRY-KEY: HKEY_LOCAL_MACHINE\System\Setup>
> (win32:reg-value-names setupkey)
("SetupType" "CmdLine" "SystemSetupInProgress" "SystemPrefix" "SystemPartition" "OsLoaderPath" "NetcardDlls")

> (win32:reg-query-value setupkey "CmdLine")
"setup -newsetup"
:STRING
> (win32:reg-query-value setupkey "SetupType")
0
:DWORD
> (win32:reg-query-value setupkey "SystemPrefix")
#(192 11 0 0 0 0 56 248)
:BINARY
> (win32:reg-query-value setupkey "SystemPartition")
"\\Device\\Harddisk0\\Partition1"
:STRING
> (win32:reg-query-value setupkey "NetcardDlls")
("MSNCDET.DLL" "amdncdet.dll" "mdgncdet.dll")
:MULTI-STRING

> (win32:reg-map-value-names (lambda (n) (format t "~a~%" n)) setupkey)
SetupType
CmdLine
SystemSetupInProgress
SystemPrefix
SystemPartition
OsLoaderPath
NetcardDlls
NIL
> (win32:reg-map-subkey-names (lambda (s) (format t "~a~%" s)) syskey)
ControlSet001
ControlSet002
DISK
Select
Setup
Clone
CurrentControlSet
NIL

> (win32:reg-close-key syskey)
NIL
> (win32:reg-close-key setupkey)
NIL


> (win32:reg-set-value win32:hkey-current-user "Fred" 1)
NIL
> (win32:reg-query-value win32:hkey-current-user "Fred")
1
:DWORD

> (win32:reg-set-value win32:hkey-current-user "Fred" "Hello")
NIL
> (win32:reg-query-value win32:hkey-current-user "Fred")
"Hello"
:STRING

> (win32:reg-set-value win32:hkey-current-user "Fred" '("Hello" "Bob"))
NIL
> (win32:reg-query-value win32:hkey-current-user "Fred")
("Hello" "Bob")
:MULTI-STRING

> (win32:reg-set-value win32:hkey-current-user "Fred" "Hello" :binary)
NIL
> (win32:reg-query-value win32:hkey-current-user "Fred")
#(72 101 108 108 111)
:BINARY
> (win32:reg-query-value-into win32:hkey-current-user (make-string 5) "Fred")
"Hello"
:BINARY
> (win32:reg-delete-value win32:hkey-current-user "Fred")
NIL

> (setf fred (win32:reg-create-subkey win32:hkey-current-user "Fred"))
#<REGISTRY-KEY: HKEY_CURRENT_USER\Fred>
> (win32:reg-set-value fred "" 1)
NIL
> (win32:reg-query-value fred)
1
:DWORD
> (win32:reg-delete-subkey win32:hkey-current-user "Fred")
NIL
> (win32:reg-query-value fred)
Error: RegQueryValueEx: Illegal operation attempted on a Registry key which has been marked for deletion

Implementation

<registry functions>= (U->)
(export '(<registry exports>))
<registry constants>
<registry errors>
<registry key representation>
<standard registry keys>
<opening and closing registry keys>
<subkey and value enumeration>
<reading key values>
<writing and deleting key values>
<creating and deleting subkeys>
<loading and unloading keys>

Registry Errors Handling

<registry errors>= (<-U)
(defun raise-reg-error (res &optional (name "registry"))
  (raise-win32-error name res))

(wrap:c-callback "RaiseRegError" raise-reg-error (:integer :string) :void)

Defines raise-reg-error, RaiseRegError (links are to index).

Registry Key Representation

<registry key representation>= (<-U) [D->]
(defstruct (registry-key
            (:constructor new-registry-key (machine name handle access))
            (:print-function (lambda (key stream d)
                               (declare (ignore d))
                               (format stream "#<~a: ~@[\\\\~a\\~]~a>"
                                       (type-of key)
                                       (registry-key-machine key)
                                       (registry-key-name key)))))
  machine name handle access)

Defines new-registry-key, registry-key, registry-key-access, registry-key-handle, registry-key-machine, registry-key-name (links are to index).

<registry exports>= (<-U) [D->]
registry-key

<registry key representation>+= (<-U) [<-D]
(defun make-registry-key (machine name hkey access)
  (let ((key (new-registry-key machine name hkey access)))
    (system:cptr-protect hkey key)
    (register-finalizer key #'reg-close-key)
    key))

Defines make-registry-key (links are to index).

Standard Registry Keys

<registry constants>= (<-U) [D->]
(wrap:c-lines "
#define CHECK_STD_KEY(n,t) do { if (strcmp(n,#t)==0) return t; } while (0)
static HKEY GetStdRegKey(char *name) {
  CHECK_STD_KEY(name, HKEY_CLASSES_ROOT);
  CHECK_STD_KEY(name, HKEY_CURRENT_CONFIG);
  CHECK_STD_KEY(name, HKEY_CURRENT_USER);
  CHECK_STD_KEY(name, HKEY_LOCAL_MACHINE);
  CHECK_STD_KEY(name, HKEY_USERS);
  return NULL;
}")
(wrap:c-function get-std-reg-key "GetStdRegKey" (:string) (:cptr "void"))

Defines get-std-reg-key, GetStdRegKey (links are to index).

<registry constants>+= (<-U) [<-D->]
(defconstant HKEY_CLASSES_ROOT (get-std-reg-key "HKEY_CLASSES_ROOT"))
(defconstant HKEY_CURRENT_CONFIG (get-std-reg-key "HKEY_CURRENT_CONFIG"))
(defconstant HKEY_CURRENT_USER (get-std-reg-key "HKEY_CURRENT_USER"))
(defconstant HKEY_LOCAL_MACHINE (get-std-reg-key "HKEY_LOCAL_MACHINE"))
(defconstant HKEY_USERS (get-std-reg-key "HKEY_USERS"))

Defines HKEY_CLASSES_ROOT, HKEY_CURRENT_CONFIG, HKEY_CURRENT_USER, HKEY_LOCAL_MACHINE, HKEY_USERS (links are to index).

<registry constants>+= (<-U) [<-D]
(wrap:c-constant KEY_CREATE_LINK "KEY_CREATE_LINK" :unsigned)
(wrap:c-constant KEY_CREATE_SUB_KEY "KEY_CREATE_SUB_KEY" :unsigned)
(wrap:c-constant KEY_ENUMERATE_SUB_KEYS "KEY_ENUMERATE_SUB_KEYS" :unsigned)
(wrap:c-constant KEY_EXECUTE "KEY_EXECUTE" :unsigned)
(wrap:c-constant KEY_NOTIFY "KEY_NOTIFY" :unsigned)
(wrap:c-constant KEY_QUERY_VALUE "KEY_QUERY_VALUE" :unsigned)
(wrap:c-constant KEY_SET_VALUE "KEY_SET_VALUE" :unsigned)
(wrap:c-constant KEY_ALL_ACCESS "KEY_ALL_ACCESS" :unsigned)
(wrap:c-constant KEY_READ "KEY_READ" :unsigned)
(wrap:c-constant KEY_WRITE "KEY_WRITE" :unsigned)

Defines KEY_ALL_ACCESS, KEY_CREATE_LINK, KEY_CREATE_SUB_KEY, KEY_ENUMERATE_SUB_KEYS, KEY_EXECUTE, KEY_NOTIFY, KEY_QUERY_VALUE, KEY_READ, KEY_SET_VALUE, KEY_WRITE (links are to index).

<standard registry keys>= (<-U)
(defconstant hkey-classes-root
  (new-registry-key nil "HKEY_CLASSES_ROOT" HKEY_CLASSES_ROOT
                    (logior KEY_READ KEY_WRITE)))
(defconstant hkey-current-config
  (new-registry-key nil "HKEY_CURRENT_CONFIG"
                    HKEY_CURRENT_CONFIG (logior KEY_READ KEY_WRITE)))
(defconstant hkey-current-user
  (new-registry-key nil "HKEY_CURRENT_USER" HKEY_CURRENT_USER
                    (logior KEY_READ KEY_WRITE)))
(defconstant hkey-local-machine
  (new-registry-key nil "HKEY_LOCAL_MACHINE" HKEY_LOCAL_MACHINE
                    (logior KEY_READ KEY_WRITE)))
(defconstant hkey-users
  (new-registry-key nil "HKEY_USERS" HKEY_USERS (logior KEY_READ KEY_WRITE)))

Defines hkey-classes-root, hkey-current-config, hkey-current-usert, hkey-local-machine, hkey-users (links are to index).

<registry exports>+= (<-U) [<-D->]
hkey-classes-root hkey-current-config hkey-current-user
hkey-local-machine hkey-users

Opening and Closing Keys

<opening and closing registry keys>= (<-U) [D->]
(wrap:std-reg-function base-reg-open-key "RegOpenKeyEx"
                       ((:cptr "void") :string :unsigned :unsigned
                        (:value (:cptr "void"))))

(defun reg-open-key (key subkey &optional (access (registry-key-access key)))
  (let* ((name (concatenate 'string (registry-key-name key) "\\" subkey))
         (sam (decode-sam access))
         (hkey (base-reg-open-key (registry-key-handle key) subkey 0 sam)))
    (make-registry-key (registry-key-machine key) name hkey sam)))

Defines base-reg-open-key, reg-open-key (links are to index).

<registry exports>+= (<-U) [<-D->]
reg-open-key

<opening and closing registry keys>+= (<-U) [<-D->]
(defun decode-sam (access)
  (cond
   ((numberp access) access)
   ((symbolp access) (decode-sam (list access)))
   (t (let ((sam 0))
        (dolist (a access sam)
          (ecase a
                 (:create-link (setf sam (logior sam KEY_CREATE_LINK)))
                 (:create-subkey (setf sam (logior sam KEY_CREATE_SUB_KEY)))
                 (:enumerate-subkeys
                  (setf sam (logior sam KEY_ENUMERATE_SUB_KEYS)))
                 (:execute (setf sam (logior sam KEY_EXECUTE)))
                 (:notify (setf sam (logior sam KEY_NOTIFY)))
                 (:query-value (setf sam (logior sam KEY_QUERY_VALUE)))
                 (:set-value (setf sam (logior sam KEY_SET_VALUE)))
                 (:all-access (setf sam (logior sam KEY_ALL_ACCESS)))
                 (:read (setf sam (logior sam KEY_READ)))
                 (:write (setf sam (logior sam KEY_WRITE)))))))))

Defines decode-sam (links are to index).

<opening and closing registry keys>+= (<-U) [<-D->]
(wrap:std-reg-function base-reg-connect-registry "RegConnectRegistry"
                       (:string (:cptr "void") (:value (:cptr "void"))))

(defun reg-connect-registry (machine key &optional
                                     (access (registry-key-access key)))
  (let ((name (registry-key-name key))
        (sam (decode-sam access))
        (hkey (base-reg-connect-registry machine (registry-key-handle key))))
    (make-registry-key machine name hkey sam)))

Defines base-reg-connect-registry, reg-connect-registry (links are to index).

<registry exports>+= (<-U) [<-D->]
reg-connect-registry

<opening and closing registry keys>+= (<-U) [<-D]
(wrap:std-reg-function base-reg-close-key "RegCloseKey" ((:cptr "void")))

(defun reg-close-key (key)
  (let ((hkey (registry-key-handle key)))
    (when hkey
      (setf (registry-key-handle key) nil)
      (base-reg-close-key hkey))))

Defines base-reg-close-key, reg-close-key (links are to index).

<registry exports>+= (<-U) [<-D->]
reg-close-key

Subkey and Value Enumeration

<subkey and value enumeration>= (<-U) [D->]
(wrap:std-reg-function base-reg-query-info-key "RegQueryInfoKey"
                       ((:cptr "void") (:cptr "char" t) (:cptr "DWORD" t)
                        (:cptr "DWORD" t)
                        (:cptr "DWORD" t) (:cptr "DWORD" t) (:cptr "DWORD" t)
                        (:cptr "DWORD" t) (:cptr "DWORD" t) (:cptr "DWORD" t)
                        (:cptr "DWORD" t) (:cptr "FILETIME" t)))

(defun reg-query-info-key (key which)
  (let* ((hkey (registry-key-handle key))
         (pval (make-dwords))
         (csk (if (eq which :subkey-count) pval nil))
         (sklen (if (eq which :max-subkey-length) pval nil))
         (cv (if (eq which :value-count) pval nil))
         (vnlen (if (eq which :max-value-name-length) pval nil))
         (vlen (if (eq which :max-value-length) pval nil)))
    (base-reg-query-info-key hkey nil nil nil csk sklen nil
                             cv vnlen vlen nil nil)
    (get-dword pval)))

Defines base-reg-query-info-key, reg-query-info-key (links are to index).

<registry exports>+= (<-U) [<-D->]
reg-query-info-key

<subkey and value enumeration>+= (<-U) [<-D->]
(wrap:std-reg-function base-reg-enum-key "RegEnumKeyEx"
                       ((:cptr "void") :unsigned :string (:cptr "DWORD")
                        (:cptr "DWORD" t) (:cptr "char" t) (:cptr "DWORD" t)
                        (:cptr "FILETIME" t)))

Defines base-reg-enum-key (links are to index).

<subkey and value enumeration>+= (<-U) [<-D->]
(defun reg-map-subkey-names (fun key)
  (let* ((hkey (registry-key-handle key))
         (bsize (reg-query-info-key key :max-subkey-length))
         (buf (make-string bsize))
         (psize (make-dwords)))
    (dotimes (index (reg-query-info-key key :subkey-count))
      (set-dword psize (+ bsize 1))
      (base-reg-enum-key hkey index buf psize nil nil nil nil)
      (funcall fun (subseq buf 0 (get-dword psize))))))

Defines reg-map-subkey-names (links are to index).

<registry exports>+= (<-U) [<-D->]
reg-map-subkey-names

<subkey and value enumeration>+= (<-U) [<-D->]
(defun reg-subkey-names (key)
  (let ((val nil))
    (reg-map-subkey-names (lambda (s) (push s val)) key)
    (nreverse val)))

Defines reg-subkey-names (links are to index).

<registry exports>+= (<-U) [<-D->]
reg-subkey-names

<subkey and value enumeration>+= (<-U) [<-D->]
(wrap:std-reg-function base-reg-enum-value "RegEnumValue"
                       ((:cptr "void") :unsigned :string (:cptr "DWORD")
                        (:cptr "void" t)
                        (:cptr "DWORD" t) (:cptr "BYTE" t) (:cptr "DWORD" t)))

Defines base-reg-enum-value (links are to index).

<subkey and value enumeration>+= (<-U) [<-D->]
(defun reg-map-value-names (fun key)
  (let* ((hkey (registry-key-handle key))
         (bsize (reg-query-info-key key :max-value-name-length))
         (buf (make-string bsize))
         (psize (make-dwords)))
    (dotimes (index (reg-query-info-key key :value-count))
      (set-dword psize (+ bsize 1))
      (base-reg-enum-value hkey index buf psize nil nil nil nil)
      (funcall fun (subseq buf 0 (get-dword psize))))))

Defines reg-map-value-names (links are to index).

<registry exports>+= (<-U) [<-D->]
reg-map-value-names

<subkey and value enumeration>+= (<-U) [<-D]
(defun reg-value-names (key)
  (let ((val nil))
    (reg-map-value-names (lambda (n) (push n val)) key)
    (nreverse val)))

Defines reg-value-names (links are to index).

<registry exports>+= (<-U) [<-D->]
reg-value-names

Reading Key Values

<reading key values>= (<-U) [D->]
(wrap:c-pointer "DWORD"
                (:make make-dwords)
                (:cast cast-dwords)
                (:get get-dword nil :unsigned)
                (:set set-dword nil :unsigned))

Defines cast-dwords, get-dword, make-dwords, set-dword (links are to index).

<reading key values>+= (<-U) [<-D->]
(wrap:c-pointer "BYTE"
                (:make make-bytes)
                (:cast cast-bytes)
                (:get get-byte nil :unsigned)
                (:set set-byte nil :unsigned))

Defines cast-bytes, get-byte, make-bytes, set-byte (links are to index).

<reading key values>+= (<-U) [<-D->]
(wrap:std-reg-function base-reg-query-value "RegQueryValueEx"
                       ((:cptr "void") :string (:cptr "void" t)
                        (:cptr "DWORD") (:cptr "BYTE" t) (:cptr "DWORD")))

Defines base-reg-query-value (links are to index).

<reading key values>+= (<-U) [<-D->]
(defun reg-query-value-type (key &optional (name ""))
  (let ((hkey (registry-key-handle key))
        (ptype (make-dwords))
        (psize (make-dwords)))
    (base-reg-query-value hkey name nil ptype nil psize)
    (reg-value-lisp-type (get-dword ptype))))

Defines reg-query-value-type (links are to index).

<registry exports>+= (<-U) [<-D->]
reg-query-value-type

<reading key values>+= (<-U) [<-D->]
(defun reg-query-value-size (key &optional (name ""))
  (let ((hkey (registry-key-handle key))
        (ptype (make-dwords))
        (psize (make-dwords)))
    (base-reg-query-value hkey name nil ptype nil psize)
    (get-dword psize)))

Defines reg-query-value-size (links are to index).

<registry exports>+= (<-U) [<-D->]
reg-query-value-size

<reading key values>+= (<-U) [<-D->]
(defun reg-query-value (key &optional (name "") &key expand)
  (let ((hkey (registry-key-handle key))
        (ptype (make-dwords))
        (psize (make-dwords)))
    (base-reg-query-value hkey name nil ptype nil psize)
    (let ((type (get-dword ptype))
          (size (get-dword psize)))
      (when (/= size 0)
        (let ((data (make-bytes size)))
          (base-reg-query-value hkey name nil ptype data psize)
          (values (reg-value-to-lisp type size data expand)
                  (reg-value-lisp-type type)))))))

Defines reg-query-value (links are to index).

<registry exports>+= (<-U) [<-D->]
reg-query-value

<reading key values>+= (<-U) [<-D->]
(defun reg-query-value-into (key buf &optional (name ""))
  (let ((hkey (registry-key-handle key))
        (ptype (make-dwords))
        (psize (make-dwords))
        (data (cast-bytes (array-data-address buf)))
        (bsize (* (system:typed-vector-element-size buf) (length buf))))
    (set-dword psize bsize)
    (base-reg-query-value hkey name nil ptype data psize)
    (values buf (reg-value-lisp-type (get-dword ptype)))))

Defines reg-query-value-into (links are to index).

<registry exports>+= (<-U) [<-D->]
reg-query-value-into

<reading key values>+= (<-U) [<-D->]
(wrap:c-constant REG_BINARY "REG_BINARY" :unsigned)
(wrap:c-constant REG_DWORD "REG_DWORD" :unsigned)
(wrap:c-constant REG_DWORD_LITTLE_ENDIAN "REG_DWORD_LITTLE_ENDIAN" :unsigned)
(wrap:c-constant REG_DWORD_BIG_ENDIAN "REG_DWORD_BIG_ENDIAN" :unsigned)
(wrap:c-constant REG_EXPAND_SZ "REG_EXPAND_SZ" :unsigned)
(wrap:c-constant REG_MULTI_SZ "REG_MULTI_SZ" :unsigned)
(wrap:c-constant REG_NONE "REG_NONE" :unsigned)
(wrap:c-constant REG_RESOURCE_LIST "REG_RESOURCE_LIST" :unsigned)
(wrap:c-constant REG_SZ "REG_SZ" :unsigned)

Defines REG_BINARY, REG_DWORD, REG_DWORD_BIG_ENDIAN, REG_DWORD_LITTLE_ENDIAN, REG_EXPAND_SZ, REG_MULTI_SZ, REG_NONE, REG_RESOURCE_LIST, REG_SZ (links are to index).

<reading key values>+= (<-U) [<-D->]
(defun reg-value-lisp-type (type)
  (cond
   ((= type REG_BINARY) :binary)
   ((= type REG_DWORD) :dword)
   ((= type REG_DWORD_LITTLE_ENDIAN) :dword-little-endian)
   ((= type REG_DWORD_BIG_ENDIAN) :dword-big-endian)
   ((= type REG_EXPAND_SZ) :expand-string)
   ((= type REG_MULTI_SZ) :multi-string)
   ((= type REG_NONE) :none)
   ((= type REG_RESOURCE_LIST) :resource-list)
   ((= type REG_SZ) :string)
   (t :unknown)))

Defines reg-value-lisp-type (links are to index).

<reading key values>+= (<-U) [<-D]
(defun reg-value-to-lisp (type size data expand)
  (flet ((data-to-string (size data)
           (let* ((ssize (- size 1))
                  (value (make-string ssize)))
             (dotimes (i ssize value)
               (setf (char value i) (int-char (get-byte data i)))))))
     (cond
      ((= type REG_SZ) (data-to-string size data))
      ((= type REG_EXPAND_SZ)
       (let ((string (data-to-string size data)))
         (if expand
             (expand-environment-strings string)
           string)))
      ((or (= type REG_DWORD) (= type REG_DWORD_LITTLE_ENDIAN))
       (get-dword (cast-dwords data)))
      ((= type REG_DWORD_BIG_ENDIAN)
       (error "can't handle big-endian DWORDs yet"));;****
      ((= type REG_MULTI_SZ)
       (let ((val nil)
             (string (data-to-string size data))
             (null-char (int-char 0))
             (start 0))
         (loop
          (let ((pos (position null-char string :start start)))
            (when (null pos) (return (nreverse val)))
            (push (subseq string start pos) val)
            (setf start (+ pos 1))))))
      (t ;; REG_BINARY, etc.
       (let ((value (make-array size :element-type 'c-uchar)))
         (dotimes (i size value) (setf (aref value i) (get-byte data i))))))))

Defines reg-value-to-lisp (links are to index).

Writing and Deleting Key Values

<writing and deleting key values>= (<-U) [D->]
(wrap:std-reg-function base-reg-set-value "RegSetValueEx"
                       ((:cptr "void") :string :unsigned
                        :unsigned (:cptr "BYTE") :unsigned))

(defun reg-set-value (key name value &optional typespec)
  (let* ((spec (if typespec typespec (default-reg-value-type value)))
         (type (decode-reg-value-type spec)))
    (multiple-value-bind (dsize data)
                         (make-reg-value-data type value)
      (base-reg-set-value (registry-key-handle key) name 0 type data dsize))))

Defines base-reg-set-value, reg-set-value (links are to index).

<registry exports>+= (<-U) [<-D->]
reg-set-value

<writing and deleting key values>+= (<-U) [<-D->]
(defun default-reg-value-type (value)
  (cond
   ((stringp value) REG_SZ)
   ((numberp value) REG_DWORD)
   ((listp value) REG_MULTI_SZ)
   (t (error "can't determine registry value type for ~s" value))))

Defines default-reg-value-type (links are to index).

<writing and deleting key values>+= (<-U) [<-D->]
(defun decode-reg-value-type (type)
  (if (numberp type)
      type
    (ecase type
           (:binary REG_BINARY)
           (:dword REG_DWORD)
           (:dword-little-endian REG_DWORD_LITTLE_ENDIAN)
           (:dword-big-endian REG_DWORD_BIG_ENDIAN)
           (:expand-string REG_EXPAND_SZ)
           (:multi-string REG_MULTI_SZ)
           (:none REG_NONE)
           (:resource-list REG_RESOURCE_LIST)
           (:string REG_SZ))))

Defines decode-reg-value-type (links are to index).

<writing and deleting key values>+= (<-U) [<-D->]
(defun make-reg-value-data (type value)
  (cond
   ((= type REG_SZ)
    (let ((val (if (stringp value) value (format nil "~s" value))))
      (values (+ (length val) 1) (cast-bytes (array-data-address val)))))
   ((or (= type REG_DWORD) (= type REG_DWORD_LITTLE_ENDIAN))
    (let ((data (make-dwords)))
      (set-dword data value)
      (values 4 (cast-bytes data))))
   ((= type REG_BINARY)
    (values (* (system:typed-vector-element-size value) (length value))
            (cast-bytes (array-data-address value))))
   ((= type REG_MULTI_SZ)
    (flet ((cat (x y) (concatenate 'string x y "\000")))
      (let* ((string (reduce #'cat value :initial-value ""))
             (data (cast-bytes (array-data-address string))))
        (values (+ (length string) 1) data))))
   (t (error "can't write registry values of type ~s"
             (reg-value-lisp-type type)))))

Defines make-reg-value-data (links are to index).

<writing and deleting key values>+= (<-U) [<-D]
(wrap:std-reg-function base-reg-delete-value "RegDeleteValue"
                       ((:cptr "void") :string))

(defun reg-delete-value (key &optional (name ""))
  (base-reg-delete-value (registry-key-handle key) name))

Defines base-reg-delete-value, reg-delete-value (links are to index).

<registry exports>+= (<-U) [<-D->]
reg-delete-value

Creating and Deleting Subkeys

<creating and deleting subkeys>= (<-U) [D->]
(wrap:std-reg-function base-reg-create-key "RegCreateKeyEx"
                       ((:cptr "void") :string :unsigned
                        (:cptr "char" t) :unsigned :unsigned
                        (:cptr "SECURITY_ATTRIBUTES" t) (:value (:cptr "void"))
                        (:cptr "DWORD" t)))

(wrap:c-constant REG_OPTION_NON_VOLATILE "REG_OPTION_NON_VOLATILE" :unsigned)

;;**** second value to say if new or existing?
(defun reg-create-subkey (key subkey &optional (access :all-access))
  (let* ((hkey (registry-key-handle key))
         (name (concatenate 'string (registry-key-name key) "\\" subkey))
         (opts REG_OPTION_NON_VOLATILE)
         (sam (decode-sam access))
         (hsubkey (base-reg-create-key hkey subkey 0 nil opts sam nil nil)))
    (make-registry-key (registry-key-machine key) name hsubkey sam)))

Defines base-reg-create-key, reg-create-subkey, REG_OPTION_NON_VOLATILE (links are to index).

<registry exports>+= (<-U) [<-D->]
reg-create-subkey

<creating and deleting subkeys>+= (<-U) [<-D]
;;**** use SHDeleteKey or SHDeleteEmptyKey instead??
(wrap:std-reg-function base-reg-delete-key "RegDeleteKey"
                       ((:cptr "void") :string))

(defun reg-delete-subkey (key name)
  (base-reg-delete-key (registry-key-handle key) name))

Defines base-reg-delete-key, reg-delete-subkey (links are to index).

<registry exports>+= (<-U) [<-D]
reg-delete-subkey

Loading and Unloading Keys

<loading and unloading keys>= (<-U)
;;**** not useful unless process previledges adjusted--See Perl AllowPriv, etc.
(wrap:std-reg-function base-reg-save-key "RegSaveKey"
                       ((:cptr "void") :string
                        (:cptr "SECURITY_ATTRIBUTES" t)))

(wrap:std-reg-function base-reg-load-key "RegLoadKey"
                       ((:cptr "void") :string :string))

Semaphores

Interface

Structure: semaphore: Semaphore structure.
Function: make-semaphore init &key maximum name: Creates a new, optionally named, semaphore with initial value init.
Function: open-semaphore name: Opens the exitsting named semaphore name.
Function: release-semaphore sem &optional count: Releases semaphore sem, incrementing it by count. The default count is one.
Function: wait-semaphore sem: Waits until semaphore sem is releases.

**** allow optional timeout in wait?

Using unnamed semaphores within a single process sort of works if the listener is used to wait and the xlsclient or some other DDE or COM connection is used to signal. This is because even though XlispStat is single-threaded, the wait on the semaphore processes events. In the listener:

<semaphore examples>= [D->]
(setf sem (win32:make-semaphore 0))
(win32:wait-semaphore sem)

In the xlsclient (e.g. in emacs):

<semaphore examples>+= [<-D->]
(win32:release-semaphore sem)

A more sensible example uses a named semaphore shared between two XlispStat processes. In one process:

<semaphore examples>+= [<-D->]
(setf sem (win32:make-semaphore 0 :name "Fred"))
(win32:wait-semaphore sem)

In another process:

<semaphore examples>+= [<-D]
(setf sem (win32:open-semaphore "Fred"))
(win32:release-semaphore sem)

Implementation

<semaphores>= (U->) [D->]
(defstruct (semaphore (:constructor new-semaphore (handle))
                      (:print-function print-semaphore))
  handle)

(defun print-semaphore (sem stream d)
  (format stream "#<~a>" (type-of sem)))

(export 'semaphore)

Defines new-semaphore, print-semaphore, semaphore (links are to index).

<semaphores>+= (U->) [<-D->]
(defconstant semaphore-maximum (- (expt 2 31) 1))

(defun wrap-semaphore (handle which)
  (unless handle
    (error "semaphore ~:[open~;create~] failed" (eq which :create)))
  (let ((sem (new-semaphore handle)))
    (system:register-finalizer sem #'close-semaphore)
    sem))

(defun make-semaphore (init &key (maximum semaphore-maximum) name)
  (wrap-semaphore (if name
                      (create-named-semaphore init maximum name)
                    (create-semaphore init maximum))
                  :create))

(defun open-semaphore (name)
  (wrap-semaphore (base-open-semaphore name) :open))

(defun close-semaphore (sem)
  (let ((handle (semaphore-handle sem)))
    (setf (semaphore-handle sem) nil)
    (close-handle handle)))

(export '(make-semaphore open-semaphore))

Defines close-semaphore, make-semaphore (links are to index).

<semaphores>+= (U->) [<-D->]
(wrap:c-lines "
#define MyCreateSemaphore(a,b) CreateSemaphore(NULL,a,b,NULL)
#define MyCreateNamedSemaphore(a,b,c) CreateSemaphore(NULL,a,b,c)
#define MyOpenSemaphore(a) OpenSemaphore(SEMAPHORE_ALL_ACCESS,FALSE,a)")
(wrap:c-function create-semaphore "MyCreateSemaphore" (:integer :integer)
         (:cptr "void"))
(wrap:c-function create-named-semaphore "MyCreateNamedSemaphore"
         (:integer :integer :string) (:cptr "void"))
(wrap:c-function base-open-semaphore "MyOpenSemaphore"
                 (:string) (:cptr "void"))

Defines create-semaphore, MyCreateSemaphore (links are to index).

<semaphores>+= (U->) [<-D->]
(wrap:c-function close-handle "CloseHandle" ((:cptr "void")) :bool)

<semaphores>+= (U->) [<-D->]
(defun release-semaphore (sem &optional (count 1))
  (let ((handle (semaphore-handle sem)))
    (unless (and handle (base-release-semaphore handle count))
      (error "semaphore release failed"))))

(export 'release-semaphore)

Defines release-semaphore (links are to index).

<semaphores>+= (U->) [<-D->]
(wrap:c-lines "
#define MyReleaseSemaphore(a,b) ReleaseSemaphore(a,b,NULL)")
(wrap:c-function base-release-semaphore "MyReleaseSemaphore"
                 ((:cptr "void") :integer) :bool)

Defines base-release-semaphore, MyReleaseSemaphore (links are to index).

<semaphores>+= (U->) [<-D->]
(defun wait-semaphore (sem)
  (let ((handle (semaphore-handle sem)))
    (unless (and handle (base-wait-semaphore handle))
      (error "semaphore wait failed"))))

(export 'wait-semaphore)

Defines wait-semaphore (links are to index).

Use MWMO_INPUTAVAILABLE in Ex version? (Richter says to.)

<semaphores>+= (U->) [<-D]
(wrap:c-lines "
static BOOL WaitSemaphore(HANDLE sem)
{
  MSG msg;
  BOOL signaled = FALSE;

  while (! signaled) {
    switch(MsgWaitForMultipleObjects(1, &sem, FALSE, INFINITE, QS_ALLEVENTS)) {
    case -1: return FALSE;
    case WAIT_OBJECT_0: signaled = TRUE; break;
    default:
      while (PeekMessage(&msg, NULL, 0, 0, PM_REMOVE)) {
        XLGLOBAL extern HWND hWndFrame, hWndClient, hAccel;
        if(! TranslateMDISysAccel(hWndClient, &msg) &&
           ! TranslateAccelerator(hWndFrame, hAccel, &msg)) {
          TTYFlushOutput();
          TranslateMessage(&msg);
          DispatchMessage(&msg);
        }
      }
    }
  }
  return TRUE;
}")

(wrap:c-function base-wait-semaphore "WaitSemaphore" ((:cptr "void")) :bool)

Defines base-wait-semaphore, WaitSemaphore (links are to index).

Odds and Ends

Interface

Function: expand-environment-strings string: Returns a string with any environment strings of the form %VAR% that appear in string expanded.

<odds and ends examples>=
> (win32:expand-environment-strings "My home is %home%")
"My home is C:\\users\\luke"

Implementation

<odds and ends>= (U->)
(wrap:c-function base-expand-environment-strings "ExpandEnvironmentStrings"
                 (:string :string :unsigned) :unsigned)

(defun expand-environment-strings (string)
  (flet ((check (n)
           (if (= n 0)
               (raise-win32-error "ExpandEnvironmentStrings")
             n)))
        (let* ((n (check (base-expand-environment-strings string "" 0)))
               (value (make-string n)))
          (check (base-expand-environment-strings string value n))
          (let ((pos (position (int-char 0) value)))
            (if pos (subseq value 0 pos) value)))))
(export 'expand-environment-strings)

Defines base-expand-environment-strings, expand-environment-strings (links are to index).

Files

<win32.wrp>=
(let ((major 3)
      (minor 52)
      (subminor 16))
  (unless (or (> system:xls-major-release major)
              (and (= system:xls-major-release major)
                   (> system:xls-minor-release minor))
              (and (= system:xls-major-release major)
                   (= system:xls-minor-release minor)
                   (>= system:xls-subminor-release subminor)))
    (error "Win32 support requires at least version ~d.~d.~d"
           major minor subminor)))

(provide "win32")
(defpackage "WIN32" (:use "XLISP"))
(in-package "WIN32")

(defvar *win32-library*)
(wrap:library-load *win32-library*)
(defun unload-win32 () (shlib:close-shared-library *win32-library*))

<error handling>
<operating system information>
<shell functions>
<registry functions>
<semaphores>
<odds and ends>

<dllstub.c>=
#include <windows.h>

int APIENTRY DllMain(HANDLE hdll, DWORD  reason, LPVOID reserved )
{
  switch( reason ) {
  case DLL_THREAD_ATTACH: break;
  case DLL_THREAD_DETACH: break;
  case DLL_PROCESS_ATTACH: break;
  case DLL_PROCESS_DETACH: break;
  }
  return( 1 );
}

<creating and deleting subkeys>: U1, D2, D3
<dllstub.c>: D1
<error handling>: D1, D2, D3, D4, D5, U6
<loading and unloading keys>: U1, D2
<odds and ends>: D1, U2
<odds and ends examples>: D1
<opening and closing registry keys>: U1, D2, D3, D4, D5
<operating system information>: D1, U2
<operating system information example>: D1
<reading key values>: U1, D2, D3, D4, D5, D6, D7, D8, D9, D10, D11
<registry constants>: U1, D2, D3, D4
<registry errors>: U1, D2
<registry examples>: D1
<registry exports>: U1, D2, D3, D4, D5, D6, D7, D8, D9, D10, D11, D12, D13, D14, D15, D16, D17, D18, D19
<registry functions>: D1, U2
<registry key representation>: U1, D2, D3
<semaphore examples>: D1, D2, D3, D4
<semaphores>: D1, D2, D3, D4, D5, D6, D7, D8, U9
<shell function examples>: D1
<shell functions>: D1, U2
<standard registry keys>: U1, D2
<subkey and value enumeration>: U1, D2, D3, D4, D5, D6, D7, D8
<win32.wrp>: D1
<writing and deleting key values>: U1, D2, D3, D4, D5, D6

base-expand-environment-strings: D1
base-format-message: D1
base-reg-close-key: D1
base-reg-connect-registry: D1
base-reg-create-key: D1
base-reg-delete-key: D1
base-reg-delete-value: D1
base-reg-enum-key: D1
base-reg-enum-value: D1
base-reg-open-key: D1
base-reg-query-info-key: D1
base-reg-query-value: D1
base-reg-set-value: D1
base-release-semaphore: D1
base-wait-semaphore: D1
cast-bytes: D1
cast-dwords: D1
close-semaphore: D1
create-semaphore: D1
decode-reg-value-type: D1
decode-sam: D1
default-reg-value-type: D1
expand-environment-strings: D1
format-message: D1
get-byte: D1
get-dword: D1
GetErrorMessage: D1
get-last-error: D1
get-std-reg-key: D1
GetStdRegKey: D1
hkey-classes-root: D1
HKEY_CLASSES_ROOT: D1, U2
hkey-current-config: D1
HKEY_CURRENT_CONFIG: D1
HKEY_CURRENT_USER: D1, U2
hkey-current-usert: D1
hkey-local-machine: D1
HKEY_LOCAL_MACHINE: D1, U2
hkey-users: D1, U2
HKEY_USERS: D1
KEY_ALL_ACCESS: D1
KEY_CREATE_LINK: D1
KEY_CREATE_SUB_KEY: D1
KEY_ENUMERATE_SUB_KEYS: D1
KEY_EXECUTE: D1
KEY_NOTIFY: D1
KEY_QUERY_VALUE: D1
KEY_READ: D1
KEY_SET_VALUE: D1
KEY_WRITE: D1
make-bytes: D1
make-dwords: D1
make-registry-key: D1
make-reg-value-data: D1
make-semaphore: D1
MyCreateSemaphore: D1
MyReleaseSemaphore: D1
new-registry-key: D1
new-semaphore: D1
print-semaphore: D1
raise-reg-error: D1
RaiseRegError: D1
raise-win32-error: D1
REG_BINARY: D1
reg-close-key: D1, U2
reg-connect-registry: D1, U2
reg-create-subkey: D1, U2
reg-delete-subkey: D1, U2
reg-delete-value: D1, U2
REG_DWORD: D1
REG_DWORD_BIG_ENDIAN: D1
REG_DWORD_LITTLE_ENDIAN: D1
REG_EXPAND_SZ: D1
registry-key: D1, U2
registry-key-access: D1
registry-key-handle: D1
registry-key-machine: D1
registry-key-name: D1
reg-map-subkey-names: D1, U2
reg-map-value-names: D1, U2
REG_MULTI_SZ: D1
REG_NONE: D1
reg-open-key: D1, U2
REG_OPTION_NON_VOLATILE: D1
reg-query-info-key: D1, U2
reg-query-value: D1, U2
reg-query-value-into: D1, U2
reg-query-value-size: D1, U2
reg-query-value-type: D1, U2
REG_RESOURCE_LIST: D1
reg-set-value: D1, U2
reg-subkey-names: D1, U2
REG_SZ: D1
reg-value-lisp-type: D1
reg-value-names: D1, U2
reg-value-to-lisp: D1
release-semaphore: D1
semaphore: D1
set-byte: D1
set-dword: D1
wait-semaphore: D1
WaitSemaphore: D1
win32-error: D1
win32-error-code: D1
win32-error-source: D1

[BibTeX bibliography]