Program Fileselect;

{$M 10000, 0, 0}

Uses PortAES, Dos;

Function  portFileSelect ( xtl, ytl : Byte; maske, such : String;
                           Var dateiPfad : String;
                           Var verzeichniss : Boolean;
                           Var error : Byte ) : Boolean;

    Const leerzeichen = '            ';

    Label nochmal;

    Var menueSpeicher : Array [ 1 .. 1100 ] Of Char;
        dateiSpeicher : Array [ 1 .. 50 ] Of String[13];
        msZaehler, dsZaehler : Word;

    Var reg : Registers;
        buffer : Array [ 1 .. 320 ] Of Byte;
        CursorMode, auswahl : Byte;
        eintrag : String;
        DirInfo : SearchRec;
        zaehler : Byte;

Begin
     nochmal:

     portFileSelect := False;
     verzeichniss := False;
     error := 0;

     eintrag := maske + such;
     If Length( eintrag ) > 18 Then
        eintrag := Copy( eintrag, 1, Pos( '\', eintrag ) ) + '..\' + such;

     For zaehler := 1 To Length( eintrag ) Do
     Begin
          menueSpeicher[ zaehler ] := eintrag[ zaehler ];
          msZaehler := zaehler;
     End;
     menueSpeicher[ msZaehler + 1 ] := Chr(0);
     Inc( msZaehler );

     dsZaehler := 0;

     FindFirst( maske + '*.*', directory, DirInfo );
     While DosError = 0 Do
     Begin
          If DirInfo.Attr And 16 = 16 Then
          Begin
               Inc( dsZaehler );
               eintrag := DirInfo.Name + leerzeichen;
               eintrag := Copy( eintrag, 1, 12 );
               dateiSpeicher[ dsZaehler ] := eintrag + '\';

               For zaehler := 1 To 12 Do
               Begin
                    Inc( msZaehler );
                    menueSpeicher[ msZaehler ] := eintrag[ zaehler ];
               End;

               Inc( msZaehler );
               menueSpeicher[ msZaehler ] := ' ';
               Inc( msZaehler );
               menueSpeicher[ msZaehler ] := '<';
               Inc( msZaehler );
               menueSpeicher[ msZaehler ] := 'D';
               Inc( msZaehler );
               menueSpeicher[ msZaehler ] := 'I';
               Inc( msZaehler );
               menueSpeicher[ msZaehler ] := 'R';
               Inc( msZaehler );
               menueSpeicher[ msZaehler ] := '>';

               Inc( msZaehler );
               menueSpeicher[ msZaehler ] := Chr(0);
          End;
          FindNext( DirInfo );
     End;

     FindFirst( maske + such, archive, DirInfo );
     While DosError = 0 Do
     Begin
          Inc( dsZaehler );
          eintrag := DirInfo.Name + leerzeichen;
          dateiSpeicher[ dsZaehler ] := Copy( eintrag, 1, 12 );

          For zaehler := 1 To 12 Do
          Begin
               Inc( msZaehler );
               menueSpeicher[ msZaehler ] := eintrag[ zaehler ];
          End;

          Inc( msZaehler );
          menueSpeicher[ msZaehler ] := Chr(0);

          FindNext( DirInfo );
     End;

     error := DosError;

     Inc( msZaehler );
     menueSpeicher[ msZaehler ] := Chr(0);

     FillChar ( buffer, 320, 0 );
     reg.ah := $08;
     reg.al := 0;
     reg.bh := 0;
     reg.dl := 0;
     reg.dh := 0;
     reg.cl := 39;
     reg.ch := 7;
     reg.ds := Seg ( buffer );
     reg.si := Ofs ( buffer );
     Intr ( $60, reg );

     reg.ah := $0F;
     reg.al := 0;
     Intr ( $61, reg );
     CursorMode := reg.bl;

     reg.ah := $0F;
     reg.al := 1;
     reg.bl := 2;
     Intr ( $61, reg );

     reg.ah := $0F;
     reg.al := 1;
     reg.al := 65;
     reg.bh := 0;
     reg.ch := 0;
     reg.cl := 0;
     reg.dl := xtl;
     reg.dh := ytl;
     reg.ds := Seg ( menueSpeicher[ 1 ] );
     reg.si := Ofs ( menueSpeicher[ 1 ] );
     reg.es := Seg ( menueSpeicher[ 1 ] );
     reg.di := $FFFF;
     Intr ( $60, reg );
     If reg.al <> 255 Then
     Begin
          auswahl := reg.al;
          If Pos( '\', dateiSpeicher[ auswahl + 1 ] ) <> 0 Then
          Begin
               verzeichniss := True;
               If Pos( '.           \', dateiSpeicher[ auswahl + 1 ] ) <> 0 Then
                  Goto nochmal;
               If Pos( '..          \', dateiSpeicher[ auswahl + 1 ] ) <> 0 Then
               Begin
                    Delete( maske, Length( maske ), 1 );
                    dateiPfad := '';
                    Repeat
                          dateiPfad := dateiPfad +
                                       Copy( maske, 1, Pos( '\', maske ) );
                          Delete( maske, 1, Pos( '\', maske ) );
                    Until Pos( '\', maske ) = 0;
               End
               Else
               Begin
                    dateiPfad := maske +
                                 Copy( dateiSpeicher[ auswahl + 1 ],
                                       1, Pos( ' ', dateiSpeicher[ auswahl + 1 ] ) - 1 ) + '\';
               End;
          End
          Else
          Begin
               dateiPfad := maske +
                            Copy( dateiSpeicher[ auswahl + 1 ],
                                  1, Pos( ' ', dateiSpeicher[ auswahl + 1 ] ) - 1 );
          End;
          portFileSelect := True;
     End;

     reg.ah := $08;
     reg.al := 2;
     reg.bh := 0;
     reg.dl := 0;
     reg.dh := 0;
     reg.cl := 39;
     reg.ch := 7;
     reg.ds := Seg ( buffer );
     reg.si := Ofs ( buffer );
     Intr ( $60, reg );

     reg.ah := $0F;
     reg.al := 1;
     reg.bl := CursorMode;
     Intr ( $61, reg );
End;

Var pfad, extension : String;
    dirFlag : Boolean;
    error : Byte;

Begin
     pfad := 'A:\';
     extension := '*.*';

     dirFlag := True;
     While dirFlag Do
           portFileSelect( 3, 0, pfad, extension, pfad, dirFlag, error );
     If error = 3 Then
        ErrorWindow( 1, 2, 'Die Pfadangabe ist falsch!' );

     WriteLn;
     WriteLn( '---', pfad, '---', error, '---' );
End.