Turbo Toolbox/Turbo_Toolbox.iso/1990/12/ldm/resiinst.pas

Pascal/Delphi Source File | 1990-10-29 | 37.8 KB | 1,364 lines

{ -------------------------------------------------------- }
{                       ResiInst V1.0                      }
{    Menügesteuertes Installationsprogramm für Resident    }
{           Copyright (C) 1990 by Torsten Priebe           }
{ -------------------------------------------------------- }

Program ResiInst;

Uses Dos, Crt;

Const
  MpxNum   = $C0;         { Nummer für Multiplex-Interrupt }
  MaxEntry = 5;             { Maximale Anzahl an Einträgem }

  ResPrev = 1;                 { Codes für Edit-Funktionen }
  ResNext = 2;

  ColNorm    = 1;    { Farb-Codes für Bildschirmverwaltung }
  ColHigh    = 2;
  ColInverse = 3;
  ColMarked  = 4;
  ColError   = 5;

  WinTitle   = 1;            { Codes für Fensterverwaltung }
  WinMain    = 2;
  WinEdit    = 3;
  WinMessage = 4;

Type
  String4  = String[4];
  String12 = String[12];
  String13 = String[13];

  HotkeyObj = Object             { Objekt für einen Hotkey }
                Value : Word;                       { Wert }
                             { liefert den Namen der Taste }
                Function Name: String12;

                Function Edit: Byte;       { Edit-Funktion }
              End;

  TitleObj = Object               { Objekt für einen Titel }
               Value : String[32];                  { Wert }

               Function Edit: Byte;        { Edit-Funktion }
             End;

  PathObj = Object       { Objekt für ein Startverzeichnis }
              Value : String[64];                   { Wert }

              Function Edit: Byte;         { Edit-Funktion }
            End;

  ProgObj = Object         { Objekt für eine Programmdatei }
              Value : String[64];                   { Wert }

              Function Edit: Byte;         { Edit-Funktion }
            End;

  EntryObj = Object  { Objekt für einen kompletten Eintrag }
               Number   : Byte;      { Nummer des Eintrags }

               Hotkey   : HotkeyObj;              { Hotkey }
               Title    : TitleObj;        { Programmtitel }
               Path     : PathObj;      { Startverzeichnis }
               ProgName : ProgObj;         { Programmdatei }

               Procedure Show;          { Eintrag anzeigen }
               Procedure Edit;         { Eintrag editieren }
             End;

  InputObj = Object       { Objekt für eine Eingaberoutine }
               Value     : String;                  { Wert }
               MaxLen,            { Max. Länge der Eingabe }
               X, Y,                         { Koordinaten }
               I         : Byte;     { akt. Cursorposition }

               Constructor Init;          { Initialisieren }
                                   { testen ob Wert gültig }
               Function CheckValue: Boolean; Virtual;
                           { einen Tastendruck verarbeiten }
               Function ManageKey(Ch: Char): Byte; Virtual;
                               { eigentliche Edit-Funktion }
               Function Edit: Byte;
             End;

  ChooseObj = Object             { Objekt zur Dateiauswahl }
                CPath         : DirStr; { akt. Verzeichnis }
                                     { wählbare Dateinamen }
                Data          : Array[1..255] Of String13;
                Count, Count_,     { Anzahl der Dateinamen }
                Bar, Scroll   : Byte;     { Balkenposition }

                Constructor Init;         { Initialisieren }
                Procedure ShowData;  { Dateinamen anzeigen }
                                          { Daten einlesen }
                Procedure ReadData; Virtual;
                                   { Wahlfenster schließen }
                Procedure Close; Virtual;
                               { eigentliche Wahl-Funktion }
                Function Choose(Var Path: PathStr): String12;
              End;

  DataType = Array[1..MaxEntry] Of EntryObj;       { Daten }

                    { Resident-Daten (im Assembler-Format) }
  ResiDataType = Array[1..MaxEntry] Of Record
                   Hotkey   : Word;
                   Title    : Array[1..32] Of Char;
                   Path,
                   ProgName : Array[1..64] Of Char;
                 End;

Var
  Data        : DataType;                          { Daten }
  EntryCount  : Byte;                { Anzahl der Einträge }
  ResiDataPtr : ^ResiDataType;            { Resident-Daten }

  InitMode    : Integer;    { Videomodus bei Programmstart }
  ExitSav     : Pointer;               { Alte Exit-Routine }

  CurrWind    : Byte;           { momentan aktives Fenster }

{ -- Hilfsroutinen --------------------------------------- }

Procedure HideCursor;                 { Cursor ausschalten }
Var
  Regs : Registers;
Begin
  Regs.AH:=$01;
  Regs.CX:=$2000;
  Intr($10, Regs);
End;

Procedure ShowCursor;                 { Cursor einschalten }
Var
  Regs : Registers;
Begin
  Regs.AH:=$01;
  If LastMode=Mono Then Regs.CX:=$0C0D Else Regs.CX:=$0607;
  Intr($10, Regs);
End;

       { String vom Assembler- ins Pascal-Format umwandeln }
Function ConvString(S: String): String;
Var
  I: Byte;
Begin
  I:=1;
  While S[I]<>#0 Do Inc(I);
  S:=Copy(S, 1, I-1);
  ConvString:=S;
End;

    { Leerzeichen an Anfang und Ende eines Strings löschen }
Function CutString(S: String): String;
Begin
  While (S<>'') And (S[1]=' ') Do Delete(S, 1, 1);
  While (S<>'') And (S[Length(S)]=' ') Do
    Delete(S, Length(S), 1);
  CutString:=S;
End;

{ -- Bildschirmverwaltung -------------------------------- }

