unit UPasHtm; { v. 0.10 } { Under GNU License } { this unit converts a pascal } { page in a web page } { JOAO PAULO SCHWARZ SCHULER } { http://www.schulers.com } { Turbo Pascal Source } { Free Pascal Source for DOS } { Free Pascal Source for Linux } { Delphi32 Source Code } (* This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. *) interface uses reser; Procedure ConvertPasToHtm(InputFileName,OutPutFileName:String); { do it ! } procedure SetColors(Com,Str,Dig,Back:string); { Set the colors used by ConvertPasToHtm procedure} implementation var clString,clCom,clNumber,clBack:string; function IsAlpha(C:char):boolean; {devolve true se eh caracter} begin IsAlpha:=( (C>='A') and (C<='Z') ) or ( (C>='a') and (C<='z') ) ; end; function IsDigit(C:char):boolean; {devolve true se eh digito} begin IsDigit:=( (C>='0') and (C<='9') ); end; function IsHexDigit(C:char):boolean; {devolve true se eh digito} begin IsHexDigit:=(IsDigit(C)) or (pos(UpCase(C),'ABCDEF')<>0); end; function IsDelim(C:char):boolean; {devolve true se eh Delimitador} begin IsDelim:=(pos(C,'~!@# $%^&*()-+=|\}{][":'';?><./,`')<>0); {_} end; procedure Converte(var S:String); var P:word; begin P:=pos('<',S); while P<>0 do begin delete(S,P,1); Insert('<',S,p); P:=pos('<',S); end; end; type THtml = object private FO:text; public constructor Init(FileName:string); procedure NewLine; procedure HWrite(S:string); procedure WriteB(S:string); procedure WriteI(S:string); procedure WriteColored(S,C:string); procedure WriteInitColor(C:string); procedure WriteEndColor; destructor Done; end; type TPasToHtm = object private Com,BStr:boolean; Htm:THtml; public constructor Init(FileName:string); procedure Add(pas:string); destructor Done; end; constructor THtml.Init(FileName:string); begin Assign(FO,FileName); ReWrite(FO); end; destructor THtml.Done; begin Close(FO); end; procedure THtml.NewLine; var C:char; begin Writeln(FO,''); end; procedure THtml.HWrite(S:string); var P:word; begin Write(FO,S); end; procedure THtml.WriteB(S:string); begin Converte(S); HWrite('<b>'+S+'</b>'); end; procedure THtml.WriteI(S:string); begin Converte(S); HWrite('<i>'+S+'</i>'); end; procedure THtml.WriteColored(S,C:string); begin WriteInitColor(C); Converte(S); HWrite(S); WriteEndColor; end; procedure THtml.WriteInitColor(C:string); begin HWrite('<font color ="'+C+'">'); end; procedure THtml.WriteEndColor; begin HWrite('</font>'); end; constructor TPasToHtm.Init(FileName:string); begin Htm.Init(FileName); Htm.HWrite('<html><body bgcolor="'+ClBack+'"><pre>'); Com:=false; Bstr:=false; end; destructor TPasToHtm.Done; begin Htm.Done; end; procedure TPasToHtm.Add(Pas:string); var P:word; C:char; L:word; Cont:boolean; Palavra:String; OLDP:word; HexDigit:boolean; begin Cont:=true; L:=Length(pas); if L>0 then begin P:=1; while P<=L do begin C:=Pas[P]; Cont:=true; if Cont and (C=chr(39)) then begin Palavra:=C; Inc(P); while (Pas[P]<>chr(39)) and (P<=L) do begin Palavra:=Palavra+Pas[P]; inc(P) end; Palavra:=Palavra+Pas[P]; Converte(Palavra); Htm.WriteColored(Palavra,clString); Cont:=false; end; if Cont and ((C='{') or ( (C='(') and (P<L) and (Pas[succ(P)]='*') )) then begin Htm.WriteInitColor(clCom); Com:=true; Htm.HWrite(Pas[P]); Cont:=false; end; if Cont and ( (C='/') and (P<L) and (Pas[succ(P)]='/') ) //added at 0.10 then begin Htm.WriteInitColor(clCom); while (P<=L) do begin Htm.HWrite(Pas[P]); inc(P) end; Htm.WriteEndColor; Cont:=false; end; if Com and Cont then begin while ((Pas[P]<>'}') and not ( (Pas[P]=')') and (Pas[pred(P)]='*'))) and (P<=L) do begin Htm.HWrite(Pas[P]); inc(P) end; if (P<=L) or (Pas[P]='}') or ( (Pas[P]=')') and (Pas[pred(P)]='*')) then begin Htm.HWrite(Pas[P]); Htm.WriteEndColor; Com:=false; end else Com:=true; Cont:=false; end; if Cont and IsDelim(C) and not(C=' ') then begin Htm.WriteB(C); Cont:=false; end; if Cont and (IsDigit(C) or ( (P>1) and (Pas[pred(P)]='$') and IsHexDigit(C))) and { numero hexa?} ((P=1) or (IsDelim(Pas[pred(P)]))) then begin HexDigit:=((P>1) and (Pas[pred(P)]='$')); Htm.WriteInitColor(clNumber); while ((IsDigit(Pas[P]) or (Pas[P]='.'))or (HexDigit and IsHexDigit(Pas[P]))) and (P<=L) do begin Htm.Hwrite(Pas[P]); inc(P); end; dec(P); Htm.WriteEndColor; Cont:=false; end; { of internal if } if Cont and IsAlpha(C) and ((P=1) or (IsDelim(Pas[pred(P)]))) then begin OLDP:=P; Palavra:=''; while not(IsDelim(Pas[P])) and (P<=L) do begin Palavra:=Palavra+Pas[P]; inc(P); end; dec(P); if IsReserved(Palavra) then begin Htm.WriteB(Palavra); end else Htm.HWrite(Palavra); Cont:=false; end; { of medium if } if Cont then Htm.HWrite(C); inc(P); end; { while } end; { of if } Htm.NewLine; end; Procedure ConvertPasToHtm(InputFileName,OutPutFileName:String); { do it ! } var PH:TPasToHtm; S:string; FI:Text; begin Assign(FI,InputFileName); Reset(FI); PH.Init(OutPutFileName); while Not(Eof(FI)) do begin Readln(FI,S); PH.Add(S); end; Close(FI); PH.Done; end; procedure SetColors(Com,Str,Dig,Back:string); { Set the colors used by ConvertPasToHtm procedure} begin clString:=Str; clCom:= Com; clNumber:= Dig; clBack:=Back; end; begin clString:='00A000'; clCom:= '0000A0'; clNumber:= 'A00000'; clBack:='FFFFFF'; end. { of unit }