Browse Source

+ ExpandUNCFilename for win32 from Klaus Hartnegg

git-svn-id: trunk@714 -
florian 20 years ago
parent
commit
13299f521b
1 changed files with 36 additions and 0 deletions
  1. 36 0
      rtl/win32/sysutils.pp

+ 36 - 0
rtl/win32/sysutils.pp

@@ -55,6 +55,7 @@ implementation
     sysconst;
     sysconst;
 
 
 {$define HASCREATEGUID}
 {$define HASCREATEGUID}
+{$define HASEXPANDUNCFILENAME}
 
 
 { Include platform independent implementation part }
 { Include platform independent implementation part }
 {$i sysutils.inc}
 {$i sysutils.inc}
@@ -69,6 +70,41 @@ begin
 end;
 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
                               File Functions
 ****************************************************************************}
 ****************************************************************************}