unitpas2xml.pas

图象处理的一些相关内容 不是很难的,实现简单,希望对大家有帮助

unit UnitPas2Xml;

interface
uses classes,Sysutils,comctrls, UnitParser,UnitKeywords;
type
  TPas2Xml=class(TParser)
  private

  public
    procedure AddHead(AFileName:string);override;
    procedure AddTail(copyright:string); override;

    procedure getbc; override;
    function  IsLetter:boolean; override;
    function  IsDigit:boolean; override;
    function  IsReserve:boolean; override;
    procedure Convert(AProgressBar:TProgressBar);override;
    procedure BeginString; override;
    procedure EndString; override;
    procedure BeginKeyword; override;
    procedure EndKeyword; override;
    procedure BeginComment; override;
    procedure EndComment; override;
    procedure BeginDigit; override;
    procedure EndDigit; override;
    procedure BeginSymb; override;
    procedure EndSymb;override;
    procedure BeginIndint;override;
    procedure EndIndint; override;
    function  CovertSpecialCh(var s:string):boolean; override;
    constructor Create;
    destructor Destroy; override;

  protected

  end;

implementation

{ TPas2Xml }

procedure TPas2Xml.AddHead(AFileName: string);
begin
  outstr:='<?xml version="1.0" encoding="gb2312"?>'+#13#10+
        '<?xml-stylesheet href="hello.css" type="text/css" ?>'+#13#10+
        '<Program>'+#13#10

end;

procedure TPas2Xml.AddTail(copyright: string);
begin
  outstr:=outstr+'</Program>';
end;


procedure TPas2Xml.BeginComment;
begin
  OutStr:=OutStr+'<Comment>';
end;

procedure TPas2Xml.BeginDigit;
begin
  OutStr:=OutStr+'<Digit>';
end;

procedure TPas2Xml.BeginIndint;
begin
  OutStr:=OutStr+'<Identifier>';
end;

procedure TPas2Xml.BeginKeyword;
begin
  OutStr:=OutStr+'<ReseveredWord>';
end;

procedure TPas2Xml.BeginString;
begin
  OutStr:=OutStr+'<String>';
end;

procedure TPas2Xml.BeginSymb;
begin
  OutStr:=OutStr+'<Symbol>';
end;

procedure TPas2Xml.Convert(AProgressBar:TProgressBar);
var
  SpecialStr:string;