Procedure SetColor(Color: Byte);            { Farbe sezten }
Begin
  If LastMode In [Mono, BW80] Then Case Color Of
    ColNorm    : TextAttr:=LightGray;
    ColHigh    : TextAttr:=White;
    ColInverse : TextAttr:=White;
    ColMarked  : TextAttr:=LightGray Shl 4;
    ColError   : TextAttr:=LightGray Shl 4;
  End Else Case Color Of
    ColNorm    : TextAttr:=Green;
    ColHigh    : TextAttr:=LightGray;
    ColInverse : TextAttr:=Cyan Shl 4;
    ColMarked  : TextAttr:=Blue Shl 4 + LightGray;
    ColError   : TextAttr:=Red Shl 4 + White;
  End;
End;

Procedure SetWindow(Wind: Byte);      { Fenster aktivieren }
Begin
  Case Wind Of
    WinTitle   : Window(2, 2, 79, 3);
    WinMain    : Window(2, 5, 79, 16);
    WinEdit    : Window(2, 18, 79, 21);
    WinMessage : Window(2, 23, 79, 24);
  End;
  CurrWind:=Wind;
End;

Procedure InitScreen;          { Bildschirm initialisieren }
Var
  I : Byte;
Begin
  InitMode:=LastMode;     { Videomodus prüfen / neu setzen }
  Case LastMode Of
    BW80, CO80, Mono   : ;
    BW40, BW40+Font8x8,
    BW80+Font8x8       : TextMode(BW80);
    Else                 TextMode(CO80);
  End;

  SetColor(ColNorm); ClrScr;          { Bildschirm löschen }

  HideCursor;
  WindMax:=$FFFF;                  { Scrolling ausschalten }

  GotoXY(1, 1);                          { Rahmen aufbauen }
  Write('╔'); For I:=1 To 78 Do Write('═'); Write('╗');
  For I:=2 To 3 Do Begin
    GotoXY(1, I); Write('║');
    GotoXY(80, I); Write('║');
  End;
  GotoXY(1, 4);
  Write('╠'); For I:=1 To 78 Do Write('═'); Write('╣');
  For I:=5 To 16 Do Begin
    GotoXY(1, I); Write('║');
    GotoXY(80, I); Write('║');
  End;
  GotoXY(1, 17);
  Write('╠'); For I:=1 To 78 Do Write('═'); Write('╣');
  For I:=18 To 21 Do Begin
    GotoXY(1, I); Write('║');
    GotoXY(80, I); Write('║');
  End;
  GotoXY(1, 22);
  Write('╠'); For I:=1 To 78 Do Write('═'); Write('╣');
  For I:=23 To 24 Do Begin
    GotoXY(1, I); Write('║');
    GotoXY(80, I); Write('║');
  End;
  GotoXY(1, 25);
  Write('╚'); For I:=1 To 78 Do Write('═'); Write('╝');

  Window(1, 1, 80, 25);             { Fenster zurücksetzen }

  SetWindow(WinTitle);        { Titel / Copyright ausgeben }
  SetColor(ColInverse); ClrScr;
  GotoXY(34, 1);
  Write('ResiInst V1.0');
  GotoXY(22, 2);
  Write('Copyright (C) 1990 by Torsten Priebe');

  SetWindow(WinMain);   { Gerüst für Dateneingabe aufbauen }
  SetColor(ColNorm);
  GotoXY(62, 3); Write('Eintrag   von  ');
  GotoXY(13, 5); Write('Hotkey: ');
  GotoXY(6, 6); Write('Programmtitel: ');
  GotoXY(3, 8); Write('Startverzeichnis: ');
  GotoXY(6, 9); Write('Programmdatei: ');

  SetWindow(WinMessage);        { Meldungsfenster aufbauen }
  SetColor(ColInverse); ClrScr;
End;

{$F+}
Procedure CloseScreen;           { Bildschirm zurücksetzen }
Begin
                            { ggf. Videomodus zurücksetzen }
  If LastMode<>InitMode Then TextMode(InitMode);

  TextAttr:=LightGray;                { Bildschirm löschen }
  Window(1, 1, 80, 25);
  ClrScr;
  ShowCursor;
  ExitProc:=ExitSav;
End;
{$F-}

{ -- Fehlermeldung, Statuszeile -------------------------- }

Procedure Error(Message: String);          { Fehlermeldung }
Var
  WindSav : Byte;
Begin
  WindSav:=CurrWind;                { akt. Fensten sichern }

  SetWindow(WinMessage);          { Fehlermeldung ausgeben }
  GotoXY(1, 2);
  SetColor(ColError); ClrEol;
  Message:=Message+' Weiter mit <Esc>';
  GotoXY((78-Length(Message)) Div 2, 2);
  Write(Message, ^G);

  Repeat Until Readkey=#27;

  GotoXY(1, 2);                    { Fehlermeldung löschen }
  SetColor(ColInverse); ClrEol;
  SetWindow(WindSav);
End;

Procedure Status(Status: String);            { Statuszeile }
Var
  WindSav : Byte;
Begin
  WindSav:=CurrWind;                { akt. Fenster sichern }

  SetWindow(WinMessage);                 { Status ausgeben }
  SetColor(ColInverse);
  GotoXY(1, 1); ClrEol;
  GotoXY((78-Length(Status)) Div 2, 1);
  Write(Status);
  SetWindow(WindSav);
End;

{ -- Objekt: InputObj ------------------------------------ }

Constructor InputObj.Init;                { Initialisieren }
Begin
                          { Wert mit Leerzeichen auffüllen }
  While Length(Value)<MaxLen Do Value:=Value+' ';
  I:=1;
End;

Function InputObj.CheckValue: Boolean;       { Wert prüfen }
Begin
  CheckValue:=True;  { Oberste Instanz hat keine Bedingung }
