{$LONGSTRINGS ON}
UNIT xFileName;

INTERFACE

type
  tChars=set of Char;

{ Возвращает TRUE если файл с именем f
1) существует или 2) может быть создан.}
function ValidFileName(const f:String):boolean;


{ Возвращает укороченное до ~Size символов имя файла в форме
"C:\Path...\Name.Ext".}
function FileNameShorten(const f:String; Size:integer):string;
function StrShorten(const s:String; Size:integer):string;

function FileNameGetPath(const f:String):String;
function FileNameTruncatePath(const f:String):String;

function FileNameGetExtension(const f:String):String;
function FileNameTruncateExtension(const f:string):string;

function FileNameGetName(const f:String):String;

function ReplSlashToBackSlash(const f:String):String;

IMPLEMENTATION
USES Windows, SysUtils, xStrScan;

function StrShorten;
  var ms:integer;
begin
  if (Size>=Length(s)) or (Size<=0) then begin
    Result:=s;
  end else begin
    if (Size>16) then begin
      Size:=Size-5;
      ms:=Size div 2;
      Result:=Copy(s,1,Size-ms)+' ... '+Copy(s,Length(s)-ms,ms);
    end else begin
      Result:=Copy(s,1,Size);
    end;
  end;
end;

function FileNameShorten;
  var ms,fnl:integer; fn:string;
begin
  if (Size>=Length(f)) or (Size<=0) then begin
    Result:=f;
  end else begin
    fn:=FileNameTruncatePath(f);
    fnl:=Length(fn);
    if fnl<(Size-10) then begin
      Size:=Size-5;
      ms:=(Size-fnl);
      Result:=Copy(f,1,ms)+' ...\'+fn;
    end else if Size>25 then begin
      Result:=Copy(f,1,7)+' ...\'+StrShorten(fn,Size-5-7);
    end else begin
      Result:=StrShorten(fn,Size);
    end;
  end;
end;

const
  cDelimiters=['.','\',':'];

function ScanBack(const f:AnsiString; const CharSet:tChars):integer;
begin
  Result:=Length(f);
  while (Result>0) and not (f[Result] in CharSet) do begin
    Dec(Result);
  end;
end;

function ScanExtDlm(const f:AnsiString):integer;
begin
  Result:=ScanBack(f,['.','\',':']);
end;

function ScanPathDlm(const f:AnsiString):integer;
begin
  Result:=ScanBack(f,['\',':']);
end;

function FileNameGetPath;
  var i:integer;
begin
  i:=ScanPathDlm(f);
  if (i>0) then Result:=Copy(f,1,i) else Result:='';
end;

function FileNameTruncatePath;
  var i:integer;
begin
  i:=ScanPathDlm(f);
  if (i>0) then Result:=Copy(f,i+1,Length(f)) else Result:=f;
end;

function FileNameGetName;
begin
  Result:=(FileNameTruncateExtension(FileNameTruncatePath(f)));
end;

function FileNameTruncateExtension;
  var i:integer;
begin
  i:=ScanExtDlm(f);
  if (i>0) and (f[i]='.') then Result:=Copy(f,1,i-1) else Result:=f;
end;

function FileNameGetExtension;
  var i:integer;
begin
  i:=ScanExtDlm(f);
  if (i>0) and (f[i]='.') then Result:=Copy(f,i,Length(f)) else Result:='';
end;


function ValidFileName;
  var h:integer;
begin
  Result:=FileExists(f);
  if not Result then begin
    h:=CreateFile(PChar(f), GENERIC_WRITE,0, NIL,
               CREATE_NEW,FILE_ATTRIBUTE_NORMAL, 0);
    Result:=h>0;
    if Result then begin
      CloseHandle(h);
      DeleteFile(f);
    end;
  end;
(*
HANDLE CreateFile(
    LPCTSTR  lpFileName,// address of name of the file
    DWORD  dwDesiredAccess,// access (read-write) mode
    DWORD  dwShareMode,	// share mode
    LPSECURITY_ATTRIBUTES  lpSecurityAttributes,// address of security descriptor
    DWORD  dwCreationDistribution,// how to create
    DWORD  dwFlagsAndAttributes,// file attributes
    HANDLE  hTemplateFile // handle of file with attributes to copy
   );  end;*)
end;

function ReplSlashToBackSlash;
  var i:integer;
begin
  Result:=f;
  for i:=1 to Length(f) do if f[i]='/' then Result[i]:='\';
end;

END.