{ DISK.INC: Disk Routines }

{==========================================================================}
{ (c) Copyright Waterline Software Developent V.O.F. 1990-1994             }
{                                                                          }
{    Waterline Software Development V.O.F.                                 }
{    Wouter Sluislaan 12                                                   }
{    1461 AC  Zuidoostbeemster                                             }
{    The Netherlands                                                       }
{                                                                          }
{ It not allowed to use this user interface in any program not owned by    }
{ the Waterline Software Development V.O.F.                                }
{ Special conditions apply to programs distributed by the Waterline        }
{ Software Development V.O.F. If the source code of any of these programs  }
{ is distributed as well, it is NOT allowed to use the user interface in   }
{ your own programs. Violators may be prosecuted!                          }
{                                                                          }
{ Please contact the Waterline Software Development V.O.F. at the above    }
{ address for your licence to use the "Ramon" user interface. You will get }
{ the most recent copy of the "Ramon" user interface and the "Ramon" user  }
{ interface expert for free. This program helps you design your user       }
{ interfaces at an instance.                                               }
{                                                                          }
{ This copyright notice should remain in this file and all files that are  }
{ part of the user interface "Ramon".                                      }
{==========================================================================}

{--------------------------------------------------------------------------}
{ TestIfExist                                                              }
{                                                                          }
{ Deze routine kijkt of de opgegeven file aanwezig is. Zoja, dan wordt     }
{ TRUE terug gegeven, anders FALSE.                                        }
{                                                                          }
FUNCTION TestIfExist (FilePath : STRING) : BOOLEAN;

VAR Search   : SearchRec;

BEGIN
     FindFirst (FilePath,$31,Search);
     TestIfExist:=(Dos.DosError = 0);
     {$IFDEF PLATFORM_OS2}
     FindClose (Search);
     {$ENDIF}
END;


{--------------------------------------------------------------------------}
{ LockFile                                                                 }
{                                                                          }
{ Locked een bestand door de eerste byte vast te zetten.                   }
{                                                                          }
FUNCTION LockFile (VAR Bestand : FILE) : BOOLEAN;
{$IFDEF PLATFORM_OS2}

VAR UnLock,
    Lock   : FileLock;

BEGIN
{$IFNDEF FPC}
     UnLock.lOffset:=0;
     UnLock.lRange:=0;

     Lock.lOffset:=1;
     Lock.lRange:=1;
{$ELSE}
     UnLock.Offset:=0;
     UnLock.Range:=0;

     Lock.Offset:=1;
     Lock.Range:=1;
{$ENDIF}

     LockFile:=(DosSetFileLocks (FileRec (Bestand).Handle,UnLock,Lock,10,0) = 0);
{$ENDIF}
{$IFDEF PLATFORM_WIN32}
BEGIN
     LockFile := Windows.LockFile (FileRec (Bestand).Handle, 1, 0, 1, 0);
{$ENDIF}
{$IFDEF PLATFORM_DOS_ALL}
VAR Result,
    Handle : WORD;

BEGIN
     Handle:=FileRec (Bestand).Handle;

     ASM
        MOV AH,$5C
        MOV AL,0   { 0 = blokeren }
        MOV BX,Handle
        MOV CX,0   { CX:DX = offset = 0 = begin van het bestand }
        MOV DX,0
        MOV SI,0   { SI:DI = Lengte = 1 byte }
        MOV DI,1
        INT 21h
        JC @Done   { carry gezet bij fout }
        MOV AX,0
        @Done:
        MOV Result,AX
     END;

     LockFile:=((Result = 0) OR (Result = 1));
{$ENDIF}
END;


{--------------------------------------------------------------------------}
{ UnLockFile                                                               }
{                                                                          }
{ UnLocked een bestand door de eerste byte weer vrij te geven.             }
{                                                                          }
FUNCTION UnLockFile (VAR Bestand : FILE) : BOOLEAN;
{$IFDEF PLATFORM_OS2}

VAR UnLock,
    Lock   : FileLock;

BEGIN
{$IFNDEF FPC}
     UnLock.lOffset:=1;
     UnLock.lRange:=1;

     Lock.lOffset:=0;
     Lock.lRange:=0;
{$ELSE}
     UnLock.Offset:=1;
     UnLock.Range:=1;

     Lock.Offset:=0;
     Lock.Range:=0;
{$ENDIF}

     UnLockFile:=(DosSetFileLocks (FileRec (Bestand).Handle,UnLock,Lock,10,0) = 0);
{$ENDIF}
{$IFDEF PLATFORM_WIN32}
BEGIN
     UnLockFile := Windows.UnLockFile (FileRec (Bestand).Handle, 1, 0, 1, 0);
{$ENDIF}
{$IFDEF PLATFORM_DOS_ALL}
VAR Result,
    Handle : WORD;

BEGIN
     Handle:=FileRec (Bestand).Handle;

     ASM
        MOV AH,$5C
        MOV AL,1       { DeBlokeren }
        MOV BX,Handle
        MOV CX,0       { CX:DX = offset = begin van het bestand }
        MOV DX,0
        MOV SI,0       { SI:DI = lengte = 1 byte }
        MOV DI,1
        INT 21h
        JC @Done
        MOV AX,0
        @Done:
        MOV Result,AX
     END;

     UnLockFile:=((Result = 0) OR (Result = 1));
{$ENDIF}
END;


