Home
Linux
Perl
Delphi
XP Util
Pas2HTML

Hier habe ich Pas2HTML durch sich selbst bearbeiten lassen. Ergebnis ist eine HTML-Datei, mit dem Source-Code. Kommentare sind blau, Schlüsselworte Fett usw. Das ganze sollte sehr ähnlich zur Delphi 2.0 IDE aussehen.

pas2html.dpr

{$A+,B-,C-,D+,E-,F-,G+,H+,I+,J+,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y-,Z1}
{$MINSTACKSIZE $00001000}
{$MAXSTACKSIZE $00004000}
{$IMAGEBASE $00400000}
{$APPTYPE CONSOLE}
{$HINTS ON}
{pas2HTML wandelt Delphi-pas nach HTML, klappt jetzt auch verdammt gut
 und ist auch ziemlich schnell geworden.
 and asm begin constructor
}

PROGRAM pas2html;

USES SysUtils;

{$R *.RES}

CONST MaxRA=69;
      Version='pas2html 0.2';
      MaxSchnitt: Byte=100;
ResArr : ARRAY[1..MaxRA] OF STRING =
('AND','ARRAY','AS','ASM','BEGIN',
'CASE', 'CLASS', 'CONST', 'CONST', 'CONSTRUCTOR', { 10 }
'DESTRUCTOR',  'DISPINTERFACE', 'DIV', 'DO', 'DOWNTO',
'ELSE', 'END', 'EXCEPT', 'EXPORTS', 'FILE', { 20 }
'FINALIZATION', 'FINALLY', 'FOR', 'FUNCTION', 'GOTO',
'IF', 'IMPLEMENTATION', 'IN', 'INHERITED', 'INITIALIZATION',{ 30 }
'INLINE', 'INTERFACE', 'IS', 'LABEL', 'LIBRARY',
'MOD', 'NIL', 'NOT', 'OBJECT', 'OF',  { 40 }
'OR', 'OUT', 'PACKED', 'PRIVATE', 'PROCEDURE', 'PROGRAM',
'PROPERTY', 'PUBLIC','RAISE', 'RECORD', 'REPEAT', 'RESOURCESTRING', { 50 }
'SET', 'SHL', 'SHR', 'STRING', 'STRINGRECOURCE',
'THEN', 'THREADVAR', 'TO', 'TRY', 'TYPE',  { 60 }
'UNIT', 'UNTIL', 'USES', 'VAR', 'WHILE',
'WITH', 'XOR');
VAR InComment: Boolean=False;

FUNCTION StringReplaceAll (text,byt,mot : STRING ) :String;
VAR plats : integer;
BEGIN
WHILE pos(byt,text) > 0 DO
      BEGIN
      plats := pos(byt,text);
      delete (text,plats,length(byt));
      insert (mot,text,plats);
      END;
result := text;
END;

