eType/de

│ Deutsch (de) │

Zeigt Textdateien in der Console an

Dieser Artikel gehört zur Konsolenprogrammierung unter Windows und zeigt das die IDE Problem mit äöü Umlauten hat, außer bei der Ausgabe.

Beispiel für ein einfaches Dateianzeige-Programm mit eigenem Menü:

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.