End;

                                   { Tastendruck auswerten }
Function InputObj.ManageKey(Ch: Char): Byte;
Var
  Res : Byte;
Begin
  Res:=0;
  Case Ch Of
    #0: Case Readkey Of
                                             { Pfeiltasten }
          'H': If CheckValue Then Res:=ResPrev Else I:=1;
          'P': If CheckValue Then Res:=ResNext Else I:=1;
          'K': If I>1 Then Dec(I);
          'M': If I<MaxLen Then Inc(I);

          'S': Begin                              { Delete }
                 Delete(Value, I, 1); Value:=Value+' ';
               End;
        End;
    #8: If I>1 Then Begin                      { Backspace }
          Delete(Value, I-1, 1); Value:=Value+' ';
          Dec(I);
        End;
    #13: If CheckValue Then                       { Return }
           Res:=ResNext Else I:=1;
    #27: Begin                                    { Escape }
           Value:='';
           While Length(Value)<MaxLen Do Value:=Value+' ';
           I:=1;
         End;
    #32..#126,                       { Eingabe von Zeichen }
    #128..#255: Begin
                  Value[I]:=Ch;
                  If I<MaxLen Then Inc(I);
                End;
  End;
  ManageKey:=Res;
End;

Function InputObj.Edit: Byte;  { eigentliche Edit-Funktion }
Var
  Ch  : Char;
  Res : Byte;
Begin
  Repeat
    GotoXY(X, Y);                 { Eingabebalken ausgeben }
    SetColor(ColMarked);
    Write(Value);
    GotoXY(X+I-1, Y);

    ShowCursor;                   { auf Tastendruck warten }
    Ch:=Readkey;
    HideCursor;

    Res:=ManageKey(Ch);          { Tastendruck verarbeiten }
  Until Res<>0;
                      { Eingabe von Leerzeichen bereinigen }
  Value:=CutString(Value);
  Edit:=Res;
End;

{ -- Objekt: ChooseObj ----------------------------------- }

Constructor ChooseObj.Init;               { Initialisieren }
Begin
  SetWindow(WinEdit);
  Count:=0; Count_:=0;
End;

Procedure ChooseObj.ShowData;             { Daten anzeigen }
Var
  I : Byte;
Begin
  For I:=Scroll To Scroll+19 Do Begin
    If I=Bar Then SetColor(ColMarked) Else
      SetColor(ColHigh);
    GotoXY((((I-Scroll) Mod 5)*15)+2, (I-Scroll) Div 5+1);
    If I>Count Then Write('':15) Else
      Write(' ', Data[I], '':13-Length(Data[I]), ' ');
  End;
End;

Procedure ChooseObj.ReadData;             { Daten einlesen }
Begin
  Count:=0;    { oberste Instanz kann keine Daten einlesen }
  Count_:=0;
End;

Procedure ChooseObj.Close;         { Wahlfenster schließen }
Var
  I : Byte;
Begin
  SetColor(ColNorm);                     { Fenster löschen }
  ClrScr;

  Window(1, 1, 80, 25);         { Verzeichnisnamen löschen }
  GotoXY(2, 17);
  For I:=1 To 78 Do Write('═');
  SetWindow(WinEdit);
End;

                            { eigentliche Auswahl-Funktion }
Function ChooseObj.Choose(Var Path: PathStr): String12;
Var
  Ch : Char;
  I  : Byte;
  P  : PathStr;
Begin
  Repeat
    If Count=0 Then Begin   { noch keine Daten eingelesen? }
      Window(1, 1, 80, 25);     { Verzeichnisnamen löschen }
      SetColor(ColNorm);
      GotoXY(2, 17);
      For I:=1 To 78 Do Write('═');
      P:=CPath;                { Verzeichnisnamen anzeigen }
      If Length(P)>3 Then Delete(P, Length(P), 1);
      P:=' '+P+' ';
      SetColor(ColInverse);
      GotoXY(40-Length(P) Div 2, 17);
      Write(P);
      SetWindow(WinEdit);

      ReadData;                           { Daten einlesen }

      If Count=0 Then Begin      { keine Einträge gefunden }
        SetColor(ColNorm); ClrScr;
        Error('Keine Einträge gefunden!');
        Close;
        Choose:='';
        Exit;
      End;

      Bar:=1; Scroll:=1;
    End;

    ShowData;                             { Daten anzeigen }
    Ch:=Readkey;
    Case Ch Of                     { Tastendruck auswerten }
      #0: Case Readkey Of
            'K': If Bar>1 Then Begin         { Pfeiltasten }
                   Dec(Bar);
                   If Bar<Scroll Then Dec(Scroll, 5);
                 End;
            'H': If Bar>5 Then Begin
                   Dec(Bar, 5);
                   If Bar<Scroll Then Dec(Scroll, 5);
                 End;
            'M': If Bar<Count Then Begin
                   Inc(Bar);
                   If Bar>Scroll+19 Then Inc(Scroll, 5);
                 End;
            'P': If Bar<Count-4 Then Begin
                   Inc(Bar, 5);
                   If Bar>Scroll+19 Then Inc(Scroll, 5);
                 End;
          End;
      #13: Begin                                  { Return }
             If Bar>Count_ Then Begin        { Verzeichnis }
               CPath:=FExpand(CPath+Data[Bar]);
               Count:=0;
             End Else Begin                        { Datei }
               Path:=CPath;
               Choose:=Data[Bar];
               Close;
               Exit;
             End;
           End;
    End;
  Until Ch=#27;
  Choose:='';
  Close;
End;

{ -- Objekt: HotkeyObj ----------------------------------- }

{$I HOTKEYS.INC}

