Unit cstructurelib;
{**
	@explan(说明)内存对象工具 %%
	@example(范例1)
	
	
**}

(*
	概览:
	天软科技
	20171215 添加注释 
	20170904 修改,提供  
		ctypedefine 函数(定义结构体)
		tcstruct 类(定义结构体)
		tcpointer 类(结构体内存管理)
		
	c语言内存结构相关功能库
	1.实现c结构体和tsl的交互
	
	提供方法
	csstotslarray2(data) 将c的结构体字符串形式 转换为tsl array 结构;由于宏定义的原因需要手工修改一下,但是也提高了转换效率
			例1:
			data := "
			typedef struct tagNMTBHOTITEM {
			  double hdr;
			  int   idOld;
			  int   idNew;
			  DWORD dwFlags;
			} NMTBHOTITEM, *LPNMTBHOTITEM;
			";
		r := csstotslarray2(data);
		typ1 := ctypedefine("tagNMTBHOTITEM",r);
		return typ1.show;//打印结构体排布情况

	使用范例:
	c中定义:
	struct ts3 {
		char a[3];
		double b;
	};
	struct ts2 {
		char a[5];
		int b[3];
		ts3 e;
		ts3* c;
	};
	struct ts1 {
		char a[3];
		ts2 m1;


	};
	
			
*)

Interface
uses parserch;
//c结构体转换为tsl对象结构由于识别有限结果需要手工修改**************************
//function writeloglen(len);
function MemoryAlignmentCalculate(data,baselen,ssize,pack);
function ReadStringFromPtr(ptr);
function WriteStringToPtr(ptr,str);
function ReadBytesFromPtr(ptr,L);
function WriteBytesToPtr(ptr,bytes);
function parserctypestr(ts,t,s,n);
function dealcppcomment(strs);
function csstotslarray(csstr,tname);
function csstotslarray2(csstr,iv);
function csstotslarray3(ret,iv);
function cstructtotslclass(data,name,fs);
function tslarraytocstructcalc(data,alim,bsi,ssize);//计算对其长度 参数 data 结构体,alim 对其 默认为8;bsi 基础地址默认为0,ssize 结构体大小 返回值
function ctypedefine(name,stc,alim,f);//结构体定义	
	//内存对象分配,释放类;
type tmemoryclass=class
    {**
    @explan(说明)存对象分配,释放类 %%
    @param(_blocks)(array) 分配的内存块;以地址为索引的数组,值为分配的大小 %%
    @param(_tool)(aefclassobj_) 内存管理底层工具 %%
    **}
    protected 
    _blocks; //分配的内存块;以地址为索引的数组,值为分配的大小;
    static _tool;
    public
    class function GetPointerSize();
    begin
        {**
        @explan(说明) 获得指针字节数 %%
        **}
        {$IFDEF win64}
        return 8;
        {$ELSE}
        return 4;
        {$ENDIF}
    end
    function opblocks(p,f,v); //内存存储操作
    begin
        {**
        @explan(说明)内存存储操作 %%
        @param(p)(integer) 内存指针 %%
        @param(f)(integer) 操作码  0 获取 1 设置 2 删除 %%
        **}
        ps := inttostr(p);
        if f=0 then //获取
        begin
            return _blocks[ps];
        end else
        if f=1 then //设置
        begin
            r := _blocks[ps];
            _blocks[ps]:= v;
            return r;
        end else
        if f=2 then //删除
        begin
            return reindex(_blocks,array(ps:nil));
        end
    end
    function tmalloc(n,f); //分配
    begin
        {**
        @explan(说明)内存分配 %%
        @param(n4)(integer) 长度 %%
        @param(f)(integer) 操作码  0 获取 1 设置 2 删除 %%
        **}
        if n>0 then
        begin
            p := _tool.tmalloc(n);
            if p <> 0 then
            begin
                if f=1 then _tool.tmset(p,n);
                opblocks(p,1,n);
            end
        end
        return p;
    end
    function tfree(p); //析构
    begin
        {**
        @explan(说明)释放内存 %%
        @param(p)(integer) 指针 %%
        **}
        pt := opblocks(p,0);
        if pt then
        begin
            _tool.tfree(p);
            opblocks(p,2);
        end
        return pt;
    end
    function trealloc(p,n,f); //重分配
    begin
        {**
        @explan(说明)重分配 %%
        @param(p)(integer) 指针 %%
        @param(n)(integer) 大小 %%
        @param(f)(integer) 操作码  0 获取 1 设置 2 删除 %%
        **}
        pt := opblocks(p,0);
        if pt and n>0 then
        begin
            //writeloglen(n);
            ptt := _tool.trealloc(p,n);
            if ppt <> pt then
            begin
                opblocks(p,2);
                if ptt <> 0 then
                begin
                    if f=1 then _tool.tmset(ptt,n);
                    opblocks(ptt,1,n);
                end
            end
        end
        return ptt;
    end
    class function mtool(); //获得内存管理工具
    begin
        {**
        @explan(说明)获取底层操作工具 %%
        @return (aefclassobj_)内存底层管理工具 
        **}
        if not ifobj(_tool)then _tool := new aefclassobj_();
        return _tool;
    end
    function create();
    begin
        _blocks := array();
        mtool();
    end
    function destroy();virtual;
    begin
        for i,v in _blocks do //析构分配的字符串空间
        begin
            if ifstring(i)and ifnumber(v)then
            begin
                _tool.tfree(strtoint(i));
                //echo "\r\n析构:",i;
            end
        end
        _blocks := array();
    end
end

	//旧的内存管理类,不支持**类型
