模仿C 能判断#include<>;main();int;char;for;printf;scanf;{}; private //在str中找第一个单词 如果 找到则返回第一个单词的地址(phrase)和下一个要分析单词的入口(nextptr) //如果str是空串则返回false function phrase(str:string;phrase,nextptr:pchar):bool; // //括号匹配函数 //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 返回出错的行,col返回出错的列; function semicolon(p,next:pchar):bool;//p:入口地址 next:下一个字符的地址 //semicolon 如果没找到 返回false next=nil 找到其他字符 返回false且 next便指向他的下一个 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; //指向下一个要分析的单词的地址 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指向下一个要分析的字符 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 //如果第一个字符不是‘<’ 则返回错误 并带回下一个 指针 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 //如果还有字符 //以下开始处理标志符识别和简单的语法分析 begin if phr^=''''#'''' then begin //判断下一个字符是不是include if phrase(nextp,phr2,nextp2)=true then begin if phr2=''''include'''' then //找下一个非空字符 begin while ((nextp2^='''' '''')and (strlen(nextp2)<>0))do begin temp22:= nextp2; nextp2:=nextp2+1; end; // while nextp2^<>'''' [1] [2] 下一页 没有相关教程
|