comet/cometpath.pas

{
  Comet - Direct TCP File Transfer for FidoNet
  cometpath.pas - DOS/Linux/OS2/Windows path bridge

  This is the foundation unit for cross-platform file operations.
  Every file access in Comet goes through these routines.

  Handles:
  - Path separator normalization (\ vs /)
  - Drive letter mapping (C:\ = /home/user/dos/c/ on Unix)
  - Case-insensitive file lookup on case-sensitive filesystems
  - 8.3 filename awareness for BSO flow files and packets
  - .FLO file path translation (read DOS paths on Linux, vice versa)
  - Directory creation with full path building

  Platform support:
  - Linux/FreeBSD: IFDEF UNIX
  - DOS (DJGPP):   IFDEF GO32V2
  - OS/2:          IFDEF OS2
  - Windows:       IFDEF MSWINDOWS

  Copyright (C) 2026 Ken Johnson
  License: GPL-2.0
}
unit cometpath;

{$mode objfpc}{$H+}

interface

uses
  SysUtils, Classes;

const
  COMET_MAXPATH = 260;               { Maximum path length                  }
  COMET_MAXDRIVES = 26;              { Drive letters A-Z                    }

  { Platform-native path separator (compile-time) }
  {$IFDEF UNIX}
  COMET_PATHSEP = '/';
  COMET_OTHERSEP = '\';
  {$ELSE}
  COMET_PATHSEP = '\';
  COMET_OTHERSEP = '/';
  {$ENDIF}

type
  { Drive mapping entry: letter -> Unix path }
  TCometDriveMap = record
    Letter:   Char;                  { 'A'..'Z'                             }
    Path:     string;                { Unix equivalent, with trailing /      }
    Active:   Boolean;               { Mapping is configured                 }
  end;

  { Path classification }
  TCometPathType = (
    cptRelative,                     { No drive, no leading separator        }
    cptAbsoluteUnix,                 { Starts with /                         }
    cptAbsoluteDOS,                  { Starts with X:\                       }
    cptAbsoluteUNC                   { Starts with \\                        }
  );


{ ---- Drive Mapping ---- }

{ Set a drive mapping: DriveLetter 'C' -> '/home/ken/dos/c/' }
procedure CometSetDriveMap(DriveLetter: Char; const UnixPath: string);

{ Remove a drive mapping }
procedure CometClearDriveMap(DriveLetter: Char);

{ Clear all drive mappings }
procedure CometClearAllDriveMaps;

{ Get the Unix path for a drive letter, '' if not mapped }
function CometGetDriveMap(DriveLetter: Char): string;

{ Reverse lookup: given a Unix path, find which drive letter maps to it }
function CometReverseDriveMap(const UnixPath: string; out DriveLetter: Char): Boolean;


{ ---- Path Normalization ---- }

{ Convert path separators to native platform style }
function CometNormPath(const Path: string): string;

{ Convert path separators to DOS style (backslash) }
function CometToDOSPath(const Path: string): string;

{ Convert path separators to Unix style (forward slash) }
function CometToUnixPath(const Path: string): string;

{ Ensure path ends with a separator }
function CometAddSlash(const Path: string): string;

