Pascal To HTML

Top  Previous  Next

 

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 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.