2423 lines
69 KiB
Plaintext
2423 lines
69 KiB
Plaintext
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 linux}
|
|
return 8;
|
|
{$endif}
|
|
{$IFDEF win64}
|
|
return 8;
|
|
{$ENDIF}
|
|
return 4;
|
|
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)内存底层管理工具
|
|
**}
|
|
return get_mem_mgr();
|
|
end
|
|
function create();
|
|
begin
|
|
_blocks := array();
|
|
_tool := 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
|
|
private
|
|
_tool;
|
|
_blocks; //分配的内存块;以地址为索引的数组,值为分配的大小;
|
|
end
|
|
//内存管理类,不支持**类型
|
|
type ctslctrans = class(tmemoryclass)
|
|
private
|
|
_tool;
|
|
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","word":
|
|
begin
|
|
if ifnumber(v)then
|
|
begin
|
|
_tool.writeshort(p,v);
|
|
ret := 1;
|
|
end
|
|
end
|
|
"shortarray","wordarray":
|
|
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();
|
|
_tool := mtool();
|
|
_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 v="userarray" then
|
|
begin
|
|
tptr := ptr+v3;
|
|
o := _objs[i];
|
|
o._setcptr_(tptr);
|
|
end else
|
|
begin
|
|
_objs[i]:= 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","word":
|
|
begin
|
|
ret := _tool.readshort(p);
|
|
end
|
|
"shortarray","wordarray":
|
|
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
|
|
if findclass("aefclassobj_") then _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,len);
|
|
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);
|
|
{$ifdef linux}
|
|
r := 0L;
|
|
memcpy_ptr_int64(r,p);
|
|
{$else}
|
|
r := 0;
|
|
memcpy_ptr_int(r,p,4);
|
|
{$endif}
|
|
return r;
|
|
end
|
|
function readulong(p);
|
|
begin
|
|
{**
|
|
@explan(说明) 读取一个ulong %%
|
|
@param(p)(pointer)内存地址 %%
|
|
**}
|
|
if _tool then
|
|
return _tool.readulong(p);
|
|
{$ifdef linux}
|
|
r := 0L;
|
|
ct := 8;
|
|
{$else}
|
|
r := 0;
|
|
ct := 4;
|
|
{$endif}
|
|
memcpy_ptr_int(r,p,ct);
|
|
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);
|
|
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);
|
|
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);
|
|
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+"\0",strlen1(v)+1);
|
|
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);
|
|
{$ifdef linux}
|
|
return writeint64(p,v);
|
|
{$else}
|
|
return writeint(p,v);
|
|
{$endif}
|
|
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,v,min(sz,length(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);
|
|
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);
|
|
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);
|
|
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);
|
|
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,8);
|
|
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,8);
|
|
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,8);
|
|
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) 对其方式 默认8 %%
|
|
**}
|
|
if not ifnumber(baselen)then baselen := 1; //最小长度
|
|
if not ifnumber(ssize)then ssize := 0; //大小
|
|
if not ifnumber(pack)then
|
|
begin
|
|
{$ifdef linux}
|
|
pack := 8;
|
|
{$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,"long":1,"word":1,"dword":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 := 8;
|
|
{$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();
|
|
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
|
|
begin
|
|
raise ("类型错误:" $ tp1);
|
|
end
|
|
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();
|
|
if not ifarray(d) then return ret;
|
|
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}
|
|
longsize := 4;
|
|
{$ifdef linux}
|
|
longsize := 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"] := longsize;
|
|
r["ulong"] := longsize;
|
|
r["LONG"] := longsize;
|
|
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["user*"] := 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. |