{Markiert //-Kommentare}
FUNCTION LineComment(text:String): STRING;
VAR i: Byte;
    InQuote: Boolean;
    InComment: Boolean;
    CloseComment: Boolean;
BEGIN
  InQuote:=False; CloseComment:=False;
  FOR i:=1 TO Length(text) DO
  BEGIN
    IF text[i]='''' THEN InQuote:=(NOT InQuote);
    IF (NOT InQuote) AND (text[i]='{') THEN InComment:=True;
    IF (NOT InQuote) AND (text[i]='}') THEN InComment:=False;
    IF (NOT (InQuote OR InComment)) THEN
    BEGIN
      IF Copy(text,i,2)='//' THEN
      BEGIN
        delete (text,i,2);
        insert ('<FONT COLOR="#0000FF">//',text,i);
        CloseComment:=True;
        Break;
      END; {of if Copy}
    END; {of not inquote}
  END; {of for i:=1 to Length}
  IF CloseComment THEN text:=text+'</FONT>';
  result:=text;
END;

{Markiert }{-Kommentare}
FUNCTION KlammerComment(text:String): STRING;
VAR i: Byte;
    InQuote: Boolean;
BEGIN
  InQuote:=False;
  i:=1;
  WHILE i<Length(text)+1 DO
  BEGIN
    IF text[i]='''' THEN InQuote:=(NOT InQuote);
    IF (NOT InQuote) THEN
    BEGIN
{      if (text[i]='/') and (text[i+1]='/') Then Exit;}
      IF (text[i]='{') THEN
      BEGIN
        delete(text,i,1);
        insert('<FONT COLOR="#0000FF">{',text,i);
        inc(i,22);
      END ELSE
      IF (text[i]='}') THEN
      BEGIN
        delete(text,i,1);
        insert('}</FONT>',text,i);
        inc(i,7);
      END;
    END; {of not inquote}
    inc(i);
  END; {of for i:=1 to Length}
  result:=text;
END;

{Stellt Keywors FETT dar}
FUNCTION KeyWordReplace(text,such: STRING): STRING;
CONST Trenner=' ,.()&;{}[]<>''#'+#13+#10;
VAR i,s: Byte;
    InQuote{, InComment}: Boolean;
BEGIN
  i:=1; InQuote:=False; {InComment:=False;} s:=Length(such);
  WHILE i<Length(text)+2-s DO
  BEGIN
    IF (NOT InComment) AND (text[i]='''') THEN InQuote:=(NOT INQuote);
    IF NOT (InQuote OR InComment) AND (text[i]='{') THEN InComment:=True;
    IF (InComment AND (NOT InQuote)) AND (text[i]='}') THEN InComment:=False;
    IF (NOT (InQuote OR InComment)) THEN
    BEGIN
      IF (UpperCase(Copy(text,i,s))=such) AND
         ((Pos(text[i-1],Trenner)>0) OR (i=1)) AND
         ((Pos(text[i+s],Trenner)>0) OR (i+s>Length(text))) THEN
         BEGIN
           delete(text,i,s);
           insert('<B>'+such+'</B>',text,i);
           inc(i,6+s);
         END;
    END; {of not inquote}
    inc(i);
  END; {of while i<Length(text)+1}
  result:=Text;
END; {of KeyWordReplace}

FUNCTION ColorKeyWords(text: STRING): STRING;
VAR i: Byte;
BEGIN
  FOR i:=1 TO MaxRA DO
  BEGIN
    text:=KeyWordReplace(text,ResArr[i]);
  END;
  result:=text;
END;

{function ColorQuote(text: String): String;
var i: Byte;
    InQuote: Boolean;
    Repla: String;
Begin
  InQuote:=False;i:=1;
  while i<Length(text)+1 Do
  Begin
    If Text[i]='''' Then
      Begin
        If InQuote Then Repla:='''</FONT>' Else Repla:='<FONT COLOR="#707070">''';
        delete(text,i,1);
        insert(Repla,text,i);
        InQuote:= (NOT InQuote);
        inc(i,Length(Repla)-1);
      end;
     inc(i);
  end;
  result:=text;
END;}

FUNCTION text2sgml(text : STRING) : STRING;
BEGIN
  text := stringreplaceall (text,'&','&');
  text := stringreplaceall (text,'&','&');
  text := stringreplaceall (text,'>','&gt;');
  text := stringreplaceall (text,'<','&lt;');
  text := stringreplaceall (text,'"','"');
  text := stringreplaceall (text,'ä','&auml;');
  text := stringreplaceall (text,'Ä','&Auml;');
  text := stringreplaceall (text,'ö','&ouml;');
  text := stringreplaceall (text,'Ö','&Ouml;');
  text := stringreplaceall (text,'ü','&uuml;');
  text := stringreplaceall (text,'Ü','&Uuml;');
  text := stringreplaceall (text,'ß','&szlig;');
  text := stringreplaceall (text,'©','&copy;');
  text := stringreplaceall (text,'®','&reg;');
  text := stringreplaceall (text,'§','&#167;');
  text := stringreplaceall (text,' ','&nbsp;');

  //text := stringreplaceall (text,'e','a');
  text := stringreplaceall (text,'}','}');
  text := stringreplaceall (text,'{','{');

  text := KlammerComment(text); {Färbt normale Kommentare}
  text := LineComment (text); {Färbt Kommentarzeilen blau ein}
  text := ColorKeyWords(text);
  result:=text;
END;


FUNCTION GetSchnitt(Zeile: STRING): Byte;
CONST Trenner='(),.''{}[]<>&;';
VAR i: Byte;
BEGIN
  FOR i:=MaxSchnitt TO Length(Zeile) DO
  BEGIN
    IF Pos(Zeile[i],Trenner)>0 THEN BEGIN Result:=i; Exit; END;
  END;
  Result:=Length(Zeile);
END;

PROCEDURE Hilfe;
BEGIN
  WriteLn('Delphi-PAS -> HTML '+Version+' © 1998 delta@earthling.net');
  WriteLn('                   http://www.yi.com/home/LackasChris');
END;

VAR i,x: Word;
    Rein, Raus: TextFile;
    Zeile, KurzZeile: STRING;
    InFile: STRING;
    sRec: TSearchRec;
    Res: Byte;
    Schnitt: Byte;
BEGIN
  i:=0;
  Hilfe;
  IF ParamStr(1)='' THEN
   BEGIN
     WriteLn(' SYNTAX:  pas2html infile');
     Exit;
   END;
  InFile:=ParamStr(1);
  Res:=FindFirst(InFile,faReadOnly,SRec);
  IF Res<>0 THEN
  BEGIN
    WriteLn(' ERROR: FILE NOT FOUND:'+InFile+'...');
    Exit;
  END;
  WHILE Res=0 DO
  BEGIN
    InFile:=ExtractFilePath(InFile)+SRec.Name;
    AssignFile(Rein,InFile);
    AssignFile(Raus,ChangeFileExt(InFile,'.html'));
    WriteLn(' PROCESSING '''+InFile+''' -> '''+
            ExtractFileName(ChangeFileExt(InFile,'.html'))+''':');
    TRY
      Reset(Rein);
      Rewrite(Raus);
      WriteLn(Raus,'<HTML><HEAD><TITLE>'+Version+':'+InFile+'</TITLE></HEAD><BODY>');
      WriteLn(Raus,'<H1>'+InFile+'</H1>');
      Write('  Line:    0');
      WHILE NOT EOF(Rein) DO
      BEGIN
        ReadLn(Rein,Zeile);
        IF Length(Zeile)<86 THEN WriteLn(Raus,Text2SGML(Zeile)) ELSE
        WHILE (Length(Zeile)>85) AND (Zeile<>'') DO
        BEGIN
          Schnitt:=GetSchnitt(Zeile);
          KurzZeile:=Copy(Zeile,1,Schnitt);
          WriteLn(Raus,Text2SGML(KurzZeile));
          Zeile:=Copy(Zeile,Schnitt+1,Length(Zeile)-Schnitt);
        END;
        WriteLn(Raus,'<BR>');
        inc(i);
        FOR x:=1 TO Length(IntToStr(i)) DO Write(#8);
        Write(i);
      END;
      WriteLn(Raus,'<FONT SIZE="-1"><A HREF="mailto:delta@earthling.net">'+
              '&copy; 1998 delta@earthling.net</A>,'+
              ' <A HREF="http://www.yi.com/home/LackasChris">'+
              'http://www.yi.com/home/LackasChris</A></FONT>');
      WriteLn(Raus,'</BODY></HTML>');
      WriteLn;
      WriteLn(' OK FILE CONVERTED to '+ChangeFileExt(InFile,'.html'));
      FINALLY
        CloseFile(Raus);
        CloseFile(Rein);
      END;
      Res:=FindNext(SRec);
      i:=0;
    END; {of while res=0}
END.
© 1998 delta@lackas.net, http://www.lackas.net 

Last visitor: dslb-084-058-185-230.pools.arcor-ip.net using Mozilla/5.0 (Windows; U; Windows NT 6.0; de; rv:1.8.1.14) Gecko/20080404 Firefox/2.0.0.14 from here on 13.5.2008 23:38 (5802)

[Home] [Linux] [Perl] [Delphi] [XP Util]

© Christian Lackas  

last update: May 14, 2000

hosted by LNS Medienservice