type ctslctrans = class(tmemoryclass)
		(**
			@example(范例--内存管理--1)
			sa := array(("f","int",2),
						("a","char[3]","cd"),
						("b","user",(("c","char[5]","ab"),
									 ("d","int",5))),
						("c","user*",(("c","char[5]","ab"),
						              ("d","int",5),
									  ("e","char*","abcd")))
						
						);
			data := tslarraytocstructcalc(sa);	
			o := new ctslctrans(data); 
			return echo o._size_(),"****", 
			            o._getvalue_("c")._size_(),"***",
						o._getvalue_("b")._size_,"***",o._getvalue_("c")._getvalue_("e");
		**)
    private
    Fstrcdata;
    _nomalloc;
    //protected
    //_blocks ;//分配的内存块;以地址为索引的数组,值为分配的大小;
    _ptr;//对象地址
    _objs;//子对象
    _objstart;//起始位置
    _objsize;//字节长度
    _objst;//类型
    _objss;//长度
    _charexten;//字符串扩展
    _size;//大小
    function setcharext(v); //设置字符串*是否可以扩展
    begin
        _charexten := v;
    end
    function _setvalue_base(i,v); //根据索引 设置值,目前值不能设置基础值
    begin
        {**
        @explan(说明)根据索引 设置值,目前只能设置基础值 %%
        @param(i)()索引 %%
        @param(v)()值 %%
        **}
        p := _objs[i];
        l := _objss[i];
        ret :=-1;
        //echo tostn(array(_objst[i],i,v)),",";
        case _objst[i]of
            "char":
            begin
                if ifstring(v)and length(v)<= l then
                begin
                    _tool.writestr(p,v);
                    ret := 1;
                end
            end
            "uint":
            begin
                if ifnumber(v)then
                begin
                    _tool.writeuint(p,v);
                    ret := 1;
                end
            end
            "int":
            begin
                if ifnumber(v)then
                begin
                    _tool.writeint(p,v);
                    ret := 1;
                end
            end
            "intptr":
            begin
                if ifnumber(v)then
                begin
                    //echo "wirtptr\r\n";
                    _tool.writeptr(p,v);
                    ret := 1;
                end
                ret := 1;
            end
            "double":
            begin
                if ifnumber(v)then
                begin
                    _tool.writedouble(p,v);
                    ret := 1;
                end
            end
            "float":
            begin
                if ifnumber(v)then
                begin
                    _tool.writefloat(p,v);
                    ret := 1;
                end
            end
            "char*":
            begin
                if ifstring(v)and length(v)<= l then
                begin
                    //echo tostn(array("char*",i,l,v)),",";
                    p1 := _tool.readptr(p);
                    _tool.writestr(p1,v);
                    //echo tostn(array(p,p1, _tool.readstr(p1)));
                    ret := 1;
                end else
                if ifstring(v)and _charexten then
                begin
                    p1 := pointmalloc(i,v);
                    _tool.writestr(p1,v);
                    ret := 1;
                end
            end
            "byte":
            begin
                if ifnumber(v)then
                begin
                    _tool.writebyte(p,v);
                    ret := 1;
                end
            end
            "short":
            begin
                if ifnumber(v)then
                begin
                    _tool.writeshort(p,v);
                    ret := 1;
                end
            end
            "shortarray":
            begin
                if arraynumberchek(v)and length(v)<= l then
                begin
                    _tool.writeshorts(p,length(v),v);
                    ret := true;
                end
            end
            "bytearray":
            begin
                if arraynumberchek(v)and length(v)<= l then
                begin
                    //echo tostn(array("bytearray",i,l,v)),",";
                    _tool.writebytes(p,length(v),v);
                    ret := true;
                end
            end
            "intarray":
            begin
                if arraynumberchek(v)and length(v)<= l then
                begin
                    _tool.writeints(p,length(v),v);
                    ret := true;
                end
            end
            "uintarray":
            begin
                if arraynumberchek(v)and length(v)<= l then
                begin
                    _tool.writeuints(p,length(v),v);
                    ret := true;
                end
            end
            "doublearray":
            begin
                if arraynumberchek(v)and length(v)<= l then
                begin
                    _tool.writedoubles(p,length(v),v);
                    ret := true;
                end
            end
            //else echo "\r\n error: type:",_objst[i];
        end;
        return ret;
    end
    function pointmalloc(v0,v2); //指针内存处理
    begin
        {**
        @explan(说明)指针内存处理 %%
        @param(v0)() 索引%%
        @param(v2)() 数据%%
        **}
        ps := _objs[v0];
        op := _tool.readptr(ps);
        if ifstring(v2)then
        begin
            len := length(v2)+1;
        end else
        if ifnumber(v2)then
        begin
            len := v2;
        end else
        if ifarray(v2)then
        begin
            len := length(v2);
        end
        if opblocks(op,0)then
        begin
            //writeloglen(len);
            p := trealloc(op,len); //重分配
        end else
        begin
            p := tmalloc(len); //分配
        end
        if p=0 then raise "内存分配失败";
        if ifstring(v)then _objss[v0]:= len-1; //长度
        else _objss[v0]:= len;
        _objsize[v0]:= len;
        _tool.tmset(p,len); //初始化
        _tool.writeptr(ps,p);
        return p;
    end
    function modyv(data,b); //修正子对象的相对位置
    begin
        r := data;        
        for i,v in data do 
        begin
            nb := r[i][3]-b;
            if v[5]="user" then 
            begin
                r[i][2] := modyv(v[2],nb);
            end 
            r[i][3] := nb;
        end 
        return r;
    end 
    {**
    @explan(说明)旧的内存管理类,不支持**类型 %%
    @param(_ptr)(integer) 对象地址 %%
    @param(_objs)(array) 子对象 %%
    @param(_objstart)(integer) 开始位置 %%
    @param(_objsize)(integer) 字节长度 %%
    @param(_objst)(string) 类型 %%
    @param(_objss)(integer) 类型长度%%
    @param(_charexten)(bool) 字符串扩展 %%
    @param(_size)(integer) 大小 %%
    **}
    public
    function operator[1](index,v);
    begin
        {**
        @explan(说明) 设置成员 %%
        @param(index)(tslobj) 下标 %%
        @param(v)(tslobj) 值
        **}
        return _setvalue_(index,v);
    end
    function operator[](index);
    begin
        {**
        @explan(说明) 获取成员 %%
        @param(index)(tslobj) 下标 %%
        @return(tslobj) 返回值 %%
        **}
        return _getvalue_(index);
    end
   
    function create(data,ptr,ifset); //构造
    begin
        {**
        @explan(说明)构造 %%
        @param(data)(array) 计算好的内存分布%%
        @param(ptr)(integer) 内存指针%%
        @param(ifset)(integer) 递归构造时使用%%
        **}
        class(tmemoryclass).create();
        _ptr := 0;
        if not(ifarray(data)and mcols(data)>3)then
        begin
            raise "内存管理对象构造错误!";
            return;
        end
        _objsize := _objstart := _blocks := _objss := _objst := _objs := array();
        ldata := length(data)-1;
        _size := data[ldata,3]+data[ldata,4]-data[0,3];
        Fstrcdata := data;
        if ifnumber(ptr)and ptr then
        begin
            _ptr := ptr;
            _nomalloc := true;
            for i,v in data do
            begin
                v0 := v[0]; //id
                v1 := v[5]; //type
                _objst[v0]:= v1;
                _objss[v0]:= v[6];
                v3 := integer(v[3]);
                _objstart[v0]:= v3;//v[3]; //开始位置
                _objsize[v0]:= v[4]; //字节长度
                
                v2 := v[2];
                //_iindex[i] := v0;
                if v1="user*" then
                begin
                    if ifset then
                    begin
                        no := new ctslctrans(v2,nil,nil);
                        _objs[v0]:= no;
                        _tool.writeptr(ptr+v3,no._getptr_); //修改原有的值
                    end else
                    begin
                        tptr := _tool.readptr(ptr+v3); //提取原有的值
                        _objs[v0]:= new ctslctrans(v2,tptr,nil);
                    end
                end else
                if v1="userarray" then
                begin
                    _objs[v0]:= new ctslctrans(modyv(v2,v3),ptr+v3,ifset);//+v3
                end else
                    _objs[v0]:= ptr+v3;
                if ifset then
                begin
                    if v1="char*" then
                    begin
                        pointmalloc(v0,v2);
                    end
                    _setvalue_base(v0,v2);
                end
            end
        end else
        begin            
            _ptr := tmalloc(_size,1);
            //_tool.tmset(_ptr,size);
            for i,v in data do
            begin
                v0 := v[0];
                v1 := v[5];
                _objst[v0]:= v1;
                _objss[v0]:= v[6];
                v3 := integer(v[3]);
                _objstart[v0]:= v3;//v[3]; //开始位置
                _objsize[v0]:= v[4]; //字节长度
                v2 := v[2];
                
                _objs[v0]:= _ptr+v3;
                if v1="user*" then
                begin
                    no := new ctslctrans(v2,nil,nil);
                    _objs[v0]:= no;
                    _tool.writeptr(_ptr+v3,no._ptr);
                end else
                if v1="userarray" then
                begin
                    no := new ctslctrans(modyv(v2,v3),_ptr+v3,true);//+v3;
                    _objs[v0]:= no;
                end else
                if v1="char*" then
                begin
                    pointmalloc(v0,v2); //内存分配
                end
                _setvalue_base(v0,v2);
            end
        end
        //echo "\r\n内存管理:" ,_ptr,tostn(data);
    end
    function _getptr2_();
    begin
        {**
        @explan(说明)获得内存指针 %%
    			
        **}
        x := 0;
        for i,v in _objstart do
        begin
            x := v;
            break;
        end
        return _getptr_()+x;
    end
    function _getptr_(); //获得地址
    begin
        {**
        @explan(说明)获得内存指针 %%
    			
        **}
        return _ptr;
    end
    function _setcptr_(ptr); //设置对象地址
    begin
        {**
        @explan(说明)设置对象地址 %%
        **}
        if ifnumber(ptr) and ptr<>_ptr and ptr and _nomalloc then 
        begin
            _ptr := ptr;
            for i,v in _objst do 
            begin
                v3 := _objstart[i];
                if v="user*" then 
                begin
                    tptr := _tool.readptr(ptr+v3);
                    o := _objs[i];
                    o._setcptr_(tptr);
                end else 
                if v1="userarray" then
                begin
                    tptr := ptr+v3;
                    o := _objs[i];
                    o._setcptr_(tptr);
                end else 
                begin
                    _objs[v0]:= ptr+v3;    
                end             
            end 
        end         
    end
    function _size_(); //获得对象占用空间大小
    begin
        {**
        @explan(说明)获得内存大小 %%
        **}
        return _size;
    end
    function _setvalue_(i,v);virtual;
    begin
        _setvalue_base(i,v);
    end
    function arraynumberchek(v); //数字数组检查
    begin
        {**
        @explan(说明)数字数组检查 %%
        @param(v)(array) %%
        **}
        ok := 0;
        if ifarray(v)and length(v)>0 then
        begin
            ok := true;
            for i,vi in v do if not ifnumber(vi)then
            begin
                ok := false;
                break;
            end
        end
        return ok;
    end
    function _getvalue_(v);virtual; //根据索引v获得对应值
    begin
        {**
        @explan(说明)根据索引v获得对应值 %%
        @param(v)() 索引%%
        **}
        p := _objs[v];
        //echo tostn(_objs);
        l := _objss[v];
        case _objst[v]of
            "char":
            begin
                ret := _tool.readstr(p);
            end
            "int":
            begin
                ret := _tool.readint(p);
            end
            "intptr":
            begin
                ret := _tool.readptr(p);
            end
            "double":
            begin
                ret := _tool.readdouble(p);
            end
            "float":
            begin
                //echo "get:",p,"\r\n";
                ret := _tool.readfloat(p);
            end
            "char*":
            begin
                p1 := _tool.readptr(p);
                //echo "\r\nstr:",p,"***",p1;
                ret := _tool.readstr(p1);
                //echo "\r\n",(ret);
            end
            "byte":
            begin
                ret := _tool.readbyte(p);
            end
            "short":
            begin
                ret := _tool.readshort(p);
            end
            "shortarray":
            begin
                ret := _tool.readshorts(p,l);
            end
            "bytearray":
            begin
                ret := _tool.readbytes(p,l);
            end
            "intarray":
            begin
                ret := _tool.readints(p,l);
            end
            "uintarray":
            begin
                ret := _tool.readuints(p,l);
            end
            "doublearray":
            begin
                ret := _tool.readdoubles(p,l);
            end else
            ret := _objs[v];
        end;
        return ret;
    end
    function _getvalueaddr_(i); //获得值对应的内存地址
    begin
        {**
        @explan(说明)获得值对应的内存地址 %%
        @param(i)() 索引%%
        **}
        return _objs[i];
    end
    
    function _getvalueaddr2_(i); //读取值对应地址的值作为地址;
    begin
        {**
        @explan(说明)读取值对应地址的值作为地址 %%
        @param(i)() 索引%%
        **}
        t := _objs[i];
        if ifnumber(t)then
        begin
            return _tool.readptr(t);
        end
        if t is class(ctslctrans)then
        begin
            return t._getptr_();
        end
    end
    function _getdata_();virtual; //获得所有数据
    begin
        {**
        @explan(说明)获得所有数据 %%
        @return(array) %%
        **}
        ret := array();
        for i,v in _objs do
        begin
            if v is class(ctslctrans)then
            begin
                ret[i]:= v._getdata_();
            end else
            ret[i]:= _getvalue_(i);
        end
        return ret;
    end
    function destroy();override; //析构
    begin
        inherited;
        //class(tmemoryclass).destroy();
        _objss := _objst := _objs := array();
    end
    function CopyToString();
    begin
        {**
        @explan(说明)将内存数据转换为字符串%%
        @return(string)
        **}
        r := ""; //binary("");
        ptr := _getptr2_();
        sz := _size_();
        if ptr and sz>0 then
        begin
            setlength(r,sz);
            for i := 0 to sz-1 do r[i+1]:= _tool.readbyte(ptr+i);
        end
        return r;
    end
    function CopyFromString(s);
    begin
        {**
        @explan(说明)将字符串拷贝到内存 %%
        @param(s)(string)
        **}
        ptr := _getptr2_();
        sz := _size_();
        if ifstring(s)and ptr and sz>0 and sz <= length(s)then
        begin
            for i := 0 to sz-1 do
            begin
                _tool.writebyte(ptr+i,ord(s[i+1]));
            end
        end
    end
