模仿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^<>' 'over
if nextp2^<>' 'then ////调用尖括号识别函数
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;
本文地址：http://com.8s8s.com/it/it4173.htm