Unit cstructurelib;
Interface
{**
	@explan(说明)内存对象工具 %%		
**}
(*
	概览:
	天软科技
	20171215 添加注释 
	20240308 整理代码				
*)
(**
			@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");
		**)
//c结构体转换为tsl对象结构由于识别有限结果需要手工修改**************************
function MemoryAlignmentCalculate(data,baselen,ssize,pack);
function ReadStringFromPtr(ptr,len);
function WriteStringToPtr(ptr,str,len);
function ReadBytesFromPtr(ptr,L);
function widestr_ptr_len(ptr); //获取宽字符指针的数据长度
function WriteBytesToPtr(ptr,bytes);
function parserctypestr(ts,t,s,n);
function tslarraytocstructcalc(data,alim,bsi,ssize);//计算对其长度 参数 data 结构体,alim对齐;bsi 基础地址默认为0,ssize 结构体大小 返回值
function get_mem_mgr();//获取内存操作对象
	//内存对象分配,释放类;
type tmemoryclass=class
    {**
    @explan(说明)存对象分配,释放类 %%
    @param(_blocks)(array) 分配的内存块;以地址为索引的数组,值为分配的大小 %%
    @param(_tool)(t_mem_mgr) 内存管理底层工具 %%
    **}
    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 (t_mem_mgr)内存底层管理工具 
        **}
        if not ifobj(_tool)then _tool := get_mem_mgr();
        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
    protected 
    static _tool;
    private
    _blocks; //分配的内存块;以地址为索引的数组,值为分配的大小;
end
	//内存管理类,不支持**类型
type ctslctrans = class(tmemoryclass)
    private
    Fstrcdata;
    _nomalloc;
    _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
            "int64":
            begin
                if ifnumber(v)then
                begin
                    //echo "wirtptr\r\n";
                    _tool.writeint64(p,v);
                    ret := 1;
                end
                ret := 1;
            end 
            "intptr","pointer":
            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
            "intptrarray","pointerarray":
            begin
                if arraynumberchek(v)and length(v)<= l then
                begin
                    _tool.writeintptrs(p,length(v),v);
                    ret := true;
                end
            end
            "int64array":
            begin
                if arraynumberchek(v)and length(v)<= l then
                begin
                    _tool.writeint64s(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 :=  _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","pointer":
            begin
                ret := _tool.readptr(p);
            end
            "int64":
            begin
                ret := _tool.readint64(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
            "intptrarray","pointerarray":
            begin
                ret := _tool.readintptrs(p,l);
            end
            "int64array":
            begin
                ret := _tool.readint64s(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
            return _tool.readbuf(ptr,sz);
            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
            return _tool.writebuf(ptr,s,min(sz,length(s)));
            {for i := 0 to min(sz,length(s))-1 do
            begin
                _tool.writebyte(ptr+i,ord(s[i+1]));
            end}
            bts := array();
            for i := 0 to min(sz,length(s))-1 do
            begin
                bts[i] := ord(s[i+1]);
            end
            return _tool.writebytes(ptr,length(bts),bts);
        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
    {**
    @explan(说明) byte数组内存管理类 %%
    **}
    public
    function create(n);
    begin
        {**
        @explan(说明)构造 %%
        @param(n)(integer|array of integer) 字符串长度 预分配%%			
        **}
        foccupancy := fdatalen := 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>foccupancy then
        begin
            fdatalen := foccupancy := n;
            fcmemobj := new ctslctrans(MemoryAlignmentCalculate(array((0,format("byte[%d]",foccupancy),array(0))))); //tslcstructure(array((0,format("byte[%d]",foccupancy),array(0))));
        end else
        if ifarray(n)and length(n)>foccupancy then
        begin
            fdatalen := foccupancy := length(n);
            fcmemobj := new ctslctrans(MemoryAlignmentCalculate(array((0,format("byte[%d]",foccupancy),n)))); //tslcstructure(array((0,format("byte[%d]",foccupancy),n)));
            t := false;
        end
        if ifarray(n) and t then
        begin
            fdatalen := length(n);
            fcmemobj._setvalue_(0,n);
        end else
        if ifnumber(n)and t then fdatalen := n;
    end
    function occupancy();
    begin
        {**
        @explan(说明)获取内存占用 %%
        @return(integer) 占用大小
        **}
        return foccupancy;
    end
    function length(n); //设置长度
    begin
        {**
        @explan(说明)设置长度 或者获取数组的占用长度%%
        @param(n)(integer|nil) nil为获取长度,数字为设置长度 %%	
        **}
        if ifnumber(n)then reset(n);
        return fdatalen;
    end
    function _getptr_();
    begin
        {**
        @explan(说明)返回数组内存指针 %%
        **}
        return fcmemobj._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 ) 返回的数组%%
        **}
        return fcmemobj._getvalue_(0);
    end
    function ptr();
    begin
        {**
        @explan(说明)返回内存指针 %%
        **}
        return _getptr_();
    end
    private 
    foccupancy;//容量
    fdatalen; //长度	
    fcmemobj; //对象
end
type tcbytearray=class
    {**
    @explan(说明) byte数组内存管理类 %%
    **}
    public
    function create(n);
    begin
        {**
        @explan(说明)构造 %%
        @param(n)(integer|array of integer) 字符串长度 预分配%%			
        **}
        fcmemobj := get_mem_mgr();
        foccupancy := fdatalen := 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>foccupancy then
        begin
            fdatalen := foccupancy := n;
            f_sptr := re_malloc(foccupancy);
            t := false;
        end else
        if ifarray(n)and length(n)>foccupancy then
        begin
            fdatalen := foccupancy := length(n);
            f_sptr := re_malloc(foccupancy);            
        end
        if ifarray(n) and t then
        begin
            fdatalen := length(n);            
            fcmemobj.writebytes(f_sptr,fdatalen,n);
        end else
            if ifnumber(n) and t then fdatalen := n;
    end
    function occupancy();
    begin
        {**
        @explan(说明)获取内存占用 %%
        @return(integer) 占用大小
        **}
        return foccupancy;
    end
    function length(n); //设置长度
    begin
        {**
        @explan(说明)设置长度 或者获取数组的占用长度%%
        @param(n)(integer|nil) nil为获取长度,数字为设置长度 %%	
        **}
        if ifnumber(n)then reset(n);
        return fdatalen;
    end
    function _getptr_();
    begin
        {**
        @explan(说明)返回数组内存指针 %%
        **}
        return f_sptr;
    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 ) 返回的数组%%
        **}
        //return fcmemobj.readbytes(f_sptr,fdatalen);
        return fcmemobj.readbytes(f_sptr,foccupancy);
    end
    function ptr();
    begin
        {**
        @explan(说明)返回内存指针 %%
        **}
        return f_sptr;
    end
    function destroy();
    begin
        free_ptr();
    end 
    private 
    function free_ptr();
    begin
        if f_sptr then 
        begin 
            fcmemobj.tfree(f_sptr);
            f_sptr := 0;
        end 
    end 
    function re_malloc(n);
    begin
        if f_sptr then 
        begin 
            return fcmemobj.trealloc(f_sptr,n);       
        end 
        //free_ptr();
        r := fcmemobj.tmalloc(n);
        fcmemobj.tmset(r,n);
        return r;
    end 
    private 
    f_sptr;
    foccupancy;//容量
    fdatalen; //长度	
    fcmemobj; //对象