end  
type tslcstructureobj=class(ctslctrans) //结构体类
    {**
    @explan(说明)tsl数据结构和内存交互接口类封装
    **}
    (**
    @example(范例--内存结构)
    sc := array(("a","int",1),("b","double",2)("c","intptr",1234));
    //兼容c中的 co = new  struct{int a = 1; double b = 2.0; intptr = 1234}
    co := new tslcstructureobj(MemoryAlignmentCalculate(sc));
    co._setvalue_("a",5); //设置成员 a的值
    echo co._getvalue_("b");//获得成员 b 的值
    echo co._size_();//获得内存大小
    echo co._getptr_() ;//对象对应的内存指针
 			
    **)
    function create(data,ptr);
    begin
        {**
        @explan(说明) 内存对象构造  %%
        @param(data)(array) 内存结构,使用 MemoryAlignmentCalculate 产生 %%
        @param(ptr)(integer|nil) 内存指针,如果不给定,自动分配,如果给定从内存读取 %%
        **}
        //return inherited create(data,ptr,nil);
        class(ctslctrans).create(data,ptr,nil);
    end
    function destroy();override;
    begin
        inherited;
    end 
end

//*********字符串相关对象**************************************	
type tcbytearray=class
    reallen;
    len; //长度	
    obj; //对象
    {**
    @explan(说明) byte数组内存管理类 %%
    @param(len)(integer) 数组占用长度 %%
    @param(reallen)(integer) 实际内存长度 %%
    @param(obj)(tslcstructureobj) 内存对象%%
    **}
    function create(n);
    begin
        {**
        @explan(说明)构造 %%
        @param(n)(integer|array of integer) 字符串长度 预分配%%
			
        **}
        reallen := len := 0;
        if not(n>0)then n := 128;
        setv(n);
    end
    function reset(n);
    begin
        {**
        @explan(说明)重新设置 %%
        @param(n)(array of byte) 设置字的数组%%	
        **}
        t := true;
        if ifnumber(n)and n>0 and n>reallen then
        begin
            len := reallen := n;
            obj := new ctslctrans(MemoryAlignmentCalculate(array((0,format("byte[%d]",reallen),array(0))))); //tslcstructure(array((0,format("byte[%d]",reallen),array(0))));
        end else
        if ifarray(n)and length(n)>reallen then
        begin
            len := reallen := length(n);
            obj := new ctslctrans(MemoryAlignmentCalculate(array((0,format("byte[%d]",reallen),n)))); //tslcstructure(array((0,format("byte[%d]",reallen),n)));
            t := false;
        end
        if ifarray(n)and t then
        begin
            len := length(n);
            obj._setvalue_(0,n);
        end else
        if ifnumber(n)and t then len := n;
    end
    function occupancy();
    begin
        {**
        @explan(说明)获取内存占用 %%
        @return(integer) 占用大小
        **}
        return reallen;
    end
    function length(n); //设置长度
    begin
        {**
        @explan(说明)设置长度 或者获取数组的占用长度%%
        @param(n)(integer|nil) nil为获取长度,数字为设置长度 %%	
        **}
        if ifnumber(n)then reset(n);
        return len;
    end
    function _getptr_();
    begin
        {**
        @explan(说明)返回数组内存指针 %%
        **}
        return obj._getptr_();
    end
    function setv(n);virtual;
    begin
        {**
        @explan(说明)设置byte数组 %%
        @param(n)(array of byte) 数组%%
			
        **}
        return reset(n);
    end
    function getv();
    begin
        {**
        @explan(说明)返回byte数组 %%
        @return(array of byte ) 返回的数组%%
        **}
        if ifobj(obj)then
        begin
            return obj._getvalue_(0);
        end
    end
    function ptr();
    begin
        {**
        @explan(说明)返回内存指针 %%
        **}
        return _getptr_();
    end
