Código: Seleccionar todo

unit UFileNameExtract;

{ Línea automática de Lazarus, eliminar si se usa Delphi }
{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils;

type

{ TNameExtract }

  TFileNameExtract = class(TObject)
  private
    FFullPath: String;
  protected
    function GetFullPath: String;
    function GetPath: String;
    function GetContainerFolder: String;
    function GetFileName: String;
    function GetFileNameNoExt: String;
    function GetExtension: String;
  public
    constructor Create(AFileName: String);
    destructor Destroy;

    property FullPath: String read GetFullPath;
    property Path: String read GetPath;
    property ContainerFolder: String read GetContainerFolder;
    property FileName: String read GetFileName;
    property FileNameNoExt: String read GetFileNameNoExt;
    property Extension: String read GetExtension;
  end;

implementation

{ TNameExtract }

function TFileNameExtract.GetFullPath: String;
begin
	Result := Self.FFullPath;
end;

function TFileNameExtract.GetPath: String;
{ Pre: el path nunca va a ser vacío, al menos debe tener "C:\" en Windows o "/" como root en Linux }
var
	I: Integer;
begin
  Result := '';
	I := Length(Self.FFullPath);
  { Por las dudas tomar en cuenta ambos delimitadores de carpetas }
  while (I > 0) and (Self.FFullPath[I] <> '\') and (Self.FFullPath[I] <> '/') do
  	Dec(I);
  { I en '\' }
  Result := Copy(Self.FFullPath, 1, I);
end;

function TFileNameExtract.GetContainerFolder: String;
var
	I, J: Integer;
begin
  Result := '';
	I := Length(Self.FFullPath);
  { Por las dudas tomar en cuenta ambos delimitadores de carpetas }
  while (I > 0) and (Self.FFullPath[I] <> '\') and (Self.FFullPath[I] <> '/') do
  	Dec(I);
  { I en '\' o '/' -> Buscar '\' o '/' anterior }
  if (I = 1) then
  begin
  	{ Caso root "/" -> Salir }
    Result := Self.FFullPath[I];
    Exit;
  end;

  J := I-1;
  while (J > 0) and (Self.FFullPath[J] <> '\') and (Self.FFullPath[J] <> '/') do
  	Dec(J);
	{ J en '\' }
  Result := Copy(Self.FFullPath, J+1, Length(Self.FFullPath) - J - (Length(Self.FFullPath) - I) - 1);
end;

function TFileNameExtract.GetFileName: String;
var
	I: Integer;
begin
  Result := '';
	I := Length(Self.FFullPath);
  { Por las dudas tomar en cuenta ambos delimitadores de carpetas }
  while (I > 0) and (Self.FFullPath[I] <> '\') and (Self.FFullPath[I] <> '/') do
  	Dec(I);
  { I en '\' o '/' }
  Result := Copy(Self.FFullPath, I+1, Length(Self.FFullPath) - I);
end;

function TFileNameExtract.GetFileNameNoExt: String;
var
	I, J: Integer;
begin
  Result := '';
	I := Length(Self.FFullPath);
  { Por las dudas tomar en cuenta ambos delimitadores de carpetas }
  while (I > 0) and (Self.FFullPath[I] <> '\') and (Self.FFullPath[I] <> '/') do
  	Dec(I);
  { I en '\' o '/' }
  J := Length(Self.FFullPath);
  while (J > 0) and (Self.FFullPath[J] <> '.') do
  	Dec(J);
 	{ J en '.' }
  if (J = 0) then
  	Result := Copy(Self.FFullPath, I + 1, Length(Self.FFullPath) - I )
  else
		Result := Copy(Self.FFullPath, I + 1, Length(Self.FFullPath) - I - (Length(Self.FFullPath) - J) - 1);
end;

function TFileNameExtract.GetExtension: String;
var
	I: Integer;
begin
	Result := '';
	I := Length(Self.FFullPath);
	while (I > 0) and not(Self.FFullPath[I] = '.') do
  	Dec(I);
  { I en '.' }
  if (I = 0) then //Archivo sin extensión
  	Result := ''
  else
  	Result := Copy(Self.FFullPath, I+1, Length(Self.FFullPath)-I);
end;

constructor TFileNameExtract.Create(AFileName: String);
begin
	{ La siguiente comprobación es innecesaria, pero se podría implementar }
	{if not(FileExists(AFileName)) then
  	raise	Exception.Create('El archivo no existe');}

  Self.FFullPath:=AFileName;

  inherited Create;
end;

destructor TFileNameExtract.Destroy;
begin
	Self.FFullPath:='';
  inherited Destroy;
end;

end.

Código: Seleccionar todo

procedure TForm1.Button1Click(Sender: TObject);
var
  MyFile: TFileNameExtract;
begin
  ListBox1.Items.BeginUpdate;
  ListBox1.Items.Clear;
  MyFile := TFileNameExtract.Create(Edit1.Text);
  with ListBox1.Items do
  begin
    Add('FullPath -> "' + MyFile.FullPath + '"');
    Add('Path -> "' + MyFile.Path + '"');
    Add('ContainerFolder -> "' + MyFile.ContainerFolder + '"');
    Add('FileName -> "' + MyFile.FileName + '"');
    Add('FileNameNoExt -> "' + MyFile.FileNameNoExt + '"');
    Add('Extension -> "' + MyFile.Extension + '"');
  end;
  MyFile.Destroy;
  ListBox1.Items.EndUpdate;
end;