Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/system/Basis/Implementation/Win32/windows-reg.sml
ViewVC logotype

Annotation of /sml/trunk/system/Basis/Implementation/Win32/windows-reg.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2933 - (view) (download)

1 : larsberg 2933 (* windows-reg.sml
2 :     *
3 :     * COPYRIGHT (c) 2008 Fellowship of SML/NJ
4 :     *
5 :     * Structure for windows registry access
6 :     *
7 :     *)
8 :    
9 :     local
10 :     structure SysWord = SysWordImp
11 :     structure Key = Windows_KEY
12 :     structure String = StringImp
13 :     in
14 :     structure Windows_REG : WINDOWS_REG = struct
15 :     type hkey = SysWord.word
16 :    
17 :     val classesRoot = 0wx80000000 : Word32.word
18 :     val currentUser = 0wx80000001 : Word32.word
19 :     val localMachine = 0wx80000002 : Word32.word
20 :     val users = 0wx80000003 : Word32.word
21 :     val performanceData = 0wx80000004 : Word32.word
22 :     val currentConfig = 0wx80000005 : Word32.word
23 :     val dynData = 0wx80000006 : Word32.word
24 :    
25 :     fun cfun x = CInterface.c_function "WIN32" x
26 :    
27 :     datatype create_result
28 :     = CREATED_NEW_KEY of hkey
29 :     | OPENED_EXISTING_KEY of hkey
30 :     val openKeyEx : hkey * string * Key.flags -> hkey = cfun "reg_open_key"
31 :     fun createKeyEx (key, name, flags) =
32 :     let
33 :     val createKey : (hkey * string * Key.flags) -> Word32.word = Unsafe.CInterface.c_function "WIN32" "reg_create_key"
34 :     in
35 :     case createKey(key, name, flags) of
36 :     0w1 => CREATED_NEW_KEY(openKeyEx(key, name, flags))
37 :     | 0w2 => OPENED_EXISTING_KEY(openKeyEx(key, name, flags))
38 :     | x => raise Fail ("Key creation failed in an unknown way.")
39 :     end
40 :     val closeKey : hkey -> unit = cfun "reg_close_key"
41 :     val deleteKey : hkey * string -> unit = cfun "reg_delete_key"
42 :     val deleteValue : hkey * string -> unit = cfun "reg_delete_value"
43 :     val enumKeyEx : hkey * int -> string option = cfun "reg_enum_key"
44 :     val enumValueEx : hkey * int -> string option = cfun "reg_enum_value"
45 :    
46 :     val queryValueType : (Word32.word * string) -> Word32.word = cfun "reg_query_value_type";
47 :     val queryValueString : (Word32.word * string) -> string = cfun "reg_query_value_string";
48 :     val queryValueMultiString : (Word32.word * string) -> string list = cfun "reg_query_value_multi_string";
49 :     val queryValueExpandString : (Word32.word * string) -> string = cfun "reg_query_value_expand_string";
50 :     val queryValueDword : (Word32.word * string) -> Word32.word = cfun "reg_query_value_dword";
51 :     val queryValueBinary : (Word32.word * string) -> Word8Vector.vector = cfun "reg_query_value_binary";
52 :     val setValueDword : (Word32.word * string * Word32.word) -> unit = cfun "reg_set_value_dword";
53 :     val setValueString : (Word32.word * string * string) -> unit = cfun "reg_set_value_string";
54 :     val setValueExpandString : (Word32.word * string * string) -> unit = cfun "reg_set_value_expand_string";
55 :     val setValueMultiString : (Word32.word * string * string list) -> unit = cfun "reg_set_value_multi_string";
56 :     val setValueBinary : (Word32.word * string * Word8Vector.vector) -> unit = cfun "reg_set_value_binary";
57 :    
58 :     datatype value
59 :     = SZ of string
60 :     | DWORD of SysWord.word
61 :     | BINARY of Word8Vector.vector
62 :     | MULTI_SZ of string list
63 :     | EXPAND_SZ of string
64 :    
65 :     (* val queryValueEx : hkey * string -> value option *)
66 :     fun queryValueEx (key, name) =
67 :     case queryValueType (key, name) of
68 :     0w1 => SOME (SZ (queryValueString(key, name)))
69 :     | 0w2 => SOME (EXPAND_SZ (queryValueExpandString(key, name)))
70 :     | 0w3 => SOME (BINARY (queryValueBinary(key, name)))
71 :     | 0w4 => SOME (DWORD (queryValueDword(key, name)))
72 :     | 0w7 => SOME (MULTI_SZ (rev(queryValueMultiString(key, name))))
73 :     | x => NONE
74 :    
75 :     (* val setValueEx : hkey * string * value -> unit *)
76 :     fun setValueEx (key, name, SZ(string)) =
77 :     setValueString(key, name, string)
78 :     | setValueEx (key, name, DWORD(dw)) =
79 :     setValueDword(key, name, dw)
80 :     | setValueEx (key, name, BINARY(bin)) =
81 :     setValueBinary(key, name, bin)
82 :     | setValueEx (key, name, MULTI_SZ(multi)) =
83 :     setValueMultiString(key, name, multi)
84 :     | setValueEx (key, name, EXPAND_SZ(expand)) =
85 :     setValueExpandString(key, name, expand)
86 :    
87 :     end
88 :     end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0