end
type tcstring=class(tcbytearray)
    {**
    @explan(说明)字符串内存管理类 %%
    @param(_flag)(integer) 字符串是否包含\0结尾%%
    **}
    private
    _flag;
    public
    function create(n);
    begin
        inherited;
    end
    function getv(n);
    begin
        {**
        @explan(说明)返回字符串 %%
        @param(n)(integer)获取字符串的长度 %%
        @return(string) 字符串%%	
        **}
        ret := "";
        nhn := not(n);
        v := class(tcbytearray).getv();
        if _flag then
        begin
            for i := 0 to self.length()-2 do
            begin
                vi := v[i];
                if n and i >= n then break;
                ret += chr(v[i]);
            end
        end else
        begin
            for i := 0 to reallen-1 do
            begin
                vi := v[i];
                if(vi=0)and nhn then break;
                if n and i >= n then break;
                ret += chr(v[i]);
            end
        end
        return ret;
    end
    function setv(v);override;
    begin
        {**
        @explan(说明)设置字符串 %%
        @param(v)(string) 字符串%%	
        **}
        r := array();
        if ifstring(v)then
        begin
            for i := 1 to length(v) do r[i-1]:= ord(v[i]);
            r[i]:= ord("\0");
        end else
        if ifnumber(v)and v >= 0 then r := v+1;
        else r := 1;
        class(tcbytearray).setv(r);
    end
    property endzero read _flag write _flag;
    {**
    @param(endzero)(bool) 默认为false字符串以\0结束 %%;
    **}
end
type tcstructwithcharptr=class(ctslctrans)
    private
    _strso; //字符串对象集合;
    _strn;
    {**
    @explan(说明)内存结构体分配管理类 %%
    @param(_strso)(array of tcstring) 字符串对象集合 %%
    @param(_strn)(array) 字符串长度标记如
    array("str1":"str1len","str2":str2len)表示
    str1,str2两个字段表示字符串
    str1len 和str2len 分别表示两个字符串的最大长度%%
		
    **}
    public
    function create(stc,strn1,strn2);
    begin
        {**
        @explan(说明)构造内存对象 %%
        @param(stc)(array) 内存分配结构描述%%
        @param(strn)(array) 字符串所在字段描述%%
        **}
        strn := array();
        if ifarray(strn1)then strn union=strn1;
        if ifarray(strn2)then strn union=strn2;
        for i in strn do //类型清理
        begin
            for j := 0 to length(stc)-1 do
            begin
                if stc[j,0]=i then
                begin
                    stc[j,1]:= "intptr";
                end
            end
        end
        class(ctslctrans).create(MemoryAlignmentCalculate(stc),nil,nil);
        if not ifarray(strn)then return;
        _strn := strn;
        _strso := array();
        for i,v in _strn do
        begin
            setstringi(i,v,128);
        end
        for i,v in strn2 do
        begin
            _strso[i].endzero := true;
        end
    end
    function destroy();override;
    begin
        _strso := nil;
        _strn := nil;
        inherited;
    end
    function operator[1](index,v);
    begin
        {**
        @explan(说明) 设置成员 %%
        @param(index)(tslobj) 下标 %%
        @param(v)(tslobj) 值
        **}
        return _setvalue_(index,v);
    end
    function operator[](index);
    begin
        {**
        @explan(说明) 获取成员 %%
        @param(index)(tslobj) 下标 %%
        @return(tslobj) 返回值 %%
        **}
        return _getvalue_(index);
    end
    function _setvalue_(id,v);override;
    begin
        {**
        @explan(说明)设置成员值 %%
        @param(id)(string) 成员id%%
        @param(v)(string|integer) 设置的值%%
        **}
        os := _strso[id];
        if ifobj(os)then
        begin
            cn := _strn[id];
            return setstringi(id,cn,v);
        end
        return inherited;
    end
    function _getvalue_(id,n);override;
    begin
        {**
        @explan(说明)获取成员值 %%
        @param(id)(string) 成员id%%
        @param(n)(integer) 如果为字符串获取字符串的长度,不送入默认为\0结尾%%
        @return(obj) tsl数据%%
        **}
        os := _strso[id];
        if ifobj(os)then return os.getv(n);
        return inherited _getvalue_(id);
    end
    function _getdata_();override;
    begin
        {**
        @explan(说明)获得结构体的值 %%
        @return(array) tsl数据%%
        **}
        r := class(ctslctrans)._getdata_();
        for i,v in _strso do if ifobj(v)then r[i]:= v.getv();
        return r;
    end
    protected
    function setstringi(i,v,n);
    begin
        {**
        @explan(说明)字符串对象分配 %%
        @param(i)(string) 字符串对象的id%%
        @param(v)(string) 字符串对象%%
        @param(n)(string) 字符串所在字段描述%%
        **}
        os := _strso[i];
        if ifnil(os)then
        begin
            os := new tcstring(n);
        end else
        os.setv(n);
        _strso[i]:= os;
        obj := class(ctslctrans);
        if obj._getvalue_(i)<> os.ptr then
        begin
            obj._setvalue_(i,os.ptr);
        end
        if not ifnil(v)then obj._setvalue_(v,os.occupancy()-1); //修改	
    end
end


	//c结构体定义类