{ Remove trailing separator (unless it's root like / or C:\) }
function CometStripSlash(const Path: string): string;

{ Classify a path }
function CometPathType(const Path: string): TCometPathType;

{ Extract just the filename (basename) from a path }
function CometBaseName(const Path: string): string;

{ Extract just the directory part from a path }
function CometDirName(const Path: string): string;

{ Extract file extension (including the dot) }
function CometExtension(const Path: string): string;


{ ---- Path Translation (DOS <-> Unix) ---- }

{ Translate a DOS path to the current platform using drive mappings.
  C:\FD\OUTBOUND\FILE.PKT -> /home/ken/dos/c/fd/outbound/FILE.PKT (on Unix)
  On DOS/Windows, just normalizes separators.
  Returns '' if drive is not mapped. }
function CometTranslatePath(const DOSPath: string): string;

{ Translate a native path back to DOS format using reverse drive mapping.
  /home/ken/dos/c/fd/outbound/file.pkt -> C:\FD\OUTBOUND\FILE.PKT
  Returns '' if no drive mapping matches. On DOS/Windows returns path as-is. }
function CometTranslateToDoS(const NativePath: string): string;

{ Translate a path from a .FLO file. Handles both DOS and Unix paths,
  auto-detects format, translates to native platform, does case-insensitive
  lookup if needed. The .FLO prefix char (#/^/~) is NOT included in Path. }
function CometTranslateFLO(const FloPath: string): string;


{ ---- Case-Insensitive File Lookup ---- }

{ Find a file by name, case-insensitive on case-sensitive filesystems.
  Tries: exact -> UPPER -> lower -> directory scan.
  Returns the actual path found, or '' if not found.
  On DOS/Windows just checks FileExists and returns the path as-is. }
function CometFindFile(const Path: string): string;

{ Find a file in a directory by name only (case-insensitive).
  Dir should end with separator. FileName is just the basename.
  Returns the full path with correct case, or '' if not found. }
function CometFindInDir(const Dir, FileName: string): string;

{ Case-insensitive file existence check }
function CometFileExists(const Path: string): Boolean;

{ Case-insensitive directory existence check }
function CometDirExists(const Path: string): Boolean;


{ ---- Directory Operations ---- }

{ Create directory and all parent directories. Returns True on success
  or if directory already exists. }
function CometMakePath(const Path: string): Boolean;


{ ---- 8.3 Filename Helpers ---- }

{ Check if a filename fits 8.3 format }
function CometIs83(const FileName: string): Boolean;

{ Truncate a filename to 8.3 format (simple truncation, no collision check) }
function CometTo83(const FileName: string): string;


implementation


{ ---- Forward declarations for Unix-only helpers ---- }

{$IFDEF UNIX}
function ResolvePathCaseWalk(const Path: string): string; forward;
function CometFindDirInDir(const ParentDir, DirName: string): string; forward;
{$ENDIF}


{ ---- Drive mapping table ---- }

var
  DriveMap: array[0..COMET_MAXDRIVES - 1] of TCometDriveMap;
  DriveMapInited: Boolean = False;

procedure InitDriveMap;
var
  I: Integer;
begin
  if DriveMapInited then Exit;
  for I := 0 to COMET_MAXDRIVES - 1 do
  begin
    DriveMap[I].Letter := Chr(Ord('A') + I);
    DriveMap[I].Path := '';
    DriveMap[I].Active := False;
  end;
  DriveMapInited := True;
end;

function DriveIndex(DriveLetter: Char): Integer;
var
  C: Char;
begin
  C := UpCase(DriveLetter);
  if (C >= 'A') and (C <= 'Z') then
    Result := Ord(C) - Ord('A')
  else
    Result := -1;
end;


{ ---- Drive Mapping Implementation ---- }

procedure CometSetDriveMap(DriveLetter: Char; const UnixPath: string);
var
  Idx: Integer;
  P: string;
begin
  InitDriveMap;
  Idx := DriveIndex(DriveLetter);
  if Idx < 0 then Exit;

  { Ensure the mapped path ends with / }
  P := CometToUnixPath(UnixPath);
  if (P <> '') and (P[Length(P)] <> '/') then
    P := P + '/';

  DriveMap[Idx].Path := P;
  DriveMap[Idx].Active := (P <> '');
end;

procedure CometClearDriveMap(DriveLetter: Char);
var
  Idx: Integer;
begin
  InitDriveMap;
  Idx := DriveIndex(DriveLetter);
  if Idx < 0 then Exit;
  DriveMap[Idx].Path := '';
  DriveMap[Idx].Active := False;
end;

procedure CometClearAllDriveMaps;
var
  I: Integer;
begin
  InitDriveMap;
  for I := 0 to COMET_MAXDRIVES - 1 do
  begin
    DriveMap[I].Path := '';
    DriveMap[I].Active := False;
  end;
end;

function CometGetDriveMap(DriveLetter: Char): string;
var
  Idx: Integer;
begin
  InitDriveMap;
  Idx := DriveIndex(DriveLetter);
  if (Idx >= 0) and DriveMap[Idx].Active then
    Result := DriveMap[Idx].Path
  else
    Result := '';
end;

function CometReverseDriveMap(const UnixPath: string; out DriveLetter: Char): Boolean;
var
  I: Integer;
  NormPath: string;
  BestLen: Integer;
  BestIdx: Integer;
begin
  Result := False;
  DriveLetter := #0;
  InitDriveMap;

  NormPath := CometToUnixPath(UnixPath);

  { Find the longest matching drive map prefix (most specific match) }
  BestLen := 0;
  BestIdx := -1;

  for I := 0 to COMET_MAXDRIVES - 1 do
  begin
    if not DriveMap[I].Active then Continue;
    if Length(DriveMap[I].Path) <= BestLen then Continue;

    { Case-insensitive prefix match }
    if (Length(NormPath) >= Length(DriveMap[I].Path)) and
       (CompareText(Copy(NormPath, 1, Length(DriveMap[I].Path)),
                    DriveMap[I].Path) = 0) then
    begin
      BestLen := Length(DriveMap[I].Path);
      BestIdx := I;
    end;
  end;

  if BestIdx >= 0 then
  begin
    DriveLetter := DriveMap[BestIdx].Letter;
    Result := True;
  end;
end;


{ ---- Path Normalization Implementation ---- }

function CometNormPath(const Path: string): string;
var
  I: Integer;
begin
  Result := Path;
  for I := 1 to Length(Result) do
  begin
    if Result[I] = COMET_OTHERSEP then
      Result[I] := COMET_PATHSEP;
  end;
end;

function CometToDOSPath(const Path: string): string;
var
  I: Integer;
begin
  Result := Path;
  for I := 1 to Length(Result) do
  begin
    if Result[I] = '/' then
      Result[I] := '\';
  end;
end;

function CometToUnixPath(const Path: string): string;
var
  I: Integer;
begin
  Result := Path;
  for I := 1 to Length(Result) do
  begin
    if Result[I] = '\' then
      Result[I] := '/';
  end;
end;

function CometAddSlash(const Path: string): string;
begin
  Result := Path;
  if Result = '' then Exit;
  if (Result[Length(Result)] <> '/') and (Result[Length(Result)] <> '\') then
    Result := Result + COMET_PATHSEP;
end;

function CometStripSlash(const Path: string): string;
begin
  Result := Path;
  if Length(Result) <= 1 then Exit;          { Don't strip '/' root }

  { Don't strip C:\ }
  if (Length(Result) = 3) and (Result[2] = ':') and
     ((Result[3] = '\') or (Result[3] = '/')) then
    Exit;

  if (Result[Length(Result)] = '/') or (Result[Length(Result)] = '\') then
    SetLength(Result, Length(Result) - 1);
end;

function CometPathType(const Path: string): TCometPathType;
begin
  if Path = '' then
  begin
    Result := cptRelative;
    Exit;
  end;

  { Unix absolute: starts with / }
  if Path[1] = '/' then
  begin
    Result := cptAbsoluteUnix;
    Exit;
  end;

  { UNC: starts with \\ }
  if (Length(Path) >= 2) and (Path[1] = '\') and (Path[2] = '\') then
  begin
    Result := cptAbsoluteUNC;
    Exit;
  end;

  { DOS absolute: X:\ or X:/ }
  if (Length(Path) >= 3) and (Path[2] = ':') and
     ((Path[3] = '\') or (Path[3] = '/')) then
  begin
    Result := cptAbsoluteDOS;
    Exit;
  end;

  { Also catch X: without trailing slash as DOS }
  if (Length(Path) >= 2) and (Path[2] = ':') and
     (UpCase(Path[1]) >= 'A') and (UpCase(Path[1]) <= 'Z') then
  begin
    Result := cptAbsoluteDOS;
    Exit;
  end;

  Result := cptRelative;
end;

function CometBaseName(const Path: string): string;
var
  I: Integer;
begin
  { Find last separator (either kind) }
  for I := Length(Path) downto 1 do
  begin
    if (Path[I] = '/') or (Path[I] = '\') then
    begin
      Result := Copy(Path, I + 1, Length(Path));
      Exit;
    end;
  end;

  { No separator found - check for drive letter }
  if (Length(Path) >= 2) and (Path[2] = ':') then
  begin
    Result := Copy(Path, 3, Length(Path));
    Exit;
  end;

  Result := Path;
end;

function CometDirName(const Path: string): string;
var
  I: Integer;
begin
  for I := Length(Path) downto 1 do
  begin
    if (Path[I] = '/') or (Path[I] = '\') then
    begin
      Result := Copy(Path, 1, I);
      Exit;
    end;
  end;

  { No separator - check for drive letter }
  if (Length(Path) >= 2) and (Path[2] = ':') then
  begin
    Result := Copy(Path, 1, 2);
    Exit;
  end;

  Result := '';
end;

function CometExtension(const Path: string): string;
var
  I: Integer;
  Base: string;
begin
  Base := CometBaseName(Path);
  for I := Length(Base) downto 1 do
  begin
    if Base[I] = '.' then
    begin
      Result := Copy(Base, I, Length(Base));
      Exit;
    end;
  end;
  Result := '';
end;


{ ---- Path Translation Implementation ---- }

function CometTranslatePath(const DOSPath: string): string;
{$IFDEF UNIX}
var
  MapPath: string;
  Rest: string;
begin
  Result := '';

  { If it's already a Unix absolute path, just normalize }
  if (DOSPath <> '') and (DOSPath[1] = '/') then
  begin
    Result := DOSPath;
    Exit;
  end;

  { Must be a DOS path with drive letter }
  if (Length(DOSPath) < 2) or (DOSPath[2] <> ':') then
  begin
    { Relative path - just normalize separators }
    Result := CometNormPath(DOSPath);
    Exit;
  end;

  MapPath := CometGetDriveMap(DOSPath[1]);
  if MapPath = '' then Exit;  { Not mapped = can't translate }

  { Strip drive letter prefix (C:\ or C:) }
  if (Length(DOSPath) >= 3) and ((DOSPath[3] = '\') or (DOSPath[3] = '/')) then
    Rest := Copy(DOSPath, 4, Length(DOSPath))
  else
    Rest := Copy(DOSPath, 3, Length(DOSPath));

  { Convert remaining backslashes to forward slashes }
  Rest := CometToUnixPath(Rest);

  Result := MapPath + Rest;
end;
{$ELSE}
begin
  { On DOS/Windows/OS2, just normalize separators }
  Result := CometNormPath(DOSPath);
end;
{$ENDIF}


function CometTranslateToDoS(const NativePath: string): string;
{$IFDEF UNIX}
var
  DriveLetter: Char;
  MapPath: string;
  Rest: string;
begin
  Result := '';

  { If it looks like a DOS path already, just return it }
  if (Length(NativePath) >= 2) and (NativePath[2] = ':') then
  begin
    Result := CometToDOSPath(NativePath);
    Exit;
  end;

  { Try reverse drive mapping }
  if not CometReverseDriveMap(NativePath, DriveLetter) then
    Exit;  { No mapping found }

  MapPath := CometGetDriveMap(DriveLetter);
  Rest := Copy(NativePath, Length(MapPath) + 1, Length(NativePath));

  { Build DOS path: C:\ + rest with backslashes, uppercased for DOS compat }
  Result := DriveLetter + ':\' + UpperCase(CometToDOSPath(Rest));
end;
{$ELSE}
begin
  { On DOS/Windows/OS2, just normalize to DOS separators }
  Result := CometToDOSPath(NativePath);
end;
{$ENDIF}


function CometTranslateFLO(const FloPath: string): string;
var
  Translated: string;
  PathKind: TCometPathType;
begin
  Result := '';
  if FloPath = '' then Exit;

  PathKind := CometPathType(FloPath);

  case PathKind of
    cptAbsoluteDOS:
      begin
        { DOS path (C:\...) - translate through drive map on Unix }
        Translated := CometTranslatePath(FloPath);
        if Translated <> '' then
          Result := CometFindFile(Translated);
      end;

    cptAbsoluteUnix:
      begin
        { Unix path (/...) - use directly on Unix, can't use on DOS }
        {$IFDEF UNIX}
        Result := CometFindFile(FloPath);
        {$ELSE}
        Result := '';
        {$ENDIF}
      end;

    cptRelative:
      begin
        { Relative path - normalize and try case-insensitive lookup }
        Translated := CometNormPath(FloPath);
        Result := CometFindFile(Translated);
      end;

    cptAbsoluteUNC:
      begin
        { UNC path - only works on Windows/OS2 }
        {$IFDEF UNIX}
        Result := '';
        {$ELSE}
        Translated := CometNormPath(FloPath);
        if FileExists(Translated) then
          Result := Translated;
        {$ENDIF}
      end;
  end;
end;


{ ---- Case-Insensitive File Lookup Implementation ---- }

function CometFindFile(const Path: string): string;
{$IFDEF UNIX}
var
  Dir, Base: string;
begin
  Result := '';
  if Path = '' then Exit;

  { Try 1: exact path as given }
  if FileExists(Path) then
  begin
    Result := Path;
    Exit;
  end;

  { Try 2: directory as-is, scan for case-insensitive filename match }
  Dir := CometDirName(Path);
  Base := CometBaseName(Path);

  if (Dir <> '') and DirectoryExists(CometStripSlash(Dir)) then
  begin
    Result := CometFindInDir(Dir, Base);
    if Result <> '' then Exit;
  end;

  { Try 3: all uppercase path }
  if FileExists(UpperCase(Path)) then
  begin
    Result := UpperCase(Path);
    Exit;
  end;

  { Try 4: all lowercase path }
  if FileExists(LowerCase(Path)) then
  begin
    Result := LowerCase(Path);
    Exit;
  end;

  { Try 5: resolve case for each path component individually.
    This handles paths where multiple directories have wrong case,
    e.g. /HOME/KEN/DOS/C/FD/OUTBOUND/file.pkt }
  Result := ResolvePathCaseWalk(Path);
end;
{$ELSE}
begin
  { On case-insensitive filesystems, just check existence }
  if FileExists(Path) then
    Result := Path
  else
    Result := '';
end;
{$ENDIF}


function CometFindInDir(const Dir, FileName: string): string;
{$IFDEF UNIX}
var
  SR: TSearchRec;
  SearchDir: string;
begin
  Result := '';
  if (Dir = '') or (FileName = '') then Exit;

  SearchDir := CometAddSlash(Dir);

  { Scan directory for case-insensitive match }
  if FindFirst(SearchDir + '*', faAnyFile, SR) = 0 then
  begin
    try
      repeat
        if (SR.Name = '.') or (SR.Name = '..') then Continue;
        if CompareText(SR.Name, FileName) = 0 then
        begin
          Result := SearchDir + SR.Name;
          Exit;
        end;
      until FindNext(SR) <> 0;
    finally
      FindClose(SR);
    end;
  end;
end;
{$ELSE}
begin
  { On case-insensitive FS, just build the path and check }
  Result := CometAddSlash(Dir) + FileName;
  if not FileExists(Result) then
    Result := '';
end;
{$ENDIF}


{$IFDEF UNIX}
{ Walk each component of a path, resolving case at each level.
  Handles paths like /HOME/KEN/DOS/C/FD/OUTBOUND where multiple
  components might have wrong case. }
function ResolvePathCaseWalk(const Path: string): string;
var
  Components: TStringList;
  Resolved: string;
  I: Integer;
  Found: string;
  Part: string;
begin
  Result := '';
  if Path = '' then Exit;

  Components := TStringList.Create;
  try
    { Normalize to forward slashes for splitting }
    Part := CometToUnixPath(Path);

    { Handle leading / }
    if (Part <> '') and (Part[1] = '/') then
    begin
      Resolved := '/';
      Delete(Part, 1, 1);
    end
    else
      Resolved := '';

    { Split on / into components }
    while Part <> '' do
    begin
      I := Pos('/', Part);
      if I > 0 then
      begin
        if I > 1 then
          Components.Add(Copy(Part, 1, I - 1));
        Delete(Part, 1, I);
      end
      else
      begin
        if Part <> '' then
          Components.Add(Part);
        Part := '';
      end;
    end;

    if Components.Count = 0 then Exit;

    { Resolve each component via directory scan }
    for I := 0 to Components.Count - 1 do
    begin
      if I < Components.Count - 1 then
      begin
        { Intermediate directory component }
        if DirectoryExists(Resolved + Components[I]) then
          Resolved := Resolved + Components[I] + '/'
        else
        begin
          { Scan parent directory for case-insensitive match }
          Found := CometFindDirInDir(Resolved, Components[I]);
          if Found = '' then Exit;  { Component not found }
          Resolved := Found;
        end;
      end
      else
      begin
        { Final component - could be file or directory }
        if FileExists(Resolved + Components[I]) or
           DirectoryExists(Resolved + Components[I]) then
        begin
          Result := Resolved + Components[I];
          Exit;
        end;

        { Scan for case-insensitive match }
        Found := CometFindInDir(Resolved, Components[I]);
        if Found <> '' then
        begin
          Result := Found;
          Exit;
        end;
      end;
    end;
  finally
    Components.Free;
  end;
end;


{ Find a subdirectory within a directory, case-insensitive.
  Returns the full path with trailing / if found, '' otherwise. }
function CometFindDirInDir(const ParentDir, DirName: string): string;
var
  SR: TSearchRec;
  SearchDir: string;
begin
  Result := '';
  if (ParentDir = '') or (DirName = '') then Exit;

  if ParentDir = '/' then
    SearchDir := '/'
  else
    SearchDir := CometAddSlash(ParentDir);

  if FindFirst(SearchDir + '*', faDirectory, SR) = 0 then
  begin
    try
      repeat
        if (SR.Name = '.') or (SR.Name = '..') then Continue;
        if ((SR.Attr and faDirectory) = 0) then Continue;
        if CompareText(SR.Name, DirName) = 0 then
        begin
          Result := SearchDir + SR.Name + '/';
          Exit;
        end;
      until FindNext(SR) <> 0;
    finally
      FindClose(SR);
    end;
  end;
end;
{$ENDIF}


function CometFileExists(const Path: string): Boolean;
begin
  {$IFDEF UNIX}
  Result := CometFindFile(Path) <> '';
  {$ELSE}
  Result := FileExists(Path);
  {$ENDIF}
end;

function CometDirExists(const Path: string): Boolean;
{$IFDEF UNIX}
var
  Base, Parent: string;
  SR: TSearchRec;
  TestPath: string;
begin
  Result := False;
  if Path = '' then Exit;

  TestPath := CometStripSlash(Path);

  { Try exact first }
  if DirectoryExists(TestPath) then
  begin
    Result := True;
    Exit;
  end;

  { Case-insensitive scan of parent directory }
  Parent := CometDirName(TestPath);
  Base := CometBaseName(TestPath);
  if (Parent = '') or (Base = '') then Exit;

  if not DirectoryExists(CometStripSlash(Parent)) then Exit;

  if FindFirst(CometAddSlash(Parent) + '*', faDirectory, SR) = 0 then
  begin
    try
      repeat
        if (SR.Name = '.') or (SR.Name = '..') then Continue;
        if ((SR.Attr and faDirectory) <> 0) and
           (CompareText(SR.Name, Base) = 0) then
        begin
          Result := True;
          Exit;
        end;
      until FindNext(SR) <> 0;
    finally
      FindClose(SR);
    end;
  end;
end;
{$ELSE}
begin
  Result := DirectoryExists(Path);
end;
{$ENDIF}


{ ---- Directory Operations Implementation ---- }

function CometMakePath(const Path: string): Boolean;
var
  NormDir: string;
begin
  NormDir := CometNormPath(CometStripSlash(Path));
  if NormDir = '' then
  begin
    Result := False;
    Exit;
  end;

  if DirectoryExists(NormDir) then
  begin
    Result := True;
    Exit;
  end;

  Result := ForceDirectories(NormDir);
end;


{ ---- 8.3 Filename Helpers Implementation ---- }

function CometIs83(const FileName: string): Boolean;
var
  DotPos: Integer;
  Name, Ext: string;
  I: Integer;

  function Valid83Char(C: Char): Boolean;
  begin
    Result := C in ['A'..'Z', 'a'..'z', '0'..'9',
                     '!', '#', '$', '%', '&', '''', '(',
                     ')', '-', '@', '^', '_', '`', '{',
                     '}', '~'];
  end;

begin
  Result := False;
  if (FileName = '') or (Length(FileName) > 12) then Exit;

  DotPos := Pos('.', FileName);

  if DotPos = 0 then
  begin
    { No extension - name must be 1-8 chars }
    if (Length(FileName) < 1) or (Length(FileName) > 8) then Exit;
    Name := FileName;
    Ext := '';
  end
  else
  begin
    Name := Copy(FileName, 1, DotPos - 1);
    Ext := Copy(FileName, DotPos + 1, Length(FileName));

    { Name 1-8 chars, extension 0-3 chars }
    if (Length(Name) < 1) or (Length(Name) > 8) then Exit;
    if Length(Ext) > 3 then Exit;

    { No second dot }
    if Pos('.', Ext) > 0 then Exit;
  end;

  for I := 1 to Length(Name) do
    if not Valid83Char(Name[I]) then Exit;

  for I := 1 to Length(Ext) do
    if not Valid83Char(Ext[I]) then Exit;

  Result := True;
end;


function CometTo83(const FileName: string): string;
var
  DotPos: Integer;
  Name, Ext: string;
  I: Integer;
  OutName, OutExt: string;

  function SanitizeChar(Ch: Char): Char;
  begin
    if Ch in ['A'..'Z', 'a'..'z', '0'..'9',
              '!', '#', '$', '%', '&', '''', '(',
              ')', '-', '@', '^', '_', '`', '{',
              '}', '~'] then
      Result := UpCase(Ch)
    else
      Result := '_';
  end;

begin
  if FileName = '' then
  begin
    Result := '';
    Exit;
  end;

  { If it already fits, just uppercase it }
  if CometIs83(FileName) then
  begin
    Result := UpperCase(FileName);
    Exit;
  end;

  { Split on LAST dot }
  DotPos := 0;
  for I := Length(FileName) downto 1 do
  begin
    if FileName[I] = '.' then
    begin
      DotPos := I;
      Break;
    end;
  end;

  if DotPos > 0 then
  begin
    Name := Copy(FileName, 1, DotPos - 1);
    Ext := Copy(FileName, DotPos + 1, Length(FileName));
  end
  else
  begin
    Name := FileName;
    Ext := '';
  end;

  { Sanitize and truncate name to 8 chars }
  OutName := '';
  for I := 1 to Length(Name) do
  begin
    if Length(OutName) >= 8 then Break;
    OutName := OutName + SanitizeChar(Name[I]);
  end;

  { Sanitize and truncate extension to 3 chars }
  if Ext <> '' then
  begin
    OutExt := '';
    for I := 1 to Length(Ext) do
    begin
      if Length(OutExt) >= 3 then Break;
      OutExt := OutExt + SanitizeChar(Ext[I]);
    end;
    Result := OutName + '.' + OutExt;
  end
  else
    Result := OutName;
end;


end.