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 ágyazá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=93;
      Keys: Array[1..M] Of String[14]=
            ('ABSOLUTE',       'ABSTRACT',       'AND',
             'AS',             'ASM',            'ASSEMBLER',
             'ARRAY',          'BEGIN',          'CASE',
             'CDECL',          'CLASS',          'CONST',
             'CONSTRUCTOR',    'DESTRUCTOR',     'DISPID',
             'DISPINTERFACE',  'DIV',            'DO',
             'DOWNTO',         'DYNAMIC',        'ELSE',
             'END',            'EXCEPT',         'EXPORT',
             'EXPORTS',        'EXTERNAL',       'FAR',
             'FILE',           'FINALIZATION',   'FINALLY',
             'FOR',            'FORWARD',        'FUNCTION',
             'GOTO',           'IF',             'IMPLEMENTATION',
             'IN',             'INDEX',          'INHERITED',
             'INITIALIZATION', 'INLINE',         'INTERFACE',
             'IS',             'LABEL',          'LIBRARY',
             'MESSAGE',        'MOD',            'NEAR',
             'NIL',            'NOT',            'OBJECT',
             'OF',             'ON',             'OR',
             'OUT',            'OVERLOAD',       'OVERRIDE',
             'PACKED',         'PASCAL',         'PLATFORM',
             'PRIVATE',        'PROCEDURE',      'PROGRAM',
             'PROPERTY',       'PROTECTED',      'PUBLIC',
             'PUBLISHED',      'RAISE',          'RECORD',
             'REGISTER',       'REINTRODUCE',    'REPEAT',
             'RESOURCETRING',  'SAFECALL',       'SET',
             'SHL',            'SHR',            'STDCALL',
             'STRING',         'THREADVAR',      'THEN',
             'TO',             'TRY',            'TYPE',
             'UNIT',           'UNTIL',          'USES',
             'VAR',            'VARARGS',        '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>/',Chr(47),'<i>'); 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.