type tcstruct= class
    //_tag;
    _size; //大小
    _maxitem; //最大元素
    _name; //名字
    _struct; //内存排布
    static _basetypes; //基础类型
    static _structs; //注册的结构体
    {**
    @ignore 忽略%%
    @explan(说明)c结构体定义类 %%
    @param(_size)(integer) 大小%%
    @param(_maxitem)(integer) 最大元素%%
    @param(_name)(string) 名称%%
    @param(_basetypes)(array) 基础类型表%%
    @param(_structs)(array) 已经注册的结构体%%
    **}
    type typeclass=class
        _st; //开始位置;
        _n; //名称
        _t; //类型名称
        _s; //size;
        _mxi; //最大子项size
        _fa; //数组标记 
        _lt; //指针连接次数
        _ltp; //连接的类型 
        _ms; //内存空间
        _ot; //原始类型;
        _fb; //是否基础类型
        _stc; //结构
        _plen; //指针分配长度
        _wlen; //写的长度;
        _oot; //原始字符串类型;
        {**
        @explan(说明)类型定义 %%
        @param(_st)(integer) 开始位置%%
        @param(_t)(string) 名称%%
        @param(_mxi)(integer) 最大子项size%%
        @param(_s)(integer) 大小%%
        @param(_fa)(integer) 数组标记%%
        @param(_lt)(integer) 指针连接次数%%
        @param(_ltp)(string) 连接的类型%%
        @param(_ms)(integer) 内存空间%%
        @param(_ot)(string) 原始类型%%
        @param(_fb)(integer) 是否基础类型%%
        @param(_fb)(integer) 是否基础类型%%
        @param(_stc)(tcstruct) 结构%%
        @param(_plen)(integer) 指针分配长度%%
        @param(_wlen)(integer) 写的长度%%
        @param(_oot)(string) 原始字符串类型%%
        **}
        function show(i);
        begin
            {**
            @explan(说明)展示 %%
            @param(i)(integer) 展示标记%%
            **}
            if ifnil(i)then echo "\r\n字段,\t类型\t原型\t位置\t大小\t内存\t数组\t指针\t指向\t基类\t长度";
            echo "\r\n",_n,"\t",_t,"\t",_ot,"\t",_st,"\t",_s,"\t",_ms,"\t",_fa,"\t",_lt,"\t",_ltp,"\t",_fb,"\t",_plen;
        end
        function destroy();
        begin
            _stc := nil;
        end
        function copy(); //对象复制
        begin
            {**
            @explan(说明)对象复制 %%
            **}
            o := new typeclass();
            o._st := _st;
            o._n := _n;
            o._t := _t;
            o._s := _s;
            o._mxi := _mxi;
            o._fa := _fa;
            o._lt := _lt;
            o._ltp := _ltp;
            o._ms := _ms;
            o._ot := _ot;
            o._fb := _fb;
            o._wlen := _wlen;
            o._plen := _plen;
            o._oot := _oot;
            if _stc is class(tcstruct)then
            begin
                o._stc := _stc.copy();
            end
            return o;
        end
    end
    function create(name,data,alim,fr);
    begin
        {**
        @explan(说明)构造 %%
        @param(name)(string) 名称%%
        @param(data)(array) 内存分配%%
        @param(alim)(integer) 对其方式%%
        @param(fr)(integer) 类型判别%%
        **}
        _sinit_();
        if ifnil(name)then return;
        if ifarray(name)then
        begin
            _name := name[0];
            _size := name[1];
            _maxitem := name[1];
            return 1;
        end
        if ifstring(name)then
        begin
            if pos("*,",name)=length(name)then raise "注册类体不能以*结尾";
            _name := name;
        end else
        raise "类型名称错误";
        if ifobj(_structs[name])and not(fr)then raise(name+"类型已经注册");
        ssize := 0;
        tslarraytocstructcalcs(data,alim,ssize,maxitem);
        if ifarray(data)and ssize>0 then
        begin
            _size := ssize;
            _struct := data;
            _maxitem := maxitem;
            _structs[_name]:= self;
        end
    end
    function hasstc(); //将结构hash化
    begin
        {**
        @explan(说明)将结构hash化 %%
        **}
        ret := array();
        for i,v in _struct do
        begin
            ret[v["n"]]:= v["tfo"];
        end
        return ret;
    end
    function findstruct(n); //结构体查找
    begin
        {**
        @explan(说明)结构体查找 %%
        @param(n)(string) 名称%%
        **}
        ov := new typeclass();
        typedeal(n,ov);
        return ov;
    end
    function copy();
    begin
        {**
        @explan(说明)对象复制 %%
        **}
        o := new tcstruct();
        o._name := _name;
        o._size := _size;
        o._maxitem := _maxitem;
        s := array();
        for i,v in _struct do
        begin
            s[i]:= v;
            s[i]["tfo"]:= v["tfo"].copy();
        end
        o._struct := s;
        return o;
    end
    function show();
    begin
        {**
        @explan(说明)展示 %%
        **}
        echo "\r\n名称:",_name;
        echo "\r\n内存大小:",_size;
        echo "\r\n最大成员:",_maxitem;
        echo "\r\n内存分布:"; //,tostn(_struct);
        echo "\r\n字段,\t类型\t原型\t位置\t大小\t内存\t数组\t指针\t指向\t基类\t长度";
        for i,v in _struct do
        begin
            o := v["tfo"];
            o.show(1);
        end
    end
    class function getptrchain(vt_,ret); //获得指针链条
    begin
        {**
        @explan(说明)获得指针链条 %%
        @param(vt_)(string) 名称%%
        @param(ret)() 返回%%
        **}
        vt := vt_;
        ret := 0;
        while(vt[length(vt)]="*") do
        begin
            ret += 1;
            vt := vt[1:length(vt)-1];
        end
        return vt;
    end
    class function setpptrchain(vt,n); //构造指针连
    begin
        {**
        @explan(说明)获得指针链条 %%
        @param(n)(integer) 指针次数%%
        @param(vt)(string) 类型名称%%
        **}
        ret := vt;
        for i := 1 to n do
        begin
            ret += "*";
        end
        return ret;
    end
    function typedeal(vt,ov,pt); //数组指针处理 char*[5] 表示5个指字符串
    begin
        {**
        @explan(说明)数组指针处理 char*[5] 表示5个指字符串 %%
        **}
        ov._oot := vt;
        if not ifobj(ov)then raise "类型判断参数错误";
        {ctrl := "\\w+[*]*";
        ParseRegExpr(ctrl,vt,"",result,MPos,Mlen);
        if length(result)>2 then raise "类型错误";
        vt_ := result[0,0];
        len := result[1,0];//大小
        ov._ot := vt_; //原型
        if len then //数组标记
        begin
        sz := strtoint(len);
        end 
        else
        begin
        sz := 0;
        end }
        parserctypestr(vt,vt_,len);
        if len then sz := len;
        else sz := 0;
        pt := 0;
        vt := getptrchain(vt_,pt);
        ot := _structs[vt];
        if ifobj(ot)then //判断类型是否已经注册
        begin
            o := ot;
            if pt then //指针
            begin
                o := _structs["pointer"];
                if sz>0 then
                begin
                    vt := setpptrchain(vt,pt);
                    ov._ot := vt;
                end else
                begin
                    vt := setpptrchain(vt,pt-1);
                    ov._ot := vt;
                end
                ov._lt := pt;
                ov._ltp := vt;
            end
            ov._s := o._size; //尺寸
            ov._mxi := o._maxitem; //最大子元素
            ov._t := o._name; //名称
            ov._fa := sz; //数组标记 
            ov._fb := _basetypes[ov._ot]; //原型是否为基础类型;
            _stc := _structs[ov._ot];
            if ifnil(_stc)then ov._stc := o.copy();
            else ov._stc := _stc.copy();
        end else
        raise "类型不存在";
        return ret;
    end

    function tslarraytocstructcalcs(data,alim,ssize,maxitem); //计算对其长度
    begin
        {**
        @explan(说明)计算对其长度 %%
    				
        **}
        if not ifnumber(alim)then
        begin
            {$ifdef linux}
            alim := 4;
            {$else}
            alim := 8;
            {$endif}
        end
        if preddata(data)=-1 then raise functionname()+"结构体数据错误!";
        npoint := 0; //开始位置
        names := data[:,"n"];
        len1 := length(names);
        if(len1>length(names union2 array()))then raise functionname()+"结构体变量名重复";
        fmaxitem(data,alim); //对其长度
        maxitem := 0;
        for i,vi in data do
        begin
            name := vi["n"]; //变量名
            ot := vi["tfo"]; //对象
            ot._n := name;
            len := size := ot._fa; //数组
            tpbyte := ot._s; //当前占用的字节
            if maxitem<ot._mxi then maxitem := ot._mxi;
            if not size then size := 1;
            sz := tpbyte * size; //数据大小
            dp1 := min(alim,ot._mxi);
            npoint := ceil(npoint/dp1)* dp1;
            ot._st := npoint; //元素开始的地址
            ot._ms := sz; //元素占用空间
            npoint += sz;
        end;
        alimlen := min(alim,maxitem);
        ssize :=(ceil(npoint/alimlen)* alimlen);
        ot._ms := ssize-ot._st;
    end
    class function _sinit_(); //初始化
    begin
        {**
        @explan(说明)初始化 %%
    				
        **}
        if ifnil(_structs)then
        begin
            _structs := array();
            _basetypes := array();
            for i,v in getctypesize() do
            begin
                if i="char*" then continue;
                _structs[i]:= new tcstruct(array(i,v));
                if i="pointer" then continue;
                _basetypes[i]:= true;
            end
        end
    end
    class function getstruct(name);
    begin
        {**
        @explan(说明)获得结构体 %%
        @param(name)(string) 类型名称%%
        **}
        return _structs[name];
    end
    function getsteps(n,ptr);
    begin
        {**
        @explan(说明)内存位置移动 %%
        @param(n)(integer) 移动个数%%
        @param(ptr)(integer) 基准位置%%
        **}
        if ifnumber(n)and ifnumber(_size)then ret := n * _size;
        if ifnumber(ptr)then ret := ptr+_size;
        return ret;
    end
    private
    function preddata(data);
    begin
        if not ifarray(data)then return-1;
        cols := array(0,1,mcols(data,1))->(mcols(data)-1);
        masthave := array("n","t");
        for i,v in masthave do
        begin
            if ifnil(cols[v])then return-1;
        end
        for i := 0 to length(data)-1 do
        begin
            data[i,"tfo"]:= new typeclass();
        end
    end 
    function fmaxitem(d,alim) //计算对其长度
    begin
        ret := array();
        for i,v in d do
        begin
            vt := v["t"];
            vo := v["tfo"];
            typedeal(vt,vo);
        end
        return ret;
    end;
    
end 
	//新的内存管理类
