Как преобразовать длинный путь к файлу в короткий

function GetShortName(sLongName: string): string;
var
  sShortName    : string;
  nShortNameLen : integer;
begin
  SetLength(sShortName, MAX_PATH);
  nShortNameLen := GetShortPathName(
    PChar(sLongName), PChar(sShortName),
    MAX_PATH - 1);
  if (0 = nShortNameLen) then
  begin
    // Обработчик ошибок...
  end;
  SetLength(sShortName, nShortNameLen);
  Result := sShortName;
end;

Использование:

procedure TForm1.Button1Click(Sender: TObject);
var
  s: string;
begin
  s:= GetShortName('C:\Program Files\Common Files');
  ShowMessage(s);
end;

Функция GetLongName делает обратное преобразование короткого имени в длинное:

function __GetLongName(
    sShortName: string; var bError : boolean): string;
var
  bAddSlash : boolean;
  SearchRec : TSearchRec;
  nStrLen   : integer;
begin
  bError    := False;
  Result    := sShortName;
  nStrLen   := Length(sShortName);
  bAddSlash := False;

  if('\' = sShortName[nStrLen]) then
  begin
    bAddSlash := True;
    SetLength(sShortName, nStrLen - 1);
    dec(nStrLen);
  end;

  if (nStrLen - Length(ExtractFileDrive(sShortName))) > 0 then
  begin
    if 0 = FindFirst(sShortName, faAnyFile, SearchRec) then
    begin
      Result := ExtractFilePath(sShortName) + SearchRec.Name;
      if bAddSlash then
      begin
        Result := Result + '\';
      end;
    end
    else
    begin
      // Обработчик ошибок...
      bError := True;
    end;
    FindClose(SearchRec);
  end;
end;

function GetLongName(sShortName: string): string;
var
  s      : string;
  p      : integer;
  bError : boolean;
begin
  Result := sShortName;

  s := '';
  p := Pos('\', sShortName);
  while p > 0 do
  begin
    s := __GetLongName(s + Copy(sShortName, 1, p), bError);
    Delete(sShortName, 1, p);
    p := Pos('\', sShortName);

    if bError then
      Exit;
  end;
  if '' <> sShortName then
  begin
    s := __GetLongName(s + sShortName, bError);
    if bError then
      Exit;
  end;
  Result := s;
end;

Использование:

procedure TForm1.Button1Click(Sender: TObject);
var
  s: string;
begin
  s:= GetShortName('C:\Program Files\Common Files');
  s:= GetLongName(s);
  ShowMessage(s);
end;