mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 11:39:40 +01:00 
			
		
		
		
	+ ExpandUNCFilename for win32 from Klaus Hartnegg
git-svn-id: trunk@714 -
This commit is contained in:
		
							parent
							
								
									e0488e169b
								
							
						
					
					
						commit
						13299f521b
					
				@ -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
 | 
			
		||||
****************************************************************************}
 | 
			
		||||
 | 
			
		||||
		Loading…
	
		Reference in New Issue
	
	Block a user