type tcpointer=class(tcstruct,tmemoryclass)
    (**
    @ignore 忽略%%
    @example(范例--内存管理--2)
    //tsl定义
    ts3 := ctypedefine("ts3",array(("n":"a","t":"char[3]"),("n":"b","t":"double")));
    ts2 := ctypedefine("ts2",array(("n":"a","t":"char[5]"),("n":"b","t":"int[3]"),("n":"e","t":"ts3"),("n":"c","t":"ts3*")));
    ts1 := ctypedefine("ts1",array(("n":"a","t":"char[3]"),("n":"m1","t":"ts2")));
    //构造c对应结构体指针,第一个参数为类名称,第二个为初始值
    o := new tcpointer("ts1",array(
    "a":"ab",
    "m1":array(
    "a":"ef",
    "b":array(2,3),
    "e":array(
    "a":"e",
    "b":3
    )
    ,
    "c":array(//注意此处指针必须按照数组的形式
    array( 
    "a":"w",
    "b":1.5
    ),
    array( 
    "a":"tt",
    "b":5
    )
    )
    )
    ));	
    使用ctypedefine 定义和c交互的内存结构
    new tcpointer(定义的类型,初始值) 管理内存对象
    o.getindexi(i) 如果为数组或者指针返回第i个数据
    o._getdata_() 获得结构体中的所有数据已一个数组形式返回
    o._getvalue_("a") 根据索引获得数据 
    o._setvalue_("a","ab") 赋值只能是基础类型,对于复杂类型可以按层级赋值,取值
    例如:
    o._getvalue_("m1")._setvalue_("a","f");
    echo tostn(o._getvalue_("m1")._getvalue_("c").getindexi(0)._getdata_);
    echo tostn(o._getvalue_("m1")._getvalue_("c").getindexi(1)._getdata_);
    **)
    _ptr; //指针 
    _desc; //描述
    _stc; //内存结构
    _hashstrc; //结构hash
    _fpa; //数组标记;
    _subobj; //子对象
    function create(sn,ivalue,ptr); //sn 名字,ivalue初始值,ptr 指针
    begin
        //初始值
        class(tcstruct).create(); //类型获得
        class(tmemoryclass).create(); //内存操作对象
        mtool();
        _subobj := array();
        if ifobj(sn)then //不变
        begin
            _desc := sn;
        end else
        begin
            _desc := findstruct(sn); //类型描述
            _desc._st := 0;
            _desc._ms := _desc._s; //内存大小描述
        end
        if _desc._fa then _fpa := "a"; //数组
        else if _desc._lt then _fpa := "p";
        _stc := _desc._stc; //结构体描述
        _hashstrc := _stc.hasstc(); //便于查找的hash	
        if ptr and ifnumber(ptr)then
        begin
            _ptr := ptr;
        end
        //if ifnil(ivalue) then return ;//没有初始值返回
        if _fpa="a" then //数组
        begin
            sz := _stc.getsteps(_desc._fa); //获得数组的分配空间
            n := _desc._t; //类型
            if not(_ptr)then //内存分配
            _ptr := tmalloc(sz,1);
            if _desc._fb then //基础类型 
            begin
                if ifstring(ivalue)and n="char" then
                begin
                    _write_(_ptr,n,ivalue,sz-1);
                    _desc._wlen := length(ivalue)+1;
                end
                if ifarray(ivalue)and n <> "char" then
                begin
                    _write_(_ptr,n+"array",ivalue,length(ivalue));
                    _desc._wlen := length(ivalue);
                end
            end else
            begin
                for i,v in ivalue do
                begin
                    if i=_desc._fa then break;
                    n := _desc._ot;
                    _subobj[i]:= new tcpointer(n,v,_ptr+_stc.getsteps(i));
                end
            end
        end else
        if _fpa="p" then //指针
        begin
            if ifnumber(ivalue)then
            begin
                len := ivalue;
                _desc._plen := len;
                sz := _stc.getsteps(len);
                if not(_ptr)then _ptr := tmalloc(sz,1);
            end else
            if ifarray(ivalue)then
            begin
                if _desc._ot="char" then raise "指针类型和赋值不符合";
                len := length(ivalue);
                _desc._plen := len;
                sz := _stc.getsteps(len);
                if not(_ptr)then _ptr := tmalloc(sz,1);
                if _desc._fb then //基础类型
                begin
                    _write_(_ptr,_desc._ot+"array",ivalue,len);
                    _desc._wlen := len;
                end else
                begin
                    for j,sv in ivalue do
                    begin
                        o := new tcpointer(_desc._ltp,sv,_ptr+_stc.getsteps(j));
                        _subobj[j]:= o;
                    end
                end
            end else
            if ifstring(ivalue)then
            begin
                if _desc._ot <> "char" then raise "字符串类型赋值错误";
                len := length(ivalue)+1;
                _desc._plen := len;
                sz := len;
                if not(_ptr)then _ptr := tmalloc(sz,1);
                _tool.writestr(_ptr,ivalue);
                _desc._wlen := len;
            end
        end else //普通类型
        begin
            if not(_ptr)then _ptr := tmalloc(_desc._s,1);
            for i,v in ivalue do
            begin
                si := _hashstrc[i];
                if ifobj(si)then
                begin
                    ptr := _ptr+si._st; //位置
                    n := si._t;
                    if si._fa>0 then //数组
                    begin
                        _subobj[i]:= new tcpointer(si,v,ptr);
                    end else
                    if si._lt>0 then //指针
                    begin
                        o := new tcpointer(si,v);
                        _subobj[i]:= o;
                        _tool.writeptr(ptr,o._ptr);
                    end else //普通类型
                    begin
                        if si._fb then
                        begin
                            _write_(ptr,n,v);
                        end else
                        begin
                            _subobj[i]:= new tcpointer(si,v,ptr);
                        end
                    end
                end else
                raise "赋值下标错误";
            end
        end
    end
    function _getptr2_();
    begin
        {**
        @explan(说明) 获取内存地址 %%
        **}
        x := 0;
        for i,v in _objstart do
        begin
            x := v;
            break;
        end
        return _getptr_()+x;
    end
    function _getptr_(); //获得地址
    begin
        return _ptr;
    end
    function _size_(); //获得对象占用空间大小
    begin
        siz := _desc._size;
        if _desc._fa then siz *= _desc._fa;
        return siz;
    end
    function _getvalueaddr_(i); //获得值对应的内存地址
    begin
        if ifnil(i)then return _ptr;
        tv := _hashstrc[i];
        if ifobj(tv)then
        begin
            return _ptr+tv._st; //元素地址
        end
    end
    function _setcptr_(ptr); //设置对象地址
    begin
        if ifnumber(ptr)and ptr then _ptr := ptr;
    end
    function _read_(p,t,l); //基本类型读取
    begin
        case t of
            "char":
            begin
                ret := _tool.readstr(p);
            end
            "int":
            begin
                ret := _tool.readint(p);
            end
            "intptr":
            begin
                ret := _tool.readptr(p);
            end
            "double":
            begin
                ret := _tool.readdouble(p);
            end
            "float":
            begin
                ret := _tool.readfloat(p);
            end
            "byte":
            begin
                ret := _tool.readbyte(p);
            end
            "short":
            begin
                ret := _tool.readshort(p);
            end
            "bytearray":
            begin
                ret := _tool.readbytes(p,l);
            end
            "intarray":
            begin
                ret := _tool.readints(p,l);
            end
            "doublearray":
            begin
                ret := _tool.readdoubles(p,l);
            end
        end;
        return ret;
    end
    function _write_(p,t,v,l); //基本类型写入
    begin
        case t of
            "char":
            begin
                if ifstring(v)then
                begin
                    if ifnumber(l)and length(v)>l then
                    begin
                        //echo "\r\nstringwrite:",l,"****",length(v);
                        return-1;
                    end
                    _tool.writestr(p,v);
                    ret := 1;
                end
            end
            "int":
            begin
                if ifnumber(v)then
                begin
                    _tool.writeint(p,v);
                    ret := 1;
                end
            end
            "intptr":
            begin
                if ifnumber(v)then
                begin
                    _tool.writeptr(p,v);
                    ret := 1;
                end
                ret := 1;
            end
            "double":
            begin
                if ifnumber(v)then
                begin
                    _tool.writedouble(p,v);
                    ret := 1;
                end
            end
            "float":
            begin
                if ifnumber(v)then
                begin
                    _tool.writefloat(p,v);
                    ret := 1;
                end
            end
            "byte":
            begin
                if ifnumber(v)then
                begin
                    _tool.writebyte(p,v);
                    ret := 1;
                end
            end
            "short":
            begin
                if ifnumber(v)then
                begin
                    _tool.writeshort(p,v);
                    ret := 1;
                end
            end
            "bytearray":
            begin
                _tool.writebytes(p,min(length(v),l),v);
                ret := true;
            end
            "intarray":
            begin
                _tool.writeints(p,min(length(v),l),v);
                ret := true;
            end
            "doublearray":
            begin
                _tool.writedoubles(p,min(length(v),l),v);
                ret := true;
            end
        end;
        return ret;
    end
    function _getdata_(); //获得所有的数据
    begin
        t := _desc._ot;
        fp := _fpa;
        if fp="a" then
        begin
            if _desc._fb then
            begin
                if t="char" then
                begin
                    //echo "\r\nreade:",_ptr;
                    v := _tool.readstr(_ptr);
                    //echo "readv:" ,v,datatype(v);
                    return v;
                end else
                begin
                    return _read_(_ptr,t+"array",_desc._fa);
                end
            end else
            begin
                ret := array();
                for i := 0 to _desc._fa-1 do
                begin
                    ret[i]:= getindexi(i)._getdata_();
                end
                return ret;
            end
        end else
        if fp="p" then
        begin
            t := _desc._ot;
            if _desc._fb then
            begin
                if t="char" then
                begin
                    return _tool.readstr(_ptr);
                end else
                begin
                    return _read_(_ptr,t+"array",_desc._plen);
                end
            end else
            begin
                ret := array();
                if ifnumber(_desc._plen)then
                begin
                    for i := 0 to _desc._plen-1 do
                    begin
                        ret[i]:= getindexi(i)._getdata_();
                    end
                end
                return ret;
            end
        end else
        begin
            ret := array();
            for i,v in _hashstrc do
            begin
                n := v._n;
                o := _getvalue_(n);
                if ifobj(o)then ret[n]:= o._getdata_();
                else ret[n]:= o;
            end
            return ret;
        end
    end
    function getindexi(i); //获得数组或者指针第i个元素,基础类型返回值,复杂类型返回对象
    begin
        if(_fpa="a" and i >= 0 and i<_desc._fa)then //
        begin
            //基础类型
            ret := _subobj[i];
            if ifobj(ret)then return ret;
            psi :=(_desc._s * i+_ptr);
            if not(_desc._fb)then //非基础类型
            begin
                return new tcpointer(_desc._t,nil,psi);
            end else //基础类型
            begin
                if _desc._t <> "char" then
                begin
                    return _read_(psi,_desc._ot);
                end
            end
        end else
        if _desc._lt>0 and i >= 0 then
        begin
            ret := _subobj[i];
            if ifobj(ret)then return ret;
            ps := _ptr;
            if ps=0 then return nil;
            if _desc._lt>1 then
            begin
                psi :=(ps+_desc._ms * i);
                o := new tcpointer(_desc._ot,nil,psi);
                _subobj[i]:= o;
                return o;
            end else
            begin
                psi := ps+(_desc._stc._size * i);
                if not(_desc._fb)then //非基础类型
                begin
                    o := new tcpointer(_desc._ot,nil,psi);
                    _subobj[i]:= o;
                    return o;
                end else //基础类型
                begin
                    if _desc._ot <> "char" then
                    begin
                        return _read_(psi,_desc._ot);
                    end else
                    return _read_(psi,"char");
                end
            end
        end
    end
    function _setvalue_(i,v); //给下标字段设置值,只支持基础类型
    begin
        if ifnil(i)then
        begin
            ds := _desc;
            //ds.show();
        end else
        ds := _hashstrc[i];
        if not ifobj(ds)then return nil;
        ptr := _ptr+ds._st;
        if ds._fb then //基础类型
        begin
            if not(ds._fa or ds._lt)then //非数组或者指针
            begin
                _write_(ptr,ds._t,v);
            end else
            if ds._fa then
            begin
                if ds._ot="char" and ifstring(v)then
                begin
                    _write_(ptr,ds._ot,v,ds._fa);
                end else
                if ds._ot <> "char" and ifarray(v)then
                begin
                    _write_(ptr,ds._ot+"array",v,ds._fa);
                end
            end else
            if ds._lt then //指针
            begin
                if(v is class(tcpointer))then //设置值 
                begin
                    if(ds._ot=v._desc._ot)and(ds._lt=v._desc._lt)then
                    begin
                        begin
                            _subobj[i]:= v;
                            _write_(ptr,"intptr",v._ptr);
                        end
                    end
                    return;
                end
                ptr := _read_(ptr,"intptr");
                if ptr then
                begin
                    if ds._ot="char" and ifstring(v)and(length(v)<ds._plen or ifnil(ds._plen))then
                    begin
                        _write_(ptr,ds._ot,v);
                    end else
                    if ds._ot <> "char" and ifarray(v)then
                    begin
                        _write_(ptr,ds._ot+"array",v,ifnumber(ds._plen)?(ds._plen):(length(v)));
                    end
                end
            end
        end
    end
    function _getvalue_(i,L); //获取值,支持基础类型,i为下标,l在为指针的时候指定长度
    begin
        v := _hashstrc[i];
        if not ifobj(v)then return nil;
        ptr := _ptr+v._st;
        t := v._ot;
        if v._fb then //基础类型 
        begin
            if v._fa then
            begin
                if v._ot="char" then return _read_(ptr,"char");
                return _read_(ptr,v._ot+"array",ifnumber(L)?min(v._fa,L):v._fa);
            end else
            if v._lt then
            begin
                ptr := _read_(ptr,"intptr");
                if ptr <> 0 then
                begin
                    if v._ot="char" then return _read_(ptr,"char");
                    return _read_(ptr,v._ot+"array",ifnumber(L)?L:v._plen);
                end
            end else
            begin
                return _read_(ptr,v._ot);
            end
        end else
        begin
            if not ifobj(_subobj[i])then
            begin
                if v._fa then //数值
                begin
                    _subobj[i]:= new tcpointer(v,nil,ptr);
                end else
                if v._lt then //指针
                begin
                    ptr := _read_(ptr,"intptr");
                    if ptr <> 0 then
                    begin
                        _subobj[i]:= new tcpointer(v,nil,ptr);
                    end
                end else
                begin
                    //echo v.show;
                    _subobj[i]:= new tcpointer(v,nil,ptr);
                end
            end
            return _subobj[i];
        end
    end
    function destroy(); //析构
    begin
        _subobj := array();
        class(tmemoryclass).destroy();
    end
    function activefree(); //主动析构,目前不完善,需要等结构体调整好后补充
    begin
        if _desc._lt then activefreesub(ptr_);
    end
    protected
    function activefreesub(ptr_);
    begin
        ptr := opblocks(ptr_,0);
        if ifnil(ptr)then
        begin
            _tool.tfree(ptr_);
        end
    end