Function HotkeyObj.Name: String12;        { Name der Taste }
Var
  I : Byte;
  S : String;
Begin
  S:='';
  For I:=1 To Hotkeys Do             { Tabelle durchsuchen }
    If HotKeyList[I].Code=Value Then Begin
      S:='<'+HotKeyList[I].Name+'>';
      I:=Hotkeys;
    End;
  Name:=S;
End;

Function HotkeyObj.Edit: Byte;      { Hotkey-Edit-Funktion }

Function CheckHotkey: Boolean;            { Hotkey gültig? }
Begin
  If Name='' Then Begin
    CheckHotkey:=False; Error('Ungültiger Hotkey!');
  End Else CheckHotkey:=True;
End;

Var
  Regs : Registers;
  Res  : Byte;
  W    : Word;

Begin
  Status('Bitte betätigen Sie den gewünschten Hotkey!');

  Res:=0;
  Repeat
    GotoXY(22, 5);         { Hotkey-Feld markiert ausgeben }
    SetColor(ColMarked);
    Write(Name, '':12-Length(Name));

    Regs.AH:=$00;     { auf Tastendruck via Int 16h warten }
    Intr($16, Regs);

    If Regs.AX=$4800 Then Begin               { Pfeil rauf }
      If CheckHotkey Then Res:=ResPrev;
    End Else If Regs.AX=$5000 Then Begin    { Pfeil runter }
      If CheckHotkey Then Res:=ResNext;
    End Else If Regs.AX=$011B Then Begin          { Escape }
      Value:=0;
    End Else Begin
      W:=Value;
      Value:=Regs.AX;                { Hotkey ausprobieren }
      If CheckHotkey Then Res:=ResNext Else Value:=W;
    End;
  Until (Res<>0);
  Edit:=Res;
End;

{ -- Objekt: TitleObj ------------------------------------ }

Type
  TitleInputObj = Object (InputObj)      { Eingabefunktion }
                    Constructor Init;
                    Function CheckValue: Boolean; Virtual;
                  End;

Constructor TitleInputObj.Init;       { neue Init-Funktion }
Begin
  MaxLen:=32;
  X:=22; Y:=6;
  InputObj.Init;
End;

                                 { neue Gültigkeitsprüfung }
Function TitleInputObj.CheckValue: Boolean;
Begin
  If CutString(Value)='' Then Begin
    CheckValue:=False; Error('Ungültiger Programmtitel!');
  End Else CheckValue:=True;
End;

Function TitleObj.Edit: Byte;        { Titel-Edit-Funktion }
Var
  TitleInput: TitleInputObj;
Begin
  Status('Bitte geben Sie den Programmtitel ein!');

  TitleInput.Value:=Value;
  TitleInput.Init;
  Edit:=TitleInput.Edit;
  Value:=TitleInput.Value;
End;

{ -- Objekt: PathObj ------------------------------------- }

Type                              { angepaßte Wahlfunktion }
  PathChooseObj = Object (ChooseObj)
                    Constructor Init;
                    Procedure ReadData; Virtual;
                    Procedure Close; Virtual;
                  End;

  PathInputObj = Object (InputObj)       { Eingabefunktion }
                   Constructor Init;
                   Function CheckValue: Boolean; Virtual;
                   Function ManageKey(Ch: Char): Byte;
                            Virtual;
                 End;

Constructor PathChooseObj.Init;  { Auswahl-Initialisierung }
Begin
  Status('Bitte wählen Sie das Startverzeichnis und '+
         'betätigen Sie <Return>!');
  ChooseObj.Init;
End;

Procedure PathChooseObj.ReadData;         { Daten einlesen }
Var
  F : SearchRec;
  P : PathStr; D : DirStr; N : NameStr; E : ExtStr;
Begin
  Count:=0;

  Inc(Count);                { erster Wert ist Verzeichnis }
  P:=CPath;
  If Length(P)>3 Then Begin
    Delete(P, Length(P), 1);
    FSplit(P, D, N, E);
    P:=N+E;
  End;
  Data[Count]:=P;
  Count_:=Count;

                               { Unterverzeichnisse suchen }
  FindFirst(CPath+'*.*', Directory, F);
  While DosError=0 Do Begin
    If (F.Attr And Directory<>0) And
       (F.Name<>'.') Then Begin
      Inc(Count);
      Data[Count]:=F.Name+'\';
    End;
    FindNext(F);
  End;
End;

Procedure PathChooseObj.Close;  { Auswahlfenster schließen }
Begin
  ChooseObj.Close;
  Status('Bitte geben Sie das Startverzeichnis ein! '+
         'Wählen mit <Leertaste>');
End;

Constructor PathInputObj.Init;    { Eingabe initialisieren }
Begin
  MaxLen:=48;
  X:=22; Y:=8;
  InputObj.Init;
End;

                                 { neue Gültigkeitsprüfung }
Function PathInputObj.CheckValue: Boolean;
Var
  F : SearchRec;
  S : String[64];
Begin
  S:=CutString(Value);
  If S='' Then DosError:=3 Else Begin
    S:=FExpand(S);
    If S[Length(S)]<>'\' Then S:=S+'\';
    FindFirst(S+'*.*', AnyFile, F);
  End;
  If Not (DosError In [0, 18]) Then Begin
    CheckValue:=False;
    Error('Ungültiges Startverzeichnis!');
  End Else CheckValue:=True;
End;

                      { erweiterte Tastendruckverarbeitung }
Function PathInputObj.ManageKey(Ch: Char): Byte;
Var
  Res        : Byte;
  P          : PathStr;
  F          : SearchRec;
  PathChoose : PathChooseObj;
  S          : String12;
