diff options
| author | Xavier Leroy <xavier.leroy@inria.fr> | 2001-04-10 11:15:05 +0000 |
|---|---|---|
| committer | Xavier Leroy <xavier.leroy@inria.fr> | 2001-04-10 11:15:05 +0000 |
| commit | 2c30b7b1912b31dec86096aa532f91e1dd15ddc0 (patch) | |
| tree | 46e4175c4692b68ceacd24ed317871e87f55284f | |
| parent | 7646d818a217e7c4019bb7b6f036ae1a597941af (diff) | |
| download | ocaml-2c30b7b1912b31dec86096aa532f91e1dd15ddc0.tar.gz | |
Ajout de link pour W2K (L. Fourquaux)
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@3487 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
| -rw-r--r-- | otherlibs/win32unix/Makefile.nt | 2 | ||||
| -rw-r--r-- | otherlibs/win32unix/link.c | 41 | ||||
| -rw-r--r-- | otherlibs/win32unix/unix.ml | 2 |
3 files changed, 43 insertions, 2 deletions
diff --git a/otherlibs/win32unix/Makefile.nt b/otherlibs/win32unix/Makefile.nt index e21cd1b1f6..f7931d27e5 100644 --- a/otherlibs/win32unix/Makefile.nt +++ b/otherlibs/win32unix/Makefile.nt @@ -24,7 +24,7 @@ CAMLOPT=..\..\boot\ocamlrun ..\..\ocamlopt -I ..\..\stdlib WIN_OBJS = accept.obj bind.obj channels.obj close.obj \ close_on.obj connect.obj createprocess.obj dup.obj dup2.obj \ getpeername.obj getpid.obj getsockname.obj gettimeofday.obj \ - listen.obj lseek.obj \ + link.obj listen.obj lseek.obj \ mkdir.obj open.obj pipe.obj read.obj select.obj sendrecv.obj \ shutdown.obj sleep.obj socket.obj sockopt.obj startup.obj system.obj \ unixsupport.obj windir.obj winwait.obj write.obj diff --git a/otherlibs/win32unix/link.c b/otherlibs/win32unix/link.c new file mode 100644 index 0000000000..cc05646cb7 --- /dev/null +++ b/otherlibs/win32unix/link.c @@ -0,0 +1,41 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* File contributed by Lionel Fourquaux */ +/* */ +/* Copyright 2001 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <windows.h> +#include <mlvalues.h> +#include <fail.h> +#include "unixsupport.h" + +typedef +BOOL (WINAPI *tCreateHardLink)( + LPCTSTR lpFileName, + LPCTSTR lpExistingFileName, + LPSECURITY_ATTRIBUTES lpSecurityAttributes +); + +value unix_link(value path1, value path2) /* ML */ +{ + HMODULE hModKernel32; + tCreateHardLink pCreateHardLink; + hModKernel32 = GetModuleHandle("KERNEL32.DLL"); + pCreateHardLink = + (tCreateHardLink) GetProcAddress(hModKernel32, "CreateHardLinkA"); + if (pCreateHardLink == NULL) + invalid_argument("Unix.link not implemented"); + if (! pCreateHardLink(String_val(path2), String_val(path1), NULL)) { + _dosmaperr(GetLastError()); + uerror("link", path2); + } + return Val_unit; +} diff --git a/otherlibs/win32unix/unix.ml b/otherlibs/win32unix/unix.ml index 25cc960ec3..1beaa96177 100644 --- a/otherlibs/win32unix/unix.ml +++ b/otherlibs/win32unix/unix.ml @@ -251,7 +251,7 @@ let fstat fd = invalid_arg "Unix.fstat not implemented" external unlink : string -> unit = "unix_unlink" external rename : string -> string -> unit = "unix_rename" -let link f1 f2 = invalid_arg "Unix.link not implemented" +external link : string -> string -> unit = "unix_link" (* File permissions and ownership *) |