模仿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;
