convert.pas

Delphi高级开发指南是开发程序的好帮手

unit Convert;

interface

uses
  Classes, NewParse;

type
  KeywordType = (ktPascal, ktDfm);

  TCodeParser = class (TNewParser)
  public
    constructor Create (SSource, SDest: TStream);
    procedure SetKeywordType (Kt: KeywordType);
    // conversion
    procedure Convert;
  protected
    // virtual methods (mostly virtual abstract)
    procedure BeforeString; virtual; abstract;
    procedure AfterString; virtual; abstract;
    procedure BeforeKeyword; virtual; abstract;
    procedure AfterKeyword; virtual; abstract;
    procedure BeforeComment; virtual; abstract;
    procedure AfterComment; virtual; abstract;
    procedure InitFile; virtual; abstract;
    procedure EndFile; virtual; abstract;
    function CheckSpecialToken (Ch1: char): string; virtual;
    function MakeStringLegal (S: String): string; virtual;
    function MakeCommentLegal (S: String): string; virtual;
  protected
    Source, Dest: TStream;
    OutStr: string;
    FKeywords: TStrings;
    Line, Pos: Integer;
  end;

  THtmlParser = class (TCodeParser)
  public
    FileName: string;
    Copyright: string;
    Alone: Boolean;
    procedure AddFileHeader (FileName: string);
    class function HtmlHead (Filename: string): string;
    class function HtmlTail (Copyright: string): string;
  protected
    // virtual methods
    procedure BeforeString; override;
    procedure AfterString; override;
    procedure BeforeKeyword; override;
    procedure AfterKeyword; override;
    procedure BeforeComment; override;
    procedure AfterComment; override;
    procedure InitFile; override;
    procedure EndFile; override;
    function CheckSpecialToken (Ch1: char): string; override;
  end;

// functions to be used by a Wizard
function OpenProjectToHTML (Filename, Copyright: string): string;
function CurrProjectToHTML (Copyright: string): string;

implementation

uses
  ExptIntf, SysUtils, ToolIntf;

var
  PascalKeywords: TStrings;
  DfmKeywords: TStrings;

const
  Quote = '''';

//////////// class TCodeParser ////////////

constructor TCodeParser.Create (SSource, SDest: TStream);
begin
  inherited Create (SSource);
  Source := SSource;
  Dest := SDest;
  SetLength (OutStr, 10000);
  OutStr := '';
  FKeywords := PascalKeywords;
end;

procedure TCodeParser.SetKeywordType (Kt: KeywordType);
begin
  case Kt of
    ktPascal: FKeywords := PascalKeywords;
    ktDfm: FKeywords := DfmKeywords;
  else
    raise Exception.Create ('Undefined keywords type');
  end;
end;

procedure TCodeParser.Convert;
begin
  InitFile; // virtual
  Line := 1;
  Pos := 0;
  // parse the entire source file
  while Token <> toEOF do
  begin
    // if the source code line has changed,
    // add the proper newline character
    while SourceLine > Line do
    begin
      AppendStr (OutStr, #13#10);
      Inc (Line);
      Pos := Pos + 2; // 2 characters, cr+lf
    end;
    // add proper white spaces (formatting)
    while SourcePos > Pos do
    begin
      AppendStr (OutStr, ' ');
      Inc (Pos);
    end;
    // check the token
    case Token of
      toSymbol:
      begin
        // if the token is not a keyword
        if FKeywords.IndexOf (TokenString) < 0 then
          // add the plain token
          AppendStr (OutStr, TokenString)
        else
        begin
          BeforeKeyword; // virtual
          AppendStr (OutStr, TokenString);
          AfterKeyword; // virtual
        end;
      end;
      toString:
      begin
        BeforeString; // virtual
        if (Length (TokenString) = 1) and
          (Ord (TokenString [1]) < 32) then
          begin
            AppendStr (OutStr, '#' +
              IntToStr (Ord (TokenString [1])));
            if Ord (TokenString [1]) < 10 then
              Pos := Pos + 1
            else
              Pos := Pos + 2;
          end
        else
        begin
          AppendStr (OutStr, MakeStringLegal (TokenString));
          Pos := Pos + 2; // 2 x hypen
        end;
        AfterString; // virtual
      end;
      toInteger:
        AppendStr (OutStr, TokenString);
      toFloat:
        AppendStr (OutStr, TokenString);
      toComment:
      begin
        BeforeComment; // virtual
        AppendStr (OutStr, MakeCommentLegal (TokenString));
        AfterComment; // virtual
      end;
      else
        // any other token
        AppendStr (OutStr, CheckSpecialToken (Token));
    end; // case Token of
    // increase the current position
    Pos := Pos + Length (TokenString);
    // move to the next token
    NextToken;
  end; // while Token <> toEOF do
  // add final code
  EndFile; // virtual
  // add the string to the stream
  Dest.WriteBuffer (Pointer(OutStr)^, Length (OutStr));
end;

function TCodeParser.CheckSpecialToken (Ch1: char): string;
begin
  Result := Ch1; // do nothing
end;

function TCodeParser.MakeStringLegal (S: String): string;
var
  I: Integer;
begin
  if Length (S) < 1 then
  begin
    Result := Quote + Quote;
    Exit;
  end;

  // if the first character is not special,
  // add the open quote
  if S[1] > #31 then
    Result := Quote
  else
    Result := '';

  // for each character of the string
  for I := 1 to Length (S) do
    case S [I] of

      // quotes must be doubled
      Quote: begin
        AppendStr (Result, Quote + Quote);
        Pos := Pos + 1;
      end;

      // special characters (characters below the value 32)
      #0..#31: begin
        Pos := Pos + Length (IntToStr (Ord (S[I])));
        // if preceeding characters are plain ones,
        // close the string
        if (I > 1) and (S[I-1] > #31) then
          AppendStr (Result, Quote);
        // add the special character
        AppendStr (Result, '#' + IntToStr (Ord (S[I])));
        // if the following characters are plain ones,
        // open the string
        if (I < Length (S) - 1) and (S[I+1] > #31) then
          AppendStr (Result, Quote);
      end;
    else
      AppendStr (Result, CheckSpecialToken(S[I]));
  end;

  // if the last character was not special,
  // add closing quote
  if (S[Length (S)] > #31) then
    AppendStr (Result, Quote);
end;

function TCodeParser.MakeCommentLegal (S: String): string;
var
  I: Integer;
begin
  Result := '';
  // for each character of the string
  for I := 1 to Length (S) do
    AppendStr (Result, CheckSpecialToken(S[I]));
end;

//////////// class THtmlParser ////////////

procedure THtmlParser.InitFile;
begin
  if Alone then
    AppendStr (OutStr, HtmlHead (Filename));
  AddFileHeader (Filename);
  AppendStr (OutStr, '<PRE>'#13#10);
end;

procedure THtmlParser.EndFile;
begin
  AppendStr (OutStr, '</PRE>');
  if Alone then
    AppendStr (OutStr, HtmlTail (Copyright))
  else
    AppendStr (OutStr, #13#10'<HR>'#13#10#13#10); // separator
end;

procedure THtmlParser.BeforeComment;
begin
  AppendStr (OutStr, '<FONT COLOR="#000080"><I>');
end;

procedure THtmlParser.AfterComment;
begin
  AppendStr (OutStr, '</I></FONT>');
end;

procedure THtmlParser.BeforeKeyword;
begin