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, MessagesSysUtilsVariantsClasses,

  GraphicsControlsForms,
  DialogsStdCtrls;

Const M=74;
      KeysArray[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)
    btForrasFileTButton;
    btKilepesTButton;
    OpenDialogTOpenDialog;
    Function Van(S: String): Boolean;
    Procedure Kiir(S: String);
    procedure btKilepesClick(SenderTObject);
    procedure btForrasFileClick(SenderTObject);
  private
    Private declarations }
  public
    Public declarations }
  end;

var
  fmPasToHtmlTfmPasToHtml;
  FTextPFTextHText;
  DNevHNevString;
  Direkt, Gomb, Kapocs, RemIdezBoolean;

implementation

{$R *.dfm}

procedure TfmPasToHtml.btKilepesClick(SenderTObject);
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:= TrueBreak 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:= TrueWrite(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:= FalseWrite(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(FTextHChr(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:= FalseWrite(FTextH, '</font><font face=Courier>') End;
  If Rem Then Begin Rem:= FalseWrite(FTextH,'</i></font>') End;
End;

procedure TfmPasToHtml.btForrasFileClick(SenderTObject);
Var WsString;
begin
  With OpenDialog Do
  If Execute Then
  Begin
    DNev:= FileNameHNev:= 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:= FalseIdez:= False;
        While Not EOF(FTextPDo
        Begin ReadLn(FtextPWs); Kiir(WsEnd;
        Write(FTextH, '</font></body></html>');
      CloseFile(FTextH);
    CloseFile(FTextP);
  End;
end;

end.