freepascal.compiler/fv/stddlg.pas

{*******************************************************}
{ Free Vision Runtime Library                           }
{ StdDlg Unit                                           }
{ Version: 0.1.0                                        }
{ Release Date: July 23, 1998                           }
{                                                       }
{*******************************************************}
{                                                       }
{ This unit is a port of Borland International's        }
{ StdDlg.pas unit.  It is for distribution with the     }
{ Free Pascal (FPK) Compiler as part of the 32-bit      }
{ Free Vision library.  The unit is still fully         }
{ functional under BP7 by using the tp compiler         }
{ directive when rebuilding the library.                }
{                                                       }
{*******************************************************}

{ Revision History

1.1a   (97/12/29)
  - fixed bug in TFileDialog.HandleEvent that prevented the user from being
    able to have an action taken automatically when the FileList was
    selected and kbEnter pressed

1.1
  - modified OpenNewFile to take a history list ID
  - implemented OpenNewFile

1.0   (1992)
  - original implementation }

unit StdDlg;

{
  This unit has been modified to make some functions global, apply patches
  from version 3.1 of the TVBUGS list, added TEditChDirDialog, and added
  several new global functions and procedures.
}

{$i platform.inc}

{$ifdef PPC_FPC}
  {$H-}
{$else}
  {$F+,O+,E+,N+}
{$endif}
{$X+,R-,I-,Q-,V-}
{$ifndef OS_UNIX}
  {$S-}
{$endif}
{$ifdef OS_DOS}
  {$define HAS_DOS_DRIVES}
{$endif}
{$ifdef OS_WINDOWS}
  {$define HAS_DOS_DRIVES}
{$endif}
{$ifdef OS_OS2}
  {$define HAS_DOS_DRIVES}
{$endif}

interface

uses
  FVConsts, Objects, Drivers, Views, Dialogs, Validate, Dos;

const
{$ifdef PPC_FPC}
  MaxDir   = 255;   { Maximum length of a DirStr. }
  MaxFName = 255; { Maximum length of a FNameStr. }

  {$ifdef OS_Unix}
  DirSeparator : Char = '/';
  {$else}
  DirSeparator : Char = '\';
  {$endif}

{$else}
  MaxDir = 67;   { Maximum length of a DirStr. }
  MaxFName = 79; { Maximum length of a FNameStr. }
  DirSeparator: Char = '\';
{$endif}


type
  { TSearchRec }

  {  Record used to store directory information by TFileDialog
     This is a part of Dos.Searchrec for Bp !! }

  TSearchRec =
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
  packed
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
  record
    Attr: Longint;
    Time: Longint;
    Size: Longint;
{$ifdef PPC_FPC}
    Name: string[255];
{$else not PPC_FPC}
    Name: string[12];
{$endif not PPC_FPC}
  end;
  PSearchRec = ^TSearchRec;

type

  { TFileInputLine is a special input line that is used by      }
  { TFileDialog that will update its contents in response to a  }
  { cmFileFocused command from a TFileList.          }

  PFileInputLine = ^TFileInputLine;
  TFileInputLine = object(TInputLine)
    constructor Init(var Bounds: TRect; AMaxLen: Sw_Integer);
    procedure HandleEvent(var Event: TEvent); virtual;
  end;

  { TFileCollection is a collection of TSearchRec's. }

  PFileCollection = ^TFileCollection;
  TFileCollection = object(TSortedCollection)
    function Compare(Key1, Key2: Pointer): Sw_Integer; virtual;
    procedure FreeItem(Item: Pointer); virtual;
    function GetItem(var S: TStream): Pointer; virtual;
    procedure PutItem(var S: TStream; Item: Pointer); virtual;
  end;

  {#Z+}
  PFileValidator = ^TFileValidator;
  {#Z-}
  TFileValidator = Object(TValidator)
  end;  { of TFileValidator }

  { TSortedListBox is a TListBox that assumes it has a     }
  { TStoredCollection instead of just a TCollection.  It will   }
  { perform an incremental search on the contents.       }

  PSortedListBox = ^TSortedListBox;
  TSortedListBox = object(TListBox)
    SearchPos: Byte;
    {ShiftState: Byte;}
    HandleDir : boolean;
    constructor Init(var Bounds: TRect; ANumCols: Sw_Word;
      AScrollBar: PScrollBar);
    procedure HandleEvent(var Event: TEvent); virtual;
    function GetKey(var S: String): Pointer; virtual;
    procedure NewList(AList: PCollection); virtual;
  end;

  { TFileList is a TSortedList box that assumes it contains     }
  { a TFileCollection as its collection.  It also communicates  }
  { through broadcast messages to TFileInput and TInfoPane      }
  { what file is currently selected.             }

  PFileList = ^TFileList;
  TFileList = object(TSortedListBox)
    constructor Init(var Bounds: TRect; AScrollBar: PScrollBar);
    destructor Done; virtual;
    function DataSize: Sw_Word; virtual;
    procedure FocusItem(Item: Sw_Integer); virtual;
    procedure GetData(var Rec); virtual;
    function GetText(Item,MaxLen: Sw_Integer): String; virtual;
    function GetKey(var S: String): Pointer; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure ReadDirectory(AWildCard: PathStr);
    procedure SetData(var Rec); virtual;
  end;

  { TFileInfoPane is a TView that displays the information      }
  { about the currently selected file in the TFileList     }
  { of a TFileDialog.                  }

  PFileInfoPane = ^TFileInfoPane;
  TFileInfoPane = object(TView)
    S: TSearchRec;
    constructor Init(var Bounds: TRect);
    procedure Draw; virtual;
    function GetPalette: PPalette; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
  end;

  { TFileDialog is a standard file name input dialog      }

  TWildStr = PathStr;

const
  fdOkButton      = $0001;      { Put an OK button in the dialog }
  fdOpenButton    = $0002;      { Put an Open button in the dialog }
  fdReplaceButton = $0004;      { Put a Replace button in the dialog }
  fdClearButton   = $0008;      { Put a Clear button in the dialog }
  fdHelpButton    = $0010;      { Put a Help button in the dialog }
  fdNoLoadDir     = $0100;      { Do not load the current directory }
            { contents into the dialog at Init. }
            { This means you intend to change the }
            { WildCard by using SetData or store }
            { the dialog on a stream. }

type

  PFileHistory = ^TFileHistory;
  TFileHistory = object(THistory)
    CurDir : PString;
    procedure HandleEvent(var Event: TEvent);virtual;
    destructor Done; virtual;
    procedure AdaptHistoryToDir(Dir : string);
  end;

  PFileDialog = ^TFileDialog;
  TFileDialog = object(TDialog)
    FileName: PFileInputLine;
    FileList: PFileList;
    FileHistory: PFileHistory;
    WildCard: TWildStr;
    Directory: PString;
    constructor Init(AWildCard: TWildStr; const ATitle,
      InputName: String; AOptions: Word; HistoryId: Byte);
    constructor Load(var S: TStream);
    destructor Done; virtual;
    procedure GetData(var Rec); virtual;
    procedure GetFileName(var S: PathStr);
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure SetData(var Rec); virtual;
    procedure Store(var S: TStream);
    function Valid(Command: Word): Boolean; virtual;
  private
    procedure ReadDirectory;
  end;

  { TDirEntry }

  PDirEntry = ^TDirEntry;
  TDirEntry = record
    DisplayText: PString;
    Directory: PString;
  end;  { of TDirEntry }

  { TDirCollection is a collection of TDirEntry's used by       }
  { TDirListBox.                 }

  PDirCollection = ^TDirCollection;
  TDirCollection = object(TCollection)
    function GetItem(var S: TStream): Pointer; virtual;
    procedure FreeItem(Item: Pointer); virtual;
    procedure PutItem(var S: TStream; Item: Pointer); virtual;
  end;

  { TDirListBox displays a tree of directories for use in the }
  { TChDirDialog.                    }

  PDirListBox = ^TDirListBox;
  TDirListBox = object(TListBox)
    Dir: DirStr;
    Cur: Word;
    constructor Init(var Bounds: TRect; AScrollBar: PScrollBar);
    destructor Done; virtual;
    function GetText(Item,MaxLen: Sw_Integer): String; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    function IsSelected(Item: Sw_Integer): Boolean; virtual;
    procedure NewDirectory(var ADir: DirStr);
    procedure SetState(AState: Word; Enable: Boolean); virtual;
  end;

  { TChDirDialog is a standard change directory dialog. }

const
  cdNormal     = $0000; { Option to use dialog immediately }
  cdNoLoadDir  = $0001; { Option to init the dialog to store on a stream }
  cdHelpButton = $0002; { Put a help button in the dialog }

type

  PChDirDialog = ^TChDirDialog;
  TChDirDialog = object(TDialog)
    DirInput: PInputLine;
    DirList: PDirListBox;
    OkButton: PButton;
    ChDirButton: PButton;
    constructor Init(AOptions: Word; HistoryId: Sw_Word);
    constructor Load(var S: TStream);
    function DataSize: Sw_Word; virtual;
    procedure GetData(var Rec); virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure SetData(var Rec); virtual;
    procedure Store(var S: TStream);
    function Valid(Command: Word): Boolean; virtual;
  private
    procedure SetUpDialog;
  end;

  PEditChDirDialog = ^TEditChDirDialog;
  TEditChDirDialog = Object(TChDirDialog)
    { TEditChDirDialog allows setting/getting the starting directory.  The
      transfer record is a DirStr. }
    function DataSize : Sw_Word; virtual;
    procedure GetData (var Rec); virtual;
    procedure SetData (var Rec); virtual;
  end;  { of TEditChDirDialog }


  {#Z+}
  PDirValidator = ^TDirValidator;
  {#Z-}
  TDirValidator = Object(TFilterValidator)
    constructor Init;
    function IsValid(const S: string): Boolean; virtual;
    function IsValidInput(var S: string; SuppressFill: Boolean): Boolean;
      virtual;
  end;  { of TDirValidator }


  FileConfirmFunc = function (AFile : FNameStr) : Boolean;
    { Functions of type FileConfirmFunc's are used to prompt the end user for
      confirmation of an operation.

      FileConfirmFunc's should ask the user whether to perform the desired
      action on the file named AFile.  If the user elects to perform the
      function FileConfirmFunc's return True, otherwise they return False.

      Using FileConfirmFunc's allows routines to be coded independant of the
      user interface implemented.  OWL and TurboVision are supported through
      conditional defines.  If you do not use either user interface you must
      compile this unit with the conditional define cdNoMessages and set all
      FileConfirmFunc variables to a valid function prior to calling any
      routines in this unit. }
    {#X ReplaceFile DeleteFile }


var

  ReplaceFile : FileConfirmFunc;
    { ReplaceFile returns True if the end user elects to replace the existing
      file with the new file, otherwise it returns False.

      ReplaceFile is only called when #CheckOnReplace# is True. }
    {#X DeleteFile }

  DeleteFile : FileConfirmFunc;
    { DeleteFile returns True if the end user elects to delete the file,
      otherwise it returns False.

       DeleteFile is only called when #CheckOnDelete# is True. }
    {#X ReplaceFile }


const

  CInfoPane = #30;

  { TStream registration records }

function Contains(S1, S2: String): Boolean;
  { Contains returns true if S1 contains any characters in S2. }

function DriveValid(Drive: Char): Boolean;
  { DriveValid returns True if Drive is a valid DOS drive.  Drive valid works
    by attempting to change the current directory to Drive, then restoring
    the original directory. }

function ExtractDir(AFile: FNameStr): DirStr;
  { ExtractDir returns the path of AFile terminated with a trailing '\'.  If
    AFile contains no directory information, an empty string is returned. }

function ExtractFileName(AFile: FNameStr): NameStr;
  { ExtractFileName returns the file name without any directory or file
    extension information. }

function Equal(const S1, S2: String; Count: Sw_word): Boolean;
  { Equal returns True if S1 equals S2 for up to Count characters.  Equal is
    case-insensitive. }

function FileExists (AFile : FNameStr) : Boolean;
  { FileExists looks for the file specified in AFile.  If AFile is present
    FileExists returns true, otherwise FileExists returns False.

    The search is performed relative to the current system directory, but
    other directories may be searched by prefacing a file name with a valid
    directory path.

    There is no check for a vaild file name or drive.  Errrors are handled
    internally and not reported in DosError.  Critical errors are left to
    the system's critical error handler. }
  {#X OpenFile }

function GetCurDir: DirStr;
  { GetCurDir returns the current directory.  The directory returned always
    ends with a trailing backslash '\'. }

function GetCurDrive: Char;
  { GetCurDrive returns the letter of the current drive as reported by the
    operating system. }

function IsWild(const S: String): Boolean;
  { IsWild returns True if S contains a question mark (?) or asterix (*). }

function IsList(const S: String): Boolean;
  { IsList returns True if S contains list separator (;) char }

function IsDir(const S: String): Boolean;
  { IsDir returns True if S is a valid DOS directory. }

procedure MakeResources;
  { MakeResources places a language specific version of all resources
    needed for the StdDlg unit to function on the RezFile using the string
    constants and variables in the Resource unit.  The Resource unit and the
    appropriate string lists must be initialized prior to calling this
    procedure. }

function NoWildChars(S: String): String;
  { NoWildChars deletes the wild card characters ? and * from the string S
    and returns the result. }

function OpenFile (var AFile : FNameStr; HistoryID : Byte) : Boolean;
  { OpenFile prompts the user to select a file using the file specifications
    in AFile as the starting file and path.  Wildcards are accepted.  If the
    user accepts a file OpenFile returns True, otherwise OpenFile returns
    False.

    Note: The file returned may or may not exist. }

function OpenNewFile (var AFile: FNameStr; HistoryID: Byte): Boolean;
  { OpenNewFile allows the user to select a directory from disk and enter a
    new file name.  If the file name entered is an existing file the user is
    optionally prompted for confirmation of replacing the file based on the
    value in #CheckOnReplace#.  If a file name is successfully entered,
    OpenNewFile returns True. }
  {#X OpenFile }

function PathValid(var Path: PathStr): Boolean;
  { PathValid returns True if Path is a valid DOS path name.  Path may be a
    file or directory name.  Trailing '\'s are removed. }

procedure RegisterStdDlg;
  { RegisterStdDlg registers all objects in the StdDlg unit for stream
    usage. }

function SaveAs (var AFile : FNameStr; HistoryID : Word) : Boolean;
  { SaveAs prompts the user for a file name using AFile as a template.  If
    AFile already exists and CheckOnReplace is True, the user is prompted
    to replace the file.

    If a valid file name is entered SaveAs returns True, other SaveAs returns
    False. }

function SelectDir (var ADir : DirStr; HistoryID : Byte) : Boolean;
  { SelectDir prompts the user to select a directory using ADir as the
    starting directory.  If a directory is selected, SelectDir returns True.
    The directory returned is gauranteed to exist. }

function ShrinkPath (AFile : FNameStr; MaxLen : Byte) : FNameStr;
  { ShrinkPath returns a file name with a maximu length of MaxLen.
    Internal directories are removed and replaced with elipses as needed to
    make the file name fit in MaxLen.

    AFile must be a valid path name. }

function StdDeleteFile (AFile : FNameStr) : Boolean;
  { StdDeleteFile returns True if the end user elects to delete the file,
    otherwise it returns False.

    DeleteFile is only called when CheckOnDelete is True. }

function StdReplaceFile (AFile : FNameStr) : Boolean;
  { StdReplaceFile returns True if the end user elects to replace the existing
    AFile with the new AFile, otherwise it returns False.

    ReplaceFile is only called when CheckOnReplace is True. }

function ValidFileName(var FileName: PathStr): Boolean;
  { ValidFileName returns True if FileName is a valid DOS file name. }


const
  CheckOnReplace : Boolean = True;
    { CheckOnReplace is used by file functions.  If a file exists, it is
      optionally replaced based on the value of CheckOnReplace.

      If CheckOnReplace is False the file is replaced without asking the
      user.  If CheckOnReplace is True, the end user is asked to replace the
      file using a call to ReplaceFile.

      CheckOnReplace is set to True by default. }

  CheckOnDelete : Boolean = True;
    { CheckOnDelete is used by file and directory functions.  If a file
      exists, it is optionally deleted based on the value of CheckOnDelete.

      If CheckOnDelete is False the file or directory is deleted without
      asking the user.  If CheckOnDelete is True, the end user is asked to
      delete the file/directory using a call to DeleteFile.

      CheckOnDelete is set to True by default. }



const
  RFileInputLine: TStreamRec = (
     ObjType: idFileInputLine;
     VmtLink: Ofs(TypeOf(TFileInputLine)^);
     Load:    @TFileInputLine.Load;
     Store:   @TFileInputLine.Store
  );

  RFileCollection: TStreamRec = (
     ObjType: idFileCollection;
     VmtLink: Ofs(TypeOf(TFileCollection)^);
     Load:    @TFileCollection.Load;
     Store:   @TFileCollection.Store
  );

  RFileList: TStreamRec = (
     ObjType: idFileList;
     VmtLink: Ofs(TypeOf(TFileList)^);
     Load:    @TFileList.Load;
     Store:   @TFileList.Store
  );

  RFileInfoPane: TStreamRec = (
     ObjType: idFileInfoPane;
     VmtLink: Ofs(TypeOf(TFileInfoPane)^);
     Load:    @TFileInfoPane.Load;
     Store:   @TFileInfoPane.Store
  );

  RFileDialog: TStreamRec = (
     ObjType: idFileDialog;
     VmtLink: Ofs(TypeOf(TFileDialog)^);
     Load:    @TFileDialog.Load;
     Store:   @TFileDialog.Store
  );

  RDirCollection: TStreamRec = (
     ObjType: idDirCollection;
     VmtLink: Ofs(TypeOf(TDirCollection)^);
     Load:    @TDirCollection.Load;
     Store:   @TDirCollection.Store
  );

  RDirListBox: TStreamRec = (
     ObjType: idDirListBox;
     VmtLink: Ofs(TypeOf(TDirListBox)^);
     Load:    @TDirListBox.Load;
     Store:   @TDirListBox.Store
  );

  RChDirDialog: TStreamRec = (
     ObjType: idChDirDialog;
     VmtLink: Ofs(TypeOf(TChDirDialog)^);
     Load:    @TChDirDialog.Load;
     Store:   @TChDirDialog.Store
  );

  RSortedListBox: TStreamRec = (
     ObjType: idSortedListBox;
     VmtLink: Ofs(TypeOf(TSortedListBox)^);
     Load:    @TSortedListBox.Load;
     Store:   @TSortedListBox.Store
  );

  REditChDirDialog : TStreamRec = (
    ObjType : idEditChDirDialog;
    VmtLink : Ofs(TypeOf(TEditChDirDialog)^);
    Load    : @TEditChDirDialog.Load;
    Store   : @TEditChDirDialog.Store);


implementation

{****************************************************************************}
{            Local Declarations              }
{****************************************************************************}

uses
  App, Memory, HistList, MsgBox, Resource;

type

  PStringRec = record
    { PStringRec is needed for properly displaying PStrings using
      MessageBox. }
    AString : PString;
  end;

{****************************************************************************}
{ PathValid                        }
{****************************************************************************}
{$ifdef go32v2}
{$define NetDrive}
{$endif go32v2}
{$ifdef win32}
{$define NetDrive}
{$endif win32}

procedure RemoveDoubleDirSep(var ExpPath : PathStr);
var
  p: longint;
{$ifdef NetDrive}
  OneDirSepRemoved: boolean;
{$endif NetDrive}
begin
  p:=pos(DirSeparator+DirSeparator,ExpPath);
{$ifdef NetDrive}
  if p=1 then
    begin
      ExpPath:=Copy(ExpPath,1,high(ExpPath));
      OneDirSepRemoved:=true;
      p:=pos(DirSeparator+DirSeparator,ExpPath);
    end
  else
    OneDirSepRemoved:=false;
{$endif NetDrive}
  while p>0 do
    begin
      ExpPath:=Copy(ExpPath,1,p)+Copy(ExpPath,p+2,high(ExpPath));
      p:=pos(DirSeparator+DirSeparator,ExpPath);
    end;
{$ifdef NetDrive}
  if OneDirSepRemoved then
    ExpPath:=DirSeparator+ExpPath;
{$endif NetDrive}
end;

function PathValid (var Path: PathStr): Boolean;
var
  ExpPath: PathStr;
  SR: SearchRec;
begin
  RemoveDoubleDirSep(Path);
  ExpPath := FExpand(Path);
{$ifdef HAS_DOS_DRIVES}
  if (Length(ExpPath) <= 3) then
    PathValid := DriveValid(ExpPath[1])
  else
{$endif}
  begin
    { do not change '/' into '' }
    if (Length(ExpPath)>1) and (ExpPath[Length(ExpPath)] = DirSeparator) then
      Dec(ExpPath[0]);
    FindFirst(ExpPath, Directory, SR);
    PathValid := (DosError = 0) and (SR.Attr and Directory <> 0);
{$ifdef NetDrive}
    if (DosError<>0) and (length(ExpPath)>2) and
       (ExpPath[1]='\') and (ExpPath[2]='\')then
      begin
        { Checking '\\machine\sharedfolder' directly always fails..
          rather try '\\machine\sharedfolder\*' PM }
      {$ifdef fpc}
        FindClose(SR);
      {$endif}
        FindFirst(ExpPath+'\*',AnyFile,SR);
        PathValid:=(DosError = 0);
      end;
{$endif NetDrive}
    {$ifdef fpc}
    FindClose(SR);
   {$endif}
  end;
end;

{****************************************************************************}
{ TDirValidator Object                        }
{****************************************************************************}
{****************************************************************************}
{ TDirValidator.Init                    }
{****************************************************************************}
constructor TDirValidator.Init;
const   { What should this list be?  The commented one doesn't allow home,
  end, right arrow, left arrow, Ctrl+XXXX, etc. }
  Chars: TCharSet = ['A'..'Z','a'..'z','.','~',':','_','-'];
{  Chars: TCharSet = [#0..#255]; }
begin
  Chars := Chars + [DirSeparator];
  if not inherited Init(Chars) then
    Fail;
end;

{****************************************************************************}
{ TDirValidator.IsValid                      }
{****************************************************************************}
function TDirValidator.IsValid(const S: string): Boolean;
begin
{  IsValid := False; }
  IsValid := True;
end;

{****************************************************************************}
{ TDirValidator.IsValidInput                  }
{****************************************************************************}
function TDirValidator.IsValidInput(var S: string; SuppressFill: Boolean): Boolean;
begin
{  IsValid := False; }
  IsValidInput := True;
end;

{****************************************************************************}
{ TFileInputLine Object                      }
{****************************************************************************}
{****************************************************************************}
{ TFileInputLine.Init                     }
{****************************************************************************}
constructor TFileInputLine.Init(var Bounds: TRect; AMaxLen: Sw_Integer);
begin
  TInputLine.Init(Bounds, AMaxLen);
  EventMask := EventMask or evBroadcast;
end;

{****************************************************************************}
{ TFileInputLine.HandleEvent                  }
{****************************************************************************}
procedure TFileInputLine.HandleEvent(var Event: TEvent);
begin
  TInputLine.HandleEvent(Event);
  if (Event.What = evBroadcast) and (Event.Command = cmFileFocused) and
    (State and sfSelected = 0) then
  begin
     if PSearchRec(Event.InfoPtr)^.Attr and Directory <> 0 then
       begin
          Data^ := PSearchRec(Event.InfoPtr)^.Name + DirSeparator +
            PFileDialog(Owner)^.WildCard;
          { PFileDialog(Owner)^.FileHistory^.AdaptHistoryToDir(
              PSearchRec(Event.InfoPtr)^.Name+DirSeparator);}
       end
     else Data^ := PSearchRec(Event.InfoPtr)^.Name;
     DrawView;
  end;
end;

{****************************************************************************}
{ TFileCollection Object                       }
{****************************************************************************}
{****************************************************************************}
{ TFileCollection.Compare                     }
{****************************************************************************}
  function uppername(const s : string) : string;
  var
    i  : Sw_integer;
    in_name : boolean;
  begin
     in_name:=true;
     for i:=length(s) downto 1 do
      if in_name and (s[i] in ['a'..'z']) then
        uppername[i]:=char(byte(s[i])-32)
      else
       begin
          uppername[i]:=s[i];
          if s[i] = DirSeparator then
            in_name:=false;
       end;
     uppername[0]:=s[0];
  end;

function TFileCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
begin
  if PSearchRec(Key1)^.Name = PSearchRec(Key2)^.Name then Compare := 0
  else if PSearchRec(Key1)^.Name = '..' then Compare := 1
  else if PSearchRec(Key2)^.Name = '..' then Compare := -1
  else if (PSearchRec(Key1)^.Attr and Directory <> 0) and
     (PSearchRec(Key2)^.Attr and Directory = 0) then Compare := 1
  else if (PSearchRec(Key2)^.Attr and Directory <> 0) and
     (PSearchRec(Key1)^.Attr and Directory = 0) then Compare := -1
  else if UpperName(PSearchRec(Key1)^.Name) > UpperName(PSearchRec(Key2)^.Name) then
    Compare := 1
{$ifdef unix}
  else if UpperName(PSearchRec(Key1)^.Name) < UpperName(PSearchRec(Key2)^.Name) then
    Compare := -1
  else if PSearchRec(Key1)^.Name > PSearchRec(Key2)^.Name then
    Compare := 1
{$endif def unix}
  else
    Compare := -1;
end;

{****************************************************************************}
{ TFileCollection.FreeItem                   }
{****************************************************************************}
procedure TFileCollection.FreeItem(Item: Pointer);
begin
  Dispose(PSearchRec(Item));
end;

{****************************************************************************}
{ TFileCollection.GetItem                     }
{****************************************************************************}
function TFileCollection.GetItem(var S: TStream): Pointer;
var
  Item: PSearchRec;
begin
  New(Item);
  S.Read(Item^, SizeOf(TSearchRec));
  GetItem := Item;
end;

{****************************************************************************}
{ TFileCollection.PutItem                     }
{****************************************************************************}
procedure TFileCollection.PutItem(var S: TStream; Item: Pointer);
begin
  S.Write(Item^, SizeOf(TSearchRec));
end;


{*****************************************************************************
               TFileList
*****************************************************************************}

const
  ListSeparator=';';

function MatchesMask(What, Mask: string): boolean;

  function upper(const s : string) : string;
  var
    i  : Sw_integer;
  begin
     for i:=1 to length(s) do
      if s[i] in ['a'..'z'] then
       upper[i]:=char(byte(s[i])-32)
      else
       upper[i]:=s[i];
     upper[0]:=s[0];
  end;

  Function CmpStr(const hstr1,hstr2:string):boolean;
  var
    found : boolean;
    i1,i2 : Sw_integer;
  begin
    i1:=0;
    i2:=0;
    if hstr1='' then
      begin
        CmpStr:=(hstr2='');
        exit;
      end;
    found:=true;
    repeat
      inc(i2);
      inc(i1);
      if (i1>length(hstr1)) or (i2>length(hstr2)) then
        break;
      case hstr1[i1] of
        '?' :
          found:=true;
        '*' :
          begin
            found:=true;
            if (i1=length(hstr1)) then
             i2:=length(hstr2)
            else
             if (i1<length(hstr1)) and (hstr1[i1+1]<>hstr2[i2]) then
              begin
                if i2<length(hstr2) then
                 dec(i1)
              end
            else
             if i2>1 then
              dec(i2);
          end;
        else
          found:=(hstr1[i1]=hstr2[i2]) or (hstr2[i2]='?');
      end;
    until (not found);
    if found then
      found:=(i1>=length(hstr1)) and (i2>=length(hstr2));
    CmpStr:=found;
  end;

var
  D1,D2 : DirStr;
  N1,N2 : NameStr;
  E1,E2 : Extstr;
begin
{$ifdef Unix}
  FSplit(What,D1,N1,E1);
  FSplit(Mask,D2,N2,E2);
{$else}
  FSplit(Upper(What),D1,N1,E1);
  FSplit(Upper(Mask),D2,N2,E2);
{$endif}
  MatchesMask:=CmpStr(N2,N1) and CmpStr(E2,E1);
end;

function MatchesMaskList(What, MaskList: string): boolean;
var P: integer;
    Match: boolean;
begin
  Match:=false;
  if What<>'' then
  repeat
    P:=Pos(ListSeparator, MaskList);
    if P=0 then P:=length(MaskList)+1;
    Match:=MatchesMask(What,copy(MaskList,1,P-1));
    Delete(MaskList,1,P);
  until Match or (MaskList='');
  MatchesMaskList:=Match;
end;

constructor TFileList.Init(var Bounds: TRect; AScrollBar: PScrollBar);
begin
  TSortedListBox.Init(Bounds, 2, AScrollBar);
end;

destructor TFileList.Done;
begin
  if List <> nil then Dispose(List, Done);
  TListBox.Done;
end;

function TFileList.DataSize: Sw_Word;
begin
  DataSize := 0;
end;

procedure TFileList.FocusItem(Item: Sw_Integer);
begin
  TSortedListBox.FocusItem(Item);
  if (List^.Count > 0) then
    Message(Owner, evBroadcast, cmFileFocused, List^.At(Item));
end;

procedure TFileList.GetData(var Rec);
begin
end;

function TFileList.GetKey(var S: String): Pointer;
const
  SR: TSearchRec = ();

procedure UpStr(var S: String);
var
  I: Sw_Integer;
begin
  for I := 1 to Length(S) do S[I] := UpCase(S[I]);
end;

begin
  if (HandleDir{ShiftState and $03 <> 0}) or ((S <> '') and (S[1]='.')) then
    SR.Attr := Directory
  else SR.Attr := 0;
  SR.Name := S;
{$ifndef Unix}
  UpStr(SR.Name);
{$endif Unix}
  GetKey := @SR;
end;

function TFileList.GetText(Item,MaxLen: Sw_Integer): String;
var
  S: String;
  SR: PSearchRec;
begin
  SR := PSearchRec(List^.At(Item));
  S := SR^.Name;
  if SR^.Attr and Directory <> 0 then
  begin
    S[Length(S)+1] := DirSeparator;
    Inc(S[0]);
  end;
  GetText := S;
end;

procedure TFileList.HandleEvent(var Event: TEvent);
var
  S : String;
  K : pointer;
  Value : Sw_integer;
begin
  if (Event.What = evMouseDown) and (Event.Double) then
  begin
    Event.What := evCommand;
    Event.Command := cmOK;
    PutEvent(Event);
    ClearEvent(Event);
  end
  else if (Event.What = evKeyDown) and (Event.CharCode='<') then
  begin
    { select '..' }
      S := '..';
      K := GetKey(S);
      If PSortedCollection(List)^.Search(K, Value) then
        FocusItem(Value);
  end
  else TSortedListBox.HandleEvent(Event);
end;

procedure TFileList.ReadDirectory(AWildCard: PathStr);
const
  FindAttr = ReadOnly + Archive;
{$ifdef Unix}
  AllFiles = '*';
{$else}
  AllFiles = '*.*';
{$endif}
  PrevDir  = '..';
var
  S: SearchRec;
  P: PSearchRec;
  FileList: PFileCollection;
  NumFiles: Word;
  FindStr,
  WildName : string;
  Dir: DirStr;
  Ext: ExtStr;
  Name: NameStr;
  Event : TEvent;
  Tmp: PathStr;
begin
  NumFiles := 0;
  FileList := New(PFileCollection, Init(5, 5));
  AWildCard := FExpand(AWildCard);
  FSplit(AWildCard, Dir, Name, Ext);
  if pos(ListSeparator,AWildCard)>0 then
   begin
     WildName:=Copy(AWildCard,length(Dir)+1,255);
     FindStr:=Dir+AllFiles;
   end
  else
   begin
     WildName:=Name+Ext;
     FindStr:=AWildCard;
   end;
  FindFirst(FindStr, FindAttr, S);
  P := PSearchRec(@P);
  while assigned(P) and (DosError = 0) do
   begin
     if (S.Attr and Directory = 0) and
        MatchesMaskList(S.Name,WildName) then
     begin
       P := MemAlloc(SizeOf(P^));
       if assigned(P) then
       begin
         P^.Attr:=S.Attr;
         P^.Time:=S.Time;
         P^.Size:=S.Size;
         P^.Name:=S.Name;
         FileList^.Insert(P);
       end;
     end;
     FindNext(S);
   end;
 {$ifdef fpc}
  FindClose(S);
 {$endif}

  Tmp := Dir + AllFiles;
  FindFirst(Tmp, Directory, S);
  while (P <> nil) and (DosError = 0) do
  begin
    if (S.Attr and Directory <> 0) and (S.Name <> '.') and (S.Name <> '..') then
    begin
      P := MemAlloc(SizeOf(P^));
      if P <> nil then
      begin
        P^.Attr:=S.Attr;
        P^.Time:=S.Time;
        P^.Size:=S.Size;
        P^.Name:=S.Name;
        FileList^.Insert(P);
      end;
    end;
    FindNext(S);
  end;
 {$ifdef fpc}
  FindClose(S);
 {$endif}
 {$ifndef Unix}
  if Length(Dir) > 4 then
 {$endif not Unix}
  begin
    P := MemAlloc(SizeOf(P^));
    if P <> nil then
    begin
      FindFirst(Tmp, Directory, S);
      FindNext(S);
      if (DosError = 0) and (S.Name = PrevDir) then
       begin
         P^.Attr:=S.Attr;
         P^.Time:=S.Time;
         P^.Size:=S.Size;
         P^.Name:=S.Name;
       end
      else
       begin
         P^.Name := PrevDir;
         P^.Size := 0;
         P^.Time := $210000;
         P^.Attr := Directory;
       end;
      FileList^.Insert(PSearchRec(P));
     {$ifdef fpc}
      FindClose(S);
     {$endif}
    end;
  end;
  if P = nil then
    MessageBox(strings^.get(sTooManyFiles), nil, mfOkButton + mfWarning);
  NewList(FileList);
  if List^.Count > 0 then
  begin
    Event.What := evBroadcast;
    Event.Command := cmFileFocused;
    Event.InfoPtr := List^.At(0);
    Owner^.HandleEvent(Event);
  end;
end;

procedure TFileList.SetData(var Rec);
begin
  with PFileDialog(Owner)^ do
    Self.ReadDirectory(Directory^ + WildCard);
end;

{****************************************************************************}
{ TFileInfoPane Object                        }
{****************************************************************************}
{****************************************************************************}
{ TFileInfoPane.Init                    }
{****************************************************************************}
constructor TFileInfoPane.Init(var Bounds: TRect);
begin
  TView.Init(Bounds);
  FillChar(S,SizeOf(S),#0);
  EventMask := EventMask or evBroadcast;
end;

{****************************************************************************}
{ TFileInfoPane.Draw                    }
{****************************************************************************}
procedure TFileInfoPane.Draw;
var
  B: TDrawBuffer;
  D: String[9];
  M: String[3];
  PM: Boolean;
  Color: Word;
  Time: DateTime;
  Path: PathStr;
  FmtId: String;
  Params: array[0..7] of LongInt;
  Str: String[80];
const
  sDirectoryLine = ' %-12s %-9s %3s %2d, %4d  %2d:%02d%cm';
  sFileLine      = ' %-12s %-9d %3s %2d, %4d  %2d:%02d%cm';
  InValidFiles : array[0..2] of string[12] = ('','.','..');
var
  Month: array[1..12] of String[3];
begin
  Month[1] := Strings^.Get(smJan);
  Month[2] := Strings^.Get(smFeb);
  Month[3] := Strings^.Get(smMar);
  Month[4] := Strings^.Get(smApr);
  Month[5] := Strings^.Get(smMay);
  Month[6] := Strings^.Get(smJun);
  Month[7] := Strings^.Get(smJul);
  Month[8] := Strings^.Get(smAug);
  Month[9] := Strings^.Get(smSep);
  Month[10] := Strings^.Get(smOct);
  Month[11] := Strings^.Get(smNov);
  Month[12] := Strings^.Get(smDec);
  { Display path }
  if (PFileDialog(Owner)^.Directory <> nil) then
    Path := PFileDialog(Owner)^.Directory^
  else Path := '';
  Path := FExpand(Path+PFileDialog(Owner)^.WildCard);
  { avoid B Buffer overflow PM }
  Path := ShrinkPath(Path, Size.X - 1);
  Color := GetColor($01);
  MoveChar(B, ' ', Color, Size.X); { fill with empty spaces }
  WriteLine(0, 0, Size.X, Size.Y, B);
  MoveStr(B[1], Path, Color);
  WriteLine(0, 0, Size.X, 1, B);
  if (S.Name = InValidFiles[0]) or (S.Name = InValidFiles[1]) or
     (S.Name = InValidFiles[2]) then
    Exit;

  { Display file }
  Params[0] := LongInt(@S.Name);
  if S.Attr and Directory <> 0 then
  begin
    FmtId := sDirectoryLine;
    D := Strings^.Get(sDirectory);
    Params[1] := LongInt(@D);
  end else
  begin
    FmtId := sFileLine;
    Params[1] := S.Size;
  end;
  UnpackTime(S.Time, Time);
  M := Month[Time.Month];
  Params[2] := LongInt(@M);
  Params[3] := Time.Day;
  Params[4] := Time.Year;
  PM := Time.Hour >= 12;
  Time.Hour := Time.Hour mod 12;
  if Time.Hour = 0 then Time.Hour := 12;
  Params[5] := Time.Hour;
  Params[6] := Time.Min;
  if PM then
    Params[7] := Byte('p')
  else Params[7] := Byte('a');
  FormatStr(Str, FmtId, Params);
  MoveStr(B, Str, Color);
  WriteLine(0, 1, Size.X, 1, B);

  { Fill in rest of rectangle }
  MoveChar(B, ' ', Color, Size.X);
  WriteLine(0, 2, Size.X, Size.Y-2, B);
end;

function TFileInfoPane.GetPalette: PPalette;
const
  P: String[Length(CInfoPane)] = CInfoPane;
begin
  GetPalette := PPalette(@P);
end;

procedure TFileInfoPane.HandleEvent(var Event: TEvent);
begin
  TView.HandleEvent(Event);
  if (Event.What = evBroadcast) and (Event.Command = cmFileFocused) then
  begin
    S := PSearchRec(Event.InfoPtr)^;
    DrawView;
  end;
end;

{****************************************************************************
              TFileHistory
****************************************************************************}

  function LTrim(const S: String): String;
  var
    I: Sw_Integer;
  begin
    I := 1;
    while (I < Length(S)) and (S[I] = ' ') do Inc(I);
    LTrim := Copy(S, I, 255);
  end;

  function RTrim(const S: String): String;
  var
    I: Sw_Integer;
  begin
    I := Length(S);
    while S[I] = ' ' do Dec(I);
    RTrim := Copy(S, 1, I);
  end;

  function RelativePath(var S: PathStr): Boolean;
  begin
    S := LTrim(RTrim(S));
    RelativePath := not ((S <> '') and ((S[1] = DirSeparator) or (S[2] = ':')));
  end;

{ try to reduce the length of S+dir as a file path+pattern }

  function Simplify (var S,Dir : string) : string;
    var i : sw_integer;
  begin
   if RelativePath(Dir) then
     begin
        if (S<>'') and (Copy(Dir,1,3)='..'+DirSeparator) then
          begin
             i:=Length(S);
             for i:=Length(S)-1 downto 1 do
               if S[i]=DirSeparator then
                 break;
             if S[i]=DirSeparator then
               Simplify:=Copy(S,1,i)+Copy(Dir,4,255)
             else
               Simplify:=S+Dir;
          end
        else
          Simplify:=S+Dir;
     end
   else
      Simplify:=Dir;
  end;

{****************************************************************************}
{ TFileHistory.HandleEvent                                                       }
{****************************************************************************}

procedure TFileHistory.HandleEvent(var Event: TEvent);
var
  HistoryWindow: PHistoryWindow;
  R,P: TRect;
  C: Word;
  Rslt: String;
begin
  TView.HandleEvent(Event);
  if (Event.What = evMouseDown) or
     ((Event.What = evKeyDown) and (CtrlToArrow(Event.KeyCode) = kbDown) and
      (Link^.State and sfFocused <> 0)) then
  begin
    if not Link^.Focus then
    begin
      ClearEvent(Event);
      Exit;
    end;
    if assigned(CurDir) then
     Rslt:=CurDir^
    else
     Rslt:='';
    Rslt:=Simplify(Rslt,Link^.Data^);
    RemoveDoubleDirSep(Rslt);
    If IsWild(Rslt) then
      RecordHistory(Rslt);
    Link^.GetBounds(R);
    Dec(R.A.X); Inc(R.B.X); Inc(R.B.Y,7); Dec(R.A.Y,1);
    Owner^.GetExtent(P);
    R.Intersect(P);
    Dec(R.B.Y,1);
    HistoryWindow := InitHistoryWindow(R);
    if HistoryWindow <> nil then
    begin
      C := Owner^.ExecView(HistoryWindow);
      if C = cmOk then
      begin
        Rslt := HistoryWindow^.GetSelection;
        if Length(Rslt) > Link^.MaxLen then Rslt[0] := Char(Link^.MaxLen);
        Link^.Data^ := Rslt;
        Link^.SelectAll(True);
        Link^.DrawView;
      end;
      Dispose(HistoryWindow, Done);
    end;
    ClearEvent(Event);
  end
  else if (Event.What = evBroadcast) then
    if ((Event.Command = cmReleasedFocus) and (Event.InfoPtr = Link))
      or (Event.Command = cmRecordHistory) then
    begin
      if assigned(CurDir) then
       Rslt:=CurDir^
      else
       Rslt:='';
      Rslt:=Simplify(Rslt,Link^.Data^);
      RemoveDoubleDirSep(Rslt);
      If IsWild(Rslt) then
        RecordHistory(Rslt);
    end;
end;

procedure TFileHistory.AdaptHistoryToDir(Dir : string);
  var S,S2 : String;
      i,Count : Sw_word;
begin
   if assigned(CurDir) then
     begin
        S:=CurDir^;
        if S=Dir then
          exit;
        DisposeStr(CurDir);
     end
   else
     S:='';
   CurDir:=NewStr(Simplify(S,Dir));

   Count:=HistoryCount(HistoryId);
   for i:=1 to count do
     begin
        S2:=HistoryStr(HistoryId,1);
        HistoryRemove(HistoryId,1);
        if RelativePath(S2) then
          if S<>'' then
            S2:=S+S2
          else
            S2:=FExpand(S2);
        { simply full path
          we should simplify relative to Dir ! }
        HistoryAdd(HistoryId,S2);
     end;

end;

destructor TFileHistory.Done;
begin
  If assigned(CurDir) then
    DisposeStr(CurDir);
  Inherited Done;
end;

{****************************************************************************
              TFileDialog
****************************************************************************}

constructor TFileDialog.Init(AWildCard: TWildStr; const ATitle,
  InputName: String; AOptions: Word; HistoryId: Byte);
var
  Control: PView;
  R: TRect;
  Opt: Word;
begin
  R.Assign(15,1,64,20);
  TDialog.Init(R, ATitle);
  Options := Options or ofCentered;
  WildCard := AWildCard;

  R.Assign(3,3,31,4);
  FileName := New(PFileInputLine, Init(R, 79));
  FileName^.Data^ := WildCard;
  Insert(FileName);
  R.Assign(2,2,3+CStrLen(InputName),3);
  Control := New(PLabel, Init(R, InputName, FileName));
  Insert(Control);
  R.Assign(31,3,34,4);
  FileHistory := New(PFileHistory, Init(R, FileName, HistoryId));
  Insert(FileHistory);

  R.Assign(3,14,34,15);
  Control := New(PScrollBar, Init(R));
  Insert(Control);
  R.Assign(3,6,34,14);
  FileList := New(PFileList, Init(R, PScrollBar(Control)));
  Insert(FileList);
  R.Assign(2,5,8,6);
  Control := New(PLabel, Init(R, labels^.get(slFiles), FileList));
  Insert(Control);

  R.Assign(35,3,46,5);
  Opt := bfDefault;
  if AOptions and fdOpenButton <> 0 then
  begin
    Insert(New(PButton, Init(R,labels^.get(slOpen), cmFileOpen, Opt)));
    Opt := bfNormal;
    Inc(R.A.Y,3); Inc(R.B.Y,3);
  end;
  if AOptions and fdOkButton <> 0 then
  begin
    Insert(New(PButton, Init(R,labels^.get(slOk), cmFileOpen, Opt)));
    Opt := bfNormal;
    Inc(R.A.Y,3); Inc(R.B.Y,3);
  end;
  if AOptions and fdReplaceButton <> 0 then
  begin
    Insert(New(PButton, Init(R, labels^.get(slReplace),cmFileReplace, Opt)));
    Opt := bfNormal;
    Inc(R.A.Y,3); Inc(R.B.Y,3);
  end;
  if AOptions and fdClearButton <> 0 then
  begin
    Insert(New(PButton, Init(R, labels^.get(slClear),cmFileClear, Opt)));
    Opt := bfNormal;
    Inc(R.A.Y,3); Inc(R.B.Y,3);
  end;
  Insert(New(PButton, Init(R, labels^.get(slCancel), cmCancel, bfNormal)));
  Inc(R.A.Y,3); Inc(R.B.Y,3);
  if AOptions and fdHelpButton <> 0 then
  begin
    Insert(New(PButton, Init(R,labels^.get(slHelp),cmHelp, bfNormal)));
    Inc(R.A.Y,3); Inc(R.B.Y,3);
  end;

  R.Assign(1,16,48,18);
  Control := New(PFileInfoPane, Init(R));
  Insert(Control);

  SelectNext(False);

  if AOptions and fdNoLoadDir = 0 then ReadDirectory;
end;

constructor TFileDialog.Load(var S: TStream);
begin
  if not TDialog.Load(S) then
    Fail;
  S.Read(WildCard, SizeOf(WildCard));
  if (S.Status <> stOk) then
  begin
    TDialog.Done;
    Fail;
  end;
  GetSubViewPtr(S, FileName);
  GetSubViewPtr(S, FileList);
  GetSubViewPtr(S, FileHistory);
  ReadDirectory;
  if (DosError <> 0) then
  begin
    TDialog.Done;
    Fail;
  end;
end;

destructor TFileDialog.Done;
begin
  DisposeStr(Directory);
  TDialog.Done;
end;

procedure TFileDialog.GetData(var Rec);
begin
  GetFilename(PathStr(Rec));
end;

procedure TFileDialog.GetFileName(var S: PathStr);

var
  Path: PathStr;
  Name: NameStr;
  Ext: ExtStr;
  TWild : string;
  TPath: PathStr;
  TName: NameStr;
  TExt: NameStr;
  i : Sw_integer;
begin
  S := FileName^.Data^;
  if RelativePath(S) then
    begin
      if (Directory <> nil) then
   S := FExpand(Directory^ + S);
    end
  else
    S := FExpand(S);
  if Pos(ListSeparator,S)=0 then
   begin
     If FileExists(S) then
       exit;
     FSplit(S, Path, Name, Ext);
     if ((Name = '') or (Ext = '')) and not IsDir(S) then
     begin
       TWild:=WildCard;
       repeat
    i:=Pos(ListSeparator,TWild);
    if i=0 then
     i:=length(TWild)+1;
    FSplit(Copy(TWild,1,i-1), TPath, TName, TExt);
    if ((Name = '') and (Ext = '')) then
      S := Path + TName + TExt
    else
      if Name = '' then
        S := Path + TName + Ext
      else
        if Ext = '' then
          begin
       if IsWild(Name) then
         S := Path + Name + TExt
       else
         S := Path + Name + NoWildChars(TExt);
          end;
    if FileExists(S) then
     break;
    System.Delete(TWild,1,i);
       until TWild='';
       if TWild='' then
         S := Path + Name + Ext;
     end;
   end;
end;

procedure TFileDialog.HandleEvent(var Event: TEvent);
begin
  if (Event.What and evBroadcast <> 0) and
     (Event.Command = cmListItemSelected) then
  begin
    EndModal(cmFileOpen);
    ClearEvent(Event);
  end;
  TDialog.HandleEvent(Event);
  if Event.What = evCommand then
    case Event.Command of
      cmFileOpen, cmFileReplace, cmFileClear:
   begin
     EndModal(Event.Command);
     ClearEvent(Event);
   end;
    end;
end;

procedure TFileDialog.SetData(var Rec);
begin
  TDialog.SetData(Rec);
  if (PathStr(Rec) <> '') and (IsWild(TWildStr(Rec))) then
  begin
    Valid(cmFileInit);
    FileName^.Select;
  end;
end;

procedure TFileDialog.ReadDirectory;
begin
  FileList^.ReadDirectory(WildCard);
  FileHistory^.AdaptHistoryToDir(GetCurDir);
  Directory := NewStr(GetCurDir);
end;

procedure TFileDialog.Store(var S: TStream);
begin
  TDialog.Store(S);
  S.Write(WildCard, SizeOf(WildCard));
  PutSubViewPtr(S, FileName);
  PutSubViewPtr(S, FileList);
  PutSubViewPtr(S, FileHistory);
end;

function TFileDialog.Valid(Command: Word): Boolean;
var
  FName: PathStr;
  Dir: DirStr;
  Name: NameStr;
  Ext: ExtStr;

  function CheckDirectory(var S: PathStr): Boolean;
  begin
    if not PathValid(S) then
    begin
      MessageBox(Strings^.Get(sInvalidDriveOrDir), nil, mfError + mfOkButton);
      FileName^.Select;
      CheckDirectory := False;
    end else CheckDirectory := True;
  end;

  function CompleteDir(const Path: string): string;
  begin
    { keep c: untouched PM }
    if (Path<>'') and (Path[Length(Path)]<>DirSeparator) and
       (Path[Length(Path)]<>':') then
     CompleteDir:=Path+DirSeparator
    else
     CompleteDir:=Path;
  end;

  function NormalizeDir(const Path: string): string;
  var Root: boolean;
  begin
    Root:=false;
    {$ifdef Unix}
    if Path=DirSeparator then Root:=true;
    {$else}
    if (length(Path)=3) and (Upcase(Path[1]) in['A'..'Z']) and
       (Path[2]=':') and (Path[3]=DirSeparator) then
         Root:=true;
    {$endif}
    if (Root=false) and (copy(Path,length(Path),1)=DirSeparator) then
      NormalizeDir:=copy(Path,1,length(Path)-1)
    else
      NormalizeDir:=Path;
  end;
function NormalizeDirF(var S: openstring): boolean;
begin
  S:=NormalizeDir(S);
  NormalizeDirF:=true;
end;

begin
  if Command = 0 then
  begin
    Valid := True;
    Exit;
  end
  else Valid := False;
  if TDialog.Valid(Command) then
  begin
    GetFileName(FName);
    if (Command <> cmCancel) and (Command <> cmFileClear) then
    begin
      if IsWild(FName) or IsList(FName) then
      begin
        FSplit(FName, Dir, Name, Ext);
        if CheckDirectory(Dir) then
        begin
          FileHistory^.AdaptHistoryToDir(Dir);
          DisposeStr(Directory);
          Directory := NewStr(Dir);
          if Pos(ListSeparator,FName)>0 then
           WildCard:=Copy(FName,length(Dir)+1,255)
          else
           WildCard := Name+Ext;
          if Command <> cmFileInit then
            FileList^.Select;
          FileList^.ReadDirectory(Directory^+WildCard);
        end;
      end
    else
      if NormalizeDirF(FName) then
      { ^^ this is just a dummy if construct (the func always returns true,
        it's just there, 'coz I don't want to rearrange the following "if"s... }
      if IsDir(FName) then
        begin
          if CheckDirectory(FName) then
          begin
            FileHistory^.AdaptHistoryToDir(CompleteDir(FName));
            DisposeStr(Directory);
            Directory := NewSTr(CompleteDir(FName));
            if Command <> cmFileInit then FileList^.Select;
            FileList^.ReadDirectory(Directory^+WildCard);
          end
        end
      else
        if ValidFileName(FName) then
          Valid := True
        else
          begin
            MessageBox(^C + Strings^.Get(sInvalidFileName), nil, mfError + mfOkButton);
            Valid := False;
          end;
    end
    else Valid := True;
  end;
end;

{ TDirCollection }

function TDirCollection.GetItem(var S: TStream): Pointer;
var
  DirItem: PDirEntry;
begin
  New(DirItem);
  DirItem^.DisplayText := S.ReadStr;
  DirItem^.Directory := S.ReadStr;
  GetItem := DirItem;
end;

procedure TDirCollection.FreeItem(Item: Pointer);
var
  DirItem: PDirEntry absolute Item;
begin
  DisposeStr(DirItem^.DisplayText);
  DisposeStr(DirItem^.Directory);
  Dispose(DirItem);
end;

procedure TDirCollection.PutItem(var S: TStream; Item: Pointer);
var
  DirItem: PDirEntry absolute Item;
begin
  S.WriteStr(DirItem^.DisplayText);
  S.WriteStr(DirItem^.Directory);
end;

{ TDirListBox }

const
  DrivesS: String = '';
  Drives: PString = @DrivesS;

constructor TDirListBox.Init(var Bounds: TRect; AScrollBar:
  PScrollBar);
begin
  DrivesS := strings^.get(sDrives);
  TListBox.Init(Bounds, 1, AScrollBar);
  Dir := '';
end;

destructor TDirListBox.Done;
begin
  if (List <> nil) then
    Dispose(List,Done);
  TListBox.Done;
end;

function TDirListBox.GetText(Item,MaxLen: Sw_Integer): String;
begin
  GetText := PDirEntry(List^.At(Item))^.DisplayText^;
end;

procedure TDirListBox.HandleEvent(var Event: TEvent);
begin
  case Event.What of
    evMouseDown:
      if Event.Double then
      begin
   Event.What := evCommand;
   Event.Command := cmChangeDir;
   PutEvent(Event);
   ClearEvent(Event);
      end;
    evKeyboard:
      if (Event.CharCode = ' ') and
    (PSearchRec(List^.At(Focused))^.Name = '..') then
   NewDirectory(PSearchRec(List^.At(Focused))^.Name);
  end;
  TListBox.HandleEvent(Event);
end;

function TDirListBox.IsSelected(Item: Sw_Integer): Boolean;
begin
{  IsSelected := Item = Cur; }
  IsSelected := Inherited IsSelected(Item);
end;

procedure TDirListBox.NewDirectory(var ADir: DirStr);
const
  PathDir       = 'ÀÄÂ';
  FirstDir     =   'ÀÂÄ';
  MiddleDir   =   ' ÃÄ';
  LastDir       =   ' ÀÄ';
  IndentSize    = '  ';
var
  AList: PCollection;
  NewDir, Dirct: DirStr;
  C, OldC: Char;
  S, Indent: String[80];
  P: PString;
  NewCur: Word;
  isFirst: Boolean;
  SR: SearchRec;
  I: Sw_Integer;

  function NewDirEntry(const DisplayText, Directory: String): PDirEntry;{$ifdef PPC_BP}near;{$endif}
  var
    DirEntry: PDirEntry;
  begin
    New(DirEntry);
    DirEntry^.DisplayText := NewStr(DisplayText);
    If Directory='' then
      DirEntry^.Directory := NewStr(DirSeparator)
    else
      DirEntry^.Directory := NewStr(Directory);
    NewDirEntry := DirEntry;
  end;

begin
  Dir := ADir;
  AList := New(PDirCollection, Init(5,5));
{$ifdef HAS_DOS_DRIVES}
  AList^.Insert(NewDirEntry(Drives^,Drives^));
  if Dir = Drives^ then
  begin
    isFirst := True;
    OldC := ' ';
    for C := 'A' to 'Z' do
    begin
      if (C < 'C') or DriveValid(C) then
      begin
   if OldC <> ' ' then
   begin
     if isFirst then
     begin
       S := FirstDir + OldC;
       isFirst := False;
     end
     else S := MiddleDir + OldC;
     AList^.Insert(NewDirEntry(S, OldC + ':' + DirSeparator));
   end;
   if C = GetCurDrive then NewCur := AList^.Count;
   OldC := C;
      end;
    end;
    if OldC <> ' ' then
      AList^.Insert(NewDirEntry(LastDir + OldC, OldC + ':' + DirSeparator));
  end
  else
{$endif HAS_DOS_DRIVES}
  begin
    Indent := IndentSize;
    NewDir := Dir;
{$ifdef HAS_DOS_DRIVES}
    Dirct := Copy(NewDir,1,3);
    AList^.Insert(NewDirEntry(PathDir + Dirct, Dirct));
    NewDir := Copy(NewDir,4,255);
{$else HAS_DOS_DRIVES}
    Dirct := '';
{$endif HAS_DOS_DRIVES}
    while NewDir <> '' do
    begin
      I := Pos(DirSeparator,NewDir);
      if I <> 0 then
      begin
   S := Copy(NewDir,1,I-1);
   Dirct := Dirct + S;
   AList^.Insert(NewDirEntry(Indent + PathDir + S, Dirct));
   NewDir := Copy(NewDir,I+1,255);
      end
      else
      begin
   Dirct := Dirct + NewDir;
   AList^.Insert(NewDirEntry(Indent + PathDir + NewDir, Dirct));
   NewDir := '';
      end;
      Indent := Indent + IndentSize;
      Dirct := Dirct + DirSeparator;
    end;
    NewCur := AList^.Count-1;
    isFirst := True;
    NewDir := Dirct + '*.*';
    FindFirst(NewDir, Directory, SR);
    while DosError = 0 do
    begin
      if (SR.Attr and Directory <> 0) and
{$ifdef FPC}
         (SR.Name <> '.') and (SR.Name <> '..') then
{$else : not FPC}
         (SR.Name[1] <> '.') then
{$endif not FPC}
      begin
   if isFirst then
   begin
     S := FirstDir;
     isFirst := False;
   end else S := MiddleDir;
   AList^.Insert(NewDirEntry(Indent + S + SR.Name, Dirct + SR.Name));
      end;
      FindNext(SR);
    end;
 {$ifdef fpc}
  FindClose(SR);
 {$endif}
    P := PDirEntry(AList^.At(AList^.Count-1))^.DisplayText;
    I := Pos('À',P^);
    if I = 0 then
    begin
      I := Pos('Ã',P^);
      if I <> 0 then P^[I] := 'À';
    end else
    begin
      P^[I+1] := 'Ä';
      P^[I+2] := 'Ä';
    end;
  end;
  NewList(AList);
  FocusItem(NewCur);
  Cur:=NewCur;
end;

procedure TDirListBox.SetState(AState: Word; Enable: Boolean);
begin
  TListBox.SetState(AState, Enable);
  if AState and sfFocused <> 0 then
    PChDirDialog(Owner)^.ChDirButton^.MakeDefault(Enable);
end;

{****************************************************************************}
{ TChDirDialog Object                     }
{****************************************************************************}
{****************************************************************************}
{ TChDirDialog.Init                      }
{****************************************************************************}
constructor TChDirDialog.Init(AOptions: Word; HistoryId: Sw_Word);
var
  R: TRect;
  Control: PView;
begin
  R.Assign(16, 2, 64, 20);
  TDialog.Init(R,strings^.get(sChangeDirectory));

  Options := Options or ofCentered;

  R.Assign(3, 3, 30, 4);
  DirInput := New(PInputLine, Init(R, 68));
  Insert(DirInput);
  R.Assign(2, 2, 17, 3);
  Control := New(PLabel, Init(R,labels^.get(slDirectoryName), DirInput));
  Insert(Control);
  R.Assign(30, 3, 33, 4);
  Control := New(PHistory, Init(R, DirInput, HistoryId));
  Insert(Control);

  R.Assign(32, 6, 33, 16);
  Control := New(PScrollBar, Init(R));
  Insert(Control);
  R.Assign(3, 6, 32, 16);
  DirList := New(PDirListBox, Init(R, PScrollBar(Control)));
  Insert(DirList);
  R.Assign(2, 5, 17, 6);
  Control := New(PLabel, Init(R, labels^.get(slDirectoryTree), DirList));
  Insert(Control);

  R.Assign(35, 6, 45, 8);
  OkButton := New(PButton, Init(R, labels^.get(slOk), cmOK, bfDefault));
  Insert(OkButton);
  Inc(R.A.Y,3); Inc(R.B.Y,3);
  ChDirButton := New(PButton,Init(R,labels^.get(slChDir),cmChangeDir,
           bfNormal));
  Insert(ChDirButton);
  Inc(R.A.Y,3); Inc(R.B.Y,3);
  Insert(New(PButton, Init(R,labels^.get(slRevert), cmRevert, bfNormal)));
  if AOptions and cdHelpButton <> 0 then
  begin
    Inc(R.A.Y,3); Inc(R.B.Y,3);
    Insert(New(PButton, Init(R,labels^.get(slHelp), cmHelp, bfNormal)));
  end;

  if AOptions and cdNoLoadDir = 0 then SetUpDialog;

  SelectNext(False);
end;

{****************************************************************************}
{ TChDirDialog.Load                      }
{****************************************************************************}
constructor TChDirDialog.Load(var S: TStream);
begin
  TDialog.Load(S);
  GetSubViewPtr(S, DirList);
  GetSubViewPtr(S, DirInput);
  GetSubViewPtr(S, OkButton);
  GetSubViewPtr(S, ChDirbutton);
  SetUpDialog;
end;

{****************************************************************************}
{ TChDirDialog.DataSize                      }
{****************************************************************************}
function TChDirDialog.DataSize: Sw_Word;
begin
  DataSize := 0;
end;

{****************************************************************************}
{ TChDirDialog.GetData                        }
{****************************************************************************}
procedure TChDirDialog.GetData(var Rec);
begin
end;

{****************************************************************************}
{ TChDirDialog.HandleEvent                   }
{****************************************************************************}
procedure TChDirDialog.HandleEvent(var Event: TEvent);
var
  CurDir: DirStr;
  P: PDirEntry;
begin
  TDialog.HandleEvent(Event);
  case Event.What of
    evCommand:
      begin
   case Event.Command of
     cmRevert: GetDir(0,CurDir);
     cmChangeDir:
       begin
         P := DirList^.List^.At(DirList^.Focused);
         if (P^.Directory^ = Drives^)
            or DriveValid(P^.Directory^[1]) then
           CurDir := P^.Directory^
         else Exit;
       end;
   else
     Exit;
   end;
   if (Length(CurDir) > 3) and
      (CurDir[Length(CurDir)] = DirSeparator) then
     CurDir := Copy(CurDir,1,Length(CurDir)-1);
   DirList^.NewDirectory(CurDir);
   DirInput^.Data^ := CurDir;
   DirInput^.DrawView;
   DirList^.Select;
   ClearEvent(Event);
      end;
  end;
end;

{****************************************************************************}
{ TChDirDialog.SetData                        }
{****************************************************************************}
procedure TChDirDialog.SetData(var Rec);
begin
end;

{****************************************************************************}
{ TChDirDialog.SetUpDialog                   }
{****************************************************************************}
procedure TChDirDialog.SetUpDialog;
var
  CurDir: DirStr;
begin
  if DirList <> nil then
  begin
    CurDir := GetCurDir;
    DirList^.NewDirectory(CurDir);
    if (Length(CurDir) > 3) and (CurDir[Length(CurDir)] = DirSeparator) then
      CurDir := Copy(CurDir,1,Length(CurDir)-1);
    if DirInput <> nil then
    begin
      DirInput^.Data^ := CurDir;
      DirInput^.DrawView;
    end;
  end;
end;

{****************************************************************************}
{ TChDirDialog.Store                    }
{****************************************************************************}
procedure TChDirDialog.Store(var S: TStream);
begin
  TDialog.Store(S);
  PutSubViewPtr(S, DirList);
  PutSubViewPtr(S, DirInput);
  PutSubViewPtr(S, OkButton);
  PutSubViewPtr(S, ChDirButton);
end;

{****************************************************************************}
{ TChDirDialog.Valid                    }
{****************************************************************************}
function TChDirDialog.Valid(Command: Word): Boolean;
var
  P: PathStr;
begin
  Valid := True;
  if Command = cmOk then
  begin
    P := FExpand(DirInput^.Data^);
    if (Length(P) > 3) and (P[Length(P)] = DirSeparator) then
      Dec(P[0]);
    {$I-}
    ChDir(P);
    if (IOResult <> 0) then
    begin
      MessageBox(Strings^.Get(sInvalidDirectory), nil, mfError + mfOkButton);
      Valid := False;
    end;
    {$I+}
  end;
end;

{****************************************************************************}
{ TEditChDirDialog Object                     }
{****************************************************************************}
{****************************************************************************}
{ TEditChDirDialog.DataSize                    }
{****************************************************************************}
function TEditChDirDialog.DataSize : Sw_Word;
begin
  DataSize := SizeOf(DirStr);
end;

{****************************************************************************}
{ TEditChDirDialog.GetData                   }
{****************************************************************************}
procedure TEditChDirDialog.GetData (var Rec);
var
  CurDir : DirStr absolute Rec;
begin
  if (DirInput = nil) then
    CurDir := ''
  else begin
    CurDir := DirInput^.Data^;
    if (CurDir[Length(CurDir)] <> DirSeparator) then
      CurDir := CurDir + DirSeparator;
  end;
end;

{****************************************************************************}
{ TEditChDirDialog.SetData                   }
{****************************************************************************}
procedure TEditChDirDialog.SetData (var Rec);
var
  CurDir : DirStr absolute Rec;
begin
  if DirList <> nil then
  begin
    DirList^.NewDirectory(CurDir);
    if DirInput <> nil then
    begin
      if (Length(CurDir) > 3) and (CurDir[Length(CurDir)] = DirSeparator) then
   DirInput^.Data^ := Copy(CurDir,1,Length(CurDir)-1)
      else DirInput^.Data^ := CurDir;
      DirInput^.DrawView;
    end;
  end;
end;

{****************************************************************************}
{ TSortedListBox Object                      }
{****************************************************************************}
{****************************************************************************}
{ TSortedListBox.Init                     }
{****************************************************************************}
constructor TSortedListBox.Init(var Bounds: TRect; ANumCols: Sw_Word;
  AScrollBar: PScrollBar);
begin
  TListBox.Init(Bounds, ANumCols, AScrollBar);
  SearchPos := 0;
  ShowCursor;
  SetCursor(1,0);
end;

{****************************************************************************}
{ TSortedListBox.HandleEvent                  }
{****************************************************************************}
procedure TSortedListBox.HandleEvent(var Event: TEvent);
const
  SpecialChars: set of Char = [#0,#9,#27];
var
  CurString, NewString: String;
  K: Pointer;
  Value : Sw_integer;
  OldPos, OldValue: Sw_Integer;
  T: Boolean;
begin
  OldValue := Focused;
  TListBox.HandleEvent(Event);
  if (OldValue <> Focused) or
     ((Event.What = evBroadcast) and (Event.InfoPtr = @Self) and
      (Event.Command = cmReleasedFocus)) then
    SearchPos := 0;
  if Event.What = evKeyDown then
  begin
    { patched to prevent error when no or empty list or Escape pressed }
    if (not (Event.CharCode in SpecialChars)) and
       (List <> nil) and (List^.Count > 0) then
    begin
      Value := Focused;
      if Value < Range then
        CurString := GetText(Value, 255)
      else
        CurString := '';
      OldPos := SearchPos;
      if Event.KeyCode = kbBack then
      begin
   if SearchPos = 0 then Exit;
   Dec(SearchPos);
          if SearchPos = 0 then
            HandleDir:= ((GetShiftState and $3) <> 0) or (Event.CharCode in ['A'..'Z']);
   CurString[0] := Char(SearchPos);
      end
      else if (Event.CharCode = '.') then
        SearchPos := Pos('.',CurString)
      else
      begin
   Inc(SearchPos);
          if SearchPos = 1 then
            HandleDir := ((GetShiftState and 3) <> 0) or (Event.CharCode in ['A'..'Z']);
   CurString[0] := Char(SearchPos);
   CurString[SearchPos] := Event.CharCode;
      end;
      K := GetKey(CurString);
      T := PSortedCollection(List)^.Search(K, Value);
      if Value < Range then
      begin
          if Value < Range then
            NewString := GetText(Value, 255)
          else
            NewString := '';
   if Equal(NewString, CurString, SearchPos) then
   begin
     if Value <> OldValue then
     begin
       FocusItem(Value);
       { Assumes ListControl will set the cursor to the first character }
       { of the sfFocused item }
       SetCursor(Cursor.X+SearchPos, Cursor.Y);
     end
              else
                SetCursor(Cursor.X+(SearchPos-OldPos), Cursor.Y);
   end
          else
            SearchPos := OldPos;
      end
      else SearchPos := OldPos;
      if (SearchPos <> OldPos) or (Event.CharCode in ['A'..'Z','a'..'z']) then
   ClearEvent(Event);
    end;
  end;
end;

function TSortedListBox.GetKey(var S: String): Pointer;
begin
  GetKey := @S;
end;

procedure TSortedListBox.NewList(AList: PCollection);
begin
  TListBox.NewList(AList);
  SearchPos := 0;
end;

{****************************************************************************}
{            Global Procedures and Functions          }
{****************************************************************************}

{****************************************************************************}
{ Contains                          }
{****************************************************************************}
function Contains(S1, S2: String): Boolean;
  { Contains returns true if S1 contains any characters in S2. }
var
  i : Byte;
begin
  Contains := True;
  i := 1;
  while ((i < Length(S2)) and (i < Length(S1))) do
    if (Upcase(S1[i]) = Upcase(S2[i])) then
      Exit
    else Inc(i);
  Contains := False;
end;

{****************************************************************************}
{ StdDeleteFile                           }
{****************************************************************************}
function StdDeleteFile (AFile : FNameStr) : Boolean;
var
  Rec : PStringRec;
begin
  if CheckOnDelete then
  begin
    AFile := ShrinkPath(AFile,33);
    Rec.AString := PString(@AFile);
    StdDeleteFile := (MessageBox(^C + Strings^.Get(sDeleteFile),
               @Rec,mfConfirmation or mfOkCancel) = cmOk);
  end
  else StdDeleteFile := False;
end;

{****************************************************************************}
{ DriveValid                         }
{****************************************************************************}
function DriveValid(Drive: Char): Boolean;
{$ifdef HAS_DOS_DRIVES}
var
  D: Char;
begin
  D := GetCurDrive;
  {$I-}
  ChDir(Drive+':');
  if (IOResult = 0) then
  begin
    DriveValid := True;
    ChDir(D+':')
  end
  else DriveValid := False;
  {$I+}
end;
{$else HAS_DOS_DRIVES}
begin
  DriveValid:=true;
end;
{$endif HAS_DOS_DRIVES}

{****************************************************************************}
{ Equal                             }
{****************************************************************************}
function Equal(const S1, S2: String; Count: Sw_word): Boolean;
var
  i: Sw_Word;
begin
  Equal := False;
  if (Length(S1) < Count) or (Length(S2) < Count) then
    Exit;
  for i := 1 to Count do
    if UpCase(S1[I]) <> UpCase(S2[I]) then
      Exit;
  Equal := True;
end;

{****************************************************************************}
{ ExtractDir                         }
{****************************************************************************}
function ExtractDir(AFile: FNameStr): DirStr;
  { ExtractDir returns the path of AFile terminated with a trailing '\'.  If
    AFile contains no directory information, an empty string is returned. }
var
  D: DirStr;
  N: NameStr;
  E: ExtStr;
begin
  FSplit(AFile,D,N,E);
  if D = '' then
  begin
    ExtractDir := '';
    Exit;
  end;
  if D[Byte(D[0])] <> DirSeparator then
    D := D + DirSeparator;
  ExtractDir := D;
end;

{****************************************************************************}
{ ExtractFileName                       }
{****************************************************************************}
function ExtractFileName(AFile: FNameStr): NameStr;
var
  D: DirStr;
  N: NameStr;
  E: ExtStr;
begin
  FSplit(AFile,D,N,E);
  ExtractFileName := N;
end;

{****************************************************************************}
{ FileExists                         }
{****************************************************************************}
function FileExists (AFile : FNameStr) : Boolean;
begin
  FileExists := (FSearch(AFile,'') <> '');
end;

{****************************************************************************}
{ GetCurDir                        }
{****************************************************************************}
function GetCurDir: DirStr;
var
  CurDir: DirStr;
begin
  GetDir(0, CurDir);
  if (Length(CurDir) > 3) then
  begin
    Inc(CurDir[0]);
    CurDir[Length(CurDir)] := DirSeparator;
  end;
  GetCurDir := CurDir;
end;

{****************************************************************************}
{ GetCurDrive                       }
{****************************************************************************}
function GetCurDrive: Char;
{$ifdef go32v2}
var
  Regs : Registers;
begin
  Regs.AH := $19;
  Intr($21,Regs);
  GetCurDrive := Char(Regs.AL + Byte('A'));
end;
{$else not go32v2}
var
  D : DirStr;
begin
  D:=GetCurDir;
  if (Length(D)>1) and (D[2]=':') then
    begin
      if (D[1]>='a') and (D[1]<='z') then
        GetCurDrive:=Char(Byte(D[1])+Byte('A')-Byte('a'))
      else
        GetCurDrive:=D[1];
    end
  else
    GetCurDrive:='C';
end;
{$endif not go32v2}

{****************************************************************************}
{ IsDir                             }
{****************************************************************************}
function IsDir(const S: String): Boolean;
var
  SR: SearchRec;
  Is: boolean;
begin
  Is:=false;
{$ifdef Unix}
  Is:=(S=DirSeparator); { handle root }
{$else}
  Is:=(length(S)=3) and (Upcase(S[1]) in['A'..'Z']) and (S[2]=':') and (S[3]=DirSeparator);
  { handle root dirs }
{$endif}
  if Is=false then
  begin
    FindFirst(S, Directory, SR);
    if DosError = 0 then
      Is := (SR.Attr and Directory) <> 0
    else
      Is := False;
   {$ifdef fpc}
    FindClose(SR);
   {$endif}
  end;
  IsDir:=Is;
end;

{****************************************************************************}
{ IsWild                           }
{****************************************************************************}
function IsWild(const S: String): Boolean;
begin
  IsWild := (Pos('?',S) > 0) or (Pos('*',S) > 0);
end;

{****************************************************************************}
{ IsList                           }
{****************************************************************************}
function IsList(const S: String): Boolean;
begin
  IsList := (Pos(ListSeparator,S) > 0);
end;

{****************************************************************************}
{ MakeResources                           }
{****************************************************************************}
procedure MakeResources;
var
  Dlg : PDialog;
  Key : String;
  i : Word;
begin
  for i := 0 to 1 do
  begin
    case i of
      0 : begin
       Key := reOpenDlg;
       Dlg := New(PFileDialog,Init('*.*',strings^.get(sOpen),
             labels^.get(slName),
             fdOkButton or fdHelpButton or fdNoLoadDir,0));
     end;
      1 : begin
       Key := reSaveAsDlg;
       Dlg := New(PFileDialog,Init('*.*',strings^.get(sSaveAs),
             labels^.get(slName),
             fdOkButton or fdHelpButton or fdNoLoadDir,0));
     end;
      2 : begin
       Key := reEditChDirDialog;
       Dlg := New(PEditChDirDialog,Init(cdHelpButton,
             hiCurrentDirectories));
     end;
    end;
    if Dlg = nil then
    begin
       PrintStr('Error initializing dialog ' + Key);
       Halt;
    end
    else begin
      RezFile^.Put(Dlg,Key);
      if (RezFile^.Stream^.Status <> stOk) then
      begin
   PrintStr('Error writing dialog ' + Key + ' to the resource file.');
   Halt;
      end;
    end;
  end;
end;

{****************************************************************************}
{ NoWildChars                       }
{****************************************************************************}
function NoWildChars(S: String): String;
const
  WildChars : array[0..1] of Char = ('?','*');
var
  i : Sw_Word;
begin
  repeat
    i := Pos('?',S);
    if (i > 0) then
      System.Delete(S,i,1);
  until (i = 0);
  repeat
    i := Pos('*',S);
    if (i > 0) then
      System.Delete(S,i,1);
  until (i = 0);
  NoWildChars:=S;
end;

{****************************************************************************}
{ OpenFile                          }
{****************************************************************************}
function OpenFile (var AFile : FNameStr; HistoryID : Byte) : Boolean;
var
  Dlg : PFileDialog;
begin
  {$ifdef cdResource}
  Dlg := PFileDialog(RezFile^.Get(reOpenDlg));
  {$else}
  Dlg := New(PFileDialog,Init('*.*',strings^.get(sOpen),labels^.get(slName),
        fdOkButton or fdHelpButton,0));
  {$endif cdResource}
    { this might not work }
  PHistory(Dlg^.FileName^.Next^.Next)^.HistoryID := HistoryID;
  OpenFile := (Application^.ExecuteDialog(Dlg,@AFile) = cmFileOpen);
end;

{****************************************************************************}
{ OpenNewFile                       }
{****************************************************************************}
function OpenNewFile (var AFile: FNameStr; HistoryID: Byte): Boolean;
  { OpenNewFile allows the user to select a directory from disk and enter a
    new file name.  If the file name entered is an existing file the user is
    optionally prompted for confirmation of replacing the file based on the
    value in #CheckOnReplace#.  If a file name is successfully entered,
    OpenNewFile returns True. }
  {#X OpenFile }
begin
  OpenNewFile := False;
  if OpenFile(AFile,HistoryID) then
  begin
    if not ValidFileName(AFile) then
      Exit;
    if FileExists(AFile) then
      if (not CheckOnReplace) or (not ReplaceFile(AFile)) then
   Exit;
    OpenNewFile := True;
  end;
end;

{****************************************************************************}
{ RegisterStdDlg                         }
{****************************************************************************}
procedure RegisterStdDlg;
begin
  RegisterType(RFileInputLine);
  RegisterType(RFileCollection);
  RegisterType(RFileList);
  RegisterType(RFileInfoPane);
  RegisterType(RFileDialog);
  RegisterType(RDirCollection);
  RegisterType(RDirListBox);
  RegisterType(RSortedListBox);
  RegisterType(RChDirDialog);
end;

{****************************************************************************}
{ StdReplaceFile                         }
{****************************************************************************}
function StdReplaceFile (AFile : FNameStr) : Boolean;
var
  Rec : PStringRec;
begin
  if CheckOnReplace then
  begin
    AFile := ShrinkPath(AFile,33);
    Rec.AString := PString(@AFile);
    StdReplaceFile :=
       (MessageBox(^C + Strings^.Get(sReplaceFile),
         @Rec,mfConfirmation or mfOkCancel) = cmOk);
  end
  else StdReplaceFile := True;
end;

{****************************************************************************}
{ SaveAs                           }
{****************************************************************************}
function SaveAs (var AFile : FNameStr; HistoryID : Word) : Boolean;
var
  Dlg : PFileDialog;
begin
  SaveAs := False;
  {$ifdef cdResource}
  Dlg := PFileDialog(RezFile^.Get(reSaveAsDlg));
  {$else}
  Dlg := New(PFileDialog,Init('*.*',strings^.get(sSaveAs),
        labels^.get(slSaveAs),
        fdOkButton or fdHelpButton,0));
  {$endif cdResource}
    { this might not work }
  PHistory(Dlg^.FileName^.Next^.Next)^.HistoryID := HistoryID;
  Dlg^.HelpCtx := hcSaveAs;
  if (Application^.ExecuteDialog(Dlg,@AFile) = cmFileOpen) and
     ((not FileExists(AFile)) or ReplaceFile(AFile)) then
    SaveAs := True;
end;

{****************************************************************************}
{ SelectDir                        }
{****************************************************************************}
function SelectDir (var ADir : DirStr; HistoryID : Byte) : Boolean;
var
  Dir: DirStr;
  Dlg : PEditChDirDialog;
  Rec : DirStr;
begin
  {$I-}
  GetDir(0,Dir);
  {$I+}
  Rec := FExpand(ADir);
  {$ifdef cdResource}
  Dlg := PEditChDirDialog(RezFile^.Get(reEditChDirDialog));
  {$else}
  Dlg := New(PEditChDirDialog,Init(cdHelpButton,HistoryID));
  {$endif cdResource}
  if (Application^.ExecuteDialog(Dlg,@Rec) = cmOk) then
  begin
    SelectDir := True;
    ADir := Rec;
  end
  else SelectDir := False;
  {$I-}
  ChDir(Dir);
  {$I+}
end;

{****************************************************************************}
{ ShrinkPath                         }
{****************************************************************************}
function ShrinkPath (AFile : FNameStr; MaxLen : Byte) : FNameStr;
var
  Filler: string;
  D1 : DirStr;
  N1 : NameStr;
  E1 : ExtStr;
  i  : Sw_Word;

begin
  if Length(AFile) > MaxLen then
  begin
    FSplit(FExpand(AFile),D1,N1,E1);
    AFile := Copy(D1,1,3) + '..' + DirSeparator;
    i := Pred(Length(D1));
    while (i > 0) and (D1[i] <> DirSeparator) do
      Dec(i);
    if (i = 0) then
      AFile := AFile + D1
    else AFile := AFile + Copy(D1,Succ(i),Length(D1)-i);
    if AFile[Length(AFile)] <> DirSeparator then
      AFile := AFile + DirSeparator;
    if Length(AFile)+Length(N1)+Length(E1) <= MaxLen then
      AFile := AFile + N1 + E1
    else
      begin
        Filler := '...' + DirSeparator;
        AFile:=Copy(Afile,1,MaxLen-Length(Filler)-Length(N1)-Length(E1))
                +Filler+N1+E1;
      end;
  end;
  ShrinkPath := AFile;
end;

{****************************************************************************}
{ ValidFileName                           }
{****************************************************************************}
function ValidFileName(var FileName: PathStr): Boolean;
var
  IllegalChars: string[12];
  Dir: DirStr;
  Name: NameStr;
  Ext: ExtStr;
begin
{$ifdef PPC_FPC}
{$ifdef go32v2}
  { spaces are allowed if LFN is supported }
  if LFNSupport then
    IllegalChars := ';,=+<>|"[]'+DirSeparator
  else
    IllegalChars := ';,=+<>|"[] '+DirSeparator;
{$else not go32v2}
{$ifdef win32}
    IllegalChars := ';,=+<>|"[]'+DirSeparator;
{$else not go32v2 and not win32 }
    IllegalChars := ';,=+<>|"[] '+DirSeparator;
{$endif not win32}
{$endif not go32v2}
{$else not PPC_FPC}
  IllegalChars := ';,=+<>|"[] '+DirSeparator;
{$endif PPC_FPC}
  ValidFileName := True;
  FSplit(FileName, Dir, Name, Ext);
  if not ((Dir = '') or PathValid(Dir)) or
     Contains(Name, IllegalChars) or
     Contains(Dir, IllegalChars) then
    ValidFileName := False;
end;

{****************************************************************************}
{        Unit Initialization Section                                         }
{****************************************************************************}
begin
{$ifdef PPC_BP}
  ReplaceFile := StdReplaceFile;
  DeleteFile := StdDeleteFile;
{$else}
  ReplaceFile := @StdReplaceFile;
  DeleteFile := @StdDeleteFile;
{$endif PPC_BP}
end.