eType/de

program eType;
    
    {$mode objFPC}
    {$longStrings on}
    {$implicitExceptions off}
    
    uses
      Crt     ;  //            , Windows;    //  so läuft's auch unter Linux
    
    var
      blnTasteGedrueckt: boolean = False;
      blnProgrammEnde: boolean = False;
      blnDateiZuEnde: boolean = False;
      intGeleseneZeilen: integer = 0;
      intP: integer = 0;
      intS: integer = 0;
      chrTastatur: char;
      datQuellDatei: Textfile;
      strZeile: string;
      strEingabe: string;
      wrdParameter: word = 0;
    
    
      function funAnsiZuOEM(strUebergabe: string): string;
      begin
        funAnsiZuOEM := '';
        strUebergabe := Utf8ToAnsi(strUebergabe);
        strUebergabe := strUebergabe + #0;
        CharToOEM(PChar(strUebergabe), @strUebergabe[1]);
        Delete(strUebergabe, Length(strUebergabe), 1);
        Result := strUebergabe;
      end;
    
    
      procedure subHilfe;
      begin
        WriteLn('   Folgende Parameter rufen die Hilfe auf:');
        WriteLn('     ? oder /? oder -? oder --? oder -h oder --h');
        WriteLn('');
        // WriteLn(funAnsiZuOEM('   Dem Programm muss ein Parameter übergeben werden.')); // wegen Win / Linux
        WriteLn('   Diese Datei muss eine Textdatei sein.');
        WriteLn('   Beispiel:');
        WriteLn('   eType test.txt');
        WriteLn('');
      end;
    
    
      procedure subFehlermeldung;
      begin
        if wrdParameter = 0 then
        begin
          textcolor(lightred);
          writeln(funAnsiZuOEM('   Es wurde kein Parameter übergeben!'));
          WriteLn('');
          textcolor(lightgray);
          Exit;
        end;
    
        if wrdParameter > 1 then
        begin
          textcolor(lightred);
          WriteLn(funAnsiZuOEM('   Es wurden zuviele Parameter übergeben!'));
          WriteLn('');
          textcolor(lightgray);
          subHilfe;
        end;
      end;
    
    
      function funParametertest: boolean;
      begin
        Result := False;
    
        // Prüft, ob die Hilfe aufgerufen wurde
        if (wrdParameter = 1) then
        begin
          case strEingabe of
            '?', '/?', '-?', '--?', '-h', '--h':
              subHilfe
            else
              Result := True;
          end;
        end;
      end;
    
    
      procedure subTastaturEingabe;
      begin
        repeat
          chrTastatur := readkey;
    
          // erhöht die Zähler um 21
          if (chrTastatur = #81) then
          begin
            if blnDateiZuEnde = False then
            begin
              Inc(intP, 21);
              Inc(intS, 21);
              blnTasteGedrueckt := True;
            end;
          end;
    
          // verringert die Zähler um 21
          if (chrTastatur = #73) and (intP >= 21) then
          begin
            Dec(intP, 21);
            Dec(intS, 21);
            blnTasteGedrueckt := True;
          end;
    
          if (chrTastatur = #79) or (chrTastatur = #27) then
          begin
            blnProgrammEnde := True;
            blnTasteGedrueckt := True;
          end;
        until blnTasteGedrueckt;
      end;
    
    
      procedure subUeberschrift;
      begin
        // leert den Bildschirm
        clrscr;
    
        // legt die Farbe der Überschrift fest
        textcolor(yellow);
        writeln(funAnsiZuOEM(
          'PGUP --> Zurückblättern | PGDN --> Vorblättern | END --> beenden'));
        // legt die Textfarbe fest
        textcolor(lightgray);
      end;
    
    
      procedure subDateiAusgeben;
      begin
        repeat
          // liest eine Zeile aus der Datei
          readln(datQuellDatei, strZeile);
          Inc(intGeleseneZeilen, 1);
          // gibt die Zeile aus der Datei am Bildschirm aus
          if intGeleseneZeilen >= intP then
            writeln(strZeile);
    
          blnDateiZuEnde := False;
          // prüft auf Dateiende
          if EOF(datQuellDatei) then
          begin
            blnDateiZuEnde := True;
            textcolor(yellow);
            writeln('EOF');
            textcolor(lightgray);
          end;
    
        until ((intGeleseneZeilen mod intS) = 0) or (EOF(datQuellDatei));
      end;
    
    
      procedure subParameterPruefen;
      begin
        wrdParameter := ParamCount;
    
        // Prüft auf die korrekte Parameteranzahl
        if wrdParameter = 1 then
        begin
          strEingabe := ParamStr(1);
          if funParametertest = False then
          begin
            ExitCode := 0;
            Halt;
          end;
        end
        else
        begin
          subFehlermeldung;
          Halt;
        end;
      end;
    
    
    
    begin
      // Setzt den Rückgabewert des Programms vorsorglich auf Fehler
      ExitCode := -1;
    
      subParameterPruefen;
    
      //Leert den Bildschirm
      ClrScr;
    
      // Initialisierung der Zähler
      intP := 0;
      intS := 21;
    
      // öffnet die Datei
      Assign(datQuellDatei, ParamStr(1));
    
      // Hauptschleife
      repeat
        // setzt den Dateizeiger auf den Dateianfang
        reset(datQuellDatei);
        intGeleseneZeilen := 0;
    
        subUeberschrift;
        subDateiAusgeben;
    
        // Schließt die Datei
        Close(datQuellDatei);
    
        subTastaturEingabe;
      until blnProgrammEnde;
    
      // Setzt den Rückgabewert des Programms auf OK
      ExitCode := 0;
    
    end.