Pascal listát HTML oldallá konvertáló program

Ha Pascal programokat Web-lapjainkon meg szeretnénk jeleníteni, akkor nagy segítséget nyújthat ez az egyszerű kis program. A program Delphi-ben készült és arra van felkészítve, hogy Delphi-ben készített *.pas kiterjesztésű állományokat átírjon HTML kóddá. Igyekeztem minél több esetre felkészíteni, de lehetséges, hogy nem minden fordítható Pascal listát konvertál helyesen. Főleg a megjegyzések egymásba ágyázására kell vigyázni, mert ott gondok lehetnek. Ugyancsak gond lehet DOS-os verziójú listákban, ha az ékezetes betűket tartalmaz. Ez utóbbi esetben a karaktereket kézzel kell a listában átírni.

A program kezelő felülete igen puritán. Gyakorlatilag csak egy forrásállomány kiválasztására van lehetőség, mely választás után a konvertálás megtörténik. A HTML állomány a Pascal állomány nevével azonos nevű, de a .html kiterjesztésű lesz. Íme a futtatási kép:

Itt pedig a program listája, melyet önmagáról készített:

unit PasToHtml;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

Const M=72;
      Keys: Array[1..M] Of String[14]=
            ('ABSOLUTE',       'AND',            'AS',
             'ASM',            'ASSEMBLER',      'ARRAY',
             'BEGIN',          'CASE',           'CLASS',
             'CONST',          'CONSTRUCTOR',    'DESTRUCTOR',
             'DIV',            'DO',             'DOWNTO',
             'ELSE',           'END',            'EXPORT',
             'EXPORTS',        'EXTERNAL',       'FAR',
             'FILE',           'FINALLY',        'FOR',
             'FORWARD',        'FUNCTION',       'GOTO',
             'IF',             'IMPLEMENTATION', 'IN',
             'INDEX',          'INHERITED',      'INLINE',
             'INTERFACE',      'IS',             'LABEL',
             'LIBRARY',        'MOD',            'NEAR',
             'NIL',            'NOT',            'OBJECT',
             'OF',             'ON',             'OR',
             'PACKED',         'PRIVATE',        'PROCEDURE',
             'PROGRAM',        'PROPERTY',       'PROTECTED',
             'PUBLIC',         'PUBLISHED',      'RAISE',
             'RECORD',         'REPEAT',         'SET',
             'SHL',            'SHR',            'STRING',
             'THEN',           'TO',             'TRY',
             'TYPE',           'UNIT',           'UNTIL',
             'USES',           'VAR',            'VIRTUAL',
             'WHILE',          'WITH',           'XOR');

type
  TfmPasToHtml = class(TForm)
    btForrasFile: TButton;
    btKilepes: TButton;
    OpenDialog: TOpenDialog;
    Function Van(S: String): Boolean;
    Procedure Kiir(S: String);
    procedure btKilepesClick(Sender: TObject);
    procedure btForrasFileClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fmPasToHtml: TfmPasToHtml;
  FTextP, FTextH: Text;
  DNev, HNev: String;
  Direkt, Gomb, Kapocs, Rem, Idez: Boolean;

implementation

{$R *.dfm}

Function TfmPasToHtml.Van(S: String): Boolean;
Var I: Word;
Begin
  Van:= False;
  For I:= 1 To M Do If S=Keys[I] Then Begin Van:= True; Break End;
End;

Procedure TfmPasToHtml.Kiir(S: String);
Var I, J: Word;
    A, B: String;
