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 *.pas kiterjesztésű állományokat tud átírni 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 html kiterjesztésű lesz.

A program futtatási képe:

A forrásfájl kiválasztása OpenDialog segítségével:

A program listája:

unit UPasToHtml;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes,

Graphics, Controls, Forms,
Dialogs, StdCtrls;

Const M=74;
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',            'NAME',
             'NEAR',           'NIL',            'NOT',
             'OBJECT',         'OF',             'ON',
             'OR',             'PACKED',         'PRIVATE',
             'PROCEDURE',      'PROGRAM',        'PROPERTY',
             'PROTECTED',      'PUBLIC',         'PUBLISHED',
'RAISE',          'RECORD',         'REPEAT',
             'SET',            'SHL',            'SHR',
             'STDCALL',        '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}

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

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,Chr(125),'</i>','</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.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.