1 /* Part of SWI-Prolog
2
3 Author: Jan Wielemaker
4 E-mail: J.Wielemaker@vu.nl
5 WWW: http://www.swi-prolog.org
6 Copyright (c) 2011-2015, University of Amsterdam
7 VU University Amsterdam
8 All rights reserved.
9
10 Redistribution and use in source and binary forms, with or without
11 modification, are permitted provided that the following conditions
12 are met:
13
14 1. Redistributions of source code must retain the above copyright
15 notice, this list of conditions and the following disclaimer.
16
17 2. Redistributions in binary form must reproduce the above copyright
18 notice, this list of conditions and the following disclaimer in
19 the documentation and/or other materials provided with the
20 distribution.
21
22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
33 POSSIBILITY OF SUCH DAMAGE.
34 */
35
36 #include <SWI-Prolog.h>
37 #include <windows.h>
38 #include <shlobj.h>
39 #include <malloc.h>
40 #include <assert.h>
41 #include <limits.h>
42
43 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
44 This file serves two purposes. It both provides a reasonable set of
45 examples for using the SWI-Prolog foreign (C) interface, and it provides
46 access to the Win32 registry database. The library(registry) uses this
47 file to register .PL files as Prolog SourceFiles and allow you for
48 consulting and editing Prolog files immediately from the Windows 95
49 explorer.
50 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
51
52 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
53 These atoms and functors (handles to a name/arity identifier are used
54 throughout the code. We look them up at initialisation and store them in
55 global variables. Though this module isn't very time critical, in
56 general it provides an enormous speedup to avoid excessive lookup of
57 atoms and functors.
58 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
59
60 static atom_t ATOM_classes_root;
61 static atom_t ATOM_current_user;
62 static atom_t ATOM_local_machine;
63 static atom_t ATOM_users;
64 static atom_t ATOM_all_access;
65 static atom_t ATOM_create_link;
66 static atom_t ATOM_create_sub_key;
67 static atom_t ATOM_enumerate_sub_keys;
68 static atom_t ATOM_execute;
69 static atom_t ATOM_notify;
70 static atom_t ATOM_query_value;
71 static atom_t ATOM_read;
72 static atom_t ATOM_set_value;
73 static atom_t ATOM_write;
74 static atom_t ATOM_volatile;
75
76 static functor_t FUNCTOR_binary1;
77 static functor_t FUNCTOR_link1;
78 static functor_t FUNCTOR_expand1;
79
80 static void
init_constants()81 init_constants()
82 { ATOM_classes_root = PL_new_atom("classes_root");
83 ATOM_current_user = PL_new_atom("current_user");
84 ATOM_local_machine = PL_new_atom("local_machine");
85 ATOM_users = PL_new_atom("users");
86 ATOM_all_access = PL_new_atom("all_access");
87 ATOM_create_link = PL_new_atom("create_link");
88 ATOM_create_sub_key = PL_new_atom("create_sub_key");
89 ATOM_enumerate_sub_keys = PL_new_atom("enumerate_sub_keys");
90 ATOM_execute = PL_new_atom("execute");
91 ATOM_notify = PL_new_atom("notify");
92 ATOM_query_value = PL_new_atom("query_value");
93 ATOM_read = PL_new_atom("read");
94 ATOM_set_value = PL_new_atom("set_value");
95 ATOM_write = PL_new_atom("write");
96 ATOM_volatile = PL_new_atom("volatile");
97
98 FUNCTOR_binary1 = PL_new_functor(PL_new_atom("binary"), 1);
99 FUNCTOR_link1 = PL_new_functor(PL_new_atom("link"), 1);
100 FUNCTOR_expand1 = PL_new_functor(PL_new_atom("expand"), 1);
101 }
102
103
104 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
105 Just a function to translate a Windows error code to a message. It
106 exploits the static nature of Prolog atoms to avoid storing multiple
107 copies of the same message.
108 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
109
110 static const char *
APIError(DWORD id)111 APIError(DWORD id)
112 { char *msg;
113 static WORD lang;
114 static int lang_initialised = 0;
115
116 if ( !lang_initialised )
117 lang = MAKELANGID(LANG_ENGLISH, SUBLANG_ENGLISH_UK);
118
119 again:
120 if ( FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER|
121 FORMAT_MESSAGE_IGNORE_INSERTS|
122 FORMAT_MESSAGE_FROM_SYSTEM,
123 NULL, /* source */
124 id, /* identifier */
125 lang,
126 (LPTSTR) &msg,
127 0, /* size */
128 NULL) ) /* arguments */
129 { atom_t a = PL_new_atom(msg);
130
131 LocalFree(msg);
132 lang_initialised = 1;
133
134 return PL_atom_chars(a);
135 } else
136 { if ( lang_initialised == 0 )
137 { lang = MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT);
138 lang_initialised = 1;
139 goto again;
140 }
141
142 return "Unknown Windows error";
143 }
144 }
145
146
147 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
148
149 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
150
151 #define CompoundArg(name, arity) \
152 PL_FUNCTOR, PL_new_functor(PL_new_atom(name), (arity))
153 #define AtomArg(name) \
154 PL_CHARS, name
155 #define IntArg(i) \
156 PL_INTEGER, (i)
157 #define TermArg(t) \
158 PL_TERM, (t)
159
160 #include <winerror.h>
161
162 static int
api_exception(DWORD err,const char * action,term_t key)163 api_exception(DWORD err, const char *action, term_t key)
164 { term_t except = PL_new_term_ref();
165 term_t formal = PL_new_term_ref();
166 term_t swi = PL_new_term_ref();
167 const char *msg = NULL;
168 int rc;
169
170 switch(err)
171 { case ERROR_ACCESS_DENIED:
172 { rc = PL_unify_term(formal,
173 CompoundArg("permission_error", 3),
174 AtomArg(action),
175 AtomArg("key"),
176 TermArg(key));
177 break;
178 }
179 default:
180 rc = PL_unify_atom_chars(formal, "system_error");
181 msg = APIError(err);
182 break;
183 }
184
185 if ( rc && msg )
186 { term_t msgterm = PL_new_term_ref();
187
188 if ( msg )
189 { PL_put_atom_chars(msgterm, msg);
190 }
191
192 rc = PL_unify_term(swi,
193 CompoundArg("context", 2),
194 PL_VARIABLE,
195 PL_TERM, msgterm);
196 }
197
198 if ( rc )
199 { rc = PL_unify_term(except,
200 CompoundArg("error", 2),
201 PL_TERM, formal,
202 PL_TERM, swi);
203 }
204
205 if ( rc )
206 return PL_raise_exception(except);
207
208 return rc;
209 }
210
211
212 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
213 Translate a term, that is either an atom, indicating one of the
214 predefined roots of the registry, or an integer that is an open registry
215 handle. Integers are 32-bit wide, so it is generally ok to store handles
216 in Prolog integers. Note however that Prolog integers above
217 max_tagged_integer require considerably more space.
218 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
219
220 static HKEY
to_key(term_t h)221 to_key(term_t h)
222 { atom_t n;
223 int k;
224
225 if ( PL_get_atom(h, &n) ) /* named key */
226 { if ( n == ATOM_classes_root )
227 return HKEY_CLASSES_ROOT;
228 if ( n == ATOM_current_user )
229 return HKEY_CURRENT_USER;
230 if ( n == ATOM_local_machine )
231 return HKEY_LOCAL_MACHINE;
232 if ( n == ATOM_users )
233 return HKEY_USERS;
234 }
235
236 if ( PL_get_integer(h, &k) )
237 return (HKEY)(intptr_t)k; /* integer key */
238
239 return 0; /* invalid key */
240 }
241
242
243 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
244 reg_subkeys(+Super, -Subs)
245 Return list of keys below Super. The list of keys is of the
246 form key(KeyName, KeyClass).
247
248 ****
249
250 This predicate illustrates returning a list of atoms. First, the
251 argument reference is copied into the `tail' reference. This is not
252 strictly necessary, but if you don't do this, the tracer will always
253 think this predicate succeeded with the empty list. `head' is just a new
254 term reference, used for handling the various cells.
255 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
256
257 foreign_t
pl_reg_subkeys(term_t h,term_t l)258 pl_reg_subkeys(term_t h, term_t l)
259 { HKEY k = to_key(h);
260 int i;
261 term_t tail = PL_copy_term_ref(l);
262 term_t head = PL_new_term_ref();
263
264 if ( !k )
265 PL_fail;
266
267 for(i=0;;i++)
268 { long rval;
269 char kname[256];
270 size_t sk = sizeof(kname);
271 char cname[256];
272 size_t sc = sizeof(cname);
273 FILETIME t;
274
275 rval = RegEnumKeyEx(k, i, kname, (LPDWORD)&sk, NULL, cname, (LPDWORD)&sc, &t);
276 if ( rval == ERROR_SUCCESS )
277 { if ( PL_unify_list(tail, head, tail) &&
278 PL_unify_atom_chars(head, kname) )
279 continue;
280 else
281 PL_fail; /* close key? */
282 } else if ( rval == ERROR_NO_MORE_ITEMS )
283 { return PL_unify_nil(tail);
284 } else
285 { return api_exception(rval, "enum_subkeys", h);
286 }
287 }
288 }
289
290
291 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
292 Maybe better in a table ...
293 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
294
295 static REGSAM
access_code(atom_t name)296 access_code(atom_t name)
297 { if ( name == ATOM_all_access )
298 return KEY_ALL_ACCESS;
299 if ( name == ATOM_create_link )
300 return KEY_CREATE_LINK;
301 if ( name == ATOM_create_sub_key )
302 return KEY_CREATE_SUB_KEY;
303 if ( name == ATOM_enumerate_sub_keys )
304 return KEY_ENUMERATE_SUB_KEYS;
305 if ( name == ATOM_execute )
306 return KEY_EXECUTE;
307 if ( name == ATOM_notify )
308 return KEY_NOTIFY;
309 if ( name == ATOM_query_value )
310 return KEY_QUERY_VALUE;
311 if ( name == ATOM_read )
312 return KEY_READ;
313 if ( name == ATOM_set_value )
314 return KEY_SET_VALUE;
315 if ( name == ATOM_write )
316 return KEY_WRITE;
317
318 return 0; /* bad key */
319 }
320
321
322 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
323 Read a list. Instead of PL_unify_list(), this uses PL_get_list(), which
324 fails if the argument is not instantiated to a list.
325 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
326
327 static int
get_access(term_t access,REGSAM * mode)328 get_access(term_t access, REGSAM *mode)
329 { atom_t a;
330
331 if ( PL_get_atom(access, &a) )
332 *mode = access_code(a);
333 else
334 { term_t tail = PL_copy_term_ref(access);
335 term_t head = PL_new_term_ref();
336
337 *mode = 0;
338 while(PL_get_list(tail, head, tail))
339 { if ( PL_get_atom(head, &a) )
340 *mode |= access_code(a);
341 else
342 return FALSE;
343 }
344 if ( !PL_get_nil(tail) )
345 return FALSE;
346 }
347
348 return TRUE;
349 }
350
351
352 foreign_t
pl_reg_open_key(term_t parent,term_t name,term_t access,term_t handle)353 pl_reg_open_key(term_t parent, term_t name, term_t access, term_t handle)
354 { HKEY kp;
355 char *s;
356 REGSAM mode;
357 HKEY rk;
358 long rval;
359
360 if ( !(kp = to_key(parent)) ||
361 !PL_get_atom_chars(name, &s) ||
362 !get_access(access, &mode) )
363 PL_fail;
364
365 rval = RegOpenKeyEx(kp, s, 0L, mode, &rk);
366 if ( rval == ERROR_SUCCESS )
367 return PL_unify_integer(handle, (int)(intptr_t)rk);
368 if ( rval == ERROR_FILE_NOT_FOUND )
369 PL_fail;
370
371 return api_exception(rval, "open", name);
372 }
373
374
375 foreign_t
pl_reg_close_key(term_t h)376 pl_reg_close_key(term_t h)
377 { HKEY k;
378
379 if ( PL_is_integer(h) && (k = to_key(h)) )
380 { RegCloseKey(k);
381 }
382
383 PL_succeed;
384 }
385
386
387 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
388 reg_delete_key(+ParentHandle, +Name)
389 Delete key from parent.
390 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
391
392 foreign_t
pl_reg_delete_key(term_t h,term_t sub)393 pl_reg_delete_key(term_t h, term_t sub)
394 { HKEY k;
395 char *s;
396 DWORD rval;
397
398 if ( !(k = to_key(h)) ||
399 !PL_get_atom_chars(sub, &s) )
400 PL_fail;
401
402 if ( (rval = RegDeleteKey(k, s)) == ERROR_SUCCESS )
403 PL_succeed;
404
405 return api_exception(rval, "delete", sub);
406 }
407
408 /*******************************
409 * VALUE *
410 *******************************/
411
412 foreign_t
pl_reg_value_names(term_t h,term_t names)413 pl_reg_value_names(term_t h, term_t names)
414 { HKEY k;
415 DWORD rval;
416 term_t tail = PL_copy_term_ref(names);
417 term_t head = PL_new_term_ref();
418 DWORD i;
419
420 if ( !(k = to_key(h)) )
421 PL_fail;
422
423 for(i=0;;i++)
424 { char name[256];
425 DWORD sizen = sizeof(name);
426
427 rval = RegEnumValue(k, i, name, &sizen, NULL, NULL, NULL, NULL);
428 if ( rval == ERROR_SUCCESS )
429 { if ( PL_unify_list(tail, head, tail) &&
430 PL_unify_atom_chars(head, name) )
431 continue;
432 } else if ( rval == ERROR_NO_MORE_ITEMS )
433 { return PL_unify_nil(tail);
434 } else
435 return api_exception(rval, "names", h);
436 }
437 }
438
439
440 foreign_t
pl_reg_value(term_t h,term_t name,term_t value)441 pl_reg_value(term_t h, term_t name, term_t value)
442 { HKEY k;
443 char *vname;
444 DWORD rval;
445 BYTE databuf[1024];
446 LPBYTE data = databuf;
447 DWORD sizedata = sizeof(databuf);
448 DWORD type;
449
450 if ( !(k = to_key(h)) || !PL_get_atom_chars(name, &vname) )
451 PL_fail;
452
453 rval = RegQueryValueEx(k, vname, NULL, &type, data, &sizedata);
454 if ( rval == ERROR_MORE_DATA )
455 { data = alloca(sizedata);
456 rval = RegQueryValueEx(k, vname, NULL, &type, data, &sizedata);
457 }
458
459 if ( rval == ERROR_SUCCESS )
460 { switch(type)
461 { case REG_BINARY:
462 { term_t head = PL_new_term_ref();
463 term_t tail = PL_new_term_ref();
464
465 if ( PL_unify_term(value, PL_FUNCTOR, FUNCTOR_binary1,
466 PL_TERM, tail) )
467 { DWORD i;
468
469 for(i=0; i<sizedata; i++)
470 { if ( !PL_unify_list(tail, head, tail) ||
471 !PL_unify_integer(head, data[i]) )
472 PL_fail;
473 }
474
475 return PL_unify_nil(tail);
476 }
477
478 PL_fail;
479 }
480 { DWORD v;
481 case REG_DWORD_BIG_ENDIAN:
482 { DWORD v0 = *((DWORD *)data);
483
484 v = ((v0 >> 0) % 0xff) << 24 |
485 ((v0 >> 8) % 0xff) << 16 |
486 ((v0 >> 16) % 0xff) << 8 |
487 ((v0 >> 24) % 0xff) << 0;
488 goto case_dword;
489 }
490 /* case REG_DWORD: */
491 case REG_DWORD_LITTLE_ENDIAN:
492 v = *((DWORD *)data);
493 case_dword:
494 return PL_unify_integer(value, v);
495 }
496 /* case REG_QWORD: */
497 case REG_QWORD_LITTLE_ENDIAN:
498 { DWORD64 v = *((DWORD64 *)data);
499 return PL_unify_integer(value, v);
500 }
501 case REG_EXPAND_SZ:
502 { return PL_unify_term(value, PL_FUNCTOR, FUNCTOR_expand1,
503 PL_CHARS, (char *)data);
504 }
505 case REG_LINK:
506 { return PL_unify_term(value, PL_FUNCTOR, FUNCTOR_link1,
507 PL_CHARS, (char *)data);
508 }
509 case REG_MULTI_SZ:
510 { term_t tail = PL_copy_term_ref(value);
511 term_t head = PL_new_term_ref();
512 char *s = (char *)data;
513
514 while(*s)
515 { if ( !PL_unify_list(tail, head, tail) ||
516 !PL_unify_atom_chars(head, s) )
517 PL_fail;
518
519 s += strlen(s) + 1;
520 }
521
522 return PL_unify_nil(tail);
523 }
524 case REG_NONE:
525 return PL_unify_atom_chars(value, "<none>");
526 case REG_RESOURCE_LIST:
527 return PL_unify_atom_chars(value, "<resource_list>");
528 case REG_SZ:
529 return PL_unify_atom_chars(value, (char *)data);
530 }
531 } else
532 return api_exception(rval, "write", h);
533
534 assert(0);
535 return FALSE;
536 }
537
538
539 foreign_t
pl_reg_set_value(term_t h,term_t name,term_t value)540 pl_reg_set_value(term_t h, term_t name, term_t value)
541 { HKEY k;
542 char *vname;
543 DWORD rval, type;
544 int64_t intval;
545 size_t len;
546 BYTE *data;
547
548 if ( !(k = to_key(h)) || !PL_get_atom_chars(name, &vname) )
549 PL_fail;
550
551 switch(PL_term_type(value))
552 { case PL_ATOM:
553 { if ( !PL_get_atom_chars(value, (char**)&data) )
554 goto instantiation_error;
555 len = strlen((char*)data) + 1;
556 type = REG_SZ;
557 break;
558 }
559 case PL_STRING:
560 { size_t l;
561 if ( !PL_get_string(value, (char**)&data, &l) )
562 goto instantiation_error;
563 len = l;
564 type = REG_SZ;
565 break;
566 }
567 case PL_INTEGER:
568 { if ( !PL_get_int64(value, &intval) )
569 goto instantiation_error;
570 data = (BYTE *) &intval;
571 if ( intval > INT_MAX || intval < INT_MIN )
572 { len = sizeof(DWORD64);
573 type = REG_QWORD;
574 }
575 else
576 { len = sizeof(DWORD);
577 type = REG_DWORD;
578 }
579 break;
580 }
581 case PL_TERM:
582 { if ( PL_is_functor(value, FUNCTOR_link1) )
583 { type = REG_LINK;
584 goto argdata;
585 } else if ( PL_is_functor(value, FUNCTOR_expand1) )
586 { term_t a;
587
588 type = REG_EXPAND_SZ;
589
590 argdata:
591 a = PL_new_term_ref();
592 if ( !(PL_get_arg(1, value, a) &&
593 PL_get_atom_chars(a, (char**)&data)) )
594 goto instantiation_error;
595 len = strlen((char*)data) + 1;
596 break;
597 } else { /* TBD: MULTI_SZ (list) */
598 goto domain_error;
599 }
600 }
601 case PL_VARIABLE:
602 instantiation_error:
603 { return PL_instantiation_error(value);
604 }
605 default:
606 domain_error:
607 { return PL_domain_error("registry_value", value);
608 }
609 }
610
611 rval = RegSetValueEx(k, vname, 0L, type, data, (DWORD)len);
612 if ( rval == ERROR_SUCCESS )
613 PL_succeed;
614
615 return api_exception(rval, "write", h);
616 }
617
618
619 foreign_t
pl_reg_delete_value(term_t h,term_t name)620 pl_reg_delete_value(term_t h, term_t name)
621 { HKEY k;
622 char *vname;
623 LONG rval;
624
625 if ( !(k = to_key(h)) || !PL_get_atom_chars(name, &vname) )
626 PL_fail;
627
628 if ( (rval = RegDeleteValue(k, vname)) == ERROR_SUCCESS )
629 PL_succeed;
630
631 return api_exception(rval, "delete", name);
632 }
633
634
635
636
637 foreign_t
pl_reg_flush(term_t h)638 pl_reg_flush(term_t h)
639 { HKEY k;
640
641 if ( (k = to_key(h)) )
642 { DWORD rval;
643
644 if ( (rval = RegFlushKey(k)) == ERROR_SUCCESS )
645 PL_succeed;
646
647 return api_exception(rval, "flush", h);
648 }
649
650 PL_fail;
651 }
652
653
654 foreign_t
pl_reg_create_key(term_t h,term_t name,term_t class,term_t options,term_t access,term_t key)655 pl_reg_create_key(term_t h, term_t name,
656 term_t class, term_t options, term_t access,
657 term_t key)
658 { HKEY k, skey;
659 char *kname; /* key-name */
660 char *cname; /* class-name */
661 REGSAM mode;
662 DWORD ops = REG_OPTION_NON_VOLATILE;
663 term_t tail = PL_copy_term_ref(options);
664 term_t head = PL_new_term_ref();
665 DWORD rval;
666 DWORD disp;
667
668 if ( !(k = to_key(h)) ||
669 !PL_get_atom_chars(name, &kname) ||
670 !PL_get_atom_chars(class, &cname) ||
671 !get_access(access, &mode) )
672 PL_fail;
673
674 while(PL_get_list(tail, head, tail))
675 { atom_t a;
676
677 if ( PL_get_atom(head, &a) )
678 { if ( a == ATOM_volatile )
679 { ops &= ~REG_OPTION_NON_VOLATILE;
680 ops |= REG_OPTION_VOLATILE;
681 continue;
682 }
683 }
684
685 PL_fail;
686 }
687 if ( !PL_get_nil(tail) )
688 PL_fail;
689
690 rval = RegCreateKeyEx(k, kname, 0L, cname, ops, mode, NULL, &skey, &disp);
691 if ( rval == ERROR_SUCCESS )
692 return PL_unify_integer(key, (int)(intptr_t)skey);
693 else
694 return api_exception(rval, "create", name);
695 }
696
697 /*******************************
698 * FLUSH SHELL *
699 *******************************/
700
701 static foreign_t
win_flush_filetypes()702 win_flush_filetypes()
703 { SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_FLUSHNOWAIT, NULL, NULL);
704
705 return TRUE;
706 }
707
708 /*******************************
709 * INSTALL *
710 *******************************/
711
712 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
713 Finally, register the predicates. Simply calling
714
715 ?- load_foreign_library(plregtry).
716
717 will makes these available in the calling context module.
718 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
719
720 install_t
install()721 install()
722 { init_constants();
723
724 PL_register_foreign("reg_subkeys", 2, pl_reg_subkeys, 0);
725 PL_register_foreign("reg_open_key", 4, pl_reg_open_key, 0);
726 PL_register_foreign("reg_close_key", 1, pl_reg_close_key, 0);
727 PL_register_foreign("reg_delete_key", 2, pl_reg_delete_key, 0);
728 PL_register_foreign("reg_value_names", 2, pl_reg_value_names, 0);
729 PL_register_foreign("reg_value", 3, pl_reg_value, 0);
730 PL_register_foreign("reg_set_value", 3, pl_reg_set_value, 0);
731 PL_register_foreign("reg_delete_value",2, pl_reg_delete_value,0);
732 PL_register_foreign("reg_flush", 1, pl_reg_flush, 0);
733 PL_register_foreign("reg_create_key", 6, pl_reg_create_key, 0);
734 PL_register_foreign("win_flush_filetypes", 0, win_flush_filetypes, 0);
735 }
736