源代码网整理以下模仿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;
软件开发网 www.mscto.com
源代码网整理以下 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;