Begin
  Res:=0;
  If Ch=' ' Then Begin             { bei Leertaste Auswahl }
    P:=FExpand(CutString(Value));
    If P[Length(P)]<>'\' Then P:=P+'\';
    FindFirst(P+'*.*', AnyFile, F);
    If Not (DosError In [0, 18]) Then Begin
      If Length(P)>3 Then Delete(P, Length(P), 1);
      Error('Verzeichnis '+P+' existiert nicht!');
      P:=FExpand('');
    End;

    PathChoose.CPath:=P;
    PathChoose.Init;
    S:=PathChoose.Choose(P);
    If Length(P)>3 Then Delete(P, Length(P), 1);
    If S<>'' Then Begin
      Value:=P;
      While Length(Value)<MaxLen Do Value:=Value+' ';
      Res:=ResNext;
    End;
    I:=1;
    SetWindow(WinMain);
  End Else Res:=InputObj.ManageKey(Ch);
  ManageKey:=Res;
End;

Function PathObj.Edit: Byte;       { Pfad-Eingabe-Funktion }
Var
  PathInput: PathInputObj;
Begin
  Status('Bitte geben Sie das Startverzeichnis ein! '+
         'Wählen mit <Leertaste>');

  PathInput.Value:=Value;
  PathInput.Init;
  Edit:=PathInput.Edit;
  Value:=FExpand(PathInput.Value);
End;

{ -- Objekt: ProgObj ------------------------------------- }

Type                           { angepaßte Auswahlfunktion }
  ProgChooseObj = Object (ChooseObj)
                    Constructor Init;
                    Procedure ReadData; Virtual;
                    Procedure Close; Virtual;
                  End;

  ProgInputObj = Object (InputObj)       { Eingabefunktion }
                   Constructor Init;
                   Function CheckValue: Boolean; Virtual;
                   Function ManageKey(Ch: Char): Byte;
                            Virtual;
                 End;

Constructor ProgChooseObj.Init;   { Auswahl initialisieren }
Begin
  Status('Bitte wählen Sie die Programmdatei und '+
         'betätigen Sie <Return>!');
  ChooseObj.Init;
End;

Procedure ProgChooseObj.ReadData;         { Daten einlesen }
Var
  F : SearchRec;
  P : PathStr; D : DirStr; N : NameStr; E : ExtStr;
Begin
  Count:=0;

                                  { Programmdateien suchen }
  FindFirst(CPath+'*.*', ReadOnly Or Archive, F);
  While DosError=0 Do Begin
    P:=F.Name;
    FSplit(P, D, N, E);
    If (E='.COM') Or (E='.EXE') Then Begin
      Inc(Count);
      Data[Count]:=F.Name;
    End;
    FindNext(F);
  End;
  Count_:=Count;

                                    { Verzeichnisse suchen }
  FindFirst(CPath+'*.*', Directory, F);
  While DosError=0 Do Begin
    If (F.Attr And Directory<>0) And
       (F.Name<>'.') Then Begin
      Inc(Count);
      Data[Count]:=F.Name+'\';
    End;
    FindNext(F);
  End;
End;

Procedure ProgChooseObj.Close;  { Auswahlfenster schließen }
Begin
  ChooseObj.Close;
  Status('Bitte geben Sie den Namen der Programmdatei '+
         'ein! Wählen mit <Leertaste>');
End;

Constructor ProgInputObj.Init;    { Eingabe initialisieren }
Begin
  MaxLen:=48;
  X:=22; Y:=9;
  InputObj.Init;
End;

                                 { neue Gültigkeitsprüfung }
Function ProgInputObj.CheckValue: Boolean;
Var
  F : SearchRec;
  S : PathStr;
  D : DirStr; N : NameStr; E : ExtStr;
Begin
  S:=CutString(Value);
  If S='' Then DosError:=18 Else Begin
    S:=FExpand(S);
    FSplit(S, D, N, E);
    If (E<>'.COM') And (E<>'.EXE') Then DosError:=18 Else
      FindFirst(S, ReadOnly+SysFile+Archive, F);
  End;

  If DosError<>0 Then Begin
    CheckValue:=False; Error('Ungültige Programmdatei!');
  End Else CheckValue:=True;
End;

                      { erweiterte Tastendruckverarbeitung }
Function ProgInputObj.ManageKey(Ch: Char): Byte;
Var
  Res        : Byte;
  F          : SearchRec;
  ProgChoose : ProgChooseObj;
  S          : String12;
  P : PathStr; D : DirStr; N : NameStr; E : ExtStr;
Begin
  Res:=0;
  If Ch=' ' Then Begin             { Auswahl bei Leertaste }
    P:=FExpand(CutString(Value));
    If P[Length(P)]<>'\' Then Begin
      FindFirst(P, Directory, F);
      If (DosError<>0) Or
         (F.Attr And Directory=0) Then Begin
        FSplit(P, D, N, E);
        P:=D;
      End Else P:=P+'\';
    End;

    FindFirst(P+'*.*', AnyFile, F);
    If Not (DosError In [0, 18]) Then Begin
      If Length(P)>3 Then Delete(P, Length(P), 1);
      Error('Verzeichnis '+P+' existiert nicht!');
      P:=FExpand('');
    End;

    ProgChoose.CPath:=P;
    ProgChoose.Init;
    S:=ProgChoose.Choose(P);
    If S<>'' Then Begin
      Value:=P+S;
      While Length(Value)<MaxLen Do Value:=Value+' ';
      Res:=ResNext;
    End;
    I:=1;
    SetWindow(WinMain);
  End Else Res:=InputObj.ManageKey(Ch);
  ManageKey:=Res;
End;

Function ProgObj.Edit: Byte;       { Programm-Edit-Funkton }
Var
  ProgInput: ProgInputObj;