begin
  try
    SrcFile:=TFileStream.Create(SrcFileName,fmOpenRead);
    getchar;
    token:='';
    AddHead('sf');
    AProgressBar.Visible:=true;
    AProgressBar.Max:=srcfile.Size;
    while srcfile.Position <srcfile.Size do
    begin
      getbc;

      case ch of
      'a'..'z','A'..'Z':
      begin    //begin case ch of  'a'..'z','A'..'Z':
        while  Isletter or Isdigit do
        begin
          concat;
          getchar;
        end;

        if IsReserve then
        begin
          BeginKeyWord;
          AppendStr(outstr,token);
          EndKeyWord;
          token:='';
        end
        else
        begin
          BeginIndint;
          AppendStr(outstr,token);
          EndIndint;
          token:='';
        end;

      end; //end case ch of  'a'..'z','A'..'Z':

      '0'..'9':
       begin  //begin case of   '0'..'9':
         while   Isdigit  do
         begin
           concat;
           getchar;
         end;
         BeginDigit;
         AppendStr(outstr,token);
         EndDigit;
         token:='';
       end;   //end case of   '0'..'9':

       '=',    '+',    '-',    '_',    '*',

       ':',    ';',    ')',    '@',

       '.',    ',',    '[',    ']',    '^':
       begin
         BeginSymb;
         AppendStr(outstr,ch);
         EndSymb;
         getchar;
         token:='';
       end;



       '<':
       begin
         BeginSymb;
         AppendStr(outstr,'&lt;');
         EndSymb;
         getchar;
         token:='';
       end;

       '>':
       begin
         BeginSymb;
         AppendStr(outstr, '&gt;');
         EndSymb;
         getchar;
         token:='';
       end;



       '$':
       begin
         BeginDigit;
         while ch in ['$','0'..'9','a'..'d','A'..'D'] do
         begin
           AppendStr(outstr,ch);
           getchar;
         end;
         EndDigit;

       end;

       '#':
       begin
         BeginString;
         while ch in ['#','0'..'9'] do
         begin
           AppendStr(outstr,ch);
           getchar;
         end;
         EndString;
       end;

       '{':
       begin  //begin case of '{':
         BeginComment;
         AppendStr(outstr,ch);
         getchar;
         while ch<>'}' do
         begin
           if ch=#13 then
           begin
             AppendStr(outstr,'&#160;<br/>'+#13#10);
             getchar;
           end
           else
           begin
             if CovertSpecialCh(SpecialStr) then
               AppendStr(outstr,SpecialStr)
             else
               AppendStr(outstr,ch);

             getchar;
           end;
         end;
         AppendStr(outstr,ch);
         EndComment;
         getchar;
       end;   //end case of '{':
       '(':
       begin
         if NextCh='*' then
         begin
           BeginComment;
           repeat
             if CovertSpecialCh(SpecialStr) then
               AppendStr(outstr,SpecialStr)
             else
               AppendStr(outstr,ch);

             getchar;
           until (ch='*') and (Nextch=')');


           AppendStr(outstr,ch);
           getchar;
           AppendStr(outstr,ch);
           EndComment;
           getchar;


         end
         else
         begin
           BeginSymb;
           AppendStr(outstr,ch);
           EndSymb;
           getchar;
           token:='';

         end;

       end;
       '/':
       begin
         if Nextch='/' then
         begin
           BeginComment;
           repeat
             if CovertSpecialCh(SpecialStr) then
             begin
               EndComment;
               BeginComment;
               AppendStr(outstr,SpecialStr);
               EndComment;
               BeginComment;
             end
             else
               AppendStr(outstr,ch);

             getchar;
           until (ch=#13);
           //跳过#10
           getchar;
           AppendStr(outstr,'&#160;<br/>'+#13#10);
           EndComment;
           getchar;

         end
         else
         begin
           BeginSymb;
           AppendStr(outstr,ch);
           EndSymb;
           getchar;
           token:='';

         end;

       end;
       {
       #13:
       begin
         if NextCh=#10 then
         begin
           AppendStr(outstr,'<br>');
           getchar;
           getchar;
         end;

       end;
       }
      // #10:;
       #39:
       begin   //begin #39
         BeginString;
         AppendStr(outstr,ch);
         getchar;
         while ch<>#39 do
         begin
           if CovertSpecialCh(SpecialStr) then
           begin
             Endstring;
             BeginString;
             AppendStr(outstr,SpecialStr);
             Endstring;
             BeginString;
           end
           else
           AppendStr(outstr,ch);

           getchar;
         end;
         AppendStr(outstr,ch);
         Endstring;
         getchar;
       end;    //end #39

       else
       begin
         AppendStr(outstr,ch);
         getchar;
       end;

     end; //end case
     AProgressBar.Position:=srcfile.Position;
    end;  //end srcfile.Position <srcfile.Size
  finally
    AddTail('sdaf');
    SrcFile.Free;
  end;

  try
    DesFile:=TFileStream.Create(DesFileName,fmopenwrite or fmcreate);

    DesFile.WriteBuffer (Pointer(outstr)^, Length (outstr));
  finally
    desfile.Free;
  end;
  AProgressBar.Visible:=false;

end;



function TPas2Xml.CovertSpecialCh(var s: string): boolean;
begin
  result:=false;
  case ch of
  '<':
  begin
    s:='&lt;';
    result:=true;
  end;

  '>':
  begin
    s:='&gt;';
    result:=true;
  end;

{  ' ':
  begin
    s:='';
    result:=true;
  end;
 }
  end;  //end case
end;

constructor TPas2Xml.Create;
begin
  FKeywords:=PascalKeywords;
end;

destructor TPas2Xml.Destroy;
begin
  FKeywords:=nil;
end;

procedure TPas2Xml.EndComment;
begin
  OutStr:=OutStr+'</Comment>';
end;

procedure TPas2Xml.EndDigit;
begin
  OutStr:=OutStr+'</Digit>';
end;

procedure TPas2Xml.EndIndint;
begin
  OutStr:=OutStr+'</Identifier>';
end;

procedure TPas2Xml.EndKeyword;
begin
  OutStr:=OutStr+'</ReseveredWord>';
end;

procedure TPas2Xml.EndString;
begin
  OutStr:=OutStr+'</String>';
end;

procedure TPas2Xml.EndSymb;
begin
  OutStr:=OutStr+'</Symbol>';
end;

procedure TPas2Xml.getbc;
begin
  while (ch=' ') or (ch=#13) do
  begin
    if ch=' ' then
      outstr:=outstr+'&#160;&#160;'
    else if ch=#13 then
    begin
      //跳过#10
      getchar;
      outstr:=outstr+'&#160;<br/>'+#13#10;
    end;
    getchar;
  end;
end;

function TPas2Xml.IsDigit: boolean;
begin
  if ch in['0'..'9']then
  result:=true
  else  result:=false
end;

function TPas2Xml.IsLetter: boolean;
begin
  if (ch in ['a'..'z','A'..'Z','_']) then
  result:=true
  else  result:=false
end;

function TPas2Xml.IsReserve: boolean;
begin
  if FKeywords.IndexOf(token)<0 then
    result:=false
  else
    result:=true;
end;

end.