Delphi XE and Unicode -
i have 1 function working in delphi 6. trying migrate old project delphi xe8, function doesn't work properly.
please me.
old function:
function readstring(var p: pointer): string; var b: byte; begin b := byte(p^); setlength(result, b); p := pointer( integer(p) + 1); move(p^, result[1], integer(b)); p := pointer( integer(p) + b ); end;
i try changed uncode, doesn't work:
function readstring(var p: pointer): string; var b: byte; lresult: ansistring; begin b := byte(p^); setlength(lresult, b); p := pointer( integer(p) + 1); move(p^, lresult[1], integer(b)); p := pointer( integer(p) + b ); result := string(lresult); end
the function use in:
getintfmetadata(myobj ifcontroller, intfmd, true);
procedure getintfmetadata(info: ptypeinfo; var intfmd: tintfmetadata; methodarrayopt: tfillmethodarrayopt); var i, offset: integer; methods: integer; baserttimethods: integer; hasrtti: integer; pp: pptypeinfo; p: pointer; selfmethcount: integer; intfmethod: pintfmethentry; begin p := pointer(info); intfmd.info := info; { tkkind } readbyte(p); intfmd.name := readstring(p); { interface flags } readbyte(p); intfmd.unitname := readstring(p); methods := readword(p); { # methods } hasrtti := readword(p); { $ffff if no rtti, # methods again if has rtti } if hasrtti = $ffff raise einterfacerttiexception.createfmt(snortti, [intfmd.unitname + '.' + intfmd.name]); { save method count } selfmethcount := methods; offset := 0; { size array , fill in information } setlength(intfmd.mda, methods); fillmethodarray(p, @intfmd, offset, selfmethcount); end; procedure fillmethodarray(p: pointer; intfmd: pintfmetadata; offset, methods: integer); var s: ansistring; i, j, k, l: integer; paramcount: integer; kind, flags: byte; paraminfo: ptypeinfo; paramname: ansistring; intfmethod: pintfmethentry; intfparam: pintfparamentry; begin := 0 methods -1 begin intfmethod := @intfmd.mda[offset]; intfmethod.name := readstring(p); kind := readbyte(p); { tkkind } intfmethod.cc := ccmap[readbyte(p)]; paramcount := readbyte(p); { param count including self } intfmethod.paramcount := paramcount - 1; intfmethod.pos := offset; intfmethod.hasrtti := true; setlength(intfmethod.params, paramcount); k := 0; j := 0 paramcount - 1 begin flags := readbyte(p); { flags } paramname := readstring(p); { param name } s := readstring(p); { param type name } l := readlong(p); { param type info } if l <> 0 paraminfo := pptypeinfo(l)^ else raise einterfacerttiexception.createfmt(snorttiparam, [paramname, intfmethod.name, intfmd.unitname + '.' + intfmd.name]); if j = 0 intfmethod.selfinfo := paraminfo else begin intfparam := @intfmethod.params[k]; intfparam.flags := tparamflags(flags); intfparam.name := paramname; intfparam.info := paraminfo; inc(k); end; end; if kind = byte(mkfunction) begin s := readstring(p); intfmethod.resultinfo := pptypeinfo(readlong(p))^; end; inc(offset); end; end; function readbyte(var p: pointer): byte; begin result := byte(p^); p := pointer( integer(p) + 1); end;
if want name of type through ptypeinfo structure:
function getname(p: pointer): string; begin result := ptypeinfo(p)^.name; end;
or better qualify pointer:
function getname(p: ptypeinfo): string; begin result := p^.name; end;
or use built in function: typinfo.gettypename.
what david pointing out in comments, ttypeinfo
record starts enum, kind
. next comes name
string. offset field better left compiler calculate.
in updated question clear increment pointer 1 (readbyte) before calling function name. don't that. this:
intfmd.name := gettypename(info);
now, use knowledge handle methods of ttypeinfo
, needs update too.
Comments
Post a Comment