Chip 2001 October/Chip_2001-10_cd1.bin/zkuste/delphi/nastroje/RTF2HTML.ZIP/r2hconv.pas

Pascal/Delphi Source File | 1998-07-15 | 104.6 KB | 2,721 lines

unit r2hconv;

interface


uses Classes, SysUtils, Mdfuncs;


const                               { Pseudo-enum fⁿr Tabellen-Behandlung }
    plain : integer = 0;
    in_cell : integer = 1;
    cell_end : integer = 2;
    row_end : integer = 3;


    fontsOpt : integer = 3;         { Die ersten <fontsOpt> Schriftarten in der font table werden bei Redundanz }
                                    { im HTML-Code wegoptimiert (sofern Flag 'optimize' gesetzt ist)            }

    ul_indent : integer = 285;      { left indent wird in (left indent DIV ul_indent) <UL>s umgewandelt       }
                                    { je kleiner dieser Wert ist, desto feiner sind die Level-Unterteilungen, }
                                    { aber es werden auch umso mehr <UL>s pro Einzug generiert                }

type format = record
    invis : boolean;                { versteckter Text }
    caps : boolean;                 { Blockschrift }
    bold : boolean;                 { fett }
    italic : boolean;               { kursiv }
    underline : boolean;            { unterstrichen }
    superscript : boolean;          { hochgestellt }
    subscript : boolean;            { tiefgestellt }
    strike : boolean;               { durchgestrichen }
    font : integer;                 { Schriftart }
    fcol : string;                  { Text-Fabe }
    fsize : integer;                { Text-Gr÷▀e }
    rjustified : boolean;           { rechtsbⁿndig }
    centered : boolean;             { zentriert }
    table : integer;                { Tabelle }
end;

type font = record
    name : string;
    number : integer;
end;

type
    stackptr = ^stackelem;     { der Formatierungs-Stack }
    stackelem = record
    tagstart : string;
    tagend : string;
    next : stackptr;
end;

type
    strlptr = ^slelem;
    slelem = record
    lstring : string;
    next : strlptr;
end;

type enumlist = record
    doclvl : integer;
    lvl : integer;
    indent : array[0..20] of integer;
end;

type ss = record
    name : string;
    ctrl : string;
end;

type flags = record
    noFonts : boolean;
    optimize : boolean;
    onlyDefiniteOpt : boolean;
end;

var
    flag : flags;
    stylesheet : array [0..300] of ss;
    killstr : strlptr;
    col : TStringList;
    fonts : array[0..200] of font;
    linkstyles, anchstyles, actlinknum, actanchnum : array [1..9] of integer;

    outstring, pntxta, pntxtb, enumtxt, txtwait : string;
    invis, bkmkpar, lastline, li_open, listitem, listbull, pnnum, nextpar, enumdigit : boolean;
    ahref, anchor, ahrefwait, newhrefnum, no_newind : boolean;

    changefmt : boolean;
    mainstack : stackptr;

    anchlvl, indexlvl, lastindent, lvlnum, globbrk : integer;

    enums : enumlist;


procedure rtf2html (filename: string; destfilename: string; param: array of string);


implementation