end

		
Implementation
function ReadStringFromPtr(ptr);
begin
    {**
    @explan(说明) 读取一个指向\0字符串指针的值 %%
    @param(ptr)(pointer) 指针 %%;
    @return(string) 字符串 %%
		
    **}
    if ptr and ifnumber(ptr)then return getmemtool().readstr(ptr);
    return "";
end
function WriteStringToPtr(ptr,str);
begin
    {**
    @explan(说明) 向一个指针写入\0结尾的字符串 %%
    @param(ptr)(pointer) 指针 %%;
    @param(str)(string) 字符串 %%	
    **}
    if ifnumber(ptr)and ifstring(str)and ptr then return getmemtool().writestr(ptr,str);
    return 0;
end
function ReadBytesFromPtr(ptr,L);
begin
    {**
    @explan(说明) 读取一个指向数组指针的值 %%
    @param(ptr)(pointer) 指针 %%;
    @param(L)(integer) 长度 %%;
    @return(array of integer) 字符串 %%	
    **}
    if ptr and ifnumber(ptr)and L>0 then return getmemtool().readbytes(ptr,L);
end
function WriteBytesToPtr(ptr,bytes);
begin
    {**
    @explan(说明) 向一个指针写入字节数据 %%
    @param(ptr)(pointer) 指针 %%;
    @param(bytes)(array of integer) 数据 %%	
    **}
    if ifnumber(ptr)and ptr and ifarray(bytes)then return getmemtool().writebytes(ptr,length(bytes),bytes);
    return 0;
end
function getmemtool();
begin
    return static new aefclassobj_();
