tslediter/funcext/tvclib/parserch.tsf

1028 lines
24 KiB
Plaintext

unit parserch ;
{**
@explan(说明)c头文件解析对外 接口 %%
**}
interface
function pcstruct(s,f);
function parserctokens(str);
function chtotslclass();
function dealcppcomment(strs);
function csstotslarray(csstr,tname);
function csstotslarray2(csstr,iv);
function csstotslarray3(ret,iv);
function cstructtotslclass(data,name,fs);
(*
//str := data();
//echo tostn(str22array(str)[:,3]);
//for := 0 to length(str) do
//return echo tostn(getgdihdata());
s := "
typedef struct _GdiplusStartupInput {
unsigned int GdiplusVersion;
unsigned int DebugEventCallback;
BOOL SuppressBackgroundThread;
BOOL SuppressExternalCodecs;
}GdiplusStartupInput;
";
return echo tostn(parsercstruct(parserctokens(s)));
rt := parsergdifunction(parserctokens(getgdihdata()));
echo tostn(rt);
*)
Implementation
function chtotslclass();
begin
parsergdifunction(parserctokens(getgdihdata()));
end
function pcstruct(s,f);
begin
{**
@explan(说明) 解析c结构体字符串到tsl结构化数据 %%
@param(s)(string) c结构体字符串 %%
@param(f)(bool) true 转换为小写 %%
@return(array) tag字段为名称
field 为字段信息
n : 名称
t : 类型 一个数组如果 array(unsigned,int)
l : 如果为数组 数组的长度
p : 如果为指针,指针的*个数
nick 别名
**}
return parsercstruct(parserctokens(f?lowercase(s):s));
end
function addtable(d,n);
begin
tbs := "";
for i := 1 to n do tbs += "\t";
r := "";
for i,v in str2array(d,"\r\n") do if v then r += tbs+v+"\r\n";
return r;
end
function cstructtotslclass(data,name,fz);
begin
{**
@explan(说明)将数组结构转换为对象 %%
**}
s := format("type %s = class(tslcstructureobj)\r\n",name);
s += "uses cstructurelib;\r\n";
s += "private\r\n\tstatic SSTRUCT;\r\n";
fs := "";
fp := "";
sf := "";
gsf := "";
intf := format("\tclass function getstruct()\r\n\tbegin\r\n\t\tif not SSTRUCT then SSTRUCT := MemoryAlignmentCalculate(\r\n%s\r\n\t\treturn SSTRUCT;\r\n\tend\r\n",addtable(tostn(data)+");",3));
if fz then cf2 := "public\r\nclass function memsize();\r\nbegin\r\n\tif not SSTRUCT then getstruct();\r\n\tif SSTRUCT then \r\n\tbegin\r\n\t\tldata := length(SSTRUCT)-1;\r\n\t\treturn SSTRUCT[ldata,3]+SSTRUCT[ldata,4]-SSTRUCT[0,3];\r\n\tend \r\n\treturn 0;\r\nend";
else cf2 := "";
cf := "\tpublic\r\n\tfunction create(ptr)\r\n\tbegin\r\n\t\tinherited create(getstruct(),ptr); \r\n\tend\r\n";
for i,v in data do
begin
v0 := v[0];
//fs += "\tF"+ v[0]+";\r\n";
fp += format('\tproperty %s index "%s" read _getvalue_ write _setvalue_;\r\n',v0,v0);
{sf += format("\tfunction Set%s(v)\r\n\tbegin\r\n",v0);
sf += format("\t\t_setvalue_('%s',v);\r\n",v0,v0,v0);
sf +="\tend\r\n";
gsf += format("\tfunction Get%s()\r\n\tbegin\r\n",v0);
gsf += format("\t\treturn _getvalue_('%s');\r\n",v0);
gsf +="\tend\r\n";}
end
s += gsf;
s += intf;
s += sf;
s += addtable(cf2,1);
s += cf;
s += fp;
s += "end";
return s;
end
//**********c结构体转换到tsl对象*********************************
function csstotslarray3(ret,iv);
begin
{**
@explan(说明)对c结构定义,初始值 %%
@param(ret)(array) 结构定义 %%
@param(iv)(array) 初始值 %%
@return(array) 结构定义
**}
r := array();
iv := array();
for i,v in ret do
begin
n := ret[i,0];
r[i]["n"]:= n;
r[i]["t"]:= ret[i,1];
iv[n]:= ret[i,2];
end
return r;
end
function csstotslarray2(csstr1,iv);
begin
{**
@explan(说明)将c的结构体字符串形式转换为tsl数组 %%
@param(csstr1)(string) c结构体字符串 %%
@param(iv)(array) 初始值 %%
@return(array) 结构定义
**}
(**
@example(转换cstruct结构到tslarray-2)
s := "
typedef struct _SYSTEMTIME {
WORD wYear;
WORD wMonth;
WORD wDayOfWeek;
WORD wDay;
WORD wHour;
WORD wMinute;
WORD wSecond;
WORD wMilliseconds;
} SYSTEMTIME, *PSYSTEMTIME;
";
return csstotslarray2(s);
**)
ret := csstotslarray(csstr1);
return csstotslarray3(ret,iv);
end
function csstotslarray(csstr1,tname);
begin
{**
@explan(说明)将c的结构体字符串形式转换为tsl数组 %%
@param(csstr1)(string) c结构体字符串 %%
@param(tname)(string) 名称,返回值 %%
@return(array) 结构定义%%
**}
(**
@example(转换cstruct结构到tslarray-1)
s := "
typedef struct tagWINDOWPOS {
HWND hwnd;
HWND hwndInsertAfter;
int x;
int y;
int cx;
int cy;
UINT flags;
} WINDOWPOS, *LPWINDOWPOS, *PWINDOWPOS;
";
return csstotslarray(s);
**)
typecp := array("int":"int",
"float":"float",
"uint":"int",
"lpstr":"char*",
"char":"char",
"char*":"char*",
"dword":"int",
"long":"int",
"byte":"byte",
"short":"short",
"word":"short", //byte[2]
"rect":"int[4]",
"size":"int[2]",
"point":"int[2]",
"double":"double",
"lpcstr":"char*",
"bool":"int",
"colorref":"int",
"nmhdr":"nmhdr",
"guid":"guid",
"cef_string_t":"cef_string_t"
);
//类型对应初始值表
typecv := array(
"float":0,
"int":0,
"char*":100,
"short":0,
"byte":0,
"int[4]":array(0,0,0,0),
"int[2]":array(0,0),
"byte[2]":array(0,0),
"double":0,
"intptr":0,
"nmhdr":array(
("hwndfrom","intptr",0),
("idfrom","intptr",0),
("code","int",0)),
"guid":(
("data1","int",0),
("data2","short",0),
("data3","short",0),
("data4","char[8]","")
)
);
//返回值
r := pcstruct(csstr1,1);
tslarray := array();
j := 0;
if ifarray(r)then tname := r["tname"];
for i,v in r["field"] do
begin
tps := v["t"];
tp := tps[length(tps)-1];
if v["p"]then
begin
if tp="char" and v["p"]=1 then tp := "char*";
end
ctyp := typecp[tp]?: "intptr"; //设置默认类型为指针
len := v["l"];
if len then ctyp := ctyp+format("[%s]",len); //设置数组初始值
tslarray[j++]:= array(v["n"],typetouser(ctyp),typecv[ctyp]?: 0); //构造数据
end
return tslarray;
(*
csstr := dealcppcomment(csstr1);
s := pos("{",csstr)+1;
e := pos("}",csstr);
//删除注释
str := copy(lowercase(csstr),s,e-s); //获取大括号之间的数据
str :=replacestr(str,"\r"," "); //替换掉换行
str :=replacestr(str,"\n"," "); //替换掉换行
str :=replacestr(str,"\t"," "); //替换掉分隔符
strs := str2array(str,";"); //按照;分割行
//类型对照表
tslarray := array();
j := 0;
//正则表达式表
//ctrl := "\\w+[*]?";
for i ,v in strs do
begin
parserctypestr(v,tp,len,name);
if not(name and tp) then continue;
ctyp := typecp[tp]?:"intptr"; //设置默认类型为指针
if len then ctyp := ctyp + format("[%d]",len); //设置数组初始值
tslarray[j++] := array(name,ctyp,typecv[ctyp]?:0); //构造数据
end
return tslarray; *)
end
{
function writeloglen(len);
begin
lf := "d:/ts/malocsize.txt";
if FileExists("",lf) then
begin
pos1 := FileSize('',lf);
end
else
begin
pos1 := 0;
end
a := format("分配空间大小%d",len);
writefile(rwraw(),'',lf,pos1,length(a),a);
end }
function typetouser(tp);
begin
if tp in array("nmhdr","guid")then
begin
return "user";
end
return tp;
end
//*************删除c注释*****************
function dealcppcomment(strs)
begin
{**
@explan(说明)删除c语言注释 %%
@param(strs)(string) c结构体字符串 %%
@return(string)
**}
rets := "";
len := length(strs);
i := 1;
while i<len do
begin
ps := strs[i:i+1];
if ps="//" then
begin
i += 2;
while(true) do
begin
if strs[i]="\n" then
begin
break;
end
i++;
end
end else
if(ps="/*")then
begin
i += 2;
while true do
begin
if strs[i:i+1]="*/" then
begin
i += 2;
break;
end
i++;
end
end
if i<len then rets += strs[i++];
end
return rets;
end
function parsercstruct(tokens,indx);
begin
{**
@explan(说明)结构体解析 %%
**}
//名称
//别名,可能多个
//内容
len := length(tokens);
indx := indx ?: 0;
ret := array();
while indx<len do
begin
indx++;
v := tokens[indx,0];
if v="struct" then
begin
//indx++;
//ret["tag"] := tokens[indx,0];
ret["tag"]:= v;
end else
if v="{" then
begin
ret["field"]:= getstruct(tokens,indx,len);
ret["nick"]:= getstructnickename(tokens,indx,len);
return ret;
end else
if not(v in array(" ","\r","\n","\t"))then
begin
ret["tname"]:= v;
end
end
end
function getstructnickename(tokens,indx,len);
begin
{**
@explan(说明) 获取typedef 别名
**}
ret := array();
lret := 0;
while indx<len do
begin
indx++;
tkv := tokens[i,0];
if tkv=";" then
begin
return ret;
end else
if tkv="*" then
begin
end else
if tkv="," then
begin
end else
begin
ret[lret++]:= tkv;
end
end
return nil;
end
function getstruct(tokens,indx,len);
begin
{**
@explan(说明)获取struct字段定义
**}
ret := array();
//类型
//名称
//指针
//数组长度
lx := array();
lxlx := "";
mc := "";
ct := 0;
cd := "";
zz := 0;
while indx<len do
begin
indx++;
if tokens[indx,2]="//" or tokens[indx,2]="/*" then continue;
tkv := tokens[indx,0];
if tkv="}" then
begin
return ret;
end else
if tkv=";" then
begin
if not(mc)then mc := lxlx;
ret[ct++]:= array("n":mc,"t":lx,"l":cd,"p":zz);
lxlx := "";
mc := "";
cd := "";
zz := 0;
lx := array();
end else
if tkv="*" then
begin
zz++;
end else
if tkv="[" then
begin
while indx<len do
begin
indx++;
if tokens[indx,2]="//" or tokens[indx,2]="/*" then continue;
tkvi := tokens[indx,0];
if tkvi="]" then
begin
break;
end else
begin
cd += tkvi;
end
end
end else
begin
if lxlx then lx[length(lx)]:= lxlx;
lxlx := tkv;
end
end
end
function getgdihdata(rpth);
begin
{**
@explan(说明) 获取c头文件数据
**}
rpth := "E:\\360yun\\tinysoft\\tslAPI\\gdiplus\\gdiplusflat.h";
sz := filesize("",rpth);
if readFile(rwRaw(),"",rpth,0,sz,rdd)then return rdd;
return " ";
end
function str22array(str);
begin
{**
@ignore 忽略
**}
kg := array("\r","\t"," ");
hh := "\n";
kghh := kg union array(hh);
ret := array();
c := 0;
r := 0;
vs := "";
lret := 0;
stt := 0;
for i := 1 to length(str) do
begin
vi := str[i];
ifkg := vi in kg;
if(ifkg)and vs then
begin
ret[lret++]:= array(r,c,vs);
vs := "";
c++;
continue;
end else
if(vi=hh)then
begin
if vs then
begin
ret[lret++]:= array(r,c,vs);
vs := "";
end
if lret then r++;
c := 0;
end else
if not(vi in kghh)then
begin
vs += vi;
end
end
if vs then ret[lret++]:= array(r,c,vs);
//return ret;
rt := array();
for i,v in ret do
begin
rt[v[0],v[1]]:= v[2];
end
return rt;
end
function bdstring(str,len,f,fl,pos);
begin
{**
@explan(说明)字符串匹配查找
**}
bud := true;
for i := 1 to fl do
begin
vpos := pos+i-1;
if vpos>len then return 0;
if str[vpos]<> f[i]then
begin
bud := false;
break;
end
end
if bud then
begin
pos +=(fl-1);
end
return bud;
end
function findstringv(str,f,len,pos,zy,hl);
begin
{**
@explan(说明)查找以f结尾的字符串
**}
vs := "";
fl := length(f);
while pos<len do
begin
pos++;
vi := str[pos];
if vi=hl then continue;
if bdstring(str,len,f,fl,pos)then break;
if zy=vi then
begin
vs += str[pos];
pos++;
continue;
end
vs += vi;
end
return vs;
end;
function setvalue(dt,vs,indx,tp);
begin
{**
@explan(说明)保存token
**}
if vs then dt[length(dt)]:= array(vs,indx,tp);
vs := "";
end
function parserctokens(gdis);
begin
{**
@explan(说明)c分词 %%
**}
len := length(gdis);
indx := 0;
kg := array("\n","\t"," ");
vs := "";
ret := array();
while indx<len do
begin
indx++;
vi := gdis[indx];
if vi="\r" then continue;
if vi="\\" then
begin
setvalue(ret,vs,indx,"token");
vip := gdis[indx+1];
if vip="\r" then
begin
vip := gdis[indx+2];
if vip="\n" then
begin
setvalue(ret,"\\\r\n",indx,"link");
indx += 2;
end
end else
if vip="\n" then
begin
setvalue(ret,"\\\n",indx,"link");
indx += 1;
end
end else
if vi=">" then
begin
setvalue(ret,vs,indx,"token");
vip := gdis[indx+1];
if vip="=" then
begin
indx++;
setvalue(ret,">=",indx,"sym");
end else
setvalue(ret,">",indx,"sym");
end else
if vi="<" then
begin
setvalue(ret,vs,indx,"token");
vip := gdis[indx+1];
if vip="=" then
begin
indx++;
setvalue(ret,"<=",indx,"sym");
end else
setvalue(ret,"<",indx,"sym");
end else
if vi="=" then
begin
setvalue(ret,vs,indx,"token");
vip := gdis[indx+1];
if vip="=" then
begin
indx++;
setvalue(ret,"==",indx,"sym");
end else
setvalue(ret,"=",indx,"sym");
end else
if vi="[" then
begin
setvalue(ret,vs,indx,"token");
setvalue(ret,"[",indx,"sym");
end else
if vi="]" then
begin
setvalue(ret,vs,indx,"token");
setvalue(ret,"]",indx,"sym");
end else
if vi="&" then
begin
setvalue(ret,vs,indx,"token");
setvalue(ret,"&",indx,"sym");
end else
if vi="*" then
begin
setvalue(ret,vs,indx,"token");
setvalue(ret,"*",indx,"*");
end else
if vi="," then
begin
setvalue(ret,vs,indx,"token");
setvalue(ret,",",indx,",");
end else
if vi=";" then
begin
setvalue(ret,vs,indx,"token");
setvalue(ret,";",indx,";");
end else
if vi="(" then
begin
setvalue(ret,vs,indx,"token");
setvalue(ret,"(",indx,"(");
end else
if vi=")" then
begin
setvalue(ret,vs,indx,"token");
setvalue(ret,")",indx,")");
end else
if vi="{" then
begin
setvalue(ret,vs,indx,"token");
setvalue(ret,"{",indx,"sym");
end else
if vi="}" then
begin
setvalue(ret,vs,indx,"token");
setvalue(ret,"}",indx,"sym");
end else
if vi="|" then
begin
setvalue(ret,vs,indx,"token");
setvalue(ret,vi,indx,"sym");
end else
if vi="?" then
begin
setvalue(ret,vs,indx,"token");
setvalue(ret,vi,indx,"sym");
end else
if vi=":" then
begin
setvalue(ret,vs,indx,"token");
setvalue(ret,vi,indx,"sym");
end else
if vi="'" then
begin
setvalue(ret,vs,indx,"token");
vs := findstringv(gdis,"'",len,indx,"\\");
setvalue(ret,vs,indx,"'");
end else
if vi='"' then
begin
setvalue(ret,vs,indx,"token");
vs := findstringv(gdis,'"',len,indx,'\\');
setvalue(ret,vs,indx,'"');
end else
if vi="/" then
begin
setvalue(ret,vs,indx,"token");
vip := gdis[indx+1];
if vip="/" then
begin
indx += 1;
vs := findstringv(gdis,"\n",len,indx,nil,"\r");
setvalue(ret,vs,indx,"//");
end else
if vip="*" then
begin
indx += 1;
vs := findstringv(gdis,"*/",len,indx,nil);
setvalue(ret,vs,indx,"/*");
end else
begin
setvalue(ret,"/",indx,"/");
end
end else
if vi in kg then
begin
setvalue(ret,vs,indx,"token");
end else
if vi="\n" then
begin
setvalue(ret,vs,indx,"token");
setvalue(ret,"\n",indx,"\n");
end else
vs += vi;
end
setvalue(ret,vs,indx,"token");
return ret;
//writetofile("",ret);
//parsergdifunction(ret);
end
function nexttoken(tokens,indx,f);
begin
if not(f)then indx++;
return tokens[indx];
end
function backtoken(tokens,indx,f);
begin
if not(f)then indx--;
return tokens[indx];
end
function parsergdifunction(tokens);
begin
{**
@explan(说明) 提取头文件函数
**}
len := length(tokens)-1;
indx :=-1;
isyms := array("GDIPCONST","_In_","_Out_");
ret := array();
retl := 0;
hst := array();
s := "type TGdiplusflat=class\r\n";
s += "{**
@explan(说明)gdi+ 的c接口函数 %%
**}\r\n";
zs := "";
while indx<len do
begin
indx++;
tokent := tokens[indx,2];
tokenv := tokens[indx,0];
if tokenv in isyms then continue;
if tokent="/*" then
begin
//echo tostn(tokens[indx]);
zs += "(* "+tokenv+" *)\r\n";
end else
if tokent="//" then
begin
zs += "//"+tokenv+"\r\n";
end else
if tokenv="(" then
begin
cs := parenthesis(tokens,indx,len,1,isyms);
s += zs;
s += "\tclass ";
s += createhs(hst,cs)+"\r\n";
hst := array();
zs := "";
end else
begin
hst[length(hst)]:= tokens[indx];
end
end
s += "\r\nend ";
writetofile2(pp,s);
end
function createhs(hd,bd);
begin
{**
@explan(说明)构造函数声明
**}
//echo tostn(bd);
lex := array("INT":"integer",
"REAL":"single",
"float":"single",
"INT64":"int64",
"double":"double",
"int":"integer",
"UINT":"integer",
"void":1,
"VOID":1,
"ARGB":"integer",
"GpStatus":"integer",
"GpWrapMode":"integer",
"TextRenderingHint":"integer",
"SmoothingMode":"integer",
"GpFillMode":"integer",
"COLORREF":"integer",
"COLOR16":"short",
"WCHAR":"string",
);
ret := "Function ";
havlx := true;
ct := "stdcall";
tp := nil;
for i := 0 to length(hd)-1 do
begin
hdi0 := hd[i,0];
vi := hd[i,0];
lx := lex[vi];
if vi=";" then
begin
continue;
end
if vi="*" then
begin
tp := "pointer";
end else
if hdi0="WINGDIPAPI" then
begin
ct := "stdcall"; //
break;
end else
if hdi0="WINAPI" then
begin
ct := "stdcall";
break;
end else
if havlx and ifstring(lx)then
begin
havlx := false;
tp := lx;
end else
if havlx and lx=1 then
begin
havlx := false;
tp := 1;
end else
if havlx then
begin
havlx := false;
tp := "pointer";
end
end
fn := hd[length(hd)-1,0];
if tp=1 then
begin
ret := "procedure ";
tp := "";
end else
tp := ":"+tp;
fn := fn ?: "";
ret +=(fn ?: "")+"(";
ps := "";
dpn := "pn";
havlx := true;
ddpoint := 0;
for i := 0 to length(bd)-1 do
begin
vi := bd[i,0];
tvi := bd[i,2];
if vi="," then
begin
if not(pn)then pn := dpn+inttostr(i);
ps +=((ddpoint>1)?"var ":"")+gzhparam(pn);
ps += ":"+plx;
pn := 0;
ps += ";";
plx := 0;
havlx := true;
ddpoint := 0;
end else
if plx and(tvi="token")then
begin
pn := vi;
end else
if vi="*" then
begin
ddpoint++;
if plx in array("integer","single","hbitmap")then
begin
ddpoint++;
end else
if plx="string" then
begin
end else
plx := "pointer";
end else
if havlx and lex[vi]then
begin
havlx := false;
plx := lex[vi];
end else
if havlx then
begin
havlx := false;
plx := "pointer";
end else
if vi="[" {or vi = "]"}or vi="&" then
begin
plx := "pointer";
end
end
if plx then
begin
if not(pn)then pn := dpn+inttostr(i);
ps +=((ddpoint>1)?"var ":"")+gzhparam(pn)+":"+plx;
end
ret += ps;
//echo tostn(array(tp,ct,fn));
ret += format(')%s;%s;external "gdiplus.dll" name "%s";',tp,ct,fn);
//echo tostn(ret),"\r\n";
return ret;
end
function gzhparam(p);
begin
{**
@explan(说明) 特殊参数名替换
**}
if p="order" then return "order_";
else if p="unit" then return "unit_";
else if p="on" then return "on_";
return p;
end
function parenthesis(tokens,pos,len,iffunc,isyms);
begin
{**
@explan(说明) 函数参数解析
**}
ret := array();
retl := 0;
tkv := "";
while pos<len do
begin
pos++;
tk := tokens[pos];
tkt := tk[2];
if tk[0]in isyms then continue;
if tkt=")" then
begin
//跳出
//pos++;
return ret;
end else
begin
if iffunc and tkt="(" then
begin
if ret[retl-1][2]="token" then
begin
retl--;
reindex(ret,array(retl:nil));
end
parenthesis(tokens,pos,len,0,isyms);
end else
if iffunc then
begin
ret[retl++]:= tk;
end
tkv := tk[0];
end
end
end
function writetofile(pp,dt);
begin
{**
@explan(说明)保存分词结果到文件
**}
pp := "E:\\360yun\\tinysoft\\tslAPI\\gdiplus\\gdiplusflat.txt";
s := tostn(dt);
if FileExists("",pp)then
begin
filedelete("",pp);
end
writefile(rwRaw(),"",pp,0,length(s),s);
end
function writetofile2(pp,s);
begin
{**
@explan(说明)保存gdi函数到文件
**}
pp := "E:\\GitHub\\tsluilib\\tsluifunc\\TGdiplusflat.tsf";
if FileExists("",pp)then
begin
filedelete("",pp);
end
writefile(rwRaw(),"",pp,0,length(s),s);
end
function gdiplusfname();
begin
{**
explan(说明)读取gdi函数名
**}
rpth := "E:\\360yun\\tinysoft\\tslAPI\\gdiplus\\gdiplus.def";
sz := filesize("",rpth);
if readFile(rwRaw(),"",rpth,0,sz,rdd)then
begin
str22array(rdd);
end
return " ";
end
end.