{  ************************************************************************  }
{                                                                            }
{  RTF2HTML V 2.1                                                            }
{  by hr                                                                     }
{  last change:  15-07-98                                                    }
{                                                                            }
{  Diese Version sollte weniger komplexe RTF-Files fehlerfrei bzw.           }
{  komplexere RTF-Files layoutmΣ▀ig weitestgehend korrekt ⁿbersetzen k÷nnen  }
{                                                                            }
{  Aufruf-Parameter:                                                         }
{                                                                            }
{  -  'optimize'                                                             }
{     eliminiert ⁿberflⁿssige HTML-Tags wie zb. '<B></B>' oder </SUB><SUB>   }
{  -  'onlyDefiniteOpt'                                                      }
{     sorgt dafⁿr, das Strings wie '</FONT><FONT FACE="Arial">' NICHT        }
{     wegoptimiert werden, da das schlie▀ende </FONT>-Tag u.u. eine andere   }
{     Anweisung als <FONT FACE="Arial"> hier im Beispiel deaktivieren        }
{     k÷nnte                                                                 }
{  -  'noFonts'                                                              }
{     deaktiviert alle <FONT FACE="...">-Anweisungen                         }
{                                                                            }
{  Folgendes wird, so weit im HTML 3 m÷glich, Σquivalent ⁿbersetzt:          }
{                                                                            }
{  -  Stylesheets im allgemeinen (flie▀t in die spezifischen Zeilen-         }
{     Formatierungen mit ein)                                                }
{  -  bold, italic, underline, strikethrough, subscript, superscript         }
{  -  center, left/right justified                                           }
{  -  AufzΣhlungen aller Arten                                               }
{  -  left indents (mittels <UL>-Schachtelungen)                             }
{  -  Zeilenumbruch/Absatz                                                   }
{  -  etwaige Farb-/Schriftart-/Schriftgr÷▀e-Formatierungen                  }
{  -  Sonderzeichen ( ' " <   usw.)                                          }
{  -  Tabellen                                                               }
{                                                                            }
{  Folgendes kann Fehler bzw. unerwⁿnschte Ergebnisse verursachen            }
{  (known 'bugs'):                                                           }
{                                                                            }
{  -  Der Aufrufparameter 'optimize' bewirkt, da▀ auch Zeichenketten wie     }
{     '</FONT><FONT FACE="Arial">' gnadenlos wegoptimiert werden kann, was   }
{     leicht in Formatierungs-Fehlern (NICHT HTML-Syntax-Fehlern) enden      }
{     kann; Abhilfe: Parameter 'onlyDefiniteOpt'                             }
{  -  ▄bernahme von Text-Formatierungen in eine Tabelle, wenn eine solche    }
{     beginnt, was in RTF rein theoretisch m÷glich ist, findet NICHT statt   }
{     GRUND:   1. werden beim Beginn einer Tabelle normalerweise ohnehin     }
{                 alle Text-Formatierungen zurⁿckgesetzt                     }
{              2. mⁿ▀te man eine 'mitgeschleifte' Formatierung in einer      }
{                 HTML-Tabelle Feld fⁿr Feld neu setzen und am Feld-Ende     }
{                 wieder l÷schen  --->  das ausgespuckte HTML-File wird      }
{                 **SEHR** gro▀                                              }
{  -  AufzΣhlungen in Tabellenfeldern (soll's ja auch geben) werden nur      }
{     mit Pseudo-Tabs und ·'s ⁿbersetzt (ohne <UL>, <LI>)              }
{  -  wenig sinnvolle RTF-Dokumente mit Punkten im Inhaltsverzeichnis,       }
{     zu denen keine entsprechende ▄berschrift existiert verursachen         }
{     HTML-Dokumente mit Phantasie-Referenzen                                }
{                                                                            }
{  Folgendes wird in der vorliegenden Version ignoriert:                     }
{                                                                            }
{  -  Kopf-/Fu▀zeile                                                         }
{  -  File Tables                                                            }
{  -  Bilder  (Text-Hinweis wird im Html-Dokument angezeigt)                 }
{  -  bestimmte rtf-spezifische Formatierungen                               }
{  -  Dokument-Infos                                                         }
{                                                                            }
{  ************************************************************************  }
{  History:                                                                  }
{                                                                            }
{  V 1.0:  - erste offizielle Version                                        }
{                                                                            }
{  V 1.1:  - Bug in IgnoreGroup() entfernt (Index binind wurde nicht erh÷ht) }
{          - Function empty() zum Leeren der Stacks                          }
{          - ─nderung bei der Behandlung von Gruppen-Enden                   }
{          - ─nderung bei der Darstellung von Bullet-Listen                  }
{                                                                            }
{  V 1.2:  - ▄bersetzung von Tabellen (neue Prozedur ProcessTable() )        }
{          - erweiterte Sonderzeichen-Behandlung                             }
{          - AufzΣhlungen/Listen werden jetzt als Symbol+Text nach HTML      }
{            konvertiert (ohne <UL> bzw. <OL>-Tags)                          }
{          - kleine Layout-Bereinigungen                                     }
{                                                                            }
{  V 1.3:  - ─nderung bei der Behandlung von Gruppen-AnfΣngen (neue Pro-     }
{            zeduren CopyStack(), CopyAttrib() )                             }
{          - neue Prozedur htmlchar() zur korrekten Ausgabe von Dokument-    }
{            Text                                                            }
{          - Bug in chfmt() entfernt (in einzelnen FΣllen wurden Format-     }
{            Flags falsch gesetzt)                                           }
{                                                                            }
{  V 2.0:  - Einbindung von Stylesheets (neue Procedures initstyles(),       }
{            plainchar() )                                                   }
{          - Inhaltsverzeichnis/▄berschrift-Verweis-Strukturen werden        }
{            in HTML-Sprungmarken umgewandelt                                }
{          - W÷rter, die mit 'http://' beginnen, werdem automatisch in       }
{            Hyperlinks umgewandelt (neue Prozedur incl_hlink() )            }
{          - AufzΣhlungen (auch geschachtelt) werden als entsprechend        }
{            strukturierte <UL>'s nach HTML konvertiert                      }
{          - verbesserte HTML-Code-Optimierfunktion                          }
{          - neue Procedures addfontname(), addcolstr(), add_ks() zur        }
{            Unterstⁿtzung von optim()                                       }
{          - Aufrufparameter fⁿr rtf2html() zum Variieren der Konvertier-    }
{            Vorgangsweisen                                                  }
{          - Globale Liste von 'left indents', womit Einzⁿge bei Auf-        }
{            zΣhlungen im RTF-Doc. in (halbwegs) entsprechend tiefe          }
{            <UL>-Schachtelungen umgewandelt werden                          }
{          - diverse kleine Layout-─nderungen                                }
{                                                                            }
{  V 2.1:  - ⁿberarbeiteter Formatierungs-Algorithmus                        }
{          - alle left indents werden nun mittels <UL>-Schachtelungen,       }
{            so weit m÷glich, ⁿbersetzt                                      }
{                                                                            }
{  ************************************************************************  }

procedure add_ks (st: string);
var
    helpp : strlptr;
begin
    New(helpp);
    helpp^.lstring := st;
    helpp^.next := killstr;
    killstr := helpp;
end;

procedure init_killstr;
begin
    killstr := NIL;
    add_ks('<FONT SIZE=-2></FONT>');
    add_ks('<FONT SIZE=-1></FONT>');
    add_ks('<FONT SIZE=+0></FONT>');
    add_ks('<FONT SIZE=+1></FONT>');
    add_ks('<FONT SIZE=+2></FONT>');
    add_ks('<FONT SIZE=+3></FONT>');
    add_ks('<FONT SIZE=+4></FONT>');
end;

function optim (src: string): string;   { eliminiert ⁿberflⁿssige Formatierungs-Anweisungen }
var
    line, comp : string;
    helpp : strlptr;

begin
    line := src;

    repeat
        comp := line;

        if flag.optimize then
        begin
            line := ReplaceAll(['<B></B>','<I></I>','<U></U>','</B><B>','</I><I>','</U><U>'],['','','','','',''],line);
            line := ReplaceAll(['<SUP></SUP>','<SUB></SUB>','<S></S>','</SUP><SUP>','</SUB><SUB>','</S><S>'],['','','','','',''],line);
            line := ReplaceAll(['<CENTER></CENTER>','</CENTER><CENTER>','<DIV ALIGN=right></DIV>','</DIV><DIV ALIGN=right>'],['','','',''],line);
        end;

        line := ReplaceAll(['<UL></UL>','</UL><UL>'],['',''],line);

        if flag.optimize then
        begin
            helpp := killstr;
            while (helpp <> NIL) do
            begin
                line := ReplaceIn(helpp^.lstring, '', line);
                helpp := helpp^.next;
            end;
        end;

    until line = comp;

    Result := line;
end;

{  ************************************************************************  }

procedure incl_hlink (var line: string);
var
   helpstr, htxt, str : string;
   h, h_end, strlen : integer;

begin
    str := line;

    h := Pos('http://', str);
    helpstr := '';

    while h > 0 do
    begin
        h_end := h + 7;
        strlen := length(str);

        while (str[h_end] <> '<')
        and (str[h_end] <> ' ')
        and (str[h_end] <> ',')
        and (h_end <= strlen) do
            Inc(h_end);

        htxt    := Copy(str, h, h_end-h);
        helpstr := helpstr + Copy(str, 1, h-1) + '<A HREF="' + htxt + '">' + htxt + '</A>';
        str     := Copy(str, h_end, length(str));

        h := Pos('http://', str);
    end;

    line := helpstr + str;
end;

{  ************************************************************************  }

procedure WriteHtml (const txt: string; var outstring: string; var outfile: textfile);
var
    i, strlen: integer;
    str, htxt: string;
    par, br: boolean;

begin
    if length(txt) > 0 then
    begin
        outstring := outstring + txt;

        par := false;
        br := false;

        str := optim(outstring);

        strlen := length(str);

        i := Pos('<P>', str) + 2;
        if i = 2 then
        begin
            i := Pos('<BR>', str) + 3;
            if i > 3 then br := true;
        end
        else
            par := true;

        if (br) or (par) or (strlen > 100) then
        begin
            while par or br do
            begin
                htxt := Copy(str, 1, i);
                incl_hlink(htxt);

                WriteLn(outfile, htxt);
                str := Copy(str, i+1, length(str)-i);

                par := false;
                br := false;

                i := Pos('<P>', str) + 2;
                if i = 2 then
                begin
                    i := Pos('<BR>', str) + 3;
                    if i > 3 then br := true;
                end
                else
                    par := true;
            end;

            outstring := str;
            strlen := length(str);

            if  (strlen > 100)
            and (outstring[strlen] = '>')
            and (outstring[strlen-1] <> 'L')
            and (outstring[strlen-1] <> 'A') then
            begin
                incl_hlink(outstring);
                WriteLn(outfile, outstring);
                outstring := '';
            end;
        end;
    end; { if length(txt) > 0 ... }
end;

{  ************************************************************************  }

function hex2dec (hex: string): integer;  { hexadezimal -> dezimal - Konvertierung fⁿr Zahlen <= 255 }
var
    i : integer;

begin
    Result := 0;
    for i := 1 to 2 do
        if (hex[i] = 'A') or (hex[i] = 'a') then Result := Result*16 + 10
        else if (hex[i] = 'B') or (hex[i] = 'b') then Result := Result*16 + 11
        else if (hex[i] = 'C') or (hex[i] = 'c') then Result := Result*16 + 12
        else if (hex[i] = 'D') or (hex[i] = 'd') then Result := Result*16 + 13
        else if (hex[i] = 'E') or (hex[i] = 'e') then Result := Result*16 + 14
        else if (hex[i] = 'F') or (hex[i] = 'f') then Result := Result*16 + 15
        else Result := Result*16 + strtoint(hex[i]);
end;

{  ************************************************************************  }

function dec2hex (num: integer): string;  { dezimal -> hexadezimal - Konvertierung fⁿr Zahlen <= 255 }
var
    hex : string;
    digit : integer;
begin
    hex := '';
    digit := num div 16;

    while length(hex) < 2 do
    begin
        if digit <= 9 then
            hex := hex + inttostr(digit)
        else if digit = 10 then
            hex := hex + 'A'
        else if digit = 11 then
            hex := hex + 'B'
        else if digit = 12 then
            hex := hex + 'C'
        else if digit = 13 then
            hex := hex + 'D'
        else if digit = 14 then
            hex := hex + 'E'
        else if digit = 15 then
            hex := hex + 'F';

        digit := num mod 16;
    end;

    Result := hex;
end;

{  ************************************************************************  }

procedure addcolstr (colstr: string);
var
    str : string;

begin
    str := '<FONT COLOR="' + colstr + '"></FONT>';
    add_ks(str);
end;

{  ************************************************************************  }

procedure addfontname (fname: string);
var
    str : string;

begin
    str := '<FONT FACE="' + fname + '"></FONT>';

    add_ks(str);

    if not flag.onlyDefiniteOpt then                     { das kann u.u. ins Auge gehen, optimiert aber sehr gut }
    begin                                                { vor allem bei <UL>'s                                  }
        str := '</FONT><FONT FACE="' + fname + '">';     { das </FONT> zu Beginn k÷nnte aber von einer anderen   }
        add_ks(str);                                     { Formatierung als <FONT FACE = "fname"> stammen        }
    end;
end;

{  ************************************************************************  }

procedure cut_tag (rtf_tag : string; var line : string);     { verkⁿrzt Stylesheet-Strings }
var
    i, strlen : integer;
    act_tag : string;

begin
    i := Pos(rtf_tag, line);
    while i > 0 do
    begin
        strlen := length(line);
        act_tag := rtf_tag;
        Inc(i, length(rtf_tag));

        while (line[i] <> '\') and (line[i] <> ' ') and (i <= strlen) do
        begin
            act_tag := act_tag + line[i];
            Inc(i);
        end;

        line := ReplaceIn (act_tag, '', line);
        i := Pos(rtf_tag, line);
    end;
end;

{  ************************************************************************  }

function optStyle(basestyle, actstyle: string) : string;
var
    sbased, sact : string;

begin
    Result := '';
    sbased := basestyle;
    sact := actstyle;

    sact := ReplaceAll(['\widctlpar','\adjustright','\nowidctlpar'],['','',''], sact);
    sact := ReplaceAll(['\keepn','\cgrid','\widctl'],['','',''], sact);

    cut_tag('\sbasedon', sact);
    cut_tag('\snext', sact);
    cut_tag('\sa', sact);
    cut_tag('\sb', sact);
    cut_tag('\lang', sact);
    cut_tag('\slmult', sact);
    cut_tag('\sl', sact);
    cut_tag('\outlinelevel', sact);
    cut_tag('\kerning', sact);
    cut_tag('\expndtw', sact);
    cut_tag('\expnd', sact);
    cut_tag('\tx', sact);

    if pos(sbased, sact) > 0 then
    begin
        sbased := '';
    end;
    if ((pos('\fi', sact) > 0) or (pos('\li', sact) > 0))
    and ((pos('\fi', sbased) > 0) or (pos('\li', sbased) > 0)) then
    begin
        cut_tag('\fi', sbased);
        cut_tag('\li', sbased);
    end;

    Result := sbased + sact;
end;

{  ************************************************************************  }

procedure CloseLists (var outstring: string; var outfile: textfile);
var
    txt : string;

begin
    txt := '';

    if listitem and not li_open then
        txt := txt + '</LI>';

    while enums.lvl > 0 do
    begin
        txt := txt + '</UL>';
        Dec(enums.lvl);
    end;

    WriteHtml(txt, outstring, outfile);
end;

{  ************************************************************************  }

function htmlcol (rtfcol: string): string;  { wandelt rft-Farbangabe in html-Farbangabe um }
var
    red_ind, green_ind, blue_ind : integer;
    redstr, greenstr, bluestr, colstr : string;
    red, green, blue : integer;

begin
    redstr := '';
    greenstr := '';
    bluestr := '';

    red_ind := pos('red',rtfcol)+3;
    green_ind := pos('green',rtfcol)+5;
    blue_ind := pos('blue',rtfcol)+4;

    while (rtfcol[red_ind] in ['0'..'9']) and (red_ind <= length(rtfcol)) do
    begin
        redstr := redstr + rtfcol[red_ind];
        Inc(red_ind);
    end;
    try
       red := strtoint(redstr);
    except
       on EConvertError do red := 0;
    end;
    redstr := dec2hex(red);

    while (rtfcol[green_ind] in ['0'..'9']) and (green_ind <= length(rtfcol)) do
    begin
        greenstr := greenstr + rtfcol[green_ind];
        Inc(green_ind);
    end;
    try
       green := strtoint(greenstr);
    except
       on EConvertError do green := 0;
    end;
    greenstr := dec2hex(green);

    while (rtfcol[blue_ind] in ['0'..'9']) and (blue_ind <= length(rtfcol)) do
    begin
        bluestr := bluestr + rtfcol[blue_ind];
        Inc(blue_ind);
    end;
    try
       blue := strtoint(bluestr);
    except
       on EConvertError do blue := 0;
    end;
    bluestr := dec2hex(blue);

    colstr := '#'+redstr+greenstr+bluestr;
    Result := colstr;
end;

{  ************************************************************************  }

procedure resetfmt (var attrib: format; const kind: string);  { setzt intern gespeicherte Formatierungen zurⁿck }
begin
    with attrib do
    begin
        if (kind = 'text') or (kind = 'all') then
        begin
            invis := false;
            caps := false;
            bold := false;
            italic := false;
            underline := false;
            superscript := false;
            subscript := false;
            strike := false;
            font:= -1;
            fcol:= 'none';
            fsize:= -1;
        end;
        if (kind = 'par') or (kind = 'all') then
        begin
            rjustified := false;
            centered := false;
        end;
        if (kind = 'all') then table := 0;
    end;
end;

{  ************************************************************************  }

function diff(attr1: format; attr2: format): boolean;  { vergleicht zwei Format-Records }
begin
    Result := false;

    if attr1.invis <> attr2.invis then
        Result := true
    else if attr1.bold <> attr2.bold then
        Result := true
    else if attr1.italic <> attr2.italic then
        Result := true
    else if attr1.underline <> attr2.underline then
        Result := true
    else if attr1.superscript <> attr2.superscript then
        Result := true
    else if attr1.subscript <> attr2.subscript then
        Result := true
    else if attr1.strike <> attr2.strike then
        Result := true
    else if attr1.font <> attr2.font then
        Result := true
    else if attr1.fcol <> attr2.fcol then
        Result := true
    else if attr1.fsize <> attr2.fsize then
        Result := true
    else if attr1.rjustified <> attr2.rjustified then
        Result := true
    else if attr1.centered <> attr2.centered then
        Result := true;
end;

{  ************************************************************************  }

function htmlfontsize (size: integer): string;  { liefert den html-Code fⁿr die angegebene neue Schrift-Gr÷▀e }
var
    sizestr: string;

begin
    if (size <> 12) then
    begin                                      { wir interpolieren..... }
        if size <= 8 then sizestr := '-2'
        else if size <= 11 then sizestr := '-1'
        else if size <= 15 then sizestr := '+1'
        else if size <= 20 then sizestr := '+2'
        else if size <= 28 then sizestr := '+3'
        else sizestr := '+4';
        Result := '<FONT SIZE=' + sizestr + '>';
    end
    else
        Result := '<FONT SIZE=+0>';
end;

{  ************************************************************************  }

function fontname (var num: integer): string;
var
    i : integer;

begin
    i := 0;
    while (fonts[i].number <> num) and (i < high(fonts)) do Inc(i);

    if i > high(fonts) then           { sollte eigentlich nicht vorkommen..... }
    begin
        num := fonts[high(fonts)].number;
        Result := fonts[high(fonts)].name;
    end
    else
        Result := fonts[i].name;
end;

{  ************************************************************************  }

procedure CopyAttrib(var dest: format; src: format);
begin
    dest.invis := src.invis;
    dest.caps := src.caps;
    dest.bold := src.bold;
    dest.italic := src.italic;
    dest.underline := src.underline;
    dest.superscript := src.superscript;
    dest.subscript := src.subscript;
    dest.strike := src.strike;
    dest.font := src.font;
    dest.fcol := src.fcol;
    dest.fsize := src.fsize;
    dest.rjustified := src.rjustified;
    dest.centered := src.centered;
  {  dest.table := src.table;}
end;

{  ************************************************************************  }

procedure addtag(var stk: stackptr; tagstart: string; tagend: string);
var                             { neue Formatierung auf den Stack ..... }
    ptr : stackptr;
begin
    New(ptr);
    ptr^.tagstart := tagstart;
    ptr^.tagend := tagend;
    ptr^.next := stk;
    stk := ptr;
end;

{  ************************************************************************  }

procedure CopyStack(var dest: stackptr; src: stackptr);
var
    helpptr : stackptr;
begin
    dest := NIL;
    helpptr := src;
    while (helpptr <> NIL) do
    begin
        addtag(dest, helpptr^.tagstart, helpptr^.tagend);
        helpptr := helpptr^.next;
    end;
end;

{  ************************************************************************  }

procedure poptag(var stk: stackptr);
var                             { oberste Formatierung vom Stack entfernen }
    ptr : stackptr;
begin
    ptr := stk;
    stk := stk^.next;
    Dispose(ptr);
end;

{  ************************************************************************  }

function contents(stk: stackptr): string;
var
    helpp : stackptr;

begin
    helpp := stk;
    Result := '';
    while (helpp <> NIL) do
    begin
        if copy(helpp^.tagend,1,6) = '</FONT' then
            Result := Result + '</FONT>'
        else
            Result := Result + helpp^.tagend;
        helpp := helpp^.next;
    end;
end;

{  ************************************************************************  }

function empty(var stk: stackptr): string;
begin
    Result := '';
    while (stk <> NIL) do
    begin
        if copy(stk^.tagend,1,6) = '</FONT' then
            Result := Result + '</FONT>'
        else
            Result := Result + stk^.tagend;
        poptag(stk);
    end;
end;

{  ************************************************************************  }

function createFTags (attrib: format): string;
var
    txt : string;

begin
    Result := '';
    with attrib do
    begin
        if bold then
        begin
            addtag(mainstack, '<B>', '</B>');
            Result := Result + '<B>';
        end;
        if italic then
        begin
            addtag(mainstack, '<I>', '</I>');
            Result := Result + '<I>';
        end;
        if underline then
        begin
            addtag(mainstack, '<U>', '</U>');
            Result := Result + '<U>';
        end;
        if subscript then
        begin
            addtag(mainstack, '<SUB>', '</SUB>');
            Result := Result + '<SUB>';
        end;
        if superscript then
        begin
            addtag(mainstack, '<SUP>', '</SUP>');
            Result := Result + '<SUP>';
        end;
        if strike then
        begin
            addtag(mainstack, '<S>', '</S>');
            Result := Result + '<S>';
        end;
        if fcol <> 'none' then
        begin
            txt := '<FONT COLOR="' + fcol + '">';
            addtag(mainstack, txt, '</FONT>');
            Result := Result + txt;
        end;
        if font > -1 then
        begin
            txt := fontname(font);
            txt := '<FONT FACE="' + txt + '">';
            addtag(mainstack, txt, '</FONT>');
            Result := Result + txt;
        end;
        if fsize > -1 then
        begin
            txt := htmlfontsize(fsize);
            addtag(mainstack, txt, '</FONT>');
            Result := Result + txt;
        end;
    end;
end;

{  ************************************************************************  }

function htmlchar(ch: string; attrib: format): string;
var
    ltr : char;
    curlink, curanch : string;

begin
    Result := '';

    if changefmt then
        Result := Result + empty(mainstack);

    if nextpar then
    begin
        if attrib.centered then
            Result := Result + '<CENTER>'
        else if attrib.rjustified then
            Result := Result + '<DIV ALIGN=right>';
    end;

    if changefmt or nextpar then
    begin
        Result := Result + CreateFTags(attrib);
    end;

    enums.doclvl := globbrk;
    nextpar := false;        { wir sind nicht mehr am Beginn eines neuen Absatzes }
    changefmt := false;

    if ahrefwait then
    begin
        if newhrefnum then        { jetzt wird's Zeit, eine Referenz zu setzen }
        begin
            ahref := true;
            newhrefnum := false;
            Inc(actlinknum[indexlvl]);
            curlink := inttostr(indexlvl) + '-' + inttostr(actlinknum[indexlvl]);
            Result := Result + '<A HREF="#' + curlink + '">';
        end;
    end;

    if anchor then
    begin                         { jetzt kommt eine Sprungmarke }
        Inc(actanchnum[anchlvl]);
        curanch := inttostr(anchlvl) + '-' + inttostr(actanchnum[anchlvl]);
        Result := Result + '<A NAME="' + curanch + '">';
    end;

    if not attrib.invis then
    begin
        if length(ch) = 1 then
        begin
            ltr := ch[1];
            if ltr = '<' then
                Result := Result + '<'
            else if ltr = '>' then
                Result := Result + '>'
            else if ltr = '&' then
                Result := Result + '&'
            else
                if ltr in ['a'..'z'] then
                begin
                    if attrib.caps then
                        Result := Result + UpperCase(ltr)
                    else
                        Result := Result + ltr;
                end
                else
                    Result := Result + ltr;
        end
        else if (length(ch) = 2) then
        begin
            if ch = 'c4' then Result := Result + 'Ä'           { '─' }
            else if ch = 'd6' then Result := Result + 'Ö'      { '╓' }
            else if ch = 'dc' then Result := Result + 'Ü'      { '▄' }
            else if ch = 'e4' then                         { 'Σ' }
            begin
                if attrib.caps then
                    Result := Result + 'Ä'
                else
                    Result := Result + 'ä';
            end
            else if ch = 'f6' then                         { '÷' }
            begin
                if attrib.caps then
                    Result := Result + 'Ö'
                else
                    Result := Result + 'ö';
            end
            else if ch = 'fc' then                         { 'ⁿ' }
            begin
                if attrib.caps then
                    Result := Result + 'Ü'
                else
                    Result := Result + 'ü';
            end
            else if ch = 'df' then Result := Result + 'ß'     { '▀' }
            else if ch = 'b7' then Result := Result + '·'    { AufzΣhlungs-Punkt }
            else Result := Result + chr(hex2dec(ch));
        end { if length(ch) = 1 ... }
        else
        begin
            if ch = '&pict;' then
                Result := Result + '<P>[*** picture ***]<P>'     { Graphik-Substitut}
            else if (Pos('&&', ch) = 1) then
                Result := Result + Copy(ch, 3, length(ch)-2)     { AufzΣhlungstext }
            else if ch = '&tab;' then
                Result := Result + '        '
            else if ch = '"e;' then
                Result := Result + #39
            else if ch = '&dblquote;' then
                Result := Result + #34
            else if ch = '&emspace;' then
                Result := Result + '  '
            else if ch = '&enspace;' then
                Result := Result + ' '
            else if ch = '&emdash;' then
                Result := Result + '--'
            else if ch = '&endash;' then
                Result := Result + '-'
            else if ch = ' ' then
                Result := Result + ch;                           { nonbreaking space }
        end;
    end
    else  { hidden text }
        Result := Result + '';

    if anchor then
    begin
        Result := Result + '</A>';
        anchor := false;
    end;
end;

{  ************************************************************************  }

function plainchar(ch: string): string;
begin
    if ch = 'c4' then Result := '─'
    else if ch = 'd6' then Result := '╓'
    else if ch = 'dc' then Result := '▄'
    else if ch = 'e4' then Result := 'Σ'
    else if ch = 'f6' then Result := '÷'
    else if ch = 'fc' then Result := 'ⁿ'
    else if ch = 'df' then Result := '▀'
    else Result := chr(hex2dec(ch));
end;

{  ************************************************************************  }

function html (const ctrlword: string; var attrib: format): string;
var                                      { fri▀t rtf-Kontrollwort & spuckt entsprechenden html-Code aus }
    num : integer;
    txt : string;

begin
    Result := '';

    if (ctrlword = 'plain') or (ctrlword = 'pard') or (ctrlword = 'sectd') then         { alle Formatierungen deaktivieren }
    begin
        if (ctrlword = 'plain') then
        begin
            resetfmt(attrib, 'text');
            changefmt := true;
            if mainstack <> NIL then
                Result := Result + empty(mainstack);
        end;

        if (ctrlword = 'pard') or (ctrlword = 'sectd') then      { neue Absatz-Formatierung }
        begin
            resetfmt(attrib, 'par');

            enumtxt := '';
            txtwait := '';
            ahrefwait := false;
            lastindent := 0;
            no_newind := true;
            li_open := false;
            listbull := false;
            enumdigit := false;
            pnnum := false;
            lvlnum := -1;

          {  if listitem then
                Result := Result + '</LI>'; }

            while enums.lvl > 0 do
            begin
                Dec(enums.lvl);
                txt := txt + '</UL>';
            end;
            listitem := false;
        end;

        if txt <> '' then Result := Result + txt;
    end

    else if ctrlword = 'v' then          { versteckter Text }
        attrib.invis := true

    else if ctrlword = 'v0' then
        attrib.invis := false

    else if ctrlword = 'caps' then       { Blockschrift }
        attrib.caps := true

    else if ctrlword = 'caps0' then
        attrib.caps := false

    else if ctrlword = 'tab' then                         { Tabulator }
    begin                                                 { Notl÷sung }
        if not attrib.invis then Result := Result + htmlchar('&tab;', attrib);
    end

    else if ctrlword = 'qc' then       { Formatierung: zentriert }
    begin
        if not attrib.centered then
        begin
            attrib.centered := true;
        end;
    end

    else if ctrlword = 'qr' then       { Formatierung: rechtsbⁿndig }
    begin
        if not attrib.rjustified then
        begin
            attrib.rjustified := true;
        end;
    end

    else if (ctrlword = 'par') or (ctrlword = 'sect') then      { neuer Absatz }
    begin
        Result := Result + empty(mainstack);

        if attrib.rjustified then
        begin
            Result := Result + '</DIV>';
        end;
        if attrib.centered then
        begin
            Result := Result + '</CENTER>';
        end;

        changefmt := true;
        newhrefnum := true;
        nextpar := true;

        if listitem then
        begin
            Result := Result + '</LI>';
            li_open := true;
        end
        else
        begin
            Result := Result + '<BR>';
            if lvlnum > -1 then
            begin
                Inc(lvlnum);
                enumtxt := pntxtb + inttostr(lvlnum) + pntxta;
            end;
            bkmkpar := false;
        end;
    end

    else if (ctrlword = 'line') then      { Zeilenumbruch }
    begin
        Result := Result + '<BR>';
    end

    else if (ctrlword = 'page')then       { Seitenumbruch }
    begin
        Result := Result + '<BR><HR><BR>';
    end

    else if (ctrlword = 'emdash') then      { langer Gedankenstrich }
    begin
        if not attrib.invis then Result := Result + htmlchar('&emdash;', attrib);
    end

    { das hier mu▀ ALLES von htmlchar ⁿbernommen werden }

    else if (ctrlword = 'endash') then      { kurzer Gedankenstrich }
    begin
        if not attrib.invis then Result := Result + htmlchar('&endash;', attrib);
    end

    else if (ctrlword = 'emspace') then      { langer Zwischenraum }
    begin
        if not attrib.invis then Result := Result + htmlchar('&emspace;', attrib);
    end

    else if (ctrlword = 'enspace') then      { kurzer Zwischenraum }
    begin
        if not attrib.invis then Result := Result + htmlchar('&enspace;', attrib);
    end

    else if (ctrlword = 'lquote') or (ctrlword = 'rquote') then      { einfaches Anfⁿhrungszeichen, Apostroph }
    begin
        if not attrib.invis then Result := Result + htmlchar('"e;', attrib);
    end

    else if (ctrlword = 'ldblquote') or (ctrlword = 'rdblquote') then     { doppeltes Anfⁿhrungszeichen }
    begin
        if not attrib.invis then Result := Result + htmlchar('&dblquote;', attrib);
    end

    else if ctrlword = 'b' then        { Formatierung: fett }
    begin
        if not attrib.bold then
        begin
            changefmt := true;
            attrib.bold := true;
        end;
    end

    else if ctrlword = 'b0' then
    begin
        if attrib.bold then
        begin
            changefmt := true;
            attrib.bold := false;
        end;
    end

    else if ctrlword = 'i' then        { Formatierung: kursiv }
    begin
        if not attrib.italic then
        begin
            changefmt := true;
            attrib.italic := true;
        end;
    end

    else if ctrlword = 'i0' then
    begin
        if attrib.italic then
        begin
            changefmt := true;
            attrib.italic := false;
        end;
    end

    else if (ctrlword = 'ul')          { Formatierung: unterstreichen }
         or (ctrlword = 'uld')
         or (ctrlword = 'uldash')
         or (ctrlword = 'uldashd')
         or (ctrlword = 'uldashdd')
         or (ctrlword = 'uldb')
         or (ctrlword = 'ulth')
         or (ctrlword = 'ulwave') then
    begin
        if not attrib.underline then
        begin
            changefmt := true;
            attrib.underline := true;
        end;
    end

    else if (ctrlword = 'ulnone') or (ctrlword = 'ul0') then    { Formatierung: unterstreichen beenden }
    begin
        if attrib.underline then
        begin
            changefmt := true;
            attrib.underline := false;
        end;
    end

    else if (ctrlword = 'super') or (pos('up',ctrlword) = 1) then  { Formatierung: hochstellen }
    begin
        if not attrib.superscript then
        begin
            changefmt := true;
            attrib.superscript := true;
        end;
    end

    else if (ctrlword = 'sub') or (pos('dn',ctrlword) = 1) then  { Formatierung: tiefstellen }
    begin
        if not attrib.subscript then
        begin
            changefmt := true;
            attrib.subscript := true;
        end;
    end

    else if (ctrlword = 'nosupersub') then    { Formatierung: hoch-/tiefstellen beenden }
    begin
        if attrib.superscript or attrib.subscript then
        begin
            changefmt := true;
            attrib.superscript := false;
            attrib.subscript := false;
        end;
    end

    else if (ctrlword = 'strike') or (ctrlword = 'strikedl') then        { Formatierung: durchstreichen }
    begin
        if not attrib.strike then
        begin
            changefmt := true;
            attrib.strike := true;
        end;
    end

    else if (ctrlword = 'strike0') or (ctrlword = 'strikedl0') then
    begin
        if attrib.strike then
        begin
            changefmt := true;
            attrib.strike := false;
        end;
    end

    else if pos('li',ctrlword) = 1 then
    begin
        if (ctrlword[3] in ['0'..'9']) and (attrib.table = 0) then
        begin
            try
                num := strtoint(copy(ctrlword,3,length(ctrlword)-2));
            except
                on EConvertError do
                    num := 0;
            end;

            if no_newind then
            begin
                lastindent := lastindent + num;
                no_newind := false;

                while (enums.indent[enums.lvl] < lastindent) and (enums.lvl <= 20)
                do
                begin
                    Inc(enums.lvl);
                    Result := Result + '<UL>';
                end;
            end;
        end;
    end

    else if pos('fi',ctrlword) = 1 then
    begin
        if ctrlword[3] in ['0'..'9','-'] then
        begin
            try
                num := strtoint(copy(ctrlword,3,length(ctrlword)-2));
            except
                on EConvertError do
                    num := 0;
            end;

            if no_newind then
            begin
                lastindent := lastindent + num;
            end;
        end;
    end

    else if pos('f',ctrlword) = 1 then
    begin
        if (ctrlword[2] in ['0'..'9']) and (not flag.noFonts) then       { neue Schriftart }
        begin
            try
                num := strtoint(copy(ctrlword,2,length(ctrlword)-1));
            except
                on EConvertError do
                    num := 0;
            end;                             { Font-Nummer erfassen }

            if attrib.font <> num then
            begin
                changefmt := true;
                attrib.font := num;
            end;
        end
        else if ctrlword[2] = 's' then       { neue Schrift-Gr÷▀e }
        begin
            try
                num := strtoint(copy(ctrlword,3,length(ctrlword)-2));
            except
                on EConvertError do             { Schrift-Gr÷▀en-Zahl erfassen }
                    num := 0;
            end;
            num := num div 2;   { Schrift-Gr÷▀en in RTF sind in halben Punkten angegeben }

            if attrib.fsize <> num then
            begin
                changefmt := true;
                attrib.fsize := num;
            end;
        end;
    end

    else if pos('cf',ctrlword) = 1 then       { neue Vordergrund-Farbe }
    begin
        try
            num := strtoint(copy(ctrlword,3,length(ctrlword)-2));
        except
            on EConvertError do              { Farb-Nummer erfassen }
                num := 0;
        end;

        if num > col.count-1 then
            txt := col[col.count-1]           { sollte auch nicht vorkommen }
        else
            txt := col[num];

        if attrib.fcol <> txt then
        begin
            changefmt := true;
            attrib.fcol := txt;
        end;
    end;
end;

{  ************************************************************************  }

function LineAt (const index: integer; const line: string; var infile: textfile): string;
var                                                      { liefert einen Teilstring von 'line' ab Position 'index' }
    nextstr, str : string;                               { zurⁿck. Ist 'line' kⁿrzer als 'index', wird eine        }
begin                                                    { neue Zeile eingelesen und an 'line' angehΣngt, und dies }
    str := line;                                         { bei Bedarf so lange wiederholt, bis 'index' kleiner als }
    while (not EOF(infile)) and (index > length(str)) do { die ZeilenlΣnge ist und somit das gewⁿnschte Resultat   }
    begin                                                { geliefert werden kann }
        ReadLn(infile, nextstr);
        str := str + nextstr;
    end;

    if index > length(str) then    { gesuchte Stelle existiert im Input-File gar nicht mehr }
        Result := ''
    else
        Result := Copy(str,index,length(str)-index+1);
end;

{  ************************************************************************  }

procedure IgnoreGroup(var line: string; var infile: textfile);   { springt zum Ende der aktuellen Group }
var
    lastline : boolean;
    i, brk, strlen : integer;
    binlen, binind : longint;

begin
    lastline := false;
    i := 0;
    strlen := 0;
    brk := 0;   { zΣhlt die geschwungenen Klammern }

    while (not lastline) and (brk > -1) do
    begin
        if EOF(infile) then lastline := true;
        strlen := length(line);
        i := 1;
        while (i <= strlen) and (brk > -1) do
        begin
            if line[i] = '\' then
            begin
                if pos('bin',line) = i+1 then     { bei BinΣr-Daten im RTF-File funktioniert das Klammern-ZΣhlen }
                begin                             { nicht und daher wird die im 'bin'-tag angegebene Menge von   }
                    binlen := 0;                  { Bytes ungeprⁿft ⁿbersprungen                                 }
                    i := i+4;
                    while (line[i] in ['0'..'9']) and (i <= strlen) do
                    begin                                           { LΣnge der BinΣr-Daten erfassen }
                        binlen := binlen * 10 + strtoint(line[i]);
                        Inc(i);
                    end;
                    binind := 1;
                    while (binind <= binlen) and (not (EOF(infile) and (i > strlen)) ) do
                    begin                                           { BinΣr-Daten ⁿberspringen }
                        if EOF(infile) then lastline := true;
                        if (i > strlen) and (not lastline) then
                        begin
                            ReadLn(infile, line);
                            Inc(binind);
                            if EOF(infile) then lastline := true;
                            i := 1;
                        end
                        else
                        begin
                            Inc(i);
                            Inc(binind);
                        end;
                    end;
                end;
            end;

            if line[i] = '{' then Inc(brk)
            else if line[i] = '}' then Dec(brk);

            Inc(i);
        end;

        if (brk > -1) and not lastline then ReadLn(infile, line);  { noch immer in in der Group --> nΣchste Zeile }
    end;

    if (i > strlen) and not lastline then
    begin
        ReadLn(infile, line);  { letztes Zeichen der Zeile war Group-Ende  -->  weiter mit neuer Zeile }
        line := '}' + line;
    end
    else line := LineAt(i-1, line, infile);    { sonst: Zeile := Zeile ab Group-Ende }
end;

{  ************************************************************************  }

procedure setfonts (var infile, outfile: textfile; var src: string);
var
    fnum, ftind, i, i2, strlen: integer;
    endfonts, lastline: boolean;
    nextstr: string;

begin
    ftind := 0;
    endfonts := false;
    lastline := false;
    i := pos('\fonttbl',src)+8;
    strlen := length(src);

    While not lastline and not endfonts do
    begin
        if EOF(infile) then lastline := true;
        while (i <= strlen) and (src[i] <> '\') do Inc(i); { Font-Deklaration suchen }
        Inc(i);
        if i > strlen then Exit;
        { Fehler im Format }

        fnum := 0;
        if src[i] = 'f' then
        begin
            Inc(i);
            while (src[i] in ['0'..'9']) and (i <= strlen) do   { Font-Nummer }
            begin
                fnum := (fnum*10)+strtoint(src[i]);
                Inc(i);
            end;

            { nun wird der Anfang des Font-Namens gesucht }
            while (i <= strlen) and (src[i] <> '}') and (src[i] <> '{') and (src[i] <> ' ') do Inc(i);
            if src[i] = '{' then
                while (i <= strlen) and (src[i] <> '}') do Inc(i);
            Inc(i);
            if i > strlen then Exit;

            { und nun das Ende..... }
            i2 := i;
            while (i2 <= strlen) and (src[i2] <> ';') and (src[i2] <> '{') and (src[i2] <> '\') do Inc(i2);
            if (src[i2] = '{') and (pos('\*\falt',src) = i2+1) then
            begin
                i := i2+9;
                while (i2 <= strlen) and (src[i2] <> '}') do Inc(i2);
            end;
            if i2 > strlen then Exit;   { Fehler im Format }

            if not flag.noFonts then
            begin
                with fonts[ftind] do
                begin
                    name := Copy(src,i,i2-i);   { Font-Name }
                    number := fnum;
                    if (flag.optimize) and (ftind < fontsOpt) then
                        addfontname(name);    { KillStrings zum spΣteren Optimieren setzen }
                end;                          { fⁿr die ersten <fontsOpt> deklarierten Schriften }
                Inc(ftind);
            end;

            src := Copy(src,i2,strlen-i2+1);

            while (length(src) < 5) and (not lastline) do
            begin    { Deklaration in nΣchster Zeile fortgesetzt }
                if EOF(infile) then
                    lastline := true
                else
                    ReadLn(infile,nextstr);
                src := src + nextstr;
            end;

            strlen := length(src);
            i := 0;

            while (i <= strlen) and (src[i] <> '}') do Inc(i);

            if i > strlen then Exit;
            { Fehler im Format }

            if (src[i] = '}') and (src[i+1] = '}') then
            begin
                endfonts := true;
                src := Copy(src,i+1,strlen-i);
            end
            { \fonttbl beendet }
            else
            begin
                while (i <= strlen) and (src[i] <> '{') do Inc(i);
                { Suche nach nΣchster Font-Deklaration }
                if i > strlen then Exit;
                { Fehler im Format }
                src := Copy(src,i,strlen-i+1);
                strlen := length(src);
                i := 0;
            end;
        end
        else
            Exit;
    end;
end;

{  ************************************************************************  }

procedure setcolours (var infile, outfile: textfile; var src: string);
var
    i, i2, strlen : integer;
    endcolours, lastline : boolean;
    colstr, nextstr : string;

begin
    endcolours := false;
    lastline := false;
    i := pos('\colortbl',src)+9;
    strlen := length(src);

    if (src[i] = ';') then col.add('#000000');  { "auto" color (Farbe 0) nicht gesetzt --> schwarz }

    While not lastline and not endcolours do
    begin
        if EOF(infile) then lastline := true;

        while (i <= strlen) and (src[i] <> '\') do Inc(i); { Farb-Deklaration suchen }
        i2 := i;
        while (i2 <= strlen) and (src[i2] <> ';') do Inc(i2); { das Ende ebendieser suchen }

        if i2 > strlen then Exit;  { Fehler im Format }
        if (src[i2+1] = '}') then endcolours := true;

        colstr := htmlcol(Copy(src,i,i2-i));
        col.add(colstr); { im html-Farben-Format in die Liste eintragen }

        if flag.optimize then
            addcolstr(colstr); { KillStrings zum spΣteren Optimieren setzen }

        src := Copy(src,i2+1,strlen);

        while (length(src) < 5) and (not EOF(infile)) do
        begin    { Deklaration in nΣchster Zeile fortgesetzt }
            ReadLn(infile,nextstr);
            src := src + nextstr;
        end;

        strlen := length(src);
        i := 0;
    end;
end;

{  ************************************************************************  }

procedure initstyles (var infile, outfile: textfile; var src: string);
var
    i, j, hrnum, strlen, snum, sbased : integer;
    endstyles, lastline, str, ctr, firststyle : boolean;
    basedon, cwd, txt, nextstr, sname, snumstr, spchar : string;

begin
    basedon := '';      { Platzhalter fⁿr Basis-Styles }
    spchar := '';       { Sonderzeichen }
    snum := 0;          { Style-Nummer im Stylesheet }
    sbased := 0;        { basierend auf Style Nr. <sbased> }
    snumstr := '';      { Style-Nummer im String-Format }
    cwd := '';          { Kontroll-Wort }
    sname := '';        { Style-Bezeichnung }
    ctr := false;       { derzeit in einem Kontrollwort ? }
    str := false;       { derzeit in einer Style-Bezeichnung ? }
    endstyles := false; { Ende des Stylesheets ? }
    lastline := false;  { Ende des Input-Files ???????   (wer wei▀...) }

    firststyle := true;
    i := pos('\stylesheet',src)+11;
    strlen := length(src);

    While (not lastline) and (not endstyles) do
    begin
        if EOF(infile) then lastline := true;

        while (i <= strlen) and (src[i] <> '{') do Inc(i); { Style-Deklaration suchen }

        if (i < strlen) then
        begin
            txt := Copy(src, i+1, 3);
            if not(
                      ((Copy(txt, 1, 2) = '\s') and (txt[3] in ['0'..'9']))   { vieles ist m÷glich in RTF ..... }
                   or (txt = '\ds')
                   or (txt = '\*\')
                   ) then    { Style 0 }
            begin
                firststyle := false;
                Inc(i);
                snum := 0;
                while (i <= strlen) and (src[i] <> '}') do
                begin
                    if src[i] = ';' then
                    begin
                         stylesheet[snum].name := sname;
                         str := false;
                    end;

                    if (
                        ctr                           { entweder Kontrollwort }
                    or  ((src[i] = '\') and not (src[i+1] = #39))
                        )                             { oder Beginn eines solchen und NICHT ein Sonderzeichen }
                    and not (src[i] = ' ')            { aber KEIN Leerzeichen }
                    then
                        stylesheet[snum].ctrl := stylesheet[snum].ctrl + src[i];

                    if str and (src[i] <> '\') then sname := sname + src[i];
                    if ctr then cwd := cwd + src[i];

                    if src[i] = ' ' then    { hier k÷nnte der Style-Name beginnen }
                    begin
                        ctr := false;
                        cwd := '';
                        str := true;
                    end;
                    if src[i] = '\' then   { hier beginnt ein Kontrollwort }
                    begin
                        if src[i+1] = #39 then
                        begin
                            spchar := src[i+2]+src[i+3];
                            sname := sname + plainchar(spchar);
                            i := i+3;
                        end
                        else
                        begin
                            ctr := true;
                            cwd := '';
                            str := false;
                            sname := '';
                        end;
                    end;
                    Inc(i);

                    if (i > strlen-5) then
                    begin
                        if not lastline then
                        begin
                            src := LineAt(i, src, infile);
                            ReadLn(infile, nextstr);
                            src := src + nextstr;
                            i := 1;
                        end;
                    end;

                    if src[i] = '{' then
                    begin
                        src := LineAt(i+1,src,infile);
                        IgnoreGroup(src, infile);
                        i := 2;
                        strlen := length(src);
                    end;
                end;
                stylesheet[snum].ctrl := optStyle('', stylesheet[snum].ctrl);
            end
            else if (txt = '\ds') or (txt = '\*\') then    { character / section style }
            begin
                src := LineAt(i+1,src,infile);
                IgnoreGroup(src, infile);
                i := 1;
            end
            else if ((Copy(txt, 1, 2) = '\s') and (txt[3] in ['0'..'9'])) then  { paragraph style             }
            begin                                                               { (das, wonach wir suchen...) }
                i := i+3;
                snumstr := '';
                while src[i] in ['0'..'9'] do
                begin
                    snumstr := snumstr + src[i];
                    Inc(i);
                end;
                try
                    snum := strtoint(snumstr);
                except
                    on EConvertError do
                        snum := 300;
                end;

                str := false;
                ctr := false;
                sname := '';
                cwd := '';

                while (i <= strlen) and (src[i] <> '}') do
                begin
                    if src[i] = ';' then
                    begin
                         stylesheet[snum].name := sname;
                         str := false;

                         if pos('toc', sname) > 0 then
                         begin
                             hrnum := 0;
                             for j := 4 to length(sname) do
                             begin
                                 if sname[j] in ['1'..'9'] then
                                     hrnum := strtoint(sname[j]);
                             end;
                             if hrnum > 0 then
                                 linkstyles[hrnum] := snum;
                         end
                         else if pos('heading', sname) > 0 then
                         begin
                             hrnum := 0;
                             for j := 8 to length(sname) do
                             begin
                                 if sname[j] in ['1'..'9'] then
                                     hrnum := strtoint(sname[j]);
                             end;
                             if hrnum > 0 then
                                 anchstyles[hrnum] := snum;
                         end;
                    end;

                    if (
                        ctr                           { entweder Kontrollwort }
                    or  ((src[i] = '\') and not (src[i+1] = #39))
                        )                             { oder Beginn eines solchen und NICHT ein Sonderzeichen }
                    and not (src[i] = ' ')            { aber KEIN Leerzeichen }
                    then
                        stylesheet[snum].ctrl := stylesheet[snum].ctrl + src[i];

                    if str and (src[i] <> '\') then sname := sname + src[i];
                    if ctr then cwd := cwd + src[i];

                    if src[i] = ' ' then    { hier k÷nnte der Style-Name beginnen }
                    begin
                        ctr := false;
                        if Copy(cwd, 1, 8) = 'sbasedon' then  { Grundlage ist ein anderer Style }
                        begin
                            try
                                sbased := strtoint(Copy(cwd, 9, length(cwd)-9));
                            except
                                on EConvertError do
                                    sbased := -1;
                            end;
                            if (sbased >= 0) and (sbased < snum) then
                            begin
                                basedon := stylesheet[sbased].ctrl;
                                stylesheet[snum].ctrl := optStyle(stylesheet[sbased].ctrl, stylesheet[snum].ctrl);
                            end;
                        end;
                        cwd := '';
                        str := true;
                    end;
                    if src[i] = '\' then   { hier beginnt ein Kontrollwort }
                    begin
                        if src[i+1] = #39 then
                        begin
                            spchar := src[i+2]+src[i+3];
                            sname := sname + plainchar(spchar);
                            i := i+3;
                        end
                        else
                        begin
                            ctr := true;
                            if Copy(cwd, 1, 8) = 'sbasedon' then { Grundlage ist ein anderer Style }
                            begin
                                try
                                    sbased := strtoint(Copy(cwd, 9, length(cwd)-9));
                                except
                                    on EConvertError do
                                        sbased := -1;
                                end;
                                if sbased >= 0 then
                                begin
                                    basedon := stylesheet[sbased].ctrl;
                                end;
                            end;
                            cwd := '';
                            str := false;
                            sname := '';
                        end;
                    end;
                    Inc(i);
                    if (i > strlen-5) then      { bei Zeiten nΣchste Zeile anhΣngen... }
                    begin
                        if not lastline then
                        begin
                            src := LineAt(i, src, infile);
                            ReadLn(infile, nextstr);
                            src := src + nextstr;
                            i := 1;
                            strlen := length(src);
                        end;
                    end;

                    if src[i] = '{' then        { Groups im Stylesheet werden hier ignoriert }
                    begin
                        src := LineAt(i+1,src,infile);
                        IgnoreGroup(src, infile);
                        i := 2;
                        strlen := length(src);
                    end;
                end; { while (i <= strlen) and (src[i] <> .... }

                stylesheet[snum].ctrl := optStyle(basedon, stylesheet[snum].ctrl);
                basedon := '';
            end;
        end; { while i <= strlen ..... }

        src := LineAt(i, src, infile);
        strlen := length(src);
        i := 1;

        while (length(src) < 5) and (not EOF(infile)) do
        begin    { Deklaration in nΣchster Zeile fortgesetzt }
            ReadLn(infile,nextstr);
            src := src + nextstr;
            strlen := length(src);
        end;

        if (src[i+1] = '}') then       { das Stylesheet ist zu Ende }
        begin
            endstyles := true;
            src := Copy(src,i+1,strlen-i);
        end
        else
        begin
            if not firststyle then
                src := Copy(src,i+1,strlen-i);
        end;
    end;
end;

{  ************************************************************************  }

procedure ProcessTable (var infile, outfile: textfile; var line: string);
var                                   { bearbeitet eine Tabelle }
    brkopen, i, lvl, strlen : integer;
    ctrlword, txt, buf : string;
    attrib : format;
    tempattrib : array[1..20] of format;
    fmtdiff, lastline, tabpard : boolean;

begin
    lvl := 1;
    brkopen := 1;             { String-Index bei ÷ffnender Klammer, wird vor IgnoreGroup() gebraucht }
    i := 1;
    lastline := false;
    li_open := false;
    tabpard := false;
    buf := '';
    resetfmt(attrib, 'all');

    WriteHtml('<BR><TABLE BORDER=2><TR><TD>', outstring, outfile);
    attrib.table := in_cell;

    While not lastline do
    begin
        strlen := length(line);

        if not tabpard then i := 1;

        if EOF(infile) then lastline := true;

        while i <= strlen do
        begin
            case line[i] of
                '{':
                    begin
                        Inc(globbrk);
                        Inc(lvl);

                        if tabpard then brkopen := i;

                        CopyAttrib(tempattrib[lvl], attrib);
                    end;
                '}':
                    begin
                        Dec(globbrk);
                        Dec(lvl);

                        fmtdiff := diff(attrib, tempattrib[lvl+1]);
                        if fmtdiff then
                        begin
                            changefmt := true;
                            CopyAttrib(attrib, tempattrib[lvl+1]);
                        end;
                    end;
                '\': { Kontroll-Ausdruck bzw. RTF-spezifische Zeichen als Text }
                    begin
                        Inc(i);
                        if line[i] in ['\','{','}'] then  {RTF-spezifisches Zeichen als Text}
                            if (attrib.table = row_end) or (attrib.table = cell_end) then
                            begin
                                if not attrib.invis then buf := buf + htmlchar(line[i], attrib);
                            end
                            else
                            begin
                                if not attrib.invis then WriteHtml(htmlchar(line[i], attrib), outstring, outfile);
                            end

                        else if line[i] = '~' then
                            if (attrib.table = row_end) or (attrib.table = cell_end) then
                            begin
                                if not attrib.invis then buf := buf + htmlchar(' ', attrib);
                            end
                            else
                            begin
                                if not attrib.invis then WriteHtml(htmlchar(' ', attrib), outstring, outfile);
                            end

                        else if line[i] = '*' then
                        begin
                            if tabpard then
                            begin
                                txt := Copy (line, 1, brkopen-1);    { vor IgnoreGroup mu▀ die Zeile seit dem letzten }
                                line := LineAt(i,line,infile);       { \pard gespeichert werden, da der aktuelle      }
                                IgnoreGroup(line, infile);           { Absatz noch nicht als Teil einer Tabelle       }
                                strlen := length(line);              { identifiziert ist                              }
                                line := txt + Copy(line, 2, strlen-1);
                                Dec(globbrk);
                                i := brkopen-1;
                            end
                            else
                            begin
                                line := LineAt(i,line,infile);
                                IgnoreGroup(line, infile);
                                strlen := length(line);
                                i := 0;
                            end;
                        end

                        else if (line[i] = '_') then
                            if (attrib.table = row_end) or (attrib.table = cell_end) then
                            begin
                                if not attrib.invis then buf := buf + htmlchar('-', attrib);
                            end
                            else
                            begin
                                if not attrib.invis then WriteHtml(htmlchar('-', attrib), outstring, outfile);
                            end

                        else if (line[i] = '-') then
                        begin
                            { nix, da es sich um ein optionales Abteilungszeichen handelt }
                        end

                        else if line[i] = #39 then   { Sonderzeichen, z.B. Umlaut, beginnend mit ' }
                        begin
                            txt := line[i+1]+line[i+2];
                            i := i+2;

                            if (attrib.table = row_end) or (attrib.table = cell_end) then
                            begin
                                buf := buf + htmlchar(txt, attrib);
                            end
                            else  { BestΣtigung, da▀ wir uns in einer neuen Cell befinden -> kein Buffer n÷tig }
                            begin
                                WriteHtml(htmlchar(txt, attrib), outstring, outfile)
                            end;
                        end

                        else if line[i] in ['a'..'z'] then  { Kontroll-Ausdruck }
                        begin
                            ctrlword := '';
                            while (line[i] in ['a'..'z','0'..'9','-']) and (i <= strlen) do
                            begin
                                ctrlword := ctrlword + line[i];
                                Inc(i);
                            end;

                            if i > strlen then                 { Kontrollwort zu Ende + neue Zeile im RTF-File }
                            begin
                                if not lastline then ReadLn(infile, line);
                                if EOF(infile) then lastline := true;
                                i := 0;
                                strlen := length(line);
                            end
                            else
                                if line[i] <> ' ' then Dec(i); { nur der Delimiter <SPACE> ist als solcher }
                                                               { Teil eines Kontrollwortes                 }

                            { Variable 'i' steht nun am Ende des Kontroll-Wortes }

                            if (ctrlword = 'bkmkstart') or
                               (ctrlword = 'bkmkend') or
                               (ctrlword = 'filetbl') or
                               (ctrlword = 'footer') or
                               (ctrlword = 'footerf') or
                               (ctrlword = 'footnote') or
                               (ctrlword = 'header') or
                               (ctrlword = 'headerf') or
                               (ctrlword = 'levelnumbers') or
                               (ctrlword = 'leveltext') or
                               (ctrlword = 'list') or
                               (ctrlword = 'listlevel') or
                               (ctrlword = 'listname') or
                               (ctrlword = 'listoverridetable') or
                               (ctrlword = 'listtable') or
                               (ctrlword = 'pict') or
                               (ctrlword = 'pntxtb') or
                               (ctrlword = 'pntxta') or
                               (ctrlword = 'revtbl') or
                               (ctrlword = 'sp') or
                               (ctrlword = 'template') then
                            begin
                                if tabpard then
                                begin
                                    txt := Copy (line, 1, brkopen-1);
                                    line := LineAt(i,line,infile);
                                    IgnoreGroup(line, infile);
                                    strlen := length(line);
                                    line := txt + Copy(line, 2, strlen-1);
                                    Dec(globbrk);
                                    i := brkopen-1;
                                end
                                else
                                begin
                                    line := LineAt(i,line,infile);
                                    IgnoreGroup(line, infile);
                                    strlen := length(line);
                                    i := 0;
                                end;

                                if ctrlword = 'pict' then
                                    if (attrib.table = row_end) or (attrib.table = cell_end) then
                                        buf := buf + htmlchar('&pict;', attrib)
                                    else
                                        WriteHtml(htmlchar('&pict;', attrib), outstring, outfile);
                            end
                            else if (ctrlword = 'par') or (ctrlword = 'sect') then      { neuer Absatz }
                            begin
                                txt := '';
                                txt := empty(mainstack);
                                if attrib.rjustified then
                                begin
                                    txt := txt + '</DIV>';
                                end;
                                if attrib.centered then
                                begin
                                    txt := txt + '</CENTER>';
                                end;

                                txt := txt + '<BR>';

                                if attrib.table = cell_end then
                                begin
                                    buf := buf + txt;
                                end
                                else if attrib.table = in_cell then
                                begin
                                    WriteHtml(txt, outstring, outfile);
                                end;
                            end
                            else if (ctrlword = 'intbl') then
                            begin
                                tabpard := false;
                            end
                            else if (ctrlword = 'pard') or ((ctrlword = 'widctlpar') and (pos('\intbl', line) <> i+1)) then
                            begin
                                if attrib.table = row_end then
                                begin
                                    if tabpard then
                                    begin
                                        attrib.table := plain;
                                        WriteHtml('</TABLE><BR>', outstring, outfile);
                                        Exit;
                                    end
                                    else
                                    begin
                                        if line[i] = ' ' then
                                            line := Copy (line, i-5, strlen-i+6)
                                        else
                                            line := Copy (line, i-4, strlen-i+5);
                                        i := 5;
                                        strlen := length(line);
                                        tabpard := true;
                                    end;
                                end;
                                if ctrlword = 'pard' then
                                    if (attrib.table = cell_end) or (attrib.table = row_end) then
                                        buf := buf + html(ctrlword, attrib)  { Buffer, weil wir noch auf \cell warten }
                                    else
                                        WriteHtml(html(ctrlword, attrib), outstring, outfile);
                            end
                            else if ctrlword = 'trowd' then      { Beginn einer Tabellen-Zeile }
                            begin
                                tabpard := false;
                                if attrib.table = row_end then     { neue Zeile in bestehender Tabelle }
                                begin
                                    buf := '';
                                    WriteHtml('<TR><TD>', outstring, outfile);
                                    resetfmt(attrib, 'all');
                                    attrib.table := in_cell;
                                end;
                            end
                            else if ctrlword = 'row' then
                            begin
                                resetfmt(attrib, 'all');
                                buf := '';
                                tabpard := false;
                                WriteHtml('</TR>', outstring, outfile);
                                attrib.table := row_end;
                            end
                            else if ctrlword = 'cell' then
                            begin
                                tabpard := false;
                                if attrib.table = cell_end then
                                    txt := '<TD>' + buf + empty(mainstack) + '</TD>'
                                else if attrib.table = row_end then
                                    txt := '<TR><TD>' + buf + empty(mainstack) + '</TD>'
                                else if attrib.table = in_cell then
                                    txt := empty(mainstack) + '</TD>';

                                WriteHtml(txt, outstring, outfile);
                                resetfmt(attrib, 'all');
                                attrib.table := cell_end;
                                buf := '';
                            end
                            else  { nicht ignoriertes Kontrollwort }
                            begin
                                if (attrib.table = cell_end) or (attrib.table = row_end) then
                                    buf := buf + html(ctrlword, attrib)  { Buffer, weil wir noch auf \cell warten }
                                else
                                    WriteHtml(html(ctrlword, attrib), outstring, outfile);
                            end;
                        end;
                    end;
                else   { Dokument-Text }
                begin
                    if (attrib.table = cell_end) or (attrib.table = row_end) then
                        { in Buffer schreiben, wir noch auf ein \cell warten, }
                        { welches bestΣtigt, da▀ die row noch nicht zu Ende ist }
                        buf := buf + htmlchar(line[i], attrib)
                    else
                        WriteHtml(htmlchar(line[i], attrib), outstring, outfile);
                end;
            end;  { case }
            Inc(i);
        end;   { while i <= strlen... }

        if not lastline then
        begin
            if not tabpard then
                ReadLn(infile, line)
            else
            begin
                ReadLn(infile, txt);
                line := line + txt;
            end;
        end;
    end;  { While not lastline }
end;

{  ************************************************************************  }

procedure ProcessGroup (var infile, outfile: textfile; var line: string; var attrib: format);
var                                   { bearbeitet eine rtf-'Group' }
    brk, i, j, num, strlen : integer;
    ctrlword, txt, lvlnumstr : string;
    tempattrib : format;
    fmtdiff, quitblock, inv : boolean;

begin
    Inc(globbrk);
    num := 0;

    quitblock := false;

    While not lastline do
    begin
        strlen := length(line);
        i := 1;
        if EOF(infile) then lastline := true;

        while i <= strlen do
        begin
            case line[i] of
                '{': { neuer Block }
                    begin
                        line := LineAt(i+1, line, infile);

                        if ahref then
                        begin
                            WriteHtml('</A>', outstring, outfile);
                            ahref := false;
                        end;

                        CopyAttrib(tempattrib, attrib);

                        ProcessGroup (infile, outfile, line, attrib);

                        fmtdiff := diff(attrib, tempattrib);
                        if fmtdiff then
                        begin
                            txt := empty(mainstack);
                            changefmt := true;
                            WriteHtml(txt, outstring, outfile);
                            CopyAttrib(attrib, tempattrib);
                        end;

                        txt := '';

                        strlen := length(line);
                        i := 0; { aufgerufene Prozedur liefert neue 'line' zurⁿck }
                    end;
                '}': { Ende des aktuellen Blocks }
                    begin
                        line := LineAt(i+1, line, infile);

                        if ahref then
                        begin
                            WriteHtml('</A>', outstring, outfile);
                            ahref := false;
                        end;

                        Dec(globbrk);
                        Exit;
                    end;
                '\': { Kontroll-Ausdruck bzw. RTF-spezifische Zeichen als Text }
                    begin
                        inv := attrib.invis;

                        Inc(i);
                        if line[i] in ['\','{','}'] then  {RTF-spezifisches Zeichen als Text}
                        begin
                            if not inv then WriteHtml(htmlchar(line[i], attrib), outstring, outfile);
                        end

                        else if line[i] = '~' then
                        begin
                            if not inv then WriteHtml(htmlchar(' ', attrib), outstring, outfile);
                        end

                        else if line[i] = '*' then
                        begin
                            if (Copy(line, i+2, 3) = 'pn ') or (Copy(line, i+2, 3) = 'pn\') then
                            begin
                                pntxta := '';
                                pntxtb := '';
                                lvlnumstr := '';
                                i := i+4;
                                brk := 1;

                                while (brk > 0) and (not quitblock) do
                                begin
                                    if line[i] = '\' then
                                    begin
                                        Inc(i);
                                        if line[i] in ['a'..'z'] then  { Kontroll-Ausdruck }
                                        begin
                                            ctrlword := '';
                                            while (line[i] in ['a'..'z','0'..'9','-']) and (i <= strlen) do
                                            begin
                                                ctrlword := ctrlword + line[i];
                                                Inc(i);
                                            end;

                                            Dec(i);    { sonst verlieren wir ein Zeichen }

                                            if (ctrlword = 'pnlvlblt')
                                            or ((pos('pnlvl', ctrlword) = 1) and (ctrlword[6] in ['5'..'9']))
                                            then
                                            begin
                                                pnnum := false;
                                                listbull := true;
                                                listitem := true;
                                                enums.doclvl := globbrk-1;   { aktuelles Group-Level speichern }
                                                Inc(enums.lvl);

                                                WriteHtml('<UL><LI type=disc>', outstring, outfile);
                                            end
                                            else if (ctrlword = 'pnlvlcont')
                                                 or (ctrlword = 'pnlvlbody')
                                                 or ((pos('pnlvl', ctrlword) = 1) and (ctrlword[6] in ['1'..'4'])) then
                                            begin
                                                if (ctrlword = 'pnlvlbody') then
                                                    pnnum := true
                                                else
                                                    pnnum := false;

                                                listbull := false;
                                                listitem := false;
                                                enums.doclvl := globbrk-1;   { aktuelles Group-Level speichern }
                                              {  enums.lvl := 0;     }
                                            end
                                            else if (ctrlword = 'pndec')
                                                 or (ctrlword = 'pncard')
                                                 or (ctrlword = 'pnucltr')
                                                 or (ctrlword = 'pnucrm')
                                                 or (ctrlword = 'pnlcltr')
                                                 or (ctrlword = 'pnlcrm')
                                                 or (ctrlword = 'pnord')
                                                 or (ctrlword = 'pnordt') then
                                            begin
                                                enumdigit := true;
                                            end
                                            else if (Pos('pnstart', ctrlword) > 0) then
                                            begin
                                                if enumdigit and pnnum then
                                                begin
                                                    lvlnumstr := '';
                                                    for j := 8 to length(ctrlword) do
                                                    begin
                                                        lvlnumstr := lvlnumstr + ctrlword[j];
                                                    end;
                                                    try
                                                        lvlnum := strtoint(lvlnumstr);
                                                    except
                                                        on EConvertError do
                                                            lvlnum := 1;
                                                    end;
                                                end;
                                            end
                                            else if (ctrlword = 'pntxta') and (pnnum) then
                                            begin               { Text, der nach der AufzΣhlungs-Nummer steht }
                                                Inc(i, 2);
                                                while line[i] <> '}' do
                                                begin
                                                    pntxta := pntxta + line[i];
                                                    Inc(i);
                                                end;
                                                Dec(i);   { sonst verlieren wir eine schlie▀ende Klammer }
                                            end
                                            else if (ctrlword = 'pntxtb') and (pnnum) then
                                            begin
                                                Inc(i, 2);      { Text, der vor der AufzΣhlungs-Nummer steht }
                                                while line[i] <> '}' do
                                                begin
                                                    pntxtb := pntxtb + line[i];
                                                    Inc(i);
                                                end;
                                                Dec(i);   { sonst verlieren wir eine schlie▀ende Klammer }
                                            end;
                                        end;
                                    end
                                    else if line[i] = '{' then
                                    begin
                                        Inc(brk);
                                    end
                                    else if line[i] = '}' then
                                    begin
                                        Dec(brk);
                                    end;

                                    Inc(i);

                                    if (i > strlen) then
                                    begin
                                        if not lastline then
                                        begin
                                            ReadLn(infile, line);
                                            if (brk = 0) then
                                            begin
                                                line := '}' + line;
                                                i := 0;
                                            end
                                            else
                                               i := 1;
                                            if EOF(infile) then lastline := true;
                                        end
                                        else
                                        begin
                                            quitblock := true;
                                        end;
                                    end;

                                    if ((quitblock) or (brk = 0)) and (i > 0) then
                                        i := i-2;                 { sonst fehlt die letzte Klammer }
                                end;                              { zum Beenden der Rekursion      }
                                if (not listbull) and (pnnum) then
                                begin
                                    txt := pntxtb + lvlnumstr + pntxta;
                                    if length(txt) > 0 then
                                    begin
                                        txt := '&&' + txt;
                                        WriteHtml(htmlchar(txt, attrib), outstring, outfile);
                                    end;
                                end;
                            end
                            else
                            begin
                                if (Copy(line, i+2, 4) = 'bkmk') and not bkmkpar then
                                begin                                      { RTF-Bookmarks wirken sich im Layout }
                                    WriteHtml('<P>', outstring, outfile);  { als vergr÷▀erter Zeilenabstand ⁿber }
                                    bkmkpar := true;                       { und unter dem Bookmark aus.....     }
                                end;
                                line := LineAt(i,line,infile);
                                IgnoreGroup(line, infile);
                                i := 0;
                                strlen := length(line);
                            end;
                        end

                        else if (line[i] = '_') then
                        begin
                            if not inv then WriteHtml(htmlchar('-', attrib), outstring, outfile);
                        end

                        else if (line[i] = '-') then
                        begin
                            { nix, da es sich um ein optionales Abteilungszeichen handelt }
                        end

                        else if line[i] = #39 then   { Sonderzeichen, z.B. Umlaut, beginnend mit ' }
                        begin
                            txt := line[i+1]+line[i+2];
                            i := i+2;
                            WriteHtml(htmlchar(txt, attrib), outstring, outfile);
                        end

                        else if line[i] in ['a'..'z'] then  { Kontroll-Ausdruck }
                        begin
                            ctrlword := '';
                            while (line[i] in ['a'..'z','0'..'9','-']) and (i <= strlen) do
                            begin
                                ctrlword := ctrlword + line[i];
                                Inc(i);
                            end;

                            if i > strlen then                 { Kontrollwort zu Ende + neue Zeile im RTF-File }
                            begin
                                if not lastline then ReadLn(infile, line);
                                if EOF(infile) then lastline := true;
                                i := 0;
                                strlen := length(line);
                            end
                            else
                                if line[i] <> ' ' then Dec(i); { nur der Delimiter <SPACE> ist als solcher }
                                                               { Teil eines Kontrollwortes                 }

                            { Variable 'i' steht nun am Ende des Kontroll-Wortes }

                            if ctrlword = 'fonttbl' then
                            begin
                                setfonts (infile, outfile, line); { erfa▀t die Schriftarten und liefert neue      }
                                i := 0;                           { Zeile ab erstem Zeichen nach der Font-Tabelle }
                                strlen := length(line);
                                if EOF(infile) then lastline := true;  { just in case... }
                            end
                            else if ctrlword = 'colortbl' then
                            begin
                                setcolours (infile, outfile, line);  { erfa▀t die verwendeten Farben und liefert neue }
                                i := 0;                              { Zeile ab erstem Zeichen nach der Farb-Tabelle  }
                                strlen := length(line);
                                if EOF(infile) then lastline := true;  { just in case... }
                            end
                            else if ctrlword = 'stylesheet' then
                            begin
                                initstyles (infile, outfile, line);  { erfa▀t die verwendeten Styles und liefert neue }
                                i := 0;                              { Zeile ab erstem Zeichen nach dem Stylesheet    }
                                strlen := length(line);
                                if EOF(infile) then lastline := true;  { just in case... }
                            end
                            else if (pos('s',ctrlword) = 1) and (ctrlword[2] in ['0'..'9']) then
                            begin                                   { Stylesheet-Eintrag }
                                try
                                    num := strtoint(copy(ctrlword,2,length(ctrlword)-1));
                                except
                                    on EConvertError do
                                        num := 0;
                                end;                             { Style-Nummer erfassen }

                                for j := 1 to 9 do
                                begin
                                    if linkstyles[j] = num then
                                    begin
                                        if anchstyles[j] > -1 then
                                        begin
                                            ahrefwait := true;
                                            newhrefnum := true;
                                            indexlvl := j;
                                        end;
                                        break;
                                    end;
                                    if anchstyles[j] = num then
                                    begin
                                        anchor := true;
                                        anchlvl := j;
                                    end;
                                end;

                                txt := LineAt(i+1, line, infile);
                                line := stylesheet[num].ctrl + txt;
                                strlen := length(line);
                                i := 0;
                            end
                            else if ctrlword = 'trowd' then
                            begin
                                WriteHtml(empty(mainstack), outstring, outfile);
                                CloseLists(outstring, outfile);

                                line := LineAt(i, line, infile);
                                ProcessTable(infile, outfile, line);
                                i := 0;
                                strlen := length(line);
                            end
                            else if (ctrlword = 'bkmkstart') or
                                    (ctrlword = 'bkmkend') or
                                    (ctrlword = 'filetbl') or
                                    (ctrlword = 'footer') or
                                    (ctrlword = 'footerf') or
                                    (ctrlword = 'footnote') or
                                    (ctrlword = 'header') or
                                    (ctrlword = 'headerf') or
                                    (ctrlword = 'info') or
                                    (ctrlword = 'levelnumbers') or
                                    (ctrlword = 'leveltext') or
                                    (ctrlword = 'list') or
                                    (ctrlword = 'listlevel') or
                                    (ctrlword = 'listname') or
                                    (ctrlword = 'listoverridetable') or
                                    (ctrlword = 'listtable') or
                                    (ctrlword = 'pict') or
                                    (ctrlword = 'pntext') or
                                    (ctrlword = 'revtbl') or
                                    (ctrlword = 'sp') or
                                    (ctrlword = 'template') then
                            begin
                                line := LineAt(i,line,infile);
                                IgnoreGroup(line, infile);
                                i := 0;
                                strlen := length(line);
                                if ctrlword = 'pict' then
                                    WriteHtml(htmlchar('&pict;', attrib), outstring, outfile);
                            end
                            else  { nicht ignoriertes Kontrollwort }
                            begin
                                if ahref then
                                    WriteHtml('</A>', outstring, outfile);

                                WriteHtml(html(ctrlword, attrib), outstring, outfile);
                                if ahref then ahref := false;
                            end;   { begin nicht ignoriertes Kontrollwort }
                        end;
                    end;
                else  { Dokument-Text }
                begin
                    if li_open then
                    begin
                        WriteHtml('<LI type=disc>', outstring, outfile);
                        li_open := false;
                    end;

                    if pnnum and nextpar and (length(enumtxt) > 0) then
                    begin
                        enumtxt := '&&' + enumtxt;
                        WriteHtml(htmlchar(enumtxt, attrib), outstring, outfile);
                        enumtxt := '';
                    end;
                    WriteHtml(htmlchar(line[i], attrib), outstring, outfile);
                end;
            end;  { case }
            Inc(i);
        end;   { while i <= strlen... }

        if not lastline then ReadLn(infile, line);
    end;  { While not lastline }

    Dec(globbrk);
end;

{  ************************************************************************  }

procedure rtf2html (filename: string; destfilename: string; param: array of string);
var
    infile, outfile: textfile;
    src, txt: string;
    attrib: format;
    i: integer;

begin
    changefmt := false;

    for i := 0 to 20 do            { Indents zur <UL>-Steuerung setzen }
    begin
        enums.indent[i] := (i*ul_indent);
    end;

    for i := 0 to 300 do           { internes Stylesheet initialisieren }
    begin
        stylesheet[i].ctrl := '';
        stylesheet[i].name := '';
    end;


    for i := 1 to 9 do            { arrays zur Sprungmarken-Steuerung initialisieren }
    begin
        linkstyles[i] := -1;
        anchstyles[i] := -1;
        actlinknum[i] := 0;
        actanchnum[i] := 0;
    end;

    flag.noFonts := false;           { default sind alle Aufrufparameter 'false' }
    flag.optimize := false;
    flag.onlyDefiniteOpt := false;

    for i := 0 to high(param) do     { auf mitgegebene Parameter prⁿfen ... }
    begin
        if param[i] = 'noFonts' then flag.noFonts := true;
        if param[i] = 'optimize' then flag.optimize := true;
        if param[i] = 'onlyDefiniteOpt' then flag.onlyDefiniteOpt := true;
    end;

    mainstack := NIL;            { Haupt-Formatierungs-Stack }
    resetfmt(attrib, 'all');     { Attribut-Record 'defaulten' }
    outstring := '';             { das, was letztendlich ins outfile geschrieben wird }
    bkmkpar := false;            { Hilfsflag zu Formatierungszwecken }
    lastline := false;           { Flag, um das File-Ende abzufangen }
    li_open := false;            { true, solange bei einer AufzΣhlung kein Ende feststeht }
    listitem := false;           { false, wenn <UL>, aber kein <LI> }
    lastindent := 0;
    no_newind := true;
    txtwait := '';
    pnnum := false;              { true, wenn ein AufzΣhlungspunkt mit formatierter Numerierung folgt }
    nextpar := true;             { true, sobald ein \par gelesen wird; false ab erstem Dokument-Text-Zeichen danach }
    enumdigit := false;          { true, wenn eine numerische AufzΣhlung folgt }
    enumtxt := '';               { der String, der die formatierte Numerierung enthΣlt }

    col := TStringList.Create;   { interne Farbtabelle }
    lvlnum := -1;                { aktuelle Zahl bei AufzΣhlungen }
    enums.lvl := 0;              { aktuelles AufzΣhlungs bzw. Einrⁿckungs-Level }
    globbrk := 0;                { Anzahl der offenen Klammern im RTF-Dokument }

    ahref := false;              { true bei einer Referenz }
    anchor := false;             { true bei einer Sprungmarke }
    indexlvl := 0;               { aktuelles Level im Inhaltsverzeichnis }
    anchlvl := 0;                { aktuelles Heading-(▄berschrift-)Level }
    ahrefwait := false;          { true, wenn der nΣchste Text Teil einer Referenz ist }
    newhrefnum := false;         { true bei jedem neuen Punkt im Inhaltsverzeichnis }

    if flag.optimize then
        init_killstr;            { wenn's optimiert werden soll, mⁿssen die Kill Strings gesetzt werden }

    AssignFile(infile, filename);
    AssignFile(outfile, destfilename);
    Reset(infile);
    ReWrite(outfile);

    WriteLn(outfile,'<HTML>');
    WriteLn(outfile,'<HEAD>');
    WriteLn(outfile,('<TITLE>'+filename+'</TITLE>'));
    WriteLn(outfile,'</HEAD>');
    WriteLn(outfile,'<BODY TEXT="#000000" BGCOLOR="#FFFFFF" LINK="#3333FF" VLINK="#999999" ALINK="#FF0000">');

    Flush(outfile);

    try
        ReadLn(infile, src);
        ProcessGroup (infile, outfile, src, attrib);

    finally
        txt := empty(mainstack);
        if attrib.rjustified then
            txt := txt + '</DIV>';
        if attrib.centered then
            txt := txt + '</CENTER>';

        WriteHtml(txt, outstring, outfile);
        CloseLists(outstring, outfile);

        WriteLn(outfile, outstring);
        WriteLn(outfile,'</BODY>');
        WriteLn(outfile,'</HTML>');
        col.Free;

        Flush(outfile);          { wir ziehen an der Leine, damit auch alles wegkommt.... }
        CloseFile(infile);
        CloseFile(outfile);
    end;
end;

end.