{--------------------------------------------------------------------------}
{ CorrectPath                                                              }
{                                                                          }
{ Deze routine corrigeert het pad. Er komt altijd een backslash aan het    }
{ einde te staan, behalve als die er al staat. Dit gebeurt niet als de     }
{ invoer leeg was (want dan zou het de root worden), of als de invoer      }
{ alleen een drive was ("C:").                                             }
{                                                                          }
FUNCTION CorrectPath (Path : STRING) : STRING;
BEGIN
     Path:=DeleteFrontAndBackSpaces (Path);

     { spaties eruit halen }
     WHILE (Path <> '') AND (Pos (' ',Path) > 0) DO
           Delete (Path,Pos (' ',Path),1);

     CorrectPath:=Path;

     { kijk of de invoer leeg is, anders zou het een root worden }
     IF (Path = '') THEN
        Exit;

     { controleer op alleen een drive letter met dubbele punt ("C:") }
     IF (Length (Path) = 2) AND (Path[Length (Path)] = ':') THEN
        Exit;

     { check for a UNC path }
     IF (Copy (Path,1,2) = '\\') THEN
        Exit;

     { kijk of de backslash er staat. Zoniet, dan toevoegen }
     { RWI 960714: should not when * or ? in path.. }
     IF (Path[Length (Path)] <> '\') THEN
        Path:=Path+'\';

     CorrectPath:=UNC_FExpand (Path);
END;


{--------------------------------------------------------------------------}
{ CreatePath                                                               }
{                                                                          }
{ Deze routine maakt het hele pad aan. Als het pad direct aanmaken niet    }
{ lukt, dan wordt ieder stuk e'e'n voor e'e'n geprobeerd en aangemaakt.    }
{ Als het helemaal niet lukt, dan wordt een foutcode <> 0 terug gegeven    }
{ voor het laagste pad dat niet kon worden aangemaakt.                     }
{                                                                          }
FUNCTION CreatePath (Path : STRING) : BYTE;

VAR IORes : BYTE;
    Orig,
    Hulp  : STRING;
    P     : BYTE;

BEGIN
     { probeer het pad in e'e'n keer aan te maken}

     { kijk of er wel een pad is of alleen C:\ }
     IF (Length (Path) = 3) AND (Path[2] = ':') AND (Path[3] = '\') THEN
     BEGIN
          CreatePath:=0; { bestaat altijd }
          Exit;
     END;

     IF (Path[Length (Path)] = '\') THEN
        Delete (Path,Length (Path),1);

     { als het pad al bestaat, dan niet aanmaken }
     GetDir (0,Orig);
     {$I-} ChDir (Path); {$I+} IORes:=IOResult;
     IF (IORes = 0) THEN
     BEGIN
          ChDir (Orig);
          CreatePath:=0;
          Exit;
     END;

     {$I-} MkDir (Path); {$I+} IORes:=IOResult;
     IF (IORes = 0) THEN
     BEGIN
          ChDir (Orig);
          CreatePath:=0;
          Exit;
     END;

     { niet gelukt. Nu stukje voor stukje vanaf het begin proberen }
     Hulp:='';
     WHILE (Path <> '') DO
     BEGIN
          IF (Path[1] = '\') THEN
          BEGIN
               Hulp:=Hulp+'\';
               Delete (Path,1,1);
          END ELSE
              IF (Hulp <> '') THEN
                 Hulp:=Hulp+'\';

          P:=Pos ('\',Path);

          IF (P <> 0) THEN
          BEGIN
               { deel tot de backslash toevoegen aan Hulp }
               Hulp:=Hulp+Copy (Path,1,P-1);
               Delete (Path,1,P);
          END ELSE
          BEGIN
               Hulp:=Hulp+Path;
               Path:='';
          END;

          IF (NOT ((Length (Hulp) = 2) AND (Hulp[2] = ':'))) THEN
          BEGIN
               {$I-} MkDir (Hulp); {$I+} IORes:=IOResult;
               IF (IORes <> 0) THEN
               BEGIN
                    ChDir (Orig);
                    CreatePath:=IORes;
                    Exit;
               END;
          END;

     END; { while }

     ChDir (Orig);
     CreatePath:=0;
END;


{---------------------------------------------------------------------------}
{ CheckAndCreatePath                                                        }
{                                                                           }
{ Returns TRUE if the path is present, FALSE if it was not present and the  }
{ user either didn't want to create it, or some error occured while         }
{ creating it. The user has been informed of this error.                    }
{                                                                           }
FUNCTION CheckAndCreatePath (Path : STRING; IncludesFilename : BOOLEAN) : BOOLEAN;

VAR Search : SearchRec;
    IORes  : BYTE;

BEGIN
     IF NoPathChecking THEN
     BEGIN
          CheckAndCreatePath:=FALSE;
          Exit;
     END;

     IF IncludesFilename THEN
        WHILE (Path <> '') AND (Path[Length (Path)] <> '\') DO
              Delete (Path,Length (Path),1);

     { laatste backslash verwijderen }
     IF (Path[Length (Path)] = '\') THEN
        Delete (Path,Length (Path),1);

     IF (Path = '') THEN
     BEGIN
          { geen path, dan in orde }
          CheckAndCreatePath:=TRUE;
          Exit;
     END;

     IF (Length (Path) >= 2) AND (Path[2] = ':') THEN
     BEGIN
          { drive letter check }
          IF (DiskSize (Ord (UpCase (Path[1]))-64) = -1) THEN
          BEGIN
               Error ('Drive '+Path[1]+' does not exist');
               CheckAndCreatePath:=FALSE;
               Exit;
          END;
     END;

     IF (Length (Path) < 3) THEN
     BEGIN
          { P: }
          CheckAndCreatePath:=TRUE;
          Exit;
     END;

     FindFirst (Path,$31,Search);
     IF (Dos.DosError = 0) THEN
     BEGIN
          CheckAndCreatePath:=TRUE;
          Exit; { gevonden; geen problemen }
     END;

     MenuDefine (20,10,'Create path '+Path+'\');
     MenuAddItem ('Yes');
     MenuAddItem ('No');
     MenuAddItem ('Work off-line (disable path checking)');
     MenuSetFirst (2);
     MenuShow;
     MenuSelect;
     MenuErase;

     IF (Key = mOpt03) THEN
        NoPathChecking:=TRUE;

     IF (Key <> mOpt01) THEN
     BEGIN
          CheckAndCreatePath:=FALSE;
          Exit;
     END;

     IORes:=CreatePath (Path);
     IF (IORes <> 0) THEN
        Error ('Failed to create '+Path+' (error '+Byte2String (IORes)+')');

     CheckAndCreatePath:=(IORes = 0);
END;


{--------------------------------------------------------------------------}
{ InputAndCreateSubDir                                                     }
{                                                                          }
{ Asks the user for a sub-directory path and returns that selection.       }
{ Returns empty if aborted.                                                }
{                                                                          }
FUNCTION InputAndCreateSubDir (Dir : STRING) : STRING;

CONST Xb = 30;
      Yb = 7;
      Xl = 33;
      Yl = 5;

VAR NewDirStr : STRING[12];
    IORes     : BYTE;
    Search    : SearchRec;
    Temp      : STRING;

BEGIN
     InputAndCreateSubDir:=''; { assume error / abort }

     WindowPush (Xb,Yb,Xl,Yl);
     BoxDraw (Double,Xb,Yb,Xl,Yl);

     FieldPushAll;
     FieldInit;

     NewDirStr:=Spaces (12);

     WriteXY (Xb+2,Yb+2,'Create directory');
     FieldAutoDefineOne (Xb+19,Yb+2,@NewDirStr,RepChar (12,'@'));

     FieldEditDirect;
     FieldPopAll;
     WindowPop;

     IF NOT (Key IN [kF10,kRet]) THEN
        Exit; { abort }

     NewDirStr:=DeleteFrontAndBackSpaces (NewDirStr);
     IF (NewDirStr = '') THEN
        Exit; { no input }

     FindFirst (Dir+NewDirStr,$31,Search);
     IF (Dos.DosError = 0) THEN
     BEGIN
          Error ('Path '+Dir+NewDirStr+' already exists');
          Exit;
     END;

     Temp:=Dir+NewDirStr;
     IF (Length (Temp) > 60) THEN
        Temp:=''+Copy (Temp,Length (Temp)-60,255);

     MenuDefine (40-(Length (Temp)+10) DIV 2,6,'Create '+Temp+' ?');
     MenuAddItem ('Yes');
     MenuAddItem ('No');
     MenuShow;
     MenuSelect;
     MenuErase;

     IF (Key = mOpt01) THEN
     BEGIN
          {$I-} MkDir (Dir+NewDirStr); {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
             Error ('Failed to create directory (error '+Byte2String (IORes)+')')
          ELSE
              InputAndCreateSubDir:=NewDirStr;
     END;
END;


{--------------------------------------------------------------------------}
{ FileManager                                                              }
{                                                                          }
{ Met deze routine kan door een boom gewandeld worden op zoek naar een     }
{ file of directory. Het argument bepaald of de files ook in beeld komen.  }
{                                                                          }
FUNCTION FileManager (Input,SearchDescr,SearchExt : STRING) : STRING;

CONST Xb  = 3;
      Yb  = 3;
      Xl  = 55;

      MAXLEN_ITEM = 13;

TYPE ItemStr = STRING[MAXLEN_ITEM];

     ItemRecordPtr = ^ItemRecord;

     ItemRecord = RECORD
                        IsDir : BOOLEAN;
                        IsHit : BOOLEAN;
                        Size  : LONGINT;
                        Item  : ItemStr;
                        Next  : ItemRecordPtr;
                  END;

VAR ItemCount  : WORD;
    FirstPtr   : ItemRecordPtr;
    PaneLines  : XYType;
    PaneY      : XYType;
    CursorLine,
    PrevCursor : BYTE;
    TopOffset,
    PrevOffset : WORD;

    {----------------------------------------------------------------------}
    { FreeItems                                                            }
    {                                                                      }
    PROCEDURE FreeItems;

    VAR ErasePtr : ItemRecordPtr;

    BEGIN
         WHILE (FirstPtr <> NIL) DO
         BEGIN
              ErasePtr:=FirstPtr;
              FirstPtr:=ErasePtr^.Next;
              FreeMem (ErasePtr,SizeOf (ItemRecord));
         END; { while }

         ItemCount:=0;
    END;


    {----------------------------------------------------------------------}
    { AddItem                                                              }
    {                                                                      }
    PROCEDURE AddItem (Item : STRING; IsDir : BOOLEAN; IsHit : BOOLEAN; Size : LONGINT);

    VAR ItemPtr,
        PrevPtr,
        ZoekPtr : ItemRecordPtr;

    BEGIN
         GetMem (ItemPtr,SizeOf (ItemRecord));
         ItemPtr^.Item:=Item;
         ItemPtr^.Next:=NIL;
         ItemPtr^.IsDir:=IsDir;
         ItemPtr^.IsHit:=IsHit;
         ItemPtr^.Size:=Size;

         Inc (ItemCount);

         IF (FirstPtr = NIL) THEN
         BEGIN
              FirstPtr:=ItemPtr;
              Exit;
         END;

          {## *** FIX (***}
         { insert sorted }
         {$IFDEF FPC}
         {## is this what you intended?}
         IF (IsDir) THEN
              Item := #1 + Item
         ELSE
              Item := #0 + Item;
         {$ELSE}
         Item:=Char (NOT IsDir)+Item;
         {$ENDIF}
         ZoekPtr:=FirstPtr;

         {## Is this what you intended?}
         {$IFNDEF FPC}
         WHILE (ZoekPtr <> NIL) AND (Item > Char (NOT ZoekPtr^.IsDir)+ZoekPtr^.Item) DO
         BEGIN
              PrevPtr:=ZoekPtr;
              ZoekPtr:=ZoekPtr^.Next;
         END;
         {$ELSE}
         WHILE (ZoekPtr <> NIL) DO
         BEGIN
              IF (ZoekPtr^.IsDir) THEN
              BEGIN
                 IF (Item > #1+ZoekPtr^.Item) THEN
                     Break;
              END ELSE
                 IF (Item > #0+ZoekPtr^.Item) THEN
                     Break;

               PrevPtr := ZoekPtr;
               ZoekPtr := ZoekPtr^.Next;
         END;
         {$ENDIF}

         { replaces first? }
         IF (ZoekPtr = FirstPtr) THEN
         BEGIN
              ItemPtr^.Next:=FirstPtr;
              FirstPtr:=ItemPtr;
              Exit;
         END;

         { insert ItemPtr between PrevPtr and ZoekPtr }
         ItemPtr^.Next:=PrevPtr^.Next;
         PrevPtr^.Next:=ItemPtr;
    END;


    {----------------------------------------------------------------------}
    { Draw                                                                 }
    {                                                                      }
    PROCEDURE Draw;

    VAR ItemPtr : ItemRecordPtr;
        Left    : WORD;
        Y       : XYType;
        Item    : STRING[Xl];
        First   : CHAR;
        Scroll  : BYTE;

    BEGIN
         ItemPtr:=FirstPtr;

         { calculate position for scroll index }
         IF (ItemCount < PaneLines) THEN
            Scroll:=255 { suppress }
         ELSE
             Scroll:=Trunc ((TopOffset/(ItemCount-PaneLines))*(PaneLines-1));

         First:='³';

         { sla over wat we niet tekenen }
         Left:=TopOffset;
         IF (Left > 0) THEN
            First:='';

         WHILE (Left > 0) DO
         BEGIN
              ItemPtr:=ItemPtr^.Next;
              IF (ItemPtr = NIL) THEN
              BEGIN
                   Error ('Internal Error');
                   Exit;
              END;
              Dec (Left);
         END; { while }

         Y:=0;
         Left:=PaneLines;
         SetColor (cBoxData);

         WHILE (Left > 0) DO
         BEGIN
              { teken deze }
              IF (ItemPtr = NIL) THEN
                 Item:=''
              ELSE BEGIN
                   Item:=AddUpWithSpaces (14,ItemPtr^.Item);

                   IF ItemPtr^.IsDir THEN
                      Item:=Item+' <dir>'
                   ELSE
                       Item:=Item+AddUpWithPreSpaces (10,Longint2String (ItemPtr^.Size));

                   IF ItemPtr^.IsHit THEN
                      Item:=Item+' ('+SearchDescr+')';

                   ItemPtr:=ItemPtr^.Next;
              END;

              IF (Left = 1) THEN
                 IF (CursorLine+TopOffset < ItemCount-1) AND
                    (ItemCount > PaneLines) THEN
                    First:='';

              IF (First = '³') AND (Y = Scroll) THEN
                 First:='þ';

              WriteXY (Xb+1,PaneY+Y,First+AddUpWithSpaces (Xl-3,Item));

              First:='³';

              Inc (Y);
              Dec (Left);
         END; { while }

         PrevCursor:=255; { not visible }
    END;


    {----------------------------------------------------------------------}
    { RemoveCursor                                                         }
    {                                                                      }
    { None-destructive cursor removal.                                     }
    {                                                                      }
    PROCEDURE RemoveCursor;
    BEGIN
         IF (PrevCursor = 255) THEN
            Exit;

         ChangeColor (Xb+1,PaneY+PrevCursor,Xl-2,cBoxData);
         PrevCursor:=255;
    END;


    {----------------------------------------------------------------------}
    { ShowCursor                                                           }
    {                                                                      }
    { None-destructive cursor drawing.                                     }
    {                                                                      }
    PROCEDURE ShowCursor;
    BEGIN
         ChangeColor (Xb+1,PaneY+CursorLine,Xl-2,cFieldCursor);
    END;


    {----------------------------------------------------------------------}
    { GetItem                                                              }
    {                                                                      }
    { Deze routine haalt het opgegeven item nummer uit de set, waarbij 0   }
    { het eerste item is. De naam wordt terug gegeven met spaties          }
    { verwijderd en eventueel een punt ingevoegd.                          }
    {                                                                      }
    FUNCTION GetItem (ItemNr : WORD; VAR IsDir : BOOLEAN) : STRING;

    VAR ItemPtr : ItemRecordPtr;
        Item    : ItemStr;

    BEGIN
         GetItem:='';
         IsDir:=FALSE;

         ItemPtr:=FirstPtr;

         WHILE (ItemNr > 0) DO
         BEGIN
              IF (ItemPtr = NIL) THEN
                 Exit;

              ItemPtr:=ItemPtr^.Next;

              Dec (ItemNr);
         END;

         IF (ItemPtr = NIL) THEN
            Exit;

         Item:=ItemPtr^.Item;
         IsDir:=ItemPtr^.IsDir;

         IF (Length (Item) > 8) THEN
         BEGIN
              { heeft een extension }
              Item[9]:='.';
              WHILE (Pos (' ',Item) > 0) DO
                    Delete (Item,Pos (' ',Item),1);
         END;

         GetItem:=Item;
    END;


{ FileManager }

VAR Yl         : XYType;
    Quit       : BOOLEAN;
    Search     : SearchRec;
    Lp         : WORD;
    Update     : BOOLEAN;
    CurrItem   : WORD;
    Dir        : DirStr;
    Temp,
    Selection  : STRING[MAXLEN_ITEM];
    Name       : NameStr;
    Ext        : ExtStr;
    IsDir      : BOOLEAN;
    Item       : ItemStr;
    Find       : BOOLEAN;  { search for Selection? }
    First      : BOOLEAN;  { Warn only the First time }
    Warn       : BOOLEAN;  { issue "not found" warning? }
    ItemPtr    : ItemRecordPtr;

BEGIN
     Dir:=Input;

     IF (SearchExt = '') THEN
     BEGIN
          { directory selection }
          IF (Dir = '') THEN
             GetDir (0,Dir);

          IF (Input[Length (Dir)] = '\') THEN
             Delete (Dir,Length (Dir),1);
     END;

     FSplit (UNC_FExpand (Dir),Dir,Name,Ext);
     Selection:=Name+Ext;

     { teken het file manager window }
     Yl:=Video.Rows-5;

     PaneLines:=Yl-5;
     PaneY:=Yb+4;

     WindowPush (Xb,Yb,Xl,Yl);
     BoxDraw (Double,Xb,Yb,Xl,Yl);

     WriteXY (Xb,Yb+3,Tl+RepChar (Xl-2,Ho)+Tr);

     IF (SearchDescr = '') THEN
     BEGIN
          IF (SearchExt = '') THEN
             WriteXY (Xb+2,Yb+1,'Directory selection')
          ELSE
              WriteXY (Xb+2,Yb+1,'File selection');
     END ELSE
         WriteXY (Xb+2,Yb+1,SearchDescr+' selection');

     PushKeysLine;
     WriteKeysLine (' ^F1 Help  ^Esc Abort  ^F3 Accept  ^Alt+A..Z Drive  ^Ins Create dir.');

     FirstPtr:=NIL;
     First:=TRUE;
     Find:=TRUE;
     Warn:=FALSE;

     Update:=TRUE;

     Quit:=FALSE;
     REPEAT
           IF Update THEN
           BEGIN
                { read directory structure from new path and print all }
                { directories and files according to the filter.       }

                FreeItems;

                CursorLine:=0;
                PrevCursor:=0;

                TopOffset:=0;
                PrevOffset:=0;

                Message ('Reading directory...');

                { directories }
                FindFirst (Dir+'*.*',$31,Search);
                WHILE (Dos.DosError = 0) DO
                BEGIN
                     IF ((Search.Attr AND $10) <> 0) AND
                        (Search.Name <> '.') AND
                        NOT ((Search.Name = '..') AND (Length (Dir) <= 3)) THEN
                     BEGIN
                          { directory, but not self (".") }
                          { not ".." when in root }

                          IF (Pos ('.',Search.Name) > 0) AND (Search.Name <> '..') THEN
                             Search.Name:=AddUpWithSpaces (9,Copy (Search.Name,1,Pos ('.',Search.Name)-1))+
                                          Copy (Search.Name,Pos ('.',Search.Name)+1,3);

                          AddItem (Search.Name,
                                   {IsDir:}TRUE,
                                   {IsHit:}FALSE,
                                   0);
                     END;

                     FindNext (Search);
                END; { while }

                {$IFDEF PLATFORM_OS2}
                FindClose (Search);
                {$ENDIF}

                { files }
                IF (SearchExt <> '') THEN
                BEGIN
                     FindFirst (Dir+SearchExt,$21,Search);
                     WHILE (Dos.DosError = 0) DO
                     BEGIN
                          IF ((Search.Attr AND $18) = 0) THEN
                          BEGIN
                               { file }
                               {Search.Name:=UpCaseString (Search.Name); } { OS/2 }

                               IF (SearchExt = '*.*') THEN
                               BEGIN
                                    IF (Pos ('.',Search.Name) > 0) THEN
                                       Search.Name:=AddUpWithSpaces (9,Copy (Search.Name,1,Pos ('.',Search.Name)-1))+
                                                    Copy (Search.Name,Pos ('.',Search.Name)+1,3);

                                    AddItem (Search.Name,
                                             {IsDir:}FALSE,
                                             {IsHit:}FALSE,
                                             Search.Size);
                               END ELSE
                               BEGIN
                                    Search.Name:=Copy (Search.Name,1,Pos ('.',Search.Name)-1);

                                    AddItem (Search.Name,
                                             {IsDir:}FALSE,
                                             {IsHit:}TRUE,
                                             Search.Size);
                               END;
                          END;

                          FindNext (Search);
                     END; { while }

                     {$IFDEF PLATFORM_OS2}
                     FindClose (Search);
                     {$ENDIF}
                END;

                IF Find THEN
                BEGIN
                     { find the item matching Selection }
                     ItemPtr:=FirstPtr;
                     CurrItem:=0;

                     Temp:=Selection;
                     IF (Pos ('.',Temp) > 0) THEN
                        Temp:=AddUpWithSpaces (9,Copy (Temp,1,Pos ('.',Temp)-1))+
                              Copy (Temp,Pos ('.',Temp)+1,3);

                     WHILE (ItemPtr <> NIL) DO
                     BEGIN
                          IF ((NOT First) OR (NOT ItemPtr^.IsDir) OR (SearchExt = '')) AND
                             CaselessMatch (Temp,ItemPtr^.Item)
                          THEN
                              Break;

                          Inc (CurrItem);
                          ItemPtr:=ItemPtr^.Next;
                     END;

                     IF (ItemPtr = NIL) THEN
                     BEGIN
                          CurrItem:=65535;

                          IF (Selection <> '') THEN
                             Warn:=First;
                     END ELSE
                     BEGIN
                          { bepaal TopOffset en CursorLine ahv CurrItem }
                          CursorLine:=PaneLines DIV 2;
                          IF (CurrItem < CursorLine) THEN
                             CursorLine:=CurrItem
                          ELSE BEGIN
                               TopOffset:=CurrItem-CursorLine;
                               { correct when scrolled "too far" }
                               WHILE (TopOffset > ItemCount-PaneLines) DO
                               BEGIN
                                    Dec (TopOffset);
                                    Inc (CursorLine);
                               END;
                          END;
                     END;

                     Find:=FALSE;
                     First:=FALSE;
                END;

                WindowPop; { message }

                Draw;

                Update:=FALSE;
           END;

           IF (TopOffset <> PrevOffset) THEN
           BEGIN
                { inhoud moet opnieuw getekend }
                Draw;
                PrevOffset:=TopOffset;
                PrevCursor:=255;
           END;

           IF (CursorLine <> PrevCursor) THEN
              RemoveCursor;

           IF Warn THEN
           BEGIN
                Error2Lines ('Could not find '+Dir+Selection,
                             'Escape ends File Manager and keeps current selection');
                Warn:=FALSE;
           END;

           IF (CursorLine <> PrevCursor) THEN
           BEGIN
                ShowCursor;
                PrevCursor:=CursorLine;
           END;

           CurrItem:=TopOffset+CursorLine;

           Selection:=GetItem (TopOffset+CursorLine,IsDir);
           IF IsDir THEN
              Selection:=Selection+'\';

           IF (Selection = '..\') THEN
              Selection:='';

           IF (Length (Dir+Selection) > Xl-4) THEN
              WriteXYC (Xb+2,Yb+2,cBoxData,
                        AddUpWithSpaces (Xl-4,''+
                        Copy (Dir,Length (Dir)-(Xl-6-Length (Selection)),Xl-5-Length (Selection))+
                        Selection))
           ELSE
              WriteXYC (Xb+2,Yb+2,cBoxData,AddUpWithSpaces (Xl-4,Dir+Selection));

           CASE ReadKey OF

                kF1 :
                    RequestHelp (HELPHANDLE_FILEMANAGER);

                kUp :
                    IF (CursorLine > 0) THEN
                       Dec (CursorLine)
                    ELSE
                        IF (TopOffset > 0) THEN
                           Dec (TopOffset);

                kDown :
                    IF (ItemCount < PaneLines) THEN
                    BEGIN
                         IF (CursorLine+1 < ItemCount) THEN
                            Inc (CursorLine);
                    END ELSE
                    BEGIN
                         IF (CursorLine < PaneLines-1) THEN
                            Inc (CursorLine)
                         ELSE
                             IF (CurrItem+1 < ItemCount) THEN
                                Inc (TopOffset);
                    END;

                kPgUp :
                    IF (CursorLine > 0) THEN
                       CursorLine:=0
                    ELSE
                        IF (TopOffset > PaneLines) THEN
                           Dec (TopOffset,PaneLines)
                        ELSE
                            TopOffset:=0;

                kPgDn :
                    IF (CursorLine < PaneLines-1) THEN
                    BEGIN
                         CursorLine:=PaneLines-1;
                         IF (CursorLine > ItemCount-1) THEN
                            CursorLine:=ItemCount-1;
                    END ELSE
                        IF (TopOffset+CursorLine+PaneLines < ItemCount) THEN
                           Inc (TopOffset,PaneLines)
                        ELSE
                            TopOffset:=ItemCount-PaneLines;

                kCtrlHome,
                kHome :
                    BEGIN
                         TopOffset:=0;
                         CursorLine:=0;
                    END;

                kCtrlEnd,
                kEnd :
                    IF (ItemCount < PaneLines) THEN
                       CursorLine:=ItemCount-1
                    ELSE BEGIN
                         CursorLine:=PaneLines-1;
                         TopOffset:=ItemCount-PaneLines;
                    END;

                kLeft :
                    IF (Length (Dir) > 3) THEN
                    BEGIN
                         { go UP (..) one directory }
                         Delete (Dir,Length (Dir),1);
                         Selection:='';

                         WHILE (Dir[Length (Dir)] <> '\') DO
                         BEGIN
                              Selection:=Dir[Length (Dir)]+Selection;
                              Delete (Dir,Length (Dir),1);
                         END;

                         Find:=TRUE;
                         Update:=TRUE;
                    END;

                kRight :
                    BEGIN
                         { down one directory }
                         Item:=GetItem (CurrItem,IsDir);
                         IF IsDir AND (Item <> '..') THEN
                         BEGIN
                              Dir:=Dir+Item+'\';
                              Update:=TRUE;
                         END;
                    END;

                kRet : { change directory }
                    BEGIN
                         Item:=GetItem (CurrItem,IsDir);
                         IF IsDir THEN
                         BEGIN
                              IF (Item = '..') THEN
                              BEGIN
                                   { zorg dat we op deze directory gaan staan }
                                   Delete (Dir,Length (Dir),1);
                                   Selection:='';

                                   WHILE (Dir[Length (Dir)] <> '\') DO
                                   BEGIN
                                        Selection:=Dir[Length (Dir)]+Selection;
                                        Delete (Dir,Length (Dir),1);
                                   END;

                                   First:=TRUE;
                              END ELSE
                                  Dir:=Dir+Item+'\';

                              Update:=TRUE;
                         END ELSE
                             Error ('Use F3 or F10 to complete a selection');
                    END;

                kF3,
                kF10 :
                    BEGIN
                         { select, both for directory and files }
                         FileManager:=Dir+Selection;
                         Quit:=TRUE;
                    END;

                kEsc :
                    BEGIN
                         { return original input }
                         FileManager:=Input;
                         Quit:=TRUE;
                    END;

                kAltA..kAltZ :
                    BEGIN
                         IF (DiskFree (Ord (Key)-Ord (kAltA)+1) > -1) THEN
                         BEGIN
                              GetDir (Ord (Key)-Ord (kAltA)+1,Dir);
                              IF (Dir[Length (Dir)] <> '\') THEN
                                 Dir:=Dir+'\';
                              Selection:='';
                              Update:=TRUE;
                         END ELSE
                             Write (#7); { beep }
                    END;

                kIns :
                    BEGIN
                         Selection:=InputAndCreateSubDir (Dir);
                         IF (Selection <> '') THEN
                         BEGIN
                              First:=TRUE;
                              Update:=TRUE;
                         END;
                    END;

                kUnknown:
                    BEGIN
                         AsciiKey:=UpCase (AsciiKey);

                         { volgende zoeken met deze letter vanaf de cursor }
                         FOR Lp:=1 TO ItemCount DO
                         BEGIN
                              { ga naar volgende item }
                              IF (CurrItem = ItemCount-1) THEN
                                 CurrItem:=0
                              ELSE
                                  Inc (CurrItem);

                              Item:=GetItem (CurrItem,IsDir);
                              IF (UpCase (Item[1]) = AsciiKey) THEN
                              BEGIN
                                   TopOffset:=0;
                                   CursorLine:=PaneLines DIV 2;
                                   IF (CurrItem < CursorLine) THEN
                                      CursorLine:=CurrItem
                                   ELSE
                                       TopOffset:=CurrItem-CursorLine;

                                   { gevonden! }
                                   Draw;
                                   Break; { uit de for }
                              END;
                         END; { for }

                         IF (Lp = ItemCount) THEN
                            Write (#7); { niet gevonden }
                    END; { kUnknown }

           END; { case }

     UNTIL Quit;

     FreeItems;

     PopKeysLine;
     WindowPop;
END;


{--------------------------------------------------------------------------}
{ CheckExistPath                                                           }
{                                                                          }
{ Deze routine controleert of een pad aanwezig is. Zoniet, dan wordt deze  }
{ (desnoods vanaf de eerste directory) aangemaakt.                         }
{                                                                          }
PROCEDURE CheckExistPath (Path : STRING);
BEGIN
     { als het pad op een \ eindigd, dan verwijderen we die }

END;


{----------------------------------------------------------------------}
{ FilenameTo83                                                         }
{                                                                      }
{ Deze routine converteert een filename naar een 8.3 naam en geeft     }
{ deze terug. Gebruik hierna FilenameTo83Instance om de naam aan te    }
{ passen en een speciale versie terug te geven voor wat er in een      }
{ directory al aanwezig is.                                            }
{                                                                      }
FUNCTION FilenameTo83 (Filename : STRING) : STRING;

VAR Lp   : BYTE;
    Modi : BOOLEAN;
    Name,
    Ext  : STRING;

BEGIN
     Modi:=FALSE; { niet veranderd }

     WHILE (Pos ('\',Filename) > 0) DO
           Delete (Filename,1,Pos ('\',Filename));

     WHILE (Pos ('/',Filename) > 0) DO
           Delete (Filename,1,Pos ('/',Filename));

     FOR Lp:=1 TO Length (Filename) DO
         IF (Filename[Lp] IN [#0..#32,'[',']','<','>','=','|','?','*','"',':',';',',','+',#127..#255]) THEN
         BEGIN
              Filename[Lp]:='_';
              Modi:=TRUE; { veranderd! }
         END;

     Name:=Filename;

     IF (Pos ('.',Name) = 0) THEN
        Ext:=''
     ElSE BEGIN
          Ext:=Name;

          WHILE (Pos ('.',Ext) > 0) DO
                Delete (Ext,1,Pos ('.',Ext));

          { correct extension for .3 }
          IF (Length (Ext) > 3) THEN
          BEGIN
               Ext:=Copy (Ext,1,3);
               Modi:=TRUE;
          END;

          Ext:='.'+Ext;

          { . moet voorkomen }
          WHILE (Name[Length (Name)] <> '.') DO
                Delete (Name,Length (Name),1);

          Delete (Name,Length (Name),1); { punt zelf weghalen }
     END;

     WHILE (Pos ('.',Name) > 0) DO
     BEGIN
          Name[Pos ('.',Name)]:='_';
          Modi:=TRUE;
     END;

     { correct Name for 8 }
     IF (Length (Name) > 8) OR Modi THEN
        Name:=Copy (Name,1,6)+'~0';

     FilenameTo83:=UpCaseString (Name+Ext);
END;


{--------------------------------------------------------------------------}
{ FilenameTo83Instance                                                     }
{                                                                          }
{ Deze routine kijkt wat er in PATH aanwezig is en geeft past eventueel de }
{ filename aan zodat er niets overschreven wordt. Hierbij wordt ~0 toege-  }
{ voegd of geupdate naar ~1..~9, ~A..~Z, ~00..~ZZ, etc.                    }
{ Het hele pad wordt terug gegeven.                                        }
{                                                                          }
FUNCTION FilenameTo83Instance (Path,Filename : STRING) : STRING;

VAR Search   : SearchRec;
    Instance : WORD;
    Name     : STRING[8];
    Ext      : STRING[4];
    FName    : STRING[12];
    G        : BYTE;

BEGIN
     FindFirst (Path+Filename,$31,Search);
     IF (Dos.DosError <> 0) OR (Length (Filename) > 12) THEN
     BEGIN
          { in 1 keer goed, of verkeerd pad etc. }
          FilenameTo83Instance:=Path+Filename; { initial response }
          Exit;
     END;

     IF (Pos ('-0.',Filename) > 0) THEN
     BEGIN
          Name:=Copy (Filename,1,Pos ('-0.',Filename)-1);
          Ext:=Copy (Filename,Pos ('.',Filename),4); { leeg bij geen . }

          { check for 8.3 }
          IF (Name+'-0'+Ext <> Filename) THEN
          BEGIN
               { illegale 8.3 ingevoerd }
               FilenameTo83Instance:=Path+Filename;
               Exit;
          END;

          Instance:=1;
     END ELSE
     BEGIN
          IF (Pos ('.',Filename) > 0) THEN
          BEGIN
               Name:=Copy (Filename,1,Pos ('.',Filename)-1);
               Ext:=Copy (Filename,Pos ('.',Filename),4);
          END ELSE
          BEGIN
               Name:=Filename; { cut to first 8 }
               Ext:='';
          END;

          { check for 8.3 }
          IF (Name+Ext <> Filename) THEN
          BEGIN
               { illegale 8.3 ingevoerd }
               FilenameTo83Instance:=Path+Filename;
               Exit;
          END;

          Instance:=0;
     END;

     { probeer alternatieven }
     REPEAT
           IF (Instance < 36) THEN
              FName:=Copy (Name,1,6)
           ELSE
               FName:=Copy (Name,1,5);

           FName:=FName+'-';

           G:=Instance MOD 36;
           IF (G >= 10) THEN
              G:=G+7;

           FName:=FName+Chr (48+G);

           IF (Instance >= 36) THEN
           BEGIN
                G:=Instance DIV 36;
                IF (G >= 10) THEN
                   G:=G+7;

                FName:=FName+Chr (48+G)+Ext;
           END ELSE
               FName:=FName+Ext;

           FindFirst (Path+FName,$31,Search);
           IF (Dos.DosError = 18) THEN
           BEGIN
                { mogelijkheid gevonden! }
                FilenameTo83Instance:=Path+FName;
                Exit;
           END;

           IF (Dos.DosError <> 0) THEN
           BEGIN
                { een of andere error }
                FilenameTo83Instance:=Path+Filename;
                Exit;
           END;

           Inc (Instance);

     UNTIL (Instance = 1296); { net voorbij -ZZ }

     FilenameTo83Instance:=Path+Filename; { je moet wat }
END;


{--------------------------------------------------------------------------}
{ ExtractPathPart                                                          }
{                                                                          }
{ This routine extracts and returns the path from a filename (or search    }
{ pattern).                                                                }
{                                                                          }
{ Examples:                                                                }
{ C:\WSD\FILE.TXT                    -> C:\WSD\                            }
{ FILE.TXT                           -> current directory (C:\WTRGATE\)    }
{ C:\POP3.IN\*.MSG                   -> C:\POP3.IN\                        }
{ C:\WSD                             -> C:\WSD\                            }
{ C:\WSD.                            -> C:\                                }
{                                                                          }
FUNCTION ExtractPathPart (Filename : STRING) : STRING;

VAR Dir  : DirStr;
    Name : NameStr;
    Ext  : ExtStr;

BEGIN
     FSplit (UNC_FExpand (Filename),Dir,Name,Ext);

     IF (Dir[Length (Dir)] <> '\') THEN
        Dir:=Dir+'\';

     { C:\WSD -> C:\ thus add "WSD\" }
     { avoid C:\WSD. -> C:\WSD }
     IF (Name <> '') AND (Ext = '') AND (Filename[Length (Filename)] <> '.') THEN
        Dir:=Dir+Name+'\';

     ExtractPathPart:=Dir;
END;


{--------------------------------------------------------------------------}
{ UNC_FExpand                                                              }
{                                                                          }
{ This routine is a prevention against FExpand, which messes up UNC paths  }
{ by inserting a drive letter in front. This routine simply doesn't call   }
{ FExpand if the path starts with a double backslash, assuming the user    }
{ knows what (s)he is typing.                                              }
{                                                                          }
FUNCTION UNC_FExpand (Path : STRING) : STRING;
BEGIN
     IF (Copy (Path,1,2) <> '\\') THEN
        Path:=FExpand (Path);

     UNC_FExpand:=Path;
END;


{ end of file disk.inc }