Begin
  I:= 1; Rem:= False;
  If S<>'' Then While S[I]=' ' Do Begin Write(FTextH, ' '); Inc(I) End;
  While I<=Length(S) Do
  Begin
    A:= '';
    Case S[I] Of
            //nyitó kapcsos zárójelet és $ jeleket keres:
      #123: If S[I+1]='$' Then
            Begin
              Direkt:= True; Write(FTextH, '<font color=green>',Chr(123),'$');
              Inc(I,2);
            End
            //ha csak nyitó kapcsos zárójelet talált:
            Else
            If Not Rem Then
            Begin
              Kapocs:= True;
              Write(FTextH, '<font color=blue><i>',Chr(123)); Inc(I);
            End;
            //ha záró kapcsos zárójelet talált:
      #125: Begin
              Kapocs:= False; Write(FTextH,'</i>',Chr(125),'</font>');
              Inc(I);
            End;
            //( és * jeleket keres:
       '(': If S[I+1]='*' Then
            Begin
              If Not Gomb And Not Kapocs And Not Rem Then
              Begin
                Gomb:= True;
                Write(FTextH, '<font color=blue><i>',Chr(40),'*');
                Inc(I,2);
              End;
            End
            //ha csak (-jelet talált:
            Else
            Begin Write(FTextH, '('); Inc(I) End;
            //* és ) jeleket keres:
       '*': If S[I+1]=')' Then
            Begin
              If Gomb Or Kapocs Or Rem Then
              Begin
                Gomb:= False;
                Write(FTextH, '</i>*',Chr(41),'</font>');
                Inc(I,2);
              End;
            End
            //ha csak *-jelet talált:
            Else
            Begin Write(FTextH, '*'); Inc(I) End;
            //egysoros rem-et keres:
       '/': If S[I+1]='/' Then
            Begin
              Rem:= True;
              Write(FTextH, '<font color=blue><i>/',Chr(47)); Inc(I,2);
            End
            //ha csak egy /-jelet talált
            Else
            Begin Write(FTextH, '/'); Inc(I) End;
            //ha idézőjelet talált:
       #39: Begin Write(FTextH, Chr(39)); Inc(I); Idez:= Not Idez End;
            //ha tag-nyitó jelet talál
       '<': Begin Write(FTextH, '<'); Inc(I) End;
            //szót keres:
       'a'..'z','A'..'Z':
            While (S[I] In ['a'..'z','A'..'Z']) And (I<=Length(S)) Do
            Begin A:= A+S[I]; Inc(I) End;
            //több space-t keres a sor belsejében
       ' ': If S<>'' Then While S[I]=' ' Do
            Begin Write(FTextH, ' '); Inc(I) End;
       Else Begin Write(FTextH, S[I]); Inc(I) End;
    End;

    If Length(A)>0 Then //ha szót talált
    Begin
      B:= A; For J:= 1 To Length(A) Do B[J]:= UpCase(A[J]);
      If Van(B) And Not Direkt And Not Gomb And
                    Not Kapocs And Not Rem And Not Idez Then
      //nem Rem-ben és idézőjelben lévő lefoglalt szót talált
      Write(FTextH, '<b><u>', A, '</u></b>') Else Write(FTextH, A);
    End;

  End;
  WriteLn(FTextH, '<br>');
  If Direkt Then
  Begin Direkt:= False; Write(FTextH, '</font><font face=Courier>') End;
  If Rem Then Begin Rem:= False; Write(FTextH,'</i></font>') End;
End;

procedure TfmPasToHtml.btKilepesClick(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TfmPasToHtml.btForrasFileClick(Sender: TObject);
Var Ws: String;
begin
  With OpenDialog Do
  If Execute Then
  Begin
    DNev:= FileName; HNev:= Copy(DNev,1,Length(DNev)-3)+'html';
    AssignFile(FTextP,DNev); Reset(FTextP);
      AssignFile(FTextH,HNev); ReWrite(FTextH);
        Write(FTextH, '<html><body><font face=Courier>');
        Direkt:= False; Gomb:= False; Kapocs:= False; Idez:= False;
        While Not EOF(FTextP) Do
        Begin ReadLn(FtextP, Ws); Kiir(Ws) End;
        Write(FTextH, '</font></body></html>');
      CloseFile(FTextH);
    CloseFile(FTextP);
  End;
end;

end.
Created by WebEdit (GM-Soft) 2009.08.23. 9:56:24