Ver Mensaje Individual
  #2  
Antiguo 19-08-2005
Avatar de roman
roman roman is offline
Moderador
 
Registrado: may 2003
Ubicación: Ciudad de México
Posts: 20.269
Reputación: 10
roman Es un diamante en brutoroman Es un diamante en brutoroman Es un diamante en bruto
Te pongo una rutinas para manejar mapeos que usé hace algún tiempo. Espero te sean de utilidad.


Código Delphi [-]
{
  Determina si una unidad lógica está disponible o no
}
function DriveAvailable(Drive: Char): Boolean;
var
  DriveType: Cardinal;

begin
  DriveType := GetDriveType(PChar(String(Drive) + ':'));
  Result := DriveType in [DRIVE_NO_ROOT_DIR, DRIVE_REMOTE];
end;

{
  Devuelve la ruta de red asignada a una unidad lógica
}
function GetConnection(Drive: Char): String;
var
  Buffer: PChar;
  BufferLen: Cardinal;
  Code: Cardinal;

begin
  Buffer := nil;
  BufferLen := 0;

  Code := WNetGetConnection(PChar(String(Drive) + ':'), Buffer, BufferLen);
  if Code = ERROR_MORE_DATA then
  begin
    GetMem(Buffer, BufferLen);
    Code := WNetGetConnection(PChar(String(Drive) + ':'), Buffer, BufferLen);
  end;

  case Code of
    NO_ERROR: Result := Buffer;
    ERROR_NOT_CONNECTED: Result := '';
    ERROR_CONNECTION_UNAVAIL: Result := 'Connection is unavailable';
  else
    raise Exception.CreateFmt('Error reading information for drive %s:', [Drive]);
  end;

  if BufferLen <> 0 then FreeMem(Buffer);
end;

{
  Devuelve si una unidad lógica está redirigida o no
}
function IsMapped(Drive: Char): Boolean;
begin
  Result := GetConnection(Drive) <> '';
end;

{
  Devuelve si una ruta de red puede asignarse
  a una unidad lógica o no.
}
function IsMappable(Path: String): Boolean;
var
  ShFileInfo: TShFileInfo;

begin
  ShGetFileInfo(PChar(Path), 0, ShFileInfo, SizeOf(ShFileInfo), SHGFI_ATTRIBUTES);
  Result := ShFileInfo.dwAttributes and SFGAO_FILESYSTEM <> 0;
end;

{
  Redirige una unidad lógica a una ruta de red
}
procedure MapDrive(Drive: Char; NetPath: String; MakePermanent: Boolean);
var
  NetResource: TNetResource;
  Flags: Cardinal;
  Code: Cardinal;

begin
  NetResource.dwType := RESOURCETYPE_DISK;
  NetResource.lpLocalName := PChar(String(Drive) + ':');
  NetResource.lpRemoteName := PChar(NetPath);
  NetResource.lpProvider := nil;

  if MakePermanent
    then Flags := CONNECT_UPDATE_PROFILE
    else Flags := 0;

  Code := WNetAddConnection2(NetResource, nil, nil, Flags);
  if Code <> NO_ERROR then
    RaiseLastOSError;
end;

// Saludos
Responder Con Cita