end
type tcstring=class(tcbytearray)
    {**
    @explan(说明)字符串内存管理类 %%
    @param(endzero)(bool) 默认为false字符串以\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 self.occupancy()-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;
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
type t_mem_mgr =  class()
    {**
    @nickname(内存管理对象) %%
    @explan(说明)内存操作底层接口 %%
    **}
    function create();
    begin
    {$ifdef win32}
        fpointersize := 4;
    {$else}
        fpointersize := 8;
    {$endif}
        //if not _tool then 
        _tool := 0;
        try
            _tool := new aefclassobj_();
        except
            
        end;
    end 
    function tmalloc(sz);
    begin
        {**
        @explan(说明)内存分配 %%
        @param(sz)(integer)大小 %%
        @return(pointer)分配的内存的句柄 %%
        **}
        if _tool then 
            return _tool.tmalloc(sz);
        return TSL_Malloc(sz);
    end
    function trealloc(p,sz);
    begin
        {**
        @explan(说明)重新内存分配 %%
        @param(sz)(integer)大小 %%
        @param(p)(pointer)内存地址 %%
        @return(pointer)新的内存地址 %%
        **}
        if _tool then 
            return _tool.trealloc(p,sz);
        return TSL_Realloc2(p,sz);
    end
    function tfree(p);
    begin
        {**
        @explan(说明) 释放内存 %%
        @param(p)(pointer)内存地址 %%
        **}
        if _tool then 
            return _tool.tfree(p);
        return TSL_Free(p);
    end
    function tmcopy(d,s,sz);
    begin
        if _tool then 
            return _tool.tmcopy(d,s,sz);  
        return memcpy(d,s,sz);  
    end  
    function tmset(p,sz);
    begin
        {**
        @explan(说明) 初始化内存 %%
        @param(sz)(integer)大小 %%
        @param(p)(pointer)内存地址 %%
        **}
        if _tool then 
            return  _tool.tmset(p,sz); //set 0 
        return memset(p,0,sz);
    end
    /////////////read/////////////////////////////////////
    function readbyte(p);
    begin
        {**
        @explan(说明) 读取一个byte %%
        @param(p)(pointer)内存地址 %%
        **}
        if _tool then 
            return  _tool.readbyte(p);
        r := 0;
        memcpy_ptr_int(r,p,1);
        return r;
    end
    function readint(p);
    begin
        {**
        @explan(说明) 读取一个int %%
        @param(p)(pointer)内存地址 %%
        **}
        if _tool then 
            return  _tool.readint(p);
        r := 0;
        memcpy_ptr_int(r,p,4);
        return r;
    end
    function readuint(p);
    begin
        {**
        @explan(说明) 读取一个uint %%
        @param(p)(pointer)内存地址 %%
        **}
        if _tool then 
            return  _tool.readuint(p);
        r := 0;
        memcpy_ptr_int(r,p,4);
        return r;
    end
    function readfloat(p);
    begin
        {**
        @explan(说明) 读取一个float %%
        @param(p)(pointer)内存地址 %%
        **}
        if _tool then 
            return  _tool.readfloat(p);
        r := 0.0;
        memcpy_ptr_Single(r,p,4);
        return r;
    end
    function readptr(p);
    begin
        {**
        @explan(说明) 读取一个pointer %%
        @param(p)(pointer)内存地址 %%
        **}
        if _tool then 
            return  _tool.readptr(p);
        r := 0L;
        memcpy_ptr_pointer(r,p,fpointersize);
        return r;
    end 
    function readint64(p);
    begin
        {**
        @explan(说明) 读取一个int64 %%
        @param(p)(pointer)内存地址 %%
        **}
        if _tool then 
        begin 
            if fpointersize=8 then return _tool.readptr(p);
            d := _tool.readuints(p,2);
            r := (int64(d[1]) shl 32) .| (int64(d[0]) .& 0xffffffffL);         
            return r; 
        end   
        r := 0L;
        memcpy_ptr_int64(r,p);
        return r;
    end 
    function readdouble(p);
    begin
        {**
        @explan(说明) 读取一个double %%
        @param(p)(pointer)内存地址 %%
        **}
        if _tool then 
            return  _tool.readdouble(p);
        r := 0.0;
        memcpy_ptr_double(r,p,8);
        return r;
    end
    function readstr(p);
    begin
        if _tool then 
            return  _tool.readstr(p);
        r:="";
        len := strlen(p);
        setlength(r,strlen(p));
        memcpy1(r,p,len);
        return r;
    end 
    function readshort(p);
    begin
        {**
        @explan(说明) 读取一个short %%
        @param(p)(pointer)内存地址 %%
        **}
        if _tool then 
            return  _tool.readshort(p);
        r := 0;
        memcpy_ptr_int(r,p,2);
        return r;
    end
    function readlong(p);
    begin
        {**
        @explan(说明) 读取一个long %%
        @param(p)(pointer)内存地址 %%
        **}
        if _tool then 
            return  _tool.readlong(p);
        r := 0;
        memcpy_ptr_int(r,p,4);
        return r;
    end
    function readulong(p);
    begin
        {**
        @explan(说明) 读取一个ulong %%
        @param(p)(pointer)内存地址 %%
        **}
        if _tool then 
            return  _tool.readulong(p);
        r := 0;
        memcpy_ptr_int(r,p,4);
        return r;
    end
    function readints(p,sz);
    begin
        {**
        @explan(说明) 读取一组int %%
        @param(p)(pointer)内存地址 %%
        @param(sz)(pointer)大小 %%
        **}
        if _tool then 
            return  _tool.readints(p,sz);
        r := ones(sz);
        memcpy_ptr_ints(r,p,sz*4);
        //echo tostn(r1);
        //echo tostn(r);
        return r;
    end
    function readuints(p,sz);
    begin
        {**
        @explan(说明) 读取一组uint %%
        @param(p)(pointer)内存地址 %%
        @param(sz)(pointer)大小 %%
        **}
        if _tool then 
            return  _tool.readuints(p,sz);
        return readints(p,sz);
    end
    function readint64s(p,sz);
    begin
        {**
        @explan(说明) 读取一组double %%
        @param(p)(pointer)内存地址 %%
        @param(sz)(pointer)大小 %%
        **}
        if _tool then 
        begin 
            if fpointersize=8 then return readintptrs(p,sz);
            r := array();
            for i:= 0 to sz-1 do 
            begin
                r[i] := readint64(p+i*fpointersize);
            end 
            return r;
        end
        r := zeros(sz);
        memcpy_ptr_int64s(r,p,sz*8);
        return r;
    end
    function readdoubles(p,sz);
    begin
        {**
        @explan(说明) 读取一组double %%
        @param(p)(pointer)内存地址 %%
        @param(sz)(pointer)大小 %%
        **}
        if _tool then 
            return  _tool.readdoubles(p,sz);        
        r := zeros(sz);
        memcpy_ptr_doubles(r,p,sz*8);
        return r;
    end
    function readbytes(p,sz);
    begin
        {**
        @explan(说明) 读取一组byte %%
        @param(p)(pointer)内存地址 %%
        @param(sz)(pointer)大小 %%
        **}
        if _tool then 
            return  _tool.readbytes(p,sz);
        s := "";
        setlength(s,sz);
        memcpy1(s,p,sz);
        r := array();
        for i := 1 to sz do 
        begin
            r[i-1] := ord(s[i]);
        end 
        return r;

    end
    function readshorts(p,sz);
    begin
        {**
        @explan(说明) 读取一组short  %%
        @param(p)(pointer)内存地址 %%
        @param(sz)(pointer)大小 %%
        **}
        if _tool then 
            return  _tool.readshorts(p,sz);
        r := ones(sz);
        memcpy_ptr_shorts(r,p,sz*2);
        return r;
    end
    function readushorts(p,sz);
    begin
        {**
        @explan(说明) 读取一组short  %%
        @param(p)(pointer)内存地址 %%
        @param(sz)(pointer)大小 %%
        **}
        if _tool then 
            return  _tool.readushorts(p,sz);
        return readshorts(p,sz);
    end
    function readfloats(p,sz);
    begin
        {**
        @explan(说明) 读取一组float  %%
        @param(p)(pointer)内存地址 %%
        @param(sz)(pointer)大小 %%
        **}
        if _tool then 
            return  _tool.readfloats(p,sz);
        r := ones(sz);
        memcpy_ptr_Single(r,p,sz*4);
        return r;
    end
    function readintptrs(p,sz);
    begin
        {**
        @explan(说明) 读取一组intptr  %%
        @param(p)(pointer)内存地址 %%
        @param(sz)(pointer)大小 %%
        **}
        if _tool then 
            return  _tool.readintptrs(p,sz);
        r := ones(sz);
        memcpy_ptr_pointers(r,p,sz*fpointersize);
        return r;
        //return memcpy_ptr_pointer(p);        
    end    
    ////////////////////write//////////////////////////////////////////////////  
    function writebyte(p,v);
    begin
        {**
        @explan(说明) 写入一个beyte %%
        @param(p)(pointer)内存地址 %%
        @param(v)(integer)值 %%
        **}
        if _tool then 
            return  _tool.writebyte(p,v);
        memcpy_int_ptr(p,v,1);
        return 1;
    end
    function writeint(p,v);
    begin
        if _tool then 
            return  _tool.writeint(p,v); 
        memcpy_int_ptr(p,v,4);
        return 1;    
    end  
    function writeuint(p,v);
    begin
        if _tool then 
            return  _tool.writeuint(p,v);   
        return writeint(p,v);
    end
    function writefloat(p,v);
    begin 
        if _tool then  
            return  _tool.writefloat(p,v);   
        memcpy_Single_ptr(p,v,4) ;
        return 1;  
    end 
    function writeptr(p,v);
    begin
        {**
        @explan(说明) 写入一个pointer%%
        @param(p)(pointer)内存地址 %%
        **}
        if _tool then 
            return  _tool.writeptr(p,v);  
        memcpy_pointer_ptr(p,v,fpointersize); 
        return 1;       
    end
    function writeint64(p,v);
    begin
        {**
        @explan(说明) 写取一个int64 %%
        @param(p)(pointer)内存地址 %%
        **} 
        if _tool then 
        begin
            if fpointersize=8 then return _tool.writeptr(p,v);       
            d := array();
            d[0] := 0xff .& v;
            for i:= 1 to 7 do 
            begin 
                d[i] := (v shr (i*8)) .& 0xff;
            end 
            return _tool.writebytes(p,8,d);
        end 
        memcpy_int64_ptr(p,v,8);
        return 1;             
    end 
    function writedouble(p,v);
    begin
        {**
        @explan(说明) 写一个double %%
        @param(p)(pointer)内存地址 %%
        **}
        if _tool then 
            return  _tool.writedouble(p,v); 
        memcpy_double_ptr(p,v,8);  
        return 1;         
    end 
    function writestr(p,v);
    begin
        if _tool then 
            return  _tool.writestr(p,v);  
        memcpy2(p,v,strlen1(v));
        return 1;
    end 
    function writeshort(p,v);
    begin
        {**
        @explan(说明) 写入一个short%%
        @param(p)(pointer)内存地址 %%
        **}
        if _tool then 
            return  _tool.writeshort(p,v);   
        memcpy_int_ptr(p,v,2);
        return 1;     
    end
    function writeushort(p,v);
    begin
        {**
        @explan(说明) 写入一个ushort%%
        @param(p)(pointer)内存地址 %%
        **}
        if _tool then 
            return  _tool.writeushort(p,v);  
        return writeshort(p,v);     
    end
    function writelong(p,v);
    begin
        {**
        @explan(说明) 写入一个long%%
        @param(p)(pointer)内存地址 %%
        **}
        if _tool then 
            return  _tool.writelong(p,v); 
        return writeint(p,v);        
    end
    function writeulong(p,v);
    begin
        {**
        @explan(说明) 写入一个ulong%%
        @param(p)(pointer)内存地址 %%
        **}
        if _tool then 
            return  _tool.writeulong(p,v); 
        return writelong(p,v);     
    end
    function writeints(p,sz,v);
    begin
        {**
        @explan(说明) 写入一组int %%
        @param(p)(pointer)内存地址 %%
        **}
        if _tool then 
            return  _tool.writeints(p,sz,v);
        return memcpy_int_ptrs(p,v,sz*4);
    end
    function writeuints(p,sz,v);
    begin
        {**
        @explan(说明) 写入一组int %%
        @param(p)(pointer)内存地址 %%
        **}
        if _tool then 
            return  _tool.writeuints(p,sz,v);
        return writeints(p,sz,v);
    end
    
    function writeint64s(p,sz,v);
    begin
        {**
        @explan(说明) 写入一组int %%
        @param(p)(pointer)内存地址 %%
        **}
        if _tool then 
        begin 
            if fpointersize=8 then return writeintptrs(p,sz,v);
            len := min(sz,length(v));
            for i:= 0 to len-1 do 
            begin 
                writeint64(p+i*fpointersize,v[i]);
            end
            return 1; 
        end         
        memcpy_int64_ptrs(p,sz,v*8);
        return 1;   
    end
    function writedoubles(p,sz,v);
    begin
        {**
        @explan(说明) 写入一组int %%
        @param(p)(pointer)内存地址 %%
        **}
        if _tool then
            return  _tool.writedoubles(p,sz,v);
        memcpy_double_ptrs(p,v,sz*8);
        return 1; 
    end
    function writebytes(p,sz,v);
    begin
        {**
        @explan(说明) 写入一组short %%
        @param(p)(pointer)内存地址 %%
        **}
        if _tool then
            return  _tool.writebytes(p,sz,v);
        r := "";
        setlength(r,sz);
        for i:=1 to sz do 
        begin 
            r[i] := v[i-1];
        end 
        memcpy2(p,r,sz);
        return 1;
    end
    function writeshorts(p,sz,v);
    begin
        {**
        @explan(说明) 写入一组short %%
        @param(p)(pointer)内存地址 %%
        **}
        if _tool then
            return  _tool.writeshorts(p,sz,v);
        memcpy_short_ptrs(p,v,sz*2);
        return 1;
    end
    function writeushorts(p,sz,v);
    begin
        {**
        @explan(说明) 写入一组ushort %%
        @param(p)(pointer)内存地址 %%
        **}
        if _tool then
            return  _tool.writeushorts(p,sz,v);
        return writeshorts(p,sz,v);
    end
    function writefloats(p,sz,v);
    begin
        {**
        @explan(说明) 写入一组float %%
        @param(p)(pointer)内存地址 %%
        **}
        if _tool then
            return  _tool.writefloats(p,sz,v);
        memcpy_Single_ptrs(p,v,sz*4);
        return 1;
    end
    function writeintptrs(p,sz,v);
    begin
        {**
        @explan(说明) 写入一组intptr %%
        @param(p)(pointer)内存地址 %%
        **}
        if _tool then
            return  _tool.writeintptrs(p,sz,v);
        memcpy_pointer_ptrs(p,v,sz*fpointersize);
        return 1;
    end
    function writelongs(p,sz,v);
    begin
        {**
        @explan(说明) 写入一组intptr %%
        @param(p)(pointer)内存地址 %%
        **}
        if _tool then
            return  _tool.writelongs(p,sz,v);
        return writeints(p,sz,v);
    end
    function writeulongs(p,sz,v);
    begin
        {**
        @explan(说明) 写入一组long %%
        @param(p)(pointer)内存地址 %%
        **}
        if _tool then
            return _tool.writeulongs(p,sz,v);
        return writelongs(p,sz,v);
    end  
    function readbuf(p,n);
    begin
        s := "";
        if not(n>0) then return s;
        setlength(s,n);
        memcpy1(s,p,n);
        return s;
    end 
    function writebuf(p,s,n);
    begin
        if not(s and ifstring(s)) then return 0;
        if ifnil(n) then n := length(s);
        return memcpy2(p,s,min(n,length(s))) ;   
    end  
    private 
    function TSL_Malloc(sz:pointer):pointer;
    begin
        _f_ := static function(sz:pointer):pointer;cdecl;external getdlsymaddress(get_tsapi_dll(),"TSL_Malloc");
        return ##_f_(sz);    
    end 
    function TSL_Free(ptr:pointer):pointer;
    begin
        _f_ := static procedure(ptr:pointer);cdecl;external getdlsymaddress(get_tsapi_dll(),"TSL_Free");
        return ##_f_(ptr);    
    end 
    function TSL_Realloc2(ptr:pointer;sz:pointer):pointer;
    begin
        _f_ := static function(ptr:pointer;sz:pointer):pointer;cdecl;external getdlsymaddress(get_tsapi_dll(),"TSL_Realloc2");
        return ##_f_(ptr,sz);    
    end 
    function memset(ptr:pointer;ch:integer;size_t:pointer):pointer;
    begin
        _f_ := static function(ptr:pointer;ch:integer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memset");
        return ##_f_(ptr,ch,size_t);
    end
    function strlen(ptr:pointer):pointer;
    begin
        _f_ := static function(ptr:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"strlen");
        return ##_f_(ptr);
    end 
    function strlen1(var ptr:string):pointer;
    begin
        _f_ := static function(var ptr:string):pointer;cdecl;external getdlsymaddress(get_std_dll(),"strlen");
        return ##_f_(ptr);
    end 
    ///////////////////int/////////////////////////////////////
    function memcpy_ptr_int(var dst:integer;src:pointer;size_t:pointer):pointer;
    begin
        _f_ := static function(var dst:integer;src:pointer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
        r :=  ##_f_(dst,src,size_t);
        //echo "\r\n read int out:",dst,"  ",r,"  ",src,"  ",size_t,"  ",isnan(dst);
        return r;
    end 
    function memcpy_ptr_ints(var dst:array of integer;src:pointer;size_t:pointer):pointer;
    begin
        _f_ := static function(var dst:array of integer;src:pointer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
        r :=  ##_f_(dst,src,size_t);
        //echo "\r\n read int out:",dst,"  ",r,"  ",src,"  ",size_t,"  ",isnan(dst);
        return r;
    end 
    function memcpy_int_ptr(dst:pointer;var src:integer;size_t:pointer):pointer;
    begin
        _f_ := static function(dst:pointer;var src:integer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
        return ##_f_(dst,src,size_t);
    end
    function memcpy_int_ptrs(dst:pointer;src:array of integer;size_t:pointer):pointer;
    begin
        _f_ := static function(dst:pointer;src:array of integer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
        return ##_f_(dst,src,size_t);
    end
    ////////////////////////////////////////////////////////////////////////////////
    ////////////////////////// short ////////////////////////////////////////////////
    function memcpy_short_ptrs(dst:pointer;src:array of short;size_t:pointer):pointer;
    begin
        _f_ := static function(dst:pointer;src:array of short;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
        r :=  ##_f_(dst,src,size_t);
        //echo "\r\n read int out:",dst,"  ",r,"  ",src,"  ",size_t,"  ",isnan(dst);
        return r;
    end 
    function memcpy_ptr_shorts(var dst:array of short;src:pointer;size_t:pointer):pointer;
    begin
        _f_ := static function(var dst:array of short;src:pointer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
        r :=  ##_f_(dst,src,size_t);
        //echo "\r\n read int out:",dst,"  ",r,"  ",src,"  ",size_t,"  ",isnan(dst);
        return r;
    end 
    //////////////////////////////////////////////////////////////////
    //////////////////////////////double/////////////////////////////////////
    function memcpy_ptr_double(var dst:double;src:pointer;size_t:pointer):pointer;
    begin
        _f_ := static function(var dst:double;src:pointer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
        r :=  ##_f_(dst,src,size_t);
        return r;
    end 
    function memcpy_ptr_doubles(var dst:array of double;src:pointer;size_t:pointer):pointer;
    begin
        _f_ := static function(var dst:array of double;src:pointer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
        r :=  ##_f_(dst,src,size_t);
        return r;
    end
    function memcpy_double_ptr(dst:pointer;var src:double;size_t:pointer):pointer;
    begin
        _f_ := static function(dst:pointer;var src:double;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
        return ##_f_(dst,src,size_t);
    end
    function memcpy_double_ptrs(dst:pointer;var src:array of double;size_t:pointer):pointer;
    begin
        _f_ := static function(dst:pointer;var src:array of double;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
        return ##_f_(dst,src,size_t);
    end
    ///////////////////////////////////////////////////////////////////////////////
    ///////////////////////////float/////////////////////////////////////////////////
    function memcpy_ptr_Single(var dst:Single;src:pointer;size_t:pointer):pointer;
    begin
        _f_ := static function(var dst:Single;src:pointer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
        r :=  ##_f_(dst,src,size_t);
        return r;
    end 
    function memcpy_ptr_Singles(var dst:array of Single;src:pointer;size_t:pointer):pointer;
    begin
        _f_ := static function(var dst:array of Single;src:pointer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
        r :=  ##_f_(dst,src,size_t);
        return r;
    end
    function memcpy_Single_ptr(dst:pointer;var src:Single;size_t:pointer):pointer;
    begin
        _f_ := static function(dst:pointer;var src:Single;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
        return ##_f_(dst,src,size_t);
    end
    function memcpy_Single_ptrs(dst:pointer;src: array of Single;size_t:pointer):pointer;
    begin
        _f_ := static function(dst:pointer;src: array of Single;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
        return ##_f_(dst,src,size_t);
    end
    //////////////////////////////////////////////////////////////////////////////////////
    ///////////////////////////////pointer/////////////////////////////////////////////////////
    function memcpy_ptr_pointer(var dst:pointer;src:pointer;size_t:pointer):pointer;
    begin
        _f_ := static function(var dst:pointer;src:pointer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
        return ##_f_(dst,src,size_t);
    end 
    function memcpy_ptr_pointers(var dst:array of pointer;src:pointer;size_t:pointer):pointer;
    begin
        _f_ := static function(var dst:array of pointer;src:pointer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
        return ##_f_(dst,src,size_t);
    end 
    function memcpy_pointer_ptr(dst:pointer;var src:pointer;size_t:pointer):pointer;
    begin
        _f_ := static function(dst:pointer;var src:pointer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
        return ##_f_(dst,src,size_t);
    end
    function memcpy_pointer_ptrs(dst:pointer;var src: array of pointer;size_t:pointer):pointer;
    begin
        _f_ := static function(dst:pointer;var src:array of pointer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
        return ##_f_(dst,src,size_t);
    end
    ///////////////////////////////////////////////////////////////////////////////////
    ///////////////////////////////int64////////////////////////////////////////////////
    function memcpy_ptr_int64(var dst:int64;src:pointer;size_t:pointer):pointer;
    begin
        _f_ := static function(var dst:int64;src:pointer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
        return ##_f_(dst,src,64);
    end 
    function memcpy_ptr_int64s(var dst:array of int64;src:pointer;size_t:pointer):pointer;
    begin
        _f_ := static function(var dst:array of int64;src:pointer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
        return ##_f_(dst,src,64);
    end 
    function memcpy_int64_ptr(dst:pointer;var src:int64;size_t:pointer):pointer;
    begin
        _f_ := static function(dst:pointer;var src:int64;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
        return ##_f_(dst,src,64);
    end
    function memcpy_int64_ptrs(dst:pointer;src:array of int64;size_t:pointer):pointer;
    begin
        _f_ := static function(dst:pointer;src:array of int64;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
        return ##_f_(dst,src,size_t);
    end    
    //////////////////////////string/////////////////////////////////////////////////////
    function memcpy(dst:pointer;src:pointer;size_t:pointer):pointer;
    begin
        _f_ := static function(dst:pointer;src:pointer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
        return ##_f_(dst,src,size_t);
    end  
    function memcpy1(var dst:string;src:pointer;size_t:pointer):pointer;
    begin
        _f_ := static function(var dst:string;src:pointer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
        return ##_f_(dst,src,size_t);
    end 
    function memcpy2(dst:pointer ; src:string;size_t:pointer):pointer;
    begin
        _f_ := static function(dst:pointer ; src:string;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
        r :=  ##_f_(dst,src,size_t);
        return r;
    end 
    function memcpy3(var dst:string ;var src:string;size_t:pointer):pointer;
    begin
        _f_ := static function(dst:string ;src:string;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
        return ##_f_(dst,src,size_t);
    end 
    /////////////////////////////////////////////////////////////////////////////////////////// 
    function get_tsapi_dll();
    begin
    {$ifdef linux}
        return "libTSLkrnl.so";//"libTSSVRAPI.so";
    {$else}
        return "TSLkrnl.dll";//"tssvrapi.dll";
    {$endif}
    end
    function get_std_dll();
    begin
    {$ifdef linux}
        return "libdl.so.2";
    {$else}
        return "msvcrt.dll";
    {$endif}
    end 
    public
    function wcslen(ptr:pointer):pointer;
    begin
        _f_ := static function(ptr:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"wcslen");
        return ##_f_(ptr);
    end
    function wcslen1(ptr:string):pointer;
    begin
        _f_ := static function(ptr:string):pointer;cdecl;external getdlsymaddress(get_std_dll(),"wcslen");
        return ##_f_(ptr);
    end 
    private 
    fpointersize;
    _tool;
end
		
Implementation
function widestr_ptr_len(ptr); //获取宽字符指针的数据长度
begin
    mg := get_mem_mgr();
    if ptr>0 or ptr<0 then 
    begin 
        return mg.wcslen(ptr);
    end 
end 
function ReadStringFromPtr(ptr,n);
begin
    {**
    @explan(说明) 读取一个指向\0字符串指针的值 %%
    @param(ptr)(pointer) 指针 %%;
    @param(n)(integer) 长度,不给以\0作为长度 %%;
    @return(string) 字符串 %%
		
    **}
    if ptr>0 or  ptr<0 then 
    begin
        if n>0 then 
        begin 
            return get_mem_mgr().readbuf(ptr,n);
        end else 
        begin 
            return get_mem_mgr().readstr(ptr);
        end 
    end 
    return "";
end
function WriteStringToPtr(ptr,s,len);
begin
    {**
    @explan(说明) 向一个指针写入\0结尾的字符串 %%
    @param(ptr)(pointer) 指针 %%;
    @param(s)(string) 字符串 %%	
    @param(len)(integer) 指定写入长度 %%	
    **}
    if ifstring(s) and (ptr>0 or ptr<0) then 
    begin
        if len>0 then 
        begin 
            return get_mem_mgr().writebuf(ptr,s,len);
        end else 
            return get_mem_mgr().writestr(ptr,s);
    end 
    return 0;
end
function ReadBytesFromPtr(ptr,L);
begin
    {**
    @explan(说明) 读取一个指向数组指针的值 %%
    @param(ptr)(pointer) 指针 %%;
    @param(L)(integer) 长度 %%;
    @return(array of integer) 字符串 %%	
    **}
    if ptr and (ptr>0 or ptr<0)and L>0 then return get_mem_mgr().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 get_mem_mgr().writebytes(ptr,length(bytes),bytes);
    return 0;
end
function get_mem_mgr();
begin
{**
    @explan(说明) 获取内存管理对象 %%  
    @return(t_mem_mgr)   
**}
    return static new t_mem_mgr();//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 tslarraytocstructcalc(data,pack,0,ssize);
end
function is_validate_type(tp);
begin
    return array("uint":1,"char":1,"float":1,"double":1,"int":1,"intptr":1,"pointer":1,"int64":1,"byte":1,"short":1,"char*":1,"user*":1)[tp];
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 get_c_typesize();;//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]; //变量值
        parserctypestr(tp,tp1,size);
        //echo "*************************",size;
        tpbyte := itemslen[i]; //当前占用的字节
        if is_validate_type(tp1)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];
        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 get_c_typesize() //获取类型大小
begin
{**
    @explan(说明) 获取类型占用内存大小 %%
    @return(array) 以类型字符串为下标的数字数组,数字表示该类型的内存大小 %%
    **}
{$ifdef win32}
    psize := 4;
{$else}
    psize := 8;
{$endif}
    r := array();
    r["int"] := 4;
    r["uint"] := 4;
    r["char*"] := psize;
    r["intptr"] := psize;
    r["SHORT"] := 2;
    r["BOOL"] := 4;
    r["char"] := 1;
    r["double"] := 8;
    r["short"] := 2;
    r["ushort"] := 2;
    r["long"] := 4;
    r["ulong"] := 4;
    r["LONG"] := 4;
    r["bool"] := 4;
    r["byte"] := 1;
    r["BYTE"] := 1;
    r["WORD"] := 2;
    r["DWORD"] := 4;
    r["word"] := 2;
    r["dword"] := 4;
    r["float"] := 4;
    r["FLOAT"] := 4;
    r["pointer"] := psize;
    r["INT64"] := 8;
    r["int64"] := 8;
    //echo "\r\n>>>>gettype";
    return r;
    {
    TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "int"), sizeof(int));
    TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "uint"), sizeof(unsigned int));
    TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "char*"), sizeof(char*));
    TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "intptr"), sizeof(INT_PTR));
    TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "SHORT"), sizeof(SHORT));
    TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "BOOL"), sizeof(BOOL));
    TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "char"), sizeof(char));
    TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "double"), sizeof(double));
    TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "short"), sizeof(short));
    TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "ushort"), sizeof(unsigned short));
    TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "long"), sizeof(long));
    TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "ulong"), sizeof(unsigned long));
    TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "LONG"), sizeof(LONG));
    TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "bool"), sizeof(bool));
    TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "byte"), sizeof(byte));
    TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "BYTE"), sizeof(BYTE));
    TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "WORD"), sizeof(WORD));
    TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "DWORD"), sizeof(DWORD));
    TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "word"), sizeof(WORD));
    TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "dword"), sizeof(DWORD));
    TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "float"), sizeof(float));
    TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "FLOAT"), sizeof(FLOAT));
    TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "pointer"), sizeof(INT_PTR));
    }
    return 1;
end 
Initialization
//Unit Initial statement here
Finalization
//Unit Final statement here
End.