From 2c30b7b1912b31dec86096aa532f91e1dd15ddc0 Mon Sep 17 00:00:00 2001
From: Xavier Leroy <xavier.leroy@inria.fr>
Date: Tue, 10 Apr 2001 11:15:05 +0000
Subject: Ajout de link pour W2K (L. Fourquaux)

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@3487 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
---
 otherlibs/win32unix/link.c | 41 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 41 insertions(+)
 create mode 100644 otherlibs/win32unix/link.c

(limited to 'otherlibs/win32unix/link.c')

diff --git a/otherlibs/win32unix/link.c b/otherlibs/win32unix/link.c
new file mode 100644
index 000000000..cc05646cb
--- /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;
+} 
-- 
cgit v1.2.3-70-g09d2