end
function MemoryAlignmentCalculate(data,baselen,ssize,pack);
begin
    {**
    @explan(说明) 结构体排布计算 %%
    @param(data)(array)  结构体信息数组,参考 cstructurelib中 tslarraytocstructcalc %%
    @param(baselen)(integer)  基准位置默认为0 %%
    @param(ssize)(integer)  大小 %%
    @param(pack)(integer)  对其方式 windows 默认8 linux 默认4 %%
    **}
    if not ifnumber(baselen)then baselen := 1; //最小长度
    if not ifnumber(ssize)then ssize := 0; //大小
    if not ifnumber(pack)then
    begin
        {$ifdef linux}
        pack := 4;
        {$else}
        pack := 8; //对齐
        {$endif}
    end
    //return tslcstructure_calc(data,baselen,ssize,pack);
    return tslarraytocstructcalc(data,pack,0,ssize);
end
function ctypedefine(name,stc,alim,f); //结构体定义
begin
    {**
    @explan(说明)结构体定义 %%
    @param(name)(string) 名称 %%
    @param(stc)(array) 内存分布 %%
    @param(alim)(integer) 对其方式 %%
    @return(tcstruct)  
    **}
    return new tcstruct(name,stc,alim,f);
end
function tslarraytocstructcalc(data,alim,bsi,ssize); //计算对其长度
begin
    {**
    @explan(说明)计算内存对其长度 %%
    @param(data)(array) 数据
    tsl数据结构 二维数组
    每行为c 结构体的一个数据
    0 列为 字符串类型的变量名字
    1 列为 变量类型 ,字符串 (包括  short,short[n],intptr,intptr[n],int,int[n],double,double[n],char[n],byte,byte[n] n为数组大小)
    当类型为char*的时候需要分配内存空间, 第2列为string值 或者是整数 string的长度
    2 列为 值
    %%
    @param(alim)(integer) 对其方式 %%
    @param(bsi)(integer) 基地址,默认为0 %%
    @param(ssize)(array) 结构体大小 %%
    @return(array)  返回值在参数data 增加下面字段
    3 列为  相对偏移
    4 列为 大小
    5 列为  名字
    6 列为  如果为数组表示个数 
    **}
    {
    data 数据
    alim 对其
    bsi 基地址 //默认为0
    ssize 结构体大小
    结构体偏移量;和c接口对接
    参数: data tsl数据结构 二维数组
    每行为c 结构体的一个数据
    0 列为 字符串类型的变量名字
    1 列为 变量类型 ,字符串 (包括  short,short[n],intptr,intptr[n],int,int[n],double,double[n],char[n],byte,byte[n] n为数组大小)
    当类型为char*的时候需要分配内存空间, 第2列为string值 或者是整数 string的长度
    2 列为 值
    返回值 增加下面字段
    3 列为  相对偏移
    4 列为 大小
    5 列为  名字
    6 列为  如果为数组表示个数
    baselen 基础长度
    ssize 结构体大小;
    pack //对其方式
    }
    if not ifnumber(alim)then
    begin
        {$ifdef linux}
        alim := 4;
        {$else}
        alim := 8;
        {$endif}
    end
    if not ifnumber(bsi)then bsi := 0;
    if ifnumber(data)then return data; //如果为整数
    if not ifarray(data)then raise functionname()+"结构体数据错误!";
    if mcols(data)<1 then raise functionname()+"结构体数据错误";
    ret := data; //返回值
    npoint := bsi; //开始位置
    names := data[:,0];
    len1 := length(names);
    if(len1>length(names union2 array()))then raise functionname()+"结构体变量名重复";
    ctypebytes := static getctypesize();
    ctypebytes["user*"]:= ctypebytes["intptr"];
    ctypenames := mrows(ctypebytes,1);
    itemslen :=  calcalimsizeA(data,ctypebytes);//对其长度    
    for i,vi in data do
    begin
        name := vi[0]; //变量名
        tp := vi[1]; //变量类型
        v := vi[2]; //变量值
        ctrl := "\\w+[*]?";
        {ParseRegExpr(ctrl,tp,"",result,MPos,Mlen);
        tp1 := result[0,0]; //类型
        size := result[1,0];//大小
        if ifstring(size) then size := strtoint(size);}
        parserctypestr(tp,tp1,size);
        //echo "*************************",size;
        tpbyte := itemslen[i]; //当前占用的字节
        if(tp1 in array("uint","char","float","double","int","intptr","byte","short","char*","user*"))then
        begin
            tpn := tp1;
            ret[i,5]:= tpn;
            if not(size)then
            begin
                if(tpn in array("char"))then
                begin
                    raise "请使用数组形式";
                end;
                size := 1;
                if ifstring(v)then size := length(v)+1;
            end else
            begin
                if ifarray(v)then
                begin
                    if length(v)>size then raise "初始值大小超过分配空间";
                end else
                if ifstring(v)then
                begin
                    //echo "*********************************************************88";
                    //echo size,tostn(v),length(v);
                    if length(v)>(size-1)then raise "初始值大小超过分配空间";
                end
                if not(tpn in array("char"))then ret[i,5]+= "array";
            end
            if tp1="char*" then
            begin
                sz := tpbyte;
            end else
            begin
                sz := tpbyte * size; //数据大小
            end
            if(tp1="user*")then //结构体指针
            begin
                ret[i,2]:= tslarraytocstructcalc(v,alim,0,0);
                sz := tpbyte; //元素大小
            end
            dp1 := min(alim,tpbyte);
            npoint := ceil(npoint/dp1)* dp1;
        end else
        if(tp1="user")then
        begin
            ret[i,5]:= "userarray";
            size := 1;
            sz := 0;
            dp1 := min(alim,tpbyte);
            npoint := ceil(npoint/dp1)* dp1;
            ret1 := tslarraytocstructcalc(v,alim,npoint,sz);
            ret[i,2]:= ret1;
        end else
        raise "类型错误";
        ret[i,3]:= npoint; //元素开始的地址
        ret[i,4]:= sz; //元素占用空间
        ret[i,6]:= size; //元素个数
        npoint += sz;
    end
    st := npoint-bsi;
    alimlen := min(alim,maxvalue(itemslen));
    ssize :=(ceil(st/alimlen)* alimlen);
    ret[length(ret)-1,4]+=(ssize-st);
    return ret;
end
function calcalimsizeA(d,cl) //计算对其长度
begin
    ret := array();
    for i,v in d do
    begin
        vt := v[1];
        {ctrl := "\\w+[*]?";
        ParseRegExpr(ctrl,vt,"",result,MPos,Mlen);
        vt := result[0,0];}
        parserctypestr(vt,tt,len);
        vt := tt;
        //echo tt,"\r\n";
        if vt="user" then ret[i]:= maxvalue(calcalimsizeA(v[2],cl));
        else ret[i]:= cl[vt];
    end
    return ret;
end;
function parserctypestr(ts,t,s,n);
begin
    {**
    @explan(说明)类型解析 %%
    @param(ts)(string) 类型字符串 如 "char[100]" %%
    @param(t)(string) 类型 %%
    @param(s)(integer) 数组长度 %%
    @param(n)(string) 名称 %%
    **}
    t := "";
    s := "";
    n := "";
    lx := 1; //解析类型
    len := length(ts);
    i := 1;
    while i <= len do
    begin
        vi := ts[i];
        if vi="[" then //解析数组长度
        begin
            i++;
            while i <= len do
            begin
                vi := ts[i];
                ixvi := ord(vi);
                if vi="]" then //转换长度
                begin
                    if s then s := strtoint(s);
                    return;
                end else
                if(ixvi >= 48 and ixvi <= 57)then s += vi; //子记录数字符号
                i++;
            end
            return;
        end else
        if vi="*" then
        begin
            t += vi;
        end else
        if(vi="\t" or vi=" ")and lx=1 and t then
        begin
            lx := 2;
        end else
        if not(vi="\t" or vi=" ")then
        begin
            if lx=2 then n += vi;
            else if lx=1 then t += vi;
        end
        i++;
    end
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注释*****************
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
//**********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

Initialization
//Unit Initial statement here
Finalization
//Unit Final statement here
End.