Begin
  Status('Bitte geben Sie den Namen der Programmdatei '+
         'ein! Wählen mit <Leertaste>');

  ProgInput.Value:=Value;
  ProgInput.Init;
  Edit:=ProgInput.Edit;
  Value:=FExpand(ProgInput.Value);
End;

{ -- Objekt: EntryObj ------------------------------------ }

Procedure EntryObj.Show;                { Eintrag anzeigen }
Begin
  SetWindow(WinMain);
  SetColor(ColHigh);
  GotoXY(70, 3);
  Write(Number);
  GotoXY(76, 3);
  Write(EntryCount);
  GotoXY(22, 5);
  Write(Hotkey.Name, '':12-Length(Hotkey.Name));
  GotoXY(22, 6);
  Write(Title.Value, '':32-Length(Title.Value));
  GotoXY(22, 8);
  Write(Path.Value, '':48-Length(Path.Value));
  GotoXY(22, 9);
  Write(ProgName.Value, '':48-Length(ProgName.Value));
End;

Procedure EntryObj.Edit;              { Eintrag bearbeiten }

Var
  Bar, Res : Byte;
  Ch       : Char;
  EntryOk  : Boolean;      { Flag für "Eintrag akzeptiert" }

                 { Edit-Funktion für "Eintrag akzeptieren" }
Function EntryOkEdit: Byte;
Begin
  Status('Betätigen Sie <Return> um den Eintrag zu '+
         'akzeptieren!');

  SetColor(ColMarked);
  GotoXY(22, 11); Write(' Eintrag akzeptieren ');
  Repeat
    Ch:=Readkey; If Ch=#13 Then EntryOk:=True;
    If Ch=#0 Then Case Readkey Of
      'H': Res:=ResPrev;
      'P': Res:=ResNext;
    End;
  Until (Res<>0) Or EntryOk;
  EntryOkEdit:=Res;
End;

Begin
  Bar:=1;
  EntryOk:=False;

  Repeat
    Show;     { Eintrag und "Eintrag akzeptieren" anzeigen }
    SetColor(ColInverse);
    GotoXY(22, 11); Write(' Eintrag akzeptieren ');

    Case Bar Of           { Entspr. Edit-Funktion aufrufen }
      1: Res:=Hotkey.Edit;
      2: Res:=Title.Edit;
      3: Res:=Path.Edit;
      4: Res:=ProgName.Edit;
      5: Res:=EntryOkEdit;
    End;

    Case Res Of              { Funktionsergebnis auswerten }
      ResPrev: If Bar>1 Then Dec(Bar);
      ResNext: If Bar<5 Then Inc(Bar);
    End;
  Until EntryOk;
  Show;
  SetColor(ColNorm);
  GotoXY(22, 11); Write('                     ');
End;

{ -- Hauptteil ------------------------------------------- }

Procedure GetData;         { Daten von Resident übernehmen }
Var
  Regs  : Registers;
  I     : Byte;
Begin
  FillChar(Data, SizeOf(Data), 0);
  For I:=1 To MaxEntry Do Data[I].Number:=I;
  Regs.AH:=MpxNum;
  Regs.AL:=$00;
  Intr($2F, Regs);

  If Regs.AL=$FF Then Begin        { Resident installiert? }
    ResiDataPtr:=Ptr(Regs.ES, Regs.BX);
    I:=1;
    While (I<=MaxEntry) And (ResiDataPtr^[I].Hotkey<>0) Do
      With Data[I] Do Begin
        Hotkey.Value:=ResiDataPtr^[I].Hotkey;
        Title.Value:=ConvString(ResiDataPtr^[I].Title);
        Path.Value:=ConvString(ResiDataPtr^[I].Path);
        ProgName.Value:=ConvString(ResiDataPtr^[I].ProgName);
        Inc(I);
      End;
    EntryCount:=I-1;
  End Else Begin
    ResiDataPtr:=Nil;
    EntryCount:=0;
  End;
End;

Procedure DeleteEntry(Nr: Byte);         { Eintrag löschen }
Var
  I : Byte;
Begin
  For I:=Nr+1 To EntryCount Do Data[I-1]:=Data[I];
  FillChar(Data[EntryCount], SizeOf(Data[EntryCount]), 0);
  Dec(EntryCount);
End;

Procedure TransData;        { Daten an Resident übertragen }
Var
  I : Byte;
Begin
  FillChar(ResiDataPtr^, SizeOf(ResiDataPtr^), 0);
  For I:=1 To MaxEntry Do With Data[I] Do
    If Hotkey.Value<>0 Then Begin
      ResiDataPtr^[I].Hotkey:=Hotkey.Value;
      Move(Title.Value[1], ResiDataPtr^[I].Title,
           Length(Title.Value));
      Move(Path.Value[1], ResiDataPtr^[I].Path,
           Length(Path.Value));
      Move(ProgName.Value[1], ResiDataPtr^[I].ProgName,
           Length(ProgName.Value));
    End;
End;

{ -- Speichern, Laden ------------------------------------ }

                      { Dateinameneingabe-Fenster ausgeben }
Procedure ShowFileInput;
Begin
  SetWindow(WinEdit);
  SetColor(ColNorm);
  GotoXY(3, 1); Write('Konfigurationsdatei:');
  SetColor(ColInverse);
  GotoXY(25, 3); Write(' Dateinamen akzeptieren ');
End;

Type                           { angepaßte Auswahlfunktion }
  FileChooseObj = Object (ChooseObj)
                    Constructor Init;
                    Procedure ReadData; Virtual;
                    Procedure Close; Virtual;
                  End;

                                { angepaßte Eingabefunktion }
  FileInputObj = Object (InputObj)
                   MustExist : Boolean;

                   Constructor Init;
                   Function CheckValue: Boolean; Virtual;
                   Function ManageKey(Ch: Char): Byte;
                            Virtual;
                 End;

