Функции для преобразования коротких и длинных имён файлов

Автор: Bjarne Winkler

Компилятор: Delphi (все версии)

Следующие три функции помогут преобразовать длинные имена файлов в коротки и наоборот. Функция Mince служит для отображения полного имени файла, включая путь.

{=========================================================}
Function Mince(PathToMince: String; InSpace: Integer): String;
{=========================================================}
// "C:\Program Files\Delphi\DDrop\TargetDemo\main.pas"
// "C:\Program Files\..\main.pas"
Var
  sl: TStringList;
  sHelp, sFile: String;
  iPos: Integer;

Begin
  sHelp := PathToMince;
  iPos := Pos('\', sHelp);
  If iPos = 0 Then
  Begin
    Result := PathToMince;
  End
  Else
  Begin
    sl := TStringList.Create;
    // Decode string
    While iPos <> 0 Do
    Begin
      sl.Add(Copy(sHelp, 1, (iPos - 1)));
      sHelp := Copy(sHelp, (iPos + 1), Length(sHelp));
      iPos := Pos('\', sHelp);
    End;
    If sHelp <> '' Then
    Begin
      sl.Add(sHelp);
    End;
    // Encode string
    sFile := sl[sl.Count - 1];
    sl.Delete(sl.Count - 1);
    Result := '';
    While (Length(Result + sFile) < InSpace) And (sl.Count <> 0) Do
    Begin
      Result := Result + sl[0] + '\';
      sl.Delete(0);
    End;
    If sl.Count = 0 Then
    Begin
      Result := Result + sFile;
    End
    Else
    Begin
      Result := Result + '..\' + sFile;
    End;
    sl.Free;
  End;
End;

{===================================================}
Function ShortFileName(Const FileName: String): String;
{===================================================}
Var
  aTmp: Array[0..255] Of Char;

Begin
  If Not FileExists(FileName) Then
  Begin
    Result := '';
  End
  Else
  Begin
    If GetShortPathName(PChar (FileName), aTmp, Sizeof (aTmp) - 1) = 0 Then
    Begin
      Result:= FileName;
    End
    Else
    Begin
      Result:= StrPas (aTmp);
    End;
  End;
End;

{==============================================}
Function LongFileName(ShortName: String): String;
{==============================================}
Var
  SR: TSearchRec;

Begin
  Result := '';
  If (pos ('\\', ShortName) + pos ('*', ShortName) +
      pos ('?', ShortName) <> 0) Or Not FileExists(ShortName) Then
  Begin
    { ignore NetBIOS name, joker chars and invalid file names }
    Exit;
  End;
  While FindFirst(ShortName, faAnyFile, SR) = 0 Do
  Begin
    { next part as prefix }
    Result := '\' + SR.Name + Result;
    SysUtils.FindClose(SR);  { the SysUtils, not the WinProcs procedure! }
    { directory up (cut before '\') }
    ShortName := ExtractFileDir (ShortName);
    If length (ShortName) <= 2 Then
    Begin
      Break;  { ShortName contains drive letter followed by ':' }
    End;
  End;
  Result := ExtractFileDrive (ShortName) + Result;
end;