模仿C

能判斷#include<>;main();int;char;for;PRintf;scanf;{};

 private
  //在str中找第一個(gè)單詞 如果 找到則返回第一個(gè)單詞的地址（phrase）和下一個(gè)要分析單詞的入口（nextptr）
   //如果str是空串則返回false
    function phrase(str:string;phrase,nextptr:pchar):bool; //
    //括號匹配函數(shù)
    //p；判斷字符的地址，char：什么括號（包括：<>;()2種)，deep:允許嵌套么？匹配成功返回true;
    function brkmatch(p:pchar;brk:char;deep:bool;next:pchar):bool;
    function corbeil(r:trichedit;line,col:pinteger):bool; //line 返回出錯(cuò)的行,col返回出錯(cuò)的列;
    function semicolon(p,next:pchar):bool;//p:入口地址  next:下一個(gè)字符的地址
     //semicolon   如果沒找到 返回false next=nil 找到其他字符 返回false且 next便指向他的下一個(gè)
    function analys(sour,dest:trichedit):bool;

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
function tform1.corbeil(r:trichedit;line,col:pinteger):bool;
var
n,l,i,c:integer;
temp:pchar;
ptr:pchar;
begin
i:=0;
c:=r.Lines.Count;
n:=0;
  while c>1 do
  begin
  getmem(temp,length(r.Lines.Strings[i])+1);
  strcopy(temp,pchar(r.Lines.Strings[i]));
  ptr:=temp;
  l:=length(r.Lines.Strings[i]);
    while  l>1 do
    begin
      if ptr^='{' then
      begin
      n:=n+1;
      end
      else
        if ptr^='}'then
        if n>0 then
        n:=n-1
        else
          begin
          result:=false;
          break;
          line^:=r.Lines.Count-c+1;
          col^:=length(r.Lines.Strings[i])-l+1;
          end;
       l:=l-1;
    end;// while  l>1 do
  freemem(temp);
  i:=i+1;
  c:=c-1;
  end;//while  line less than  linecount
if n=0 then
result:=true
else
result:=false;
end;

function tform1.phrase(str:string;phrase,nextptr:pchar):bool;
var
phr:pchar;
n:pchar;
temp:pchar;
ptr:pchar; //指向下一個(gè)要分析的單詞的地址

begin
n:=' ';
str:=trim(str);
if length(str)<>0 then
begin
getmem(temp,length(str)+1);
strcopy(temp,pchar(str));
ptr:=strpos(temp,n);
getmem(phr,integer(ptr-temp)+1);
strlcopy(phr,temp,integer(ptr-temp));
phrase:=phr;
nextptr:=ptr;//是空格
result:=true;
end
else
result:=false;
freemem(temp);
end;
function tform1.brkmatch(p:pchar;brk:char;deep:bool;next:pchar):bool;
var
n,len:integer;
begin
len:=strlen(p)-1;
if deep=true then
  begin
  if p^='('then
      begin
        n:=1;
        while len>0 do
          begin
          p:=p+1;
          if p^='(' then
              n:=n+1
            else
               if p^=')' then
               if n>0  then
                    n:=n-1
               else
               begin
                 result:=false;
                 next:=p+1;   //不成功 flase next不為空表示)多余
                 break;
               end;

          end;  //while over;
        if n>0 then
        begin
          result:=false;
          next:=nil;//result=false且next為空表示(多余
        end
        else
          begin
          result:=true;   //如果'('匹配成功則 true next 為 null
          next:=nil;
          end;//else
      end; //if p^='('then over

  end //if deep=true then over
else
if deep=false then
begin
  if  p^='<'  then
  begin
    while len>0 do
    begin
      len:=len-1;
      p:=p+1;
      if p^='>'then
      begin
        result:=true;
        break;
        next:=p+1;    //如果是'<'匹配成功,true且next指向下一個(gè)要分析的字符
      end;  //    if p^='>'then
    end;//while len>0 do
    if len=0 then
    begin
    result:=false;
    next:=nil;
    end;//len=0 over
    end// if
  else   //如果第一個(gè)字符不是‘<’ 則返回錯(cuò)誤 并帶回下一個(gè) 指針
  begin
    result:=false;
    next:=p+1;

  end; //

end; //if deep=false then ovser

end;   //function over;
function tform1.semicolon(p,next:pchar):bool;//p:入口地址
var
temp,ptr:pchar;
i:integer;
begin
i:=strlen(p);
while i>1 do
begin
if p^=';'then
begin
result:=true;
next:=p+1;
break;
end;//if p^=';'then
if  p^=' 'then
begin
i:=i-1;
p:=p+1;

end;// if  p^=' '
if ((p^<>' ')or (p^<>';'))then
begin
result:=false;
next:=p+1;
break;
end;
end;//while
if i=1  then
begin
result:=false;
next:=nil;
end;
end;//function semicolon(p:pchar)over;
function analys(sour,dest:trichedit):bool;
var
able,unable:bool;
lcount,lWords,i :integer;
phr,nextp:pchar;
phr2,nextp2,temp21,temp22:pchar;
phr3,nextp3:pchar;
braket:char;
s:string;
begin
temp21:=nil;
temp22:=nil;
able:=true;
unable:=false;
lcount:=sour.Lines.Count;
i:=0;
while lcount >1 do
  begin
  s:=sour.Lines.Strings[i];  //將行賦給 s
  if trim(pchar(s))<>nil then    //非空串
    begin

    if phrase(s;phr;nextp)=true then //如果還有字符
    //以下開始處理標(biāo)志符識(shí)別和簡單的語法分析
        begin
        if phr^='#' then
            begin     //判斷下一個(gè)字符是不是include
            if phrase(nextp,phr2,nextp2)=true then
                begin
                if phr2='include' then   //找下一個(gè)非空字符
                    begin
                    while ((nextp2^=' ')and (strlen(nextp2)<>0))do
                          begin
                          temp22:= nextp2;
                          nextp2:=nextp2+1;
                          end; //   while nextp2^<>' 'over
                     if nextp2^<>' 'then ////調(diào)用尖括號識(shí)別函數(shù)
                        begin
                        braket:='<';
                        if brakmatch(nextp2,braket,unabel)=true then
                        begin

                        end;

                        end;
                    end;//  if phr2='include' then over
                end;

            end;
        end;
    end;
  end;//while  lcount >1
end;