[Win32forth-cvs] win32forth/src REGISTRY.F,1.1,1.2

[Dirk B. <db...@us...>]

Update of /cvsroot/win32forth/win32forth/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31440/src

Modified Files:
	REGISTRY.F 
Log Message:
Registry support partly rewritten. Now it's possible to acess the complete registry and not only HKEY_CURRENT_USER


Index: REGISTRY.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/REGISTRY.F,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** REGISTRY.F	21 Dec 2004 00:19:08 -0000	1.1
--- REGISTRY.F	1 Jan 2005 10:23:15 -0000	1.2
***************
*** 1,17 ****
! (( registry.f   The Registry Interface for Win32Forth            by Tom Zimmer
  
!         Andrew implemented the functionality in C, and I translated it
!         into Forth
  
! 2002/08/31 arm (minor) use ANS file words replaceing FXXX-FILE
! 2002/09/24 arm release for testing
! 2002/10/08 arm Consolidation
! 2003/09/08 dbu removed the registry entries 'Directory' and 'Version'
  
! ))
  
! cr .( Loading Windows Registry...)
  
! INTERNAL
  
  \ Default registry key.  Change this string to put your programs registry
--- 1,78 ----
! \ $Id$
! \
! \ registry.f   The Registry Interface for Win32Forth            by Tom Zimmer
! \ 
! \         Andrew implemented the functionality in C, and I translated it
! \         into Forth
! \ 
! \ 2002/08/31 arm (minor) use ANS file words replaceing FXXX-FILE
! \ 2002/09/24 arm release for testing
! \ 2002/10/08 arm Consolidation
! \ 2003/09/08 dbu removed the registry entries 'Directory' and 'Version'
! \ Sonntag, Dezember 26 2004 dbu mostly rewritten
  
! cr .( Loading Windows Registry...)
  
! \ anew -Registry.f
  
! INTERNAL
  
! 5 proc RegOpenKeyEx
! 9 proc RegCreateKeyEx
! 1 proc RegCloseKey
! 6 proc RegQueryValueEx
! 6 proc RegSetValueEx
  
! \ ************************************************************************************
! \ Low level Registry words
! \
! \ With these words the complete registry can be accessed
! \ ************************************************************************************
! 
! external
! 
! \ RegOpenKey opens the specified registry key
! : (RegOpenKey)	{ hKey lpSubKey samDesired \ hkResult -- hkResult }
!  		&OF hkResult samDesired 0 lpSubKey hKey
! 		call RegOpenKeyEx ERROR_SUCCESS =
! 		if hkResult else INVALID_HANDLE_VALUE then ;
! 
! \ RegCreateKey creates the specified registry key.
! \ If the key already exists, it is opened.
! : (RegCreateKey) { hKey lpSubKey samDesired \ Class Disposition hkResult -- hkResult }
! 		0 to Class
! 		0 to Disposition
! 		
! 		&OF Disposition         \ disposition value buffer
! 		&OF hkResult            \ key handle
! 		0                       \ inheritance
! 		samDesired              \ desired security access
! 		REG_OPTION_NON_VOLATILE \ special options
! 		&OF Class               \ class string
! 		0                       \ reserved
! 		lpSubKey                \ subkey name
! 		hKey                    \ handle to open key
! 
! 		call RegCreateKeyEx ERROR_SUCCESS =
! 		if hkResult else INVALID_HANDLE_VALUE then ;
! 
! \ RegCloseKey releases a handle to the specified registry key
! : (RegCloseKey)	( hKey -- f )
! 		call RegCloseKey ERROR_SUCCESS = ;
! 		
! \ RegQueryValue retrieves the type and data for a specified value name
! \ associated with an open registry key
! : (RegQueryValue) { hKey lpValueName rType lpData lpcbData \ -- f }
! 		lpcbData lpData &OF rType null
! 		lpValueName hKey call RegQueryValueEx ERROR_SUCCESS = ;
! 
! \ RegSetValue sets the data and type of a specified value under a registry key. 
! : (RegSetValue)	{ hKey lpValueName rType lpData cbData \ -- f }
! 		cbData lpData rType null
! 		lpValueName hKey call RegSetValueEx ERROR_SUCCESS = ;
! 
! \ ************************************************************************************
! \ High level Registry words...
! \ ************************************************************************************
  
  \ Default registry key.  Change this string to put your programs registry
***************
*** 20,130 ****
  \ that will be specific not only to your program, but to the particular
  \ directory instance of your program that is running.
  