Constructor FileChooseObj.Init;     { Auswahl initialieren }
Begin
  Status('Bitte wählen Sie die Konfigurationsdatei und '+
         'betätigen Sie <Return>!');
  ChooseObj.Init;
End;

Procedure FileChooseObj.ReadData;         { Daten einlesen }
Var
  F : SearchRec;
Begin
  Count:=0;
                                          { Dateien suchen }
  FindFirst(CPath+'*.SET', ReadOnly Or Archive, F);
  While DosError=0 Do Begin
    Inc(Count);
    Data[Count]:=F.Name;
    FindNext(F);
  End;

  Count_:=Count;                    { Verzeichnisse suchen }
  FindFirst(CPath+'*.*', Directory, F);
  While DosError=0 Do Begin
    If (F.Attr And Directory<>0) And (F.Name<>'.') Then Begin
      Inc(Count);
      Data[Count]:=F.Name+'\';
    End;
    FindNext(F);
  End;
End;

Procedure FileChooseObj.Close;  { Auswahlfenster schließen }
Begin
  ChooseObj.Close;
  ShowFileInput;
  Status('Bitte geben Sie den Dateinamen ein! Wählen mit '+
         '<Leertaste>');
End;

Constructor FileInputObj.Init;    { Eingabe initialisieren }
Begin
  MaxLen:=48;
  X:=25; Y:=1;
  InputObj.Init;
End;

                                 { neue Gültigkeitsprüfung }
Function FileInputObj.CheckValue: Boolean;
Var
  F : SearchRec;
  S : PathStr;
  D : DirStr; N : NameStr; E : ExtStr;
Begin
  If CutString(Value)='' Then DosError:=0 Else Begin
    S:=FExpand(CutString(Value));
    FSplit(S, D, N, E);
    If E='' Then Begin
      E:='.SET';
      S:=S+'.SET';
    End;
                            { nur Erweiterung .SET erlaubt }
    If E<>'.SET' Then DosError:=255 Else
      FindFirst(S, ReadOnly Or Archive, F);
  End;
  If (DosError<>0) And
     (MustExist Or (DosError<>18)) Then Begin
    CheckValue:=False;
    Error('Ungültige Konfigurationsdatei!');
  End Else CheckValue:=True;
End;

                      { erweiterte Tastendruckverarbeitung }
Function FileInputObj.ManageKey(Ch: Char): Byte;
Var
  Res        : Byte;
  F          : SearchRec;
  FileChoose : FileChooseObj;
  S          : String12;
  P : PathStr; D : DirStr; N : NameStr; E : ExtStr;
Begin
  Res:=0;
  If Ch=' ' Then Begin             { Auswahl bei Leertaste }
    P:=FExpand(CutString(Value));
    If P[Length(P)]<>'\' Then Begin
      FindFirst(P, Directory, F);
      If (DosError<>0) Or
         (F.Attr And Directory=0) Then Begin
        FSplit(P, D, N, E);
        P:=D;
      End Else P:=P+'\';
    End;

    FindFirst(P+'*.*', AnyFile, F);
    If Not (DosError In [0, 18]) Then Begin
      If Length(P)>3 Then Delete(P, Length(P), 1);
      Error('Verzeichnis '+P+' existiert nicht!');
      P:=FExpand('');
    End;

    FileChoose.CPath:=P;
    FileChoose.Init;
    S:=FileChoose.Choose(P);
    If S<>'' Then Begin
      Value:=P+S;
      While Length(Value)<MaxLen Do Value:=Value+' ';
      Res:=ResNext;
    End;
    I:=1;
  End Else Res:=InputObj.ManageKey(Ch);
  ManageKey:=Res;
End;

                              { Dateinameneingabe-Funktion }
Function GetFileName(MustExist: Boolean): PathStr;
Var
  FileName : PathStr;
  Bar, Res : Byte;
  NameOk   : Boolean;         { Flag für "Name akzeptiert" }

Function GetFileNameEdit: Byte;
Var
  FileInput : FileInputObj;
  D : DirStr; N : NameStr; E : ExtStr;
Begin
  Status('Bitte geben Sie den Dateinamen ein! Wählen mit '+
         '<Leertaste>');

  SetWindow(WinEdit);
  FileInput.MustExist:=MustExist;
  FileInput.Value:=FileName;
  FileInput.Init;
  GetFileNameEdit:=FileInput.Edit;
  FileName:=FileInput.Value;
  If FileName<>'' Then Begin
    FileName:=FExpand(FileName);
    FSplit(FileName, D, N, E);
    If E='' Then FileName:=FileName+'.SET';
  End;
End;

              { Edit-Funktion für "Dateinamen akzeptieren" }
Function NameOkEdit: Byte;
Var
  Res : Byte;
  Ch  : Char;
Begin
  Status('Bitte drücken Sie <Return> um den Dateinamen zu '+
         'akzeptieren!');
  Res:=0;
  SetColor(ColMarked);
  GotoXY(25, 3); Write(' Dateinamen akzeptieren ');
  Repeat
    Ch:=Readkey;
    Case Ch Of
      #0: Case Readkey Of
            'H': Res:=ResPrev;
            'P': Res:=ResNext;
          End;
      #13: Begin NameOk:=True; Res:=ResNext; End;
    End;
  Until Res<>0;
  NameOkEdit:=Res;
End;

