Merged revisions 714-715 via svnmerge from

/trunk

git-svn-id: branches/fixes_2_0@716 -

rtl/objpas/sysutils/fina.inc

@@ -101,13 +101,18 @@ Begin
 {$endif}
 end;
 
+
+{$ifndef HASEXPANDUNCFILENAME}
 function ExpandUNCFileName (Const FileName : string): String;
 begin
   Result:=ExpandFileName (FileName);
   //!! Here should follow code to replace the drive: part with UNC...
 end;
+{$endif HASEXPANDUNCFILENAME}
+
 
-Const MaxDirs = 129;
+Const
+  MaxDirs = 129;
 
 function ExtractRelativepath (Const BaseName,DestName : String): String;
 

rtl/win32/sysutils.pp

@@ -55,6 +55,7 @@ implementation
     sysconst;
 
 {$define HASCREATEGUID}
+{$define HASEXPANDUNCFILENAME}
 
 { Include platform independent implementation part }
 {$i sysutils.inc}
@@ -69,6 +70,41 @@ begin
 end;
 
 
+function ExpandUNCFileName (const filename:string) : string;
+{ returns empty string on errors }
+var
+  s    : ansistring;
+  size : dword;
+  rc   : dword;
+  p,buf : pchar;
+begin
+  s := ExpandFileName (filename);
+
+  s := s + #0;
+
+  size := max_path;
+  getmem(buf,size);
+
+  try
+    rc := WNetGetUniversalName (pchar(s), UNIVERSAL_NAME_INFO_LEVEL, buf, @size);
+
+    if rc=ERROR_MORE_DATA then
+      begin
+        buf:=reallocmem(buf,size);
+        rc := WNetGetUniversalName (pchar(s), UNIVERSAL_NAME_INFO_LEVEL, buf, @size);
+      end;
+    if rc = NO_ERROR then
+      Result := PRemoteNameInfo(buf)^.lpUniversalName
+    else if rc = ERROR_NOT_CONNECTED then
+      Result := filename
+    else
+      Result := '';
+  finally
+    freemem(buf);
+  end;
+end;
+
+
 {****************************************************************************
                               File Functions
 ****************************************************************************}