! EXTERNAL
! 
! create PROGREG MAX-PATH allot
! 
! : PROGREG-SET-BASE-PATH ( -- )
!         s" Win32Forth " PROGREG place
!         version# ((version)) PROGREG +place
!         s" \" PROGREG +place ;
  
! : PROGREG-INIT ( -- )
!         PROGREG-SET-BASE-PATH s" Win32For\" PROGREG +place ;
  
  initialization-chain chain-add PROGREG-INIT
  PROGREG-INIT
  
! INTERNAL
  
!   create basereg ," SOFTWARE\"
! variable disposition
! variable regkey
! variable regtype
! variable reglen
  
  named-new$ ReturnedKey$
  
! EXTERNAL
! 
! 9 proc RegCreateKeyEx
! 6 proc RegQueryValueEx
! 1 proc RegCloseKey
! 6 proc RegSetValueEx
! 
  
! \ sadr,slen = the registry section to get the key of
  \ return -1 if we could not get the key
! 
! : RegGetKey     { sadr slen \ key$ -- regkey | -1 }  \ read the key of a section
!                 MAXSTRING localAlloc: key$
!                 basereg count         key$  place
!                 progreg count         key$ +place
!                 sadr slen             key$ +place
!                                       key$ +NULL
!                 disposition rel>abs         \ we get it, but don't use it
!                 regkey      rel>abs         \ the return value
!                 NULL
!                 KEY_ALL_ACCESS
!                 REG_OPTION_NON_VOLATILE
!                 NULL
!                 0
!                 key$ 1+  rel>abs
!                 HKEY_CURRENT_USER
!                 Call RegCreateKeyEx
!                 if      -1
!                 else    regkey @
!                 then    ;
! 
  
  \ read registry key value string 'vadr,vlen'
  \ from            section string 'sadr,slen'
!  \ return             data string 'dadr,dlen'
  
  \ sadr,slen = the registry key section string
  \ vadr,vlen = the registry key value string to read
  \ dadr,dlen = the registry key data string returned
! 
! : RegGetString  { vadr vlen sadr slen -- dadr dlen }
                  ReturnedKey$ off                \ initially clear return buffer
-                 sadr slen RegGetKey dup -1 =
-                 if      drop
-                         ReturnedKey$ count
-                         EXIT                    \ return on error, empty data
-                 then    >r
-                 MAXCOUNTED reglen !             \ init max length of string
  
!                 reglen          rel>abs
!                 ReturnedKey$ 1+ rel>abs
!                 regtype         rel>abs
!                 0
!                 vadr            rel>abs
!                 r@
!                 Call RegQueryValueEx
!                 if      ReturnedKey$ off
!                 else    reglen @ 1- 0max ReturnedKey$ c!
!                 then    ReturnedKey$ count
!                 r> Call RegCloseKey drop ;
  
  \ Write to the registry, a key value string 'vadr,vlen'
  \ in                         section string 'sadr,slen'
  \ the                           data string 'dadr,dlen'
- 
  : RegSetString  { dadr dlen vadr vlen sadr slen \ val$ khdl -- }
!                 MAXSTRING localAlloc: val$      \ allocate a dynamic string
!                 dlen "CLIP" to dlen             \ clip key to 255 characters
!                 sadr slen RegGetKey to khdl
!                 khdl -1 =
!                 if      EXIT                    \ just return, ignore error
!                 then
                  dadr dlen val$ place
                            val$ +NULL
!                 dlen 1+                         \ data length including NULL
!                 val$ 1+ rel>abs                 \ null terminated data string
!                 REG_SZ
!                 0
!                 vadr    rel>abs
!                 khdl Call RegSetValueEx drop
!                 khdl Call RegCloseKey drop ;
  
  : SetSetting    ( a1 n1 a2 n2 -- )      \ a1,n1=value string, a2,n2=key string
--- 81,186 ----
  \ that will be specific not only to your program, but to the particular
  \ directory instance of your program that is running.
+ create BaseReg ," SOFTWARE\" MAXSTRING allot-to
+ create ProgReg MAXSTRING allot
  
! : PROGREG-SET-BASE-PATH ( -- ) 
! 		s" Win32Forth " ProgReg place
! 		version# ((version)) ProgReg +place
! 		s" \" ProgReg +place ;
  
! : PROGREG-INIT	( -- )
! 		PROGREG-SET-BASE-PATH s" Win32For\" ProgReg +place ;
  
  initialization-chain chain-add PROGREG-INIT
  PROGREG-INIT
  
! HKEY_CURRENT_USER value regBaseKey
! KEY_ALL_ACCESS    value regAccessMask
  
! INTERNAL
  
+ variable regLen
  named-new$ ReturnedKey$
  
! : BuildSection	( sadr slen adr -- adr1 )
! 		>R
!                 BaseReg count r@  place
!                 ProgReg count r@ +place
!                               r@ +place
!                               r@ +NULL
! 		r> 1+ ;
  
! \ sadr,slen = the registry section to get the key of  (for read accesss)
  \ return -1 if we could not get the key
! : RegGetKeyRead { sadr slen \ section$ -- regkey }  \ read the key of a section
!                 MAXSTRING 2 + LocalAlloc: section$
! 		regBaseKey
! 		sadr slen section$ BuildSection
! 		regAccessMask (RegOpenKey) ;
! 		
! external
  
  \ read registry key value string 'vadr,vlen'
  \ from            section string 'sadr,slen'
! \ return             data string 'dadr,dlen'
  
  \ sadr,slen = the registry key section string
  \ vadr,vlen = the registry key value string to read
  \ dadr,dlen = the registry key data string returned
! : RegGetString  { vadr vlen sadr slen \ regType -- dadr dlen }
                  ReturnedKey$ off                \ initially clear return buffer
  
!                 sadr slen RegGetKeyRead dup INVALID_HANDLE_VALUE =
!                 if   drop ReturnedKey$ count
!                      EXIT \ return on error, empty data
!                 then
! 
! 		dup 
! 		vadr
! 		&OF regType               \ we get it, but we don't need it
!                 ReturnedKey$ 1+
!                 MAXCOUNTED regLen !             \ init max length of string
!                 regLen          
! 		(RegQueryValue)
! 
!                 if   regLen @ 1- 0max ReturnedKey$ c! \ make counted string
!                 else ReturnedKey$ off \ return empty data on error
!                 then (RegCloseKey) drop
! 
! 		ReturnedKey$ count ;
! 
! internal
! 
! \ sadr,slen = the registry section to get the key of (for write accesss)
! \ return -1 if we could not get the key
! : RegGetKeyWrite { sadr slen \ section$ -- regkey }  \ read the key of a section
!                 MAXSTRING 2 + LocalAlloc: section$
! 		regBaseKey
! 		sadr slen section$ BuildSection
! 		regAccessMask (RegCreateKey) ;
! 
! external
  
  \ Write to the registry, a key value string 'vadr,vlen'
  \ in                         section string 'sadr,slen'
  \ the                           data string 'dadr,dlen'
  : RegSetString  { dadr dlen vadr vlen sadr slen \ val$ khdl -- }
! 
!                 sadr slen RegGetKeyWrite to khdl
!                 khdl INVALID_HANDLE_VALUE =
!                 if exit then \ just return, ignore error
! 
!                 dlen 2 + LocalAlloc: val$    \ allocate a dynamic string
                  dadr dlen val$ place
                            val$ +NULL
! 
! 		khdl
! 		vadr
!                 REG_SZ                       \ type
!                 val$ 1+                      \ null terminated data string
!                 dlen 1+                      \ data length including NULL
! 		(RegSetValue) drop
! 
!                 khdl (RegCloseKey) drop ;
  
  : SetSetting    ( a1 n1 a2 n2 -- )      \ a1,n1=value string, a2,n2=key string
***************
*** 134,147 ****
                  s" Settings" RegGetString ;
  
! : .registry     ( -- )
!                 cr ." Console location:" s" Console"   GetSetting type ;
  
! : re-register   ( -- )  \ DEPRECATED
!                 .registry ;
  
  INTERNAL
  
! :noname         ( -- ) \ write the current version into the registry
!                        \ needed by the w32fConsole.dll to find the right
                         \ place to read/write from/into the registry
                  s" Win32Forth" PROGREG place
--- 190,203 ----
                  s" Settings" RegGetString ;
  
! \ : .registry     ( -- ) \ DEPRECATED
! \                 cr ." Console location:" s" Console"   GetSetting type ;
  
! \ : re-register   ( -- ) \ DEPRECATED
! \                 .registry ;
  
  INTERNAL
  
! :noname         ( -- ) \ Write the current version into the registry.
!                        \ Needed by the w32fConsole.dll to find the right
                         \ place to read/write from/into the registry
                  s" Win32Forth" PROGREG place
***************
*** 172,173 ****
--- 228,230 ----
                  s" 5,9" s" WindowPosition" SetSetting ;
  
+