979 lines
30 KiB
Plaintext
979 lines
30 KiB
Plaintext
unit utslvclsyntaxparser;
|
|
{**
|
|
@explan(说明) 设计器中tsl脚本解析相关 %%
|
|
@date(20220518)
|
|
**}
|
|
interface
|
|
type ttslscripparser = class(tslparser) //对外接口
|
|
{**
|
|
@explan(说明) 解析tsl 类 %%
|
|
**}
|
|
function create();
|
|
begin
|
|
inherited;
|
|
end
|
|
end
|
|
implementation
|
|
type tslparser = class(tslparserbase) //语法解析
|
|
private
|
|
FTokener;
|
|
FTokens;
|
|
FCurrentPos;
|
|
FTokenLen;
|
|
FScriptPath;
|
|
function SetScriptPath(v);
|
|
begin
|
|
size := filesize("",v); //获取文件大小
|
|
readFile(rwraw(),"",v,0,size,data);
|
|
SetScript(data);
|
|
end
|
|
function SetScript(v);
|
|
begin
|
|
if FTokener.tslstr <> v then
|
|
begin
|
|
FTokener.tslstr := v;
|
|
FTokens := FTokener.tokens();
|
|
if FTokens then FTokenLen := length(FTokens)-1;
|
|
FTokenLen :=-1;
|
|
end
|
|
end
|
|
function tkopok();
|
|
begin
|
|
return FCurrentPos>=0 and FCurrentPos<FTokenLen;
|
|
end
|
|
function getTokenPos(ps);
|
|
begin
|
|
return FTokens[ps,2]+1;
|
|
end
|
|
function getTokenRow(ps);
|
|
begin
|
|
return FTokens[ps,3];
|
|
end
|
|
function ctoken(tk,tp,pos,r);
|
|
begin
|
|
if not FTokens then return 0;
|
|
//r := tkopok(pos);
|
|
tk := FTokens[FCurrentPos,0];
|
|
tp := FTokens[FCurrentPos,1];
|
|
pos := FTokens[FCurrentPos,2]+1;
|
|
r := FTokens[FCurrentPos,3];
|
|
FCurrentPos++;
|
|
return tk;
|
|
end
|
|
function bpos(n);
|
|
begin
|
|
if n >= 0 then FCurrentPos -= n;
|
|
else FCurrentPos--;
|
|
end
|
|
function btoken(tk,tp,pos,n);
|
|
begin
|
|
bpos(n);
|
|
r := ctoken(tk,tp,pos);
|
|
return r;
|
|
end
|
|
function GetScript();
|
|
begin
|
|
return FTokener.tslstr;
|
|
end
|
|
public
|
|
function create();
|
|
begin
|
|
inherited;
|
|
FTokener := new tsltoken();
|
|
end
|
|
//type beg end name
|
|
function GetClassAbstract();
|
|
begin
|
|
{**
|
|
@explan(说明) 获得class 的基本信息 %%
|
|
@return(array) 包括"name","inherited","uses" 等信息 %%
|
|
**}
|
|
if not Tokens then return array();
|
|
FCurrentPos := 0;
|
|
while true do
|
|
begin
|
|
ctoken(tk,tp,pos);
|
|
if ifnil(tk)then return array();
|
|
if tk="type" and tp <> TT_STR then
|
|
begin
|
|
r := array();
|
|
ctoken(tk,tp,pos);
|
|
if tp=TT_IDE then
|
|
begin
|
|
r["name"]:= tk;
|
|
ctoken(tk,tp,pos);
|
|
if tk <> "=" then return 0;
|
|
ctoken(tk,tp,pos);
|
|
if tk <> "class" then return 0;
|
|
ctoken(tk,tp,pos);
|
|
inh := array();
|
|
if tk="(" then
|
|
begin
|
|
while true do
|
|
begin
|
|
ctoken(tk,tp,pos);
|
|
if ifnil(tk)then break;
|
|
if tk=")" then break;
|
|
if tk="," then continue;
|
|
else inh[length(inh)]:= tk;
|
|
end
|
|
r["inherited"]:= inh;
|
|
end
|
|
while true do
|
|
begin
|
|
ctoken(tk,tp,pos);
|
|
if ifnil(tk)then break;
|
|
if tk="uses" and tp <> TT_STR then
|
|
begin
|
|
ru := array();
|
|
while true do
|
|
begin
|
|
ctoken(tk,tp,pos);
|
|
if ifnil(tk)then break;
|
|
if tk="," then continue;
|
|
if tk=";" then break;
|
|
ru[length(ru)]:= tk;
|
|
end
|
|
r["uses"]:= ru;
|
|
break;
|
|
end
|
|
end
|
|
return r;
|
|
end
|
|
end else
|
|
return array();
|
|
end
|
|
end
|
|
function GetClassInfo(fi);
|
|
begin
|
|
{**
|
|
@explan(说明) 获得class的详细信息 %%
|
|
@param(fi)(bool) 是否获得class成员的位置信息 %%
|
|
**}
|
|
r := array();
|
|
if not Tokens then return r;
|
|
FCurrentPos := 0;
|
|
while true do
|
|
begin
|
|
ctoken(tk,tp,pos);
|
|
if ifnil(tk)then exit;
|
|
if tk="type" and tp <> TT_STR then break;
|
|
end
|
|
if tk="type" and tp <> TT_STR then
|
|
begin
|
|
r["beg"]:= pos;
|
|
tr := parserclass(fi);
|
|
if ifarray(tr)then r union=tr;
|
|
r["end"]:= CurrentPos;
|
|
return r;
|
|
end
|
|
return r;
|
|
end
|
|
function gettslfunctions();
|
|
begin
|
|
funcsinfo := array();
|
|
if not Tokens then return funcsinfo;
|
|
FCurrentPos := 0;
|
|
funcsinfo := array();
|
|
while true do
|
|
begin
|
|
ctoken(tk,tp,pos,row);
|
|
if ifnil(tk)then break;
|
|
if tk="type" and tp <> TT_STR then
|
|
begin
|
|
tr := parserclass(0);
|
|
end
|
|
if (tk="function" or tk="procedure") and tp <> TT_STR then
|
|
begin
|
|
bpos();
|
|
bfpos := CurrentPos;
|
|
lenf := length(funcsinfo);
|
|
tfn := parserfunction();
|
|
funcsinfo[lenf]["name"]:= tfn;
|
|
funcsinfo[lenf]["startpos"]:= getTokenPos(bfpos);
|
|
//echo ">>cretfpos===",self.CurrentPos,"====",length(Tokens);
|
|
len := length(Tokens)-1;
|
|
if (len>CurrentPos) then
|
|
begin
|
|
funcsinfo[lenf]["endpos"]:= getTokenPos(self.CurrentPos)-1;
|
|
end else
|
|
begin
|
|
funcsinfo[lenf]["endpos"]:= getTokenPos(len)+2;
|
|
end
|
|
funcsinfo[lenf]["row"]:= row;
|
|
end
|
|
end
|
|
return funcsinfo;
|
|
end
|
|
function parserclass(fi);
|
|
begin
|
|
{**
|
|
@explan(说明) 获得class详细 %%
|
|
@param(fi)(bool) 是否获得函数的信息 %%
|
|
**}
|
|
ctoken(tk,tp,pos);
|
|
r := array();
|
|
if tp=TT_IDE then
|
|
begin
|
|
r["name"]:= tk;
|
|
ctoken(tk,tp,pos);
|
|
if tk <> "=" then raise "解析错误";
|
|
ctoken(tk,tp,pos);
|
|
if tk <> "class" then raise "解析错误";
|
|
ctoken(tk,tp,pos);
|
|
if tk="(" then
|
|
begin
|
|
pa := array();
|
|
while true do
|
|
begin
|
|
ctoken(tk,tp,pos);
|
|
if ifnil(tk) then break;
|
|
if tk=")" then
|
|
begin
|
|
r["inheritedendpos"] := pos;
|
|
break;
|
|
end
|
|
if tk <> "," then pa[length(pa)]:= tk;
|
|
end
|
|
r["inherited"]:= pa;
|
|
end else
|
|
begin
|
|
bpos();
|
|
end
|
|
props := array();
|
|
funcs := array();
|
|
funcsinfo := array();
|
|
filed := array();
|
|
priv := "public";
|
|
while true do
|
|
begin
|
|
ctoken(tk,tp,pos,row);
|
|
if ifnil(tk)then break;
|
|
if tk in array("private","public","protected")then
|
|
begin
|
|
priv := tk;
|
|
continue;
|
|
end
|
|
if tk in array("weakref","autoref") then
|
|
begin
|
|
continue;
|
|
end
|
|
if tk="[" and tp=TT_SYM then
|
|
begin
|
|
wkps := pos;
|
|
while true do
|
|
begin
|
|
ctoken(tk,tp,pos,row);
|
|
if ifnil(tk) then break;
|
|
if tk="]" and tp=TT_SYM then
|
|
begin
|
|
weakflag := array("beg":wkps,"end":pos);
|
|
break;
|
|
end
|
|
end
|
|
if ifnil(tk) then break;
|
|
if tk="]" then continue;
|
|
end
|
|
if tk="uses" and tp=TT_IDE then
|
|
begin
|
|
usb := pos;
|
|
pu := array();
|
|
while true do
|
|
begin
|
|
ctoken(tk,tp,pos);
|
|
if ifnil(tk) then break;
|
|
if tp=TT_IDE then
|
|
begin
|
|
pu[length(pu)]:= tk;
|
|
end else
|
|
if tk=";" then break;
|
|
end
|
|
r["uses"]:= array("row":row,"beg":usb,"end":pos,"info":pu);
|
|
end else
|
|
if tk="static" and tp=TT_IDE then
|
|
begin
|
|
if not r["filed"]then r["filed"]:= array();
|
|
staticflag := array("beg":pos);
|
|
sf := parserfiled();
|
|
for i := 0 to length(sf)-1 do
|
|
begin
|
|
if i=0 then
|
|
begin
|
|
staticflag["end"] := sf[i]["beg"]-1;
|
|
end
|
|
sf[i]["static"]:= true;
|
|
sf[i]["staticpos"]:= pos;
|
|
sf[i]["priv"]:= priv;
|
|
end
|
|
if (length(sf)=1) then
|
|
begin
|
|
sf[0]["dstatic"] := staticflag;
|
|
end
|
|
if weakflag and (length(sf)=1) then
|
|
begin
|
|
sf[0]["weakref"] := weakflag;
|
|
|
|
weakflag := nil;
|
|
end
|
|
filed union=sf;
|
|
end else
|
|
if tk="function" or tk="procedure" then
|
|
begin
|
|
bpos();
|
|
bfpos := CurrentPos;
|
|
lenf := length(funcsinfo);
|
|
tfn := parserfunction();
|
|
if priv="public" then funcs[length(funcs)]:= tfn;
|
|
if fi then
|
|
begin
|
|
funcsinfo[lenf]["name"]:= tfn;
|
|
funcsinfo[lenf]["startpos"]:= getTokenPos(bfpos);
|
|
funcsinfo[lenf]["endpos"]:= getTokenPos(self.CurrentPos)-1;
|
|
funcsinfo[lenf]["row"]:= row;
|
|
end
|
|
end else
|
|
if tk="property" then
|
|
begin
|
|
props[length(props)]:= parserproperty();
|
|
end else
|
|
if tk="class" and tp=TT_IDE then
|
|
begin
|
|
if priv="public" then funcs[length(funcs)]:= parserfunction();
|
|
end else
|
|
if tk=";" then continue;
|
|
else if tk="end" and tp=TT_IDE then break;
|
|
else if tk="type" then
|
|
begin
|
|
cr := array();
|
|
cr["type"]:= "class";
|
|
cr["beg"]:= pos;
|
|
cr["info"]:= parserclass(fi);
|
|
cr["end"]:= CurrentPos;
|
|
end else
|
|
if tk="type" then break;
|
|
else
|
|
begin
|
|
bpos();
|
|
sf:=parserfiled(priv);
|
|
if weakflag and (length(sf)=1) then
|
|
begin
|
|
sf[0]["weakref"] := weakflag;
|
|
weakflag := nil;
|
|
end
|
|
filed union= sf;
|
|
end
|
|
end
|
|
end
|
|
r["prop"]:= props;
|
|
r["funcs"]:= funcs;
|
|
r["filed"]:= filed;
|
|
r["funcsinfo"]:= funcsinfo;
|
|
prn := array();
|
|
if filed then prn := filed[:,"name"];
|
|
r["members"]:=(prn union2 funcs)union2 props;
|
|
return r;
|
|
end
|
|
function parsertype();
|
|
begin
|
|
ctoken(tk,tp,pos);
|
|
tarray := "";
|
|
if tk="array" then
|
|
begin
|
|
tarray := "array ";
|
|
ctoken(tk,tp,pos);
|
|
if tk=";" then
|
|
begin
|
|
return tarray;
|
|
end else
|
|
if tk="of" then
|
|
begin
|
|
tarray += "of ";
|
|
ctoken(tk,tp,pos);
|
|
end
|
|
end
|
|
return tarray+tk;
|
|
end
|
|
function parserfiled(priv);
|
|
begin
|
|
cstflg := false;
|
|
rcount := 0;
|
|
r := array();
|
|
while true do
|
|
begin
|
|
ctoken(tk,tp,pos);
|
|
if ifnil(tk) then break;
|
|
if tk="end" and tp=TT_IDE then
|
|
begin
|
|
bpos();
|
|
break;
|
|
end
|
|
if tk="=" and tp=TT_SYM then
|
|
begin
|
|
i_t := "";
|
|
while true do
|
|
begin
|
|
ctoken(tk,tp,pos);
|
|
if ifnil(tk) then break;
|
|
if tp=TT_SYM and tk=";" then
|
|
begin
|
|
bpos();
|
|
break;
|
|
end
|
|
i_t+=tk;
|
|
end
|
|
r[rcount]["init"] := i_t;
|
|
continue;
|
|
end
|
|
if tk=";" then
|
|
begin
|
|
if rcount then
|
|
begin
|
|
r[rcount]["last"]:= true;
|
|
r[rcount]["beg"] := r[rcount]["precomma"];
|
|
if not (r[rcount]["end"]>0) then
|
|
begin
|
|
r[rcount]["end"] := pos-1;
|
|
end
|
|
|
|
end else
|
|
begin
|
|
r[rcount]["end"]:= pos;
|
|
end
|
|
break;
|
|
// return r;
|
|
end else
|
|
if tk="," then
|
|
begin
|
|
if rcount>0 then
|
|
begin
|
|
r[rcount]["nextcomma"]:= pos;
|
|
end else
|
|
begin
|
|
r[rcount]["first"]:= true;
|
|
end
|
|
r[rcount]["end"] := pos;
|
|
rcount++;
|
|
r[rcount]["precomma"]:= pos;
|
|
|
|
end else
|
|
if tk=":" then
|
|
begin
|
|
if rcount>0 then
|
|
begin
|
|
r[rcount]["end"] := pos-1;
|
|
end
|
|
tpv := parsertype();
|
|
for i := 0 to length(r)-1 do
|
|
begin
|
|
r[i]["type"]:= tpv;
|
|
end
|
|
continue;
|
|
ctoken(tk,tp,pos);
|
|
tarray := "";
|
|
if tk="array" then
|
|
begin
|
|
tarray := "array ";
|
|
ctoken(tk,tp,pos);
|
|
if tk=";" then
|
|
begin
|
|
for i := 0 to length(r) do
|
|
begin
|
|
r[i]["type"]:= "array";
|
|
end
|
|
break;
|
|
// return r;
|
|
end else
|
|
if tk="of" then
|
|
begin
|
|
tarray += "of ";
|
|
ctoken(tk,tp,pos);
|
|
end
|
|
end
|
|
end else
|
|
if tk="const" then
|
|
begin
|
|
cstflg := true;
|
|
end
|
|
else
|
|
begin
|
|
r[rcount]["name"]:= tk;
|
|
r[rcount]["beg"]:= pos;
|
|
r[rcount]["id"]:= rcount;
|
|
r[rcount]["priv"]:= priv;
|
|
if cstflg then r[rcount]["const"] := true;
|
|
end
|
|
end
|
|
len := length(r);
|
|
return r;
|
|
end
|
|
function parserproperty();
|
|
begin
|
|
r := "";
|
|
while true do
|
|
begin
|
|
ctoken(tk,tp,pos);
|
|
if not r then r := tk;
|
|
if tk=";" then return r;
|
|
end
|
|
return r;
|
|
end
|
|
function parserfunction();
|
|
begin
|
|
ctoken(tk,tp,pos);
|
|
ctoken(tk,tp,pos);
|
|
fn := "";
|
|
if tk <> "(" then fn := tk;
|
|
while true do
|
|
begin
|
|
if ifnil(tk) then break;
|
|
if tk="begin" then
|
|
begin
|
|
//return parserstatement();
|
|
parserstatement();
|
|
break;
|
|
end else
|
|
if tk="(" then
|
|
begin
|
|
while true do
|
|
begin
|
|
ctoken(tk,tp,pos);
|
|
if tk=")" and tp <> TT_STR then
|
|
begin
|
|
break;
|
|
end
|
|
end
|
|
parserfunctionplus();
|
|
break;
|
|
end else
|
|
if tk=":" then
|
|
begin
|
|
bpos();
|
|
parserfunctionplus();
|
|
break;
|
|
end else
|
|
if tk="." then
|
|
begin
|
|
ctoken(tk,tp,pos);
|
|
fn := tk;
|
|
end else
|
|
if tk=";" then
|
|
begin
|
|
parserfunctionplus();
|
|
break;
|
|
end
|
|
ctoken(tk,tp,pos);
|
|
end
|
|
return fn;
|
|
end
|
|
function parserfunctionplus();
|
|
begin
|
|
ctoken(tk,tp,pos);
|
|
if ifnil(tk)then return;
|
|
if tk=";" then
|
|
begin
|
|
parserfunctionplus();
|
|
end else
|
|
if tk=":" then
|
|
begin
|
|
parsertype();
|
|
parserfunctionplus();
|
|
end else
|
|
if tk="begin" then
|
|
begin
|
|
return parserstatement();
|
|
end else
|
|
if tk="name" then
|
|
begin
|
|
ctoken(tk,tp,pos);
|
|
end else
|
|
if tk in array("virtual","cdecl","stdcall","external","override","overload")then
|
|
begin
|
|
ctoken(tk,tp,pos);
|
|
parserfunctionplus();
|
|
end else
|
|
begin
|
|
bpos();
|
|
end
|
|
end
|
|
|
|
function parserstatement();
|
|
begin
|
|
while true do
|
|
begin
|
|
ctoken(tk,tp,pos);
|
|
if ifnil(tk)then return;
|
|
if tk="end" and tp <> TT_STR then
|
|
begin
|
|
n := 0;
|
|
while true do
|
|
begin
|
|
n++;
|
|
ctoken(tk,tp,pos);
|
|
if ifnil(tk)then return;
|
|
if tk <> ";" then
|
|
begin
|
|
bpos(n);
|
|
return;
|
|
end else
|
|
begin
|
|
n--; //分号包括进来
|
|
end
|
|
end
|
|
return array(pos+3);
|
|
end else
|
|
if tp <> TT_STR and(tk in array("begin","select","sselect",
|
|
"mselct","vselect","try","case","update"))then
|
|
begin
|
|
parserstatement();
|
|
end
|
|
end
|
|
end
|
|
property Script read GetScript write SetScript;
|
|
property ScriptPath read FScriptPath write SetScriptPath;
|
|
property Tokens read FTokens;
|
|
property CurrentPos read FCurrentPos write FCurrentPos;
|
|
end
|
|
|
|
type tslparserbase= class //基础变量
|
|
{**
|
|
@explan(说明) tsl语言解析基类 %%
|
|
**}
|
|
static TT_IDE; //标示符
|
|
static TT_STR; //字符串
|
|
static TT_SYM; //分隔符
|
|
static TT_OK;
|
|
function create();
|
|
begin
|
|
if not TT_OK then
|
|
begin
|
|
TT_IDE := "标示符";
|
|
TT_STR := "字符串";
|
|
TT_SYM := "分割";
|
|
TT_OK := true;
|
|
end
|
|
end
|
|
function setdata(ret,nk,vs,tp,idx,hh) //解析
|
|
begin
|
|
{**
|
|
@explan(说明)保存数据
|
|
**}
|
|
if tp="空格" or tp="回车" or tp="换行" then return;
|
|
if tp in array("说明0","说明1","说明2","说明")then
|
|
begin
|
|
vs := "";
|
|
return;
|
|
end
|
|
if tp="语句" then //语句解析
|
|
begin
|
|
vs := lowercase(trim(vs));
|
|
end
|
|
//if vs in array("of","array") then tp := "关键字";
|
|
ret[nk,0]:= vs;
|
|
ret[nk,1]:= tp;
|
|
if ifnumber(idx)and tp="语句" then ret[nk,2]:= idx-length(vs);
|
|
else if ifnumber(idx)and tp <> "字符串" then ret[nk,2]:= idx;
|
|
case tp of
|
|
"语句":ret[nk,1]:= TT_IDE;
|
|
"字符串":ret[nk,1]:= TT_STR;
|
|
else ret[nk,1]:= TT_SYM;
|
|
end;
|
|
vs := "";
|
|
ret[nk,3]:= hh;
|
|
nk++;
|
|
end;
|
|
function findstringv2(str,fg,len,pos,hh);
|
|
begin
|
|
fgl := length(fg);
|
|
pfg := 0;
|
|
vs := "";
|
|
while pos<len do
|
|
begin
|
|
vi := str[pos];
|
|
if vi="\n" then
|
|
begin
|
|
hh++;
|
|
end
|
|
for i2 := 1 to fgl do
|
|
begin
|
|
vi := str[pos+i2];
|
|
if vi <> fg[i2]then break;
|
|
pfg := i2;
|
|
if pos=len then break;
|
|
end
|
|
if pfg=fgl then
|
|
begin
|
|
pos += fgl;
|
|
break;
|
|
end
|
|
vs += vi;
|
|
pos++;
|
|
end
|
|
return vs;
|
|
end
|
|
function findstringv(str,f,len,pos,zy,hh);
|
|
begin
|
|
{**
|
|
@explan(说明)查找以f结尾的字符串
|
|
**}
|
|
pos++;
|
|
vs := "";
|
|
if not(hh >= 0)then hh := 0;
|
|
while pos<len do
|
|
begin
|
|
vi := str[pos];
|
|
if vi="\n" then
|
|
begin
|
|
hh++;
|
|
//echo "\r\nfindh:",hh;
|
|
end
|
|
pos++;
|
|
if vi=f then break;
|
|
if zy and vi="\\" then
|
|
begin
|
|
if pos=len then break;
|
|
nvi := str[pos];
|
|
case nvi of
|
|
"r":vs += "\r";
|
|
"n":vs += "\n";
|
|
"t":vs += "\t";
|
|
"b":vs += "\b";
|
|
else vs += nvi;
|
|
end;
|
|
pos++;
|
|
continue;
|
|
end
|
|
vs += vi;
|
|
end
|
|
pos--;
|
|
return vs;
|
|
end;
|
|
end
|
|
type tsltoken = class(tslparserbase) //分词
|
|
{**
|
|
@explan(说明) tsl语言分词 %%
|
|
**}
|
|
private
|
|
FTSLstr;
|
|
FTokens;
|
|
function SetTslStr(v);
|
|
begin
|
|
if v <> FTSLstr then
|
|
begin
|
|
FTSLstr := v;
|
|
FTokens := nil;
|
|
end
|
|
end
|
|
public
|
|
function create();
|
|
begin
|
|
inherited;
|
|
end
|
|
function tokens();
|
|
begin
|
|
if FTokens then return FTokens;
|
|
if not ifstring(FTSLstr)then return array();
|
|
str := binary(FTSLstr);
|
|
pos :=-1;
|
|
len := length(str);
|
|
FTokens := array();
|
|
nk := 0;
|
|
vs := "";
|
|
hh := 0;
|
|
while true do
|
|
begin
|
|
pos++;
|
|
if pos >= len then break;
|
|
v := str[pos];
|
|
if v="%" then
|
|
begin
|
|
kk := 1;
|
|
v1 := str[pos+kk];
|
|
if v1="%" then
|
|
begin
|
|
pls := "%%";
|
|
while true do
|
|
begin
|
|
kk++;
|
|
if pos+kk >= len then break;
|
|
if str[pos+kk]in array(" ","\t","\r","\n")then
|
|
begin
|
|
if str[pos+kk]="\n" then hh++;
|
|
break;
|
|
end else
|
|
pls += str[pos+kk];
|
|
end
|
|
pos += kk;
|
|
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
|
vs := findstringv2(str,pls,len,pos,hh);
|
|
//vs := findstringv(str,pls,len,pos,nil,hh); //str,f,len,pos,zy,hh
|
|
setdata(FTokens,nk,vs,"字符串",pos,hh);
|
|
vf := 0;
|
|
continue;
|
|
end
|
|
end
|
|
if v='"' then
|
|
begin
|
|
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
|
vs := findstringv(str,'"',len,pos,1,hh);
|
|
setdata(FTokens,nk,vs,"字符串",pos,hh);
|
|
vf := 0;
|
|
end else
|
|
if v="'" then
|
|
begin
|
|
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
|
vs := findstringv(str,"'",len,pos,1,hh);
|
|
setdata(FTokens,nk,vs,"字符串",pos,hh);
|
|
vf := 0;
|
|
end else
|
|
if v='{' then
|
|
begin
|
|
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
|
vs := findstringv(str,'}',len,pos,nil,hh);
|
|
lvs := length(vs);
|
|
flvs := true;
|
|
if lvs>5 then
|
|
begin
|
|
if vs[1:2]="**" and(vs[3]in array(" ","\t","\r","\n"))and vs[lvs-1:lvs]="**" and(vs[lvs-2]in array(" ","\t","\r","\n"))then
|
|
begin
|
|
flvs := false;
|
|
vv := trim(vs[3:lvs-2]);
|
|
if vs[3]="\n" then hh++;
|
|
setdata(FTokens,nk,vv,"说明",pos,hh);
|
|
if vs[lvs-2]="\n" then hh++;
|
|
vs := "";
|
|
end
|
|
end
|
|
if flvs then setdata(FTokens,nk,vs,"说明0",pos,hh);
|
|
vf := 0;
|
|
end else
|
|
if v="#" then
|
|
begin
|
|
pos++;
|
|
vi := str[pos];
|
|
if vi="!" then
|
|
begin
|
|
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
|
vs := findstringv(str,'\n',len,pos,nil,hh);
|
|
setdata(FTokens,nk,vs,"说明2",pos,hh);
|
|
vf := 0;
|
|
end else
|
|
begin
|
|
pos--;
|
|
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
|
setdata(FTokens,nk,v,"分割",pos,hh);
|
|
vf := 0;
|
|
end
|
|
end else
|
|
if v="/" then
|
|
begin
|
|
pos++;
|
|
vi := str[pos];
|
|
if vi="/" then
|
|
begin
|
|
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
|
vs := findstringv(str,'\n',len,pos,nil,hh);
|
|
setdata(FTokens,nk,vs,"说明2",pos,hh);
|
|
vf := 0;
|
|
end else
|
|
begin
|
|
vs += v;
|
|
pos--;
|
|
end
|
|
end else
|
|
if v='(' then
|
|
begin
|
|
pos++;
|
|
vi := str[pos];
|
|
if vi="*" then
|
|
begin
|
|
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
|
pos++;
|
|
while pos <= len do
|
|
begin
|
|
vi := str[pos];
|
|
if vi="\n" then hh++;
|
|
if pos<len and vi="*" and str[pos+1]=")" then
|
|
begin
|
|
pos += 1;
|
|
break;
|
|
end else
|
|
vs += vi;
|
|
pos++;
|
|
end
|
|
//*******************************************************
|
|
lvs := length(vs);
|
|
flvs := true;
|
|
if lvs>3 then
|
|
begin
|
|
if vs[1]="*" and(vs[2]in array(" ","\t","\r","\n"))and vs[lvs]="*" and(vs[lvs-1]in array(" ","\t","\r","\n"))then
|
|
begin
|
|
flvs := false;
|
|
vv := trim(vs[2:lvs-1]);
|
|
if vs[2]="\n" then hh++;
|
|
setdata(FTokens,nk,vv,"说明",pos,hh);
|
|
if vs[lvs-1]="\n" then hh++;
|
|
vs := "";
|
|
end
|
|
end
|
|
if flvs then setdata(FTokens,nk,vs,"说明1",pos,hh);
|
|
//*********************************************************
|
|
vf := 0;
|
|
end else
|
|
begin
|
|
if length(vs)then setdata(FTokens,nk,vs,"语句",pos-1,hh);
|
|
setdata(FTokens,nk,v,"前括号",pos,hh);
|
|
pos--;
|
|
continue;
|
|
end
|
|
end else
|
|
if v=")" then
|
|
begin
|
|
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
|
setdata(FTokens,nk,v,"后括号",pos,hh);
|
|
end else
|
|
if v="\t" then
|
|
begin
|
|
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
|
if vf then continue;
|
|
vf := 1;
|
|
setdata(FTokens,nk,v,"空格",pos,hh);
|
|
end else
|
|
if v=" " then
|
|
begin
|
|
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
|
if vf then continue;
|
|
vf := 1;
|
|
setdata(FTokens,nk,v,"空格",pos,hh);
|
|
end else
|
|
if v='\n' then
|
|
begin
|
|
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
|
hh++;
|
|
if vf then continue;
|
|
vf := 1;
|
|
setdata(FTokens,nk,v,"换行",pos,hh);
|
|
end else
|
|
if v='\r' then
|
|
begin
|
|
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
|
if vf then continue;
|
|
vf := 1;
|
|
setdata(FTokens,nk,v,"回车",pos,hh);
|
|
end else
|
|
if v in array(",",";",".","]","[",":","=","!")then
|
|
begin
|
|
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
|
setdata(FTokens,nk,v,"分割",pos,hh);
|
|
end else
|
|
begin
|
|
vs += v;
|
|
end
|
|
end
|
|
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
|
return FTokens;
|
|
end
|
|
property tslstr read FTSLstr write SetTSLstr;
|
|
end
|
|
initialization
|
|
|
|
end. |