Begin
  NameOk:=False;
  FileName:=''; Bar:=1;
  Repeat
    ShowFileInput;               { Eingabefenster anzeigen }
    SetColor(ColHigh);
    GotoXY(25, 1); Write(FileName, '':48-Length(FileName));

    Case Bar Of
      1: Begin
           Res:=GetFileNameEdit;
           If Res=ResNext Then Bar:=2;
         End;
      2: Begin
           Res:=NameOkEdit;
           If Res=ResPrev Then Bar:=1;
         End;
    End;
  Until NameOk;
  SetColor(ColNorm); ClrScr;
  GetFileName:=FileName;
End;

                  { Daten in Konfigurationsdatei speichern }
Procedure SaveFile;

                                  { Word in Hex darstellen }
Function HexWord(W: Word): String4;
Const
  HexCode: Array[0..15] Of Char = '0123456789ABCDEF';
Begin
  HexWord:=HexCode[Hi(W) Shr 4]+HexCode[Hi(W) And $F]+
           HexCode[Lo(W) Shr 4]+HexCode[Lo(W) And $F];
End;

Var
  F     : Text;
  FName : PathStr;
  I     : Byte;
Begin
  FName:=GetFileName(False);
  If FName<>'' Then Begin
    Assign(F, FName);
    Rewrite(F);
    For I:=1 To EntryCount Do With Data[I] Do
      Writeln(F, HexWord(Hotkey.Value), ';', Title.Value,
              ';', Path.Value, ';', ProgName.Value);
    Close(F);
  End;
End;

Procedure LoadFile;            { Konfigurationsdatei laden }
Var
  F     : Text;
  FName : PathStr;
  I, P  : Byte;
  S, S1 : String;
  Code  : Integer;
Begin
  FName:=GetFileName(True);
  If FName<>'' Then Begin
    Assign(F, FName);
    Reset(F);
    FillChar(Data, SizeOf(Data), 0);
    For I:=1 To MaxEntry Do Data[I].Number:=I;
    I:=1;
    While Not Eof(F) Do Begin
      Readln(F, S);
      With Data[I] Do Begin
        P:=Pos(';', S);
        S1:=Copy(S, 1, P-1);
        Val('$'+S1, Hotkey.Value, Code);
        Delete(S, 1, P);

        P:=Pos(';', S);
        Title.Value:=Copy(S, 1, P-1);
        Delete(S, 1, P);

        P:=Pos(';', S);
        Path.Value:=Copy(S, 1, P-1);
        Delete(S, 1, P);

        ProgName.Value:=S;
      End;
      Inc(I);
    End;
    EntryCount:=I-1;
    Close(F);
  End;
End;

Procedure ManageFunctions;          { Hauptmenü-Verwaltung }

Procedure GetFunction(Var Bar: Byte); { Menüpunkt anwählen }
Const
  Functions : Array[1..9] Of String[15] =
  ('Zurück', 'Vor', 'Edit', 'Löschen', 'Neu', 'Übertragen',
   'Speichern', 'Laden', 'Ende');
Var
  I  : Byte;
  Ch : Char;
Begin
  SetWindow(WinMain);
  SetColor(ColNorm);
  Status('Bitte wählen Sie eine Funktion!');
  Repeat
    GotoXY(5, 1);
    For I:=1 To 9 Do Begin
      If I=Bar Then SetColor(ColMarked) Else
        SetColor(ColInverse);
      Write(' ', Functions[I], ' ');
    End;
    Ch:=Readkey;
    If Ch=#0 Then Case Readkey Of
      'K': If Bar>1 Then Dec(Bar) Else Bar:=9;
      'M': If Bar<9 Then Inc(Bar) Else Bar:=1;
    End;
  Until Ch=#13;
End;

Var
  Bar, ActEntry : Byte;

Begin
  If EntryCount=0 Then ActEntry:=0 Else ActEntry:=1;
  Data[ActEntry].Show;
  Bar:=1;
  Repeat
    GetFunction(Bar);
    Case Bar Of
      1: If ActEntry>1 Then Begin                 { Zurück }
           Dec(ActEntry); Data[ActEntry].Show;
         End Else Error('Kein weiterer Eintrag vorhanden!');
      2: If ActEntry<EntryCount Then Begin           { Vor }
           Inc(ActEntry); Data[ActEntry].Show;
         End Else Error('Kein weiterer Eintrag vorhanden!');
      3: If ActEntry>0 Then                         { Edit }
           Data[ActEntry].Edit
         Else Error('Kein Eintrag vorhanden!');
      4: If ActEntry>0 Then Begin                { Löschen }
           DeleteEntry(ActEntry);
           If ActEntry>EntryCount Then ActEntry:=EntryCount;
           Data[ActEntry].Show;
         End Else Error('Kein Eintrag vorhanden!');
      5: If EntryCount<MaxEntry Then Begin           { Neu }
           Inc(EntryCount);
           ActEntry:=EntryCount;
           Data[ActEntry].Edit;
         End Else Error('Keine weiteren Einträge möglich!');
      6: If ResiDataPtr<>Nil Then Begin       { Übertragen }
           TransData;
           If EntryCount=0 Then ActEntry:=0 Else
             ActEntry:=1;
           Data[ActEntry].Show;
         End Else Error('Resident ist nicht installiert!');
      7: Begin                                 { Speichern }
           SaveFile;
           If EntryCount=0 Then ActEntry:=0 Else
             ActEntry:=1;
           Data[ActEntry].Show;
         End;
      8: Begin                                     { Laden }
           LoadFile;
           If EntryCount=0 Then ActEntry:=0 Else
             ActEntry:=1;
           Data[ActEntry].Show;
         End;
    End;
  Until Bar=9;
End;

Begin { Hauptprogramm }
  ExitSav:=ExitProc;      { neue Exit-Routine installieren }
  ExitProc:=@CloseScreen;
  InitScreen;
  GetData;
  ManageFunctions;
End.