diff options
Diffstat (limited to 'plugins/Utils.pas/strans.pas')
| -rw-r--r-- | plugins/Utils.pas/strans.pas | 828 |
1 files changed, 828 insertions, 0 deletions
diff --git a/plugins/Utils.pas/strans.pas b/plugins/Utils.pas/strans.pas new file mode 100644 index 0000000000..b70057c33c --- /dev/null +++ b/plugins/Utils.pas/strans.pas @@ -0,0 +1,828 @@ +{}
+unit strans;
+
+interface
+
+uses windows{$IFDEF Miranda}, m_api{$ENDIF};
+// <align>|[<key>]<type> [(<type alias>)] [<alias>] [arr.len] [value]|
+const
+ char_separator = '|';
+ char_hex = '$';
+ char_return = '*';
+ char_script = '%';
+{$IFDEF Miranda}
+ char_mmi = '&';
+{$ENDIF}
+const
+ SST_BYTE = 0;
+ SST_WORD = 1;
+ SST_DWORD = 2;
+ SST_QWORD = 3;
+ SST_NATIVE = 4;
+ SST_BARR = 5;
+ SST_WARR = 6;
+ SST_BPTR = 7;
+ SST_WPTR = 8;
+ SST_LAST = 9;
+ SST_PARAM = 10;
+ SST_UNKNOWN = -1;
+const
+ EF_RETURN = $00000001;
+ EF_SCRIPT = $00000002;
+ EF_MMI = $00000004;
+ EF_LAST = $00000080;
+type
+ // int_ptr = to use aligned structure data at start
+ PStructResult = ^TStructResult;
+ TStructResult = record
+ typ :int_ptr;
+ len :int_ptr;
+ offset:int_ptr;
+ end;
+type
+ TStructType = record
+ typ :integer;
+ short:PAnsiChar;
+ full :PAnsiChar;
+ end;
+const
+ MaxStructTypes = 11;
+const
+ StructElems: array [0..MaxStructTypes-1] of TStructType = (
+ (typ:SST_BYTE ; short:'byte' ; full:'Byte'),
+ (typ:SST_WORD ; short:'word' ; full:'Word'),
+ (typ:SST_DWORD ; short:'dword' ; full:'DWord'),
+ (typ:SST_QWORD ; short:'qword' ; full:'QWord'),
+ (typ:SST_NATIVE; short:'native'; full:'NativeInt'),
+ (typ:SST_BARR ; short:'b.arr' ; full:'Byte Array'),
+ (typ:SST_WARR ; short:'w.arr' ; full:'Word Array'),
+ (typ:SST_BPTR ; short:'b.ptr' ; full:'Pointer to bytes'),
+ (typ:SST_WPTR ; short:'w.ptr' ; full:'Pointer to words'),
+{$IFDEF Miranda}
+ (typ:SST_LAST ; short:'last' ; full:'Last result'),
+ (typ:SST_PARAM ; short:'param' ; full:'Parameter')
+{$ELSE}
+ (typ:SST_LAST ; short:'last' ; full:'Parameter 1'),
+ (typ:SST_PARAM ; short:'param' ; full:'Parameter 2')
+{$ENDIF}
+ );
+
+
+type
+ tOneElement = record
+ etype :integer;
+ flags :integer; // EF_MMI,EF_SCRIPT,EF_RETURN
+ len :integer; // value length (for arrays and pointers)
+ align :integer;
+ alias :array [0..63] of AnsiChar;
+ talias:array [0..63] of AnsiChar; // type alias
+ svalue:array [0..31] of AnsiChar; // numeric value text
+ case boolean of
+ false: (value:int64);
+ true : (text :pointer);
+ end;
+
+
+function GetOneElement(txt:pAnsiChar;var res:tOneElement;
+ SizeOnly:boolean;num:integer=0):integer;
+procedure FreeElement(var element:tOneElement);
+
+{$IFDEF Miranda}
+const
+ rtInt = 1;
+ rtWide = 2;
+{$ENDIF}
+
+function MakeStructure(txt:pAnsiChar;aparam,alast:LPARAM
+ {$IFDEF Miranda}; restype:integer=rtInt{$ENDIF}):pointer;
+
+function GetStructureResult(var struct;atype:pinteger=nil;alen:pinteger=nil):int_ptr;
+
+procedure FreeStructure(var struct);
+
+implementation
+
+uses common{$IFDEF Miranda}, mirutils{$ENDIF};
+
+type
+ pint_ptr = ^int_ptr;
+ TWPARAM = WPARAM;
+ TLPARAM = LPARAM;
+
+type
+ pShortTemplate = ^tShortTemplate;
+ tShortTemplate = packed record
+ etype :byte;
+ flags :byte;
+ offset:word;
+ end;
+
+// adjust offset to field
+function AdjustSize(var summ:int_ptr;eleadjust:integer;adjust:integer):integer;
+var
+ rest,lmod:integer;
+begin
+ // packed, byte or array of byte
+ if adjust=0 then
+ adjust:={$IFDEF WIN32}4{$ELSE}8{$ENDIF}; // SizeOf(int_ptr);
+
+ if (adjust=1) or (eleadjust=1) then
+ else
+ begin
+ case adjust of
+ 2: begin
+ lmod:=2;
+ end;
+ 4: begin
+ if eleadjust>2 then
+ lmod:=4
+ else
+ lmod:=2;
+ end;
+ 8: begin
+ if eleadjust>4 then
+ lmod:=8
+ else if eleadjust>2 then
+ lmod:=4
+ else
+ lmod:=2;
+ end;
+ else
+ lmod:=2;
+ end;
+ rest:=summ mod lmod;
+ if rest>0 then
+ begin
+ summ:=summ+(lmod-rest);
+ end;
+ end;
+
+ result:=summ;
+end;
+
+procedure SkipSpace(var txt:pAnsiChar); {$IFDEF FPC}inline;{$ENDIF}
+begin
+ while (txt^ in [' ',#9]) do inc(txt);
+end;
+
+function GetOneElement(txt:pAnsiChar;var res:tOneElement;
+ SizeOnly:boolean;num:integer=0):integer;
+var
+ pc,pc1:pAnsiChar;
+ i,llen:integer;
+begin
+ FillChar(res,SizeOf(res),0);
+
+ if num>0 then // Skip needed element amount
+ begin
+ end;
+
+ SkipSpace(txt);
+ // process flags
+ while not (txt^ in sWordOnly) do
+ begin
+ case txt^ of
+ char_return: res.flags:=res.flags or EF_RETURN;
+{$IFDEF Miranda}
+ char_script: res.flags:=res.flags or EF_SCRIPT;
+ char_mmi : res.flags:=res.flags or EF_MMI;
+{$ENDIF}
+ end;
+ inc(txt);
+ end;
+
+ SkipSpace(txt);
+ // element type
+ pc:=txt;
+ llen:=0;
+ repeat
+ inc(pc);
+ inc(llen);
+ until pc^ IN [#0,#9,' ',char_separator];
+ // recogninze data type
+ i:=0;
+ while i<MaxStructTypes do
+ begin
+ if StrCmp(txt,StructElems[i].short,llen)=0 then //!!
+ break;
+ inc(i);
+ end;
+ if i>=MaxStructTypes then
+ begin
+ result :=SST_UNKNOWN;
+ res.etype:=SST_UNKNOWN;
+ exit;
+ end;
+ result:=StructElems[i].typ;
+ res.etype:=result;
+
+ if (not SizeOnly) or (result in [SST_WARR,SST_BARR,SST_WPTR,SST_BPTR]) then
+ begin
+ // type alias, inside parentheses
+ SkipSpace(pc);
+ if not (pc^ in [#0,char_separator]) then
+ begin
+ if (pc^='(') and ((pc+1)^ in sIdFirst) then
+ begin
+ inc(pc); // skip space and parenthesis
+ pc1:=@res.talias;
+ repeat
+ pc1^:=pc^;
+ inc(pc1);
+ inc(pc);
+ until (pc^=')'){ or (pc^=' ')} or (pc^=char_separator);
+ if pc^=')' then inc(pc);
+ end;
+ end;
+
+ // alias, starting from letter
+ // start: points to separator or space
+ SkipSpace(pc);
+ if not (pc^ in [#0,char_separator]) then
+ begin
+ if pc^ in sIdFirst then
+ begin
+// inc(pc); // skip space
+ pc1:=@res.alias;
+ repeat
+ pc1^:=pc^;
+ inc(pc1);
+ inc(pc);
+ until (pc^=' ') or (pc^=char_separator);
+ end;
+ end;
+
+ // next - values
+ // if has empty simple value, then points to next element but text-to-number will return 0 anyway
+// if pc^=' ' then inc(pc); // points to value or nothing if no args
+ SkipSpace(pc);
+ case result of
+ SST_LAST,SST_PARAM: ;
+
+ SST_BYTE,SST_WORD,SST_DWORD,SST_QWORD,SST_NATIVE: begin
+ begin
+ if (res.flags and EF_SCRIPT)=0 then
+ begin
+ pc1:=@res.svalue;
+ if pc^=char_hex then
+ begin
+ inc(pc);
+ while pc^ in sHexNum do
+ begin
+ pc1^:=pc^;
+ inc(pc1);
+ inc(pc);
+ end;
+ res.value:=HexToInt(res.svalue)
+ end
+ else
+ begin
+ while pc^ in sNum do
+ begin
+ pc1^:=pc^;
+ inc(pc1);
+ inc(pc);
+ end;
+ res.value:=StrToInt(res.svalue);
+ end;
+ end
+ else
+ begin
+ txt:=pc;
+ //!!
+ while not (pc^ in [#0,char_separator]) do inc(pc);
+ if txt<>pc then
+ StrDup(pAnsiChar(res.text),txt,pc-txt)
+ else
+ res.text:=nil;
+ end;
+ end;
+ end;
+
+ SST_BARR,SST_WARR,SST_BPTR,SST_WPTR: begin
+ // if pc^ in sNum then
+ res.len:=StrToInt(pc);
+ if not SizeOnly then
+ begin
+ while pc^ in sNum do inc(pc);
+
+ // skip space
+// if pc^=' ' then inc(pc);
+ SkipSpace(pc);
+
+ //!!
+ if not (pc^ in [#0,char_separator]) then
+ begin
+ txt:=pc;
+ while not (pc^ in [#0,char_separator]) do inc(pc);
+ if txt<>pc then
+ StrDup(pAnsiChar(res.text),txt,pc-txt)
+ else
+ res.text:=nil;
+ end;
+ end;
+ end;
+ end;
+ end;
+
+ case result of
+ SST_LAST,
+ SST_PARAM : begin res.len:=SizeOf(LPARAM); res.align:=SizeOf(LPARAM); end;
+ SST_BYTE : begin res.len:=1; res.align:=1; end;
+ SST_WORD : begin res.len:=2; res.align:=2; end;
+ SST_DWORD : begin res.len:=4; res.align:=4; end;
+ SST_QWORD : begin res.len:=8; res.align:=8; end;
+ SST_NATIVE: begin res.len:=SizeOf(LPARAM); res.align:=SizeOf(LPARAM); end; // SizeOf(NativeInt)
+ SST_BARR : res.align:=1;
+ SST_WARR : res.align:=2;
+ SST_BPTR : res.align:=SizeOf(pointer);
+ SST_WPTR : res.align:=SizeOf(pointer);
+ end;
+end;
+
+// within translation need to check array size limit
+// "limit" = array size, elements, not bytes!
+procedure TranslateBlob(dst:pByte;const element:tOneElement);
+var
+ datatype:integer;
+ clen,len:integer;
+ src:pAnsiChar;
+ srcw:pWideChar absolute src;
+ buf:array [0..9] of AnsiChar;
+ bufw:array [0..4] of WideChar absolute buf;
+begin
+ if element.text=nil then exit;
+
+ if element.etype in [SST_WARR,SST_WPTR] then
+ begin
+ if (element.flags and EF_SCRIPT)<>0 then
+ datatype:=2 // Wide to Wide (if script done)
+ else
+ datatype:=1; // UTF to Wide
+ end
+ else // Ansi to Ansi
+ datatype:=0;
+
+ pint64(@buf)^:=0;
+
+ src:=element.text;
+ case datatype of
+ 0: begin // Ansi source for ansi
+ len:=StrLen(src);
+ if (element.len<>0) and (element.len<len) then
+ len:=element.len;
+
+ if StrScan(src,char_hex)=nil then
+ begin
+ move(src^,dst^,len);
+ end
+ else
+ begin
+ while (src^<>#0) and (len>0) do
+ begin
+ if (src^=char_hex) and ((src+1)^ in sHexNum) and ((src+2)^ in sHexNum) then
+ begin
+ buf[0]:=(src+1)^;
+ buf[1]:=(src+2)^;
+ inc(src,2+1);
+ dst^:=HexToInt(buf);
+ end
+ else
+ begin
+ dst^:=ord(src^);
+ inc(src);
+ end;
+ inc(dst);
+ dec(len);
+ end;
+ end;
+ end;
+
+ 1: begin // UTF8 source for unicode
+ // char_hex not found in UTF8 as Ansi - no reason to check as UTF8
+ // right, if char_hex is in ASCI7 only
+{
+ if StrScan(src,char_hex)=nil then
+ begin
+ // convert UTF8 to Wide without zero
+ end
+ else
+}
+ begin
+ len:=element.len;
+ while (src^<>#0) and (len>0) do
+ begin
+ if (src^=char_hex) and
+ ((src+1)^ in sHexNum) and
+ ((src+2)^ in sHexNum) then
+ begin
+ buf[0]:=(src+1)^;
+ buf[1]:=(src+2)^;
+ if ((src+3)^ in sHexNum) and
+ ((src+4)^ in sHexNum) then
+ begin
+ buf[2]:=(src+3)^;
+ buf[3]:=(src+4)^;
+ pWord(dst)^:=HexToInt(buf);
+ inc(src,4+1);
+ inc(dst,2);
+ end
+ else
+ begin
+ buf[2]:=#0;
+ dst^:=HexToInt(buf);
+ inc(dst);
+ inc(src,2+1);
+ end;
+ end
+ else
+ begin
+ pWideChar(dst)^:=CharUTF8ToWide(src,@clen);
+ inc(src,clen{CharUTF8Len(src)});
+ inc(dst,2);
+ dec(len);
+ end;
+ end;
+ end;
+ end;
+{$IFDEF Miranda}
+ 2: begin // Unicode source for unicode
+ len:=StrLenW(srcw);
+ if (element.len<>0) and (element.len<len) then
+ len:=element.len;
+
+ if StrScanW(srcw,char_hex)=nil then
+ begin
+ move(srcw^,dst^,len*SizeOf(WideChar));
+ end
+ else
+ begin
+ while (srcw^<>#0) and (len>0) do
+ begin
+ if (srcw^=char_hex) and
+ (ord(srcw[1])<255) and (AnsiChar(srcw[1]) in sHexNum) and
+ (ord(srcw[2])<255) and (AnsiChar(srcw[2]) in sHexNum) then
+ begin
+ bufw[0]:=srcw[1];
+ bufw[1]:=srcw[2];
+ if (ord(srcw[3])<255) and (AnsiChar(srcw[3]) in sHexNum) and
+ (ord(srcw[4])<255) and (AnsiChar(srcw[4]) in sHexNum) then
+ begin
+ bufw[2]:=srcw[3];
+ bufw[3]:=srcw[4];
+ pWord(dst)^:=HexToInt(bufw);
+ inc(src,4);
+ end
+ else
+ begin
+ bufw[2]:=#0;
+ dst^:=HexToInt(bufw);
+ dec(dst);
+ inc(srcw,2);
+ end;
+ end
+ else
+ pWideChar(dst)^:=srcw^;
+ inc(srcw);
+ inc(dst,2);
+ dec(len);
+ end;
+ end;
+ end;
+{$ENDIF}
+ end;
+end;
+
+procedure FreeElement(var element:tOneElement);
+begin
+ case element.etype of
+ SST_PARAM,SST_LAST: begin
+ end;
+ SST_BYTE,SST_WORD,SST_DWORD,
+ SST_QWORD,SST_NATIVE: begin
+ if (element.flags and EF_SCRIPT)<>0 then
+ mFreeMem(element.text);
+ end;
+ SST_BARR,SST_WARR,
+ SST_BPTR,SST_WPTR: begin
+ mFreeMem(element.text);
+ end;
+ end;
+end;
+
+function MakeStructure(txt:pAnsiChar;aparam,alast:LPARAM
+ {$IFDEF Miranda}; restype:integer=rtInt{$ENDIF}):pointer;
+var
+ summ:int_ptr;
+ lsrc:pAnsiChar;
+ res:pByte;
+ ppc,p,pc:pAnsiChar;
+{$IFDEF Miranda}
+ buf:array [0..31] of WideChar;
+ pLast: pWideChar;
+ valuein,value:pWideChar;
+{$ENDIF}
+ amount,align:integer;
+ lmod,code,alen,ofs:integer;
+ element:tOneElement;
+ tmpl:pShortTemplate;
+ addsize:integer;
+begin
+ result:=nil;
+ if (txt=nil) or (txt^=#0) then
+ exit;
+
+ pc:=txt;
+
+ ppc:=pc;
+ summ:=0;
+
+ if pc^ in sNum then
+ begin
+ align:=ord(pc^)-ord('0');//StrToInt(pc);
+ lsrc:=StrScan(pc,char_separator)+1; // not just +2 for future features
+ end
+ else
+ begin
+ align:=0;
+ lsrc:=pc;
+ end;
+
+ code:=SST_UNKNOWN;
+ alen:=0;
+ ofs :=0;
+
+ amount:=0;
+ // size calculation
+ while lsrc^<>#0 do
+ begin
+ p:=StrScan(lsrc,char_separator);
+// if p<>nil then p^:=#0;
+
+ GetOneElement(lsrc,element,true);
+ AdjustSize(summ,element.align,align);
+
+ if ((element.flags and EF_RETURN)<>0) and (code=SST_UNKNOWN) then
+ begin
+ code:=element.etype;
+ alen:=element.len;
+ ofs :=summ;
+ end;
+
+ if (element.etype=SST_BPTR) or (element.etype=SST_WPTR) then
+ inc(summ,SizeOf(pointer))
+ else
+ inc(summ,element.len);
+
+ inc(amount);
+
+ if p=nil then break;
+ lsrc:=p+1;
+ end;
+
+ // memory allocation with result record and template
+ addsize:=SizeOF(TStructResult)+SizeOF(tShortTemplate)*amount+SizeOf(dword);
+ lmod:=addsize mod SizeOf(pointer);
+ if lmod<>0 then
+ inc(addsize,SizeOf(pointer)-lmod);
+
+ inc(summ,addsize);
+
+ mGetMem (tmpl,summ);
+ FillChar(tmpl^,summ,0);
+
+ res:=pByte(pAnsiChar(tmpl)+addsize-SizeOf(tStructResult)-SizeOf(dword));
+ pdword(res)^:=amount; inc(res,SizeOf(dword));
+ with PStructResult(res)^ do
+ begin
+ typ :=code;
+ len :=alen;
+ offset:=ofs;
+ end;
+
+ inc(res,SizeOf(tStructResult));
+ result:=res;
+
+ pc:=ppc;
+
+ // translation
+ if pc^ in sNum then
+ // pc:=pc+2;
+ pc:=StrScan(pc,char_separator)+1;
+
+ while pc^<>#0 do
+ begin
+ p:=StrScan(pc,char_separator);
+ GetOneElement(pc,element,false);
+
+ if (element.flags and EF_SCRIPT)<>0 then
+ begin
+{$IFDEF Miranda}
+ if restype=rtInt then
+ pLast:=IntToStr(buf,alast)
+ else
+ pLast:=pWideChar(alast);
+ // BPTR,BARR - Ansi
+ // WPTR,WARR - Unicode
+ // BYTE,WORD,DWORD,QWORD,NATIVE - ???
+ // in value must be converted to unicode/ansi but not UTF8
+ UTF8ToWide(element.text,valuein);
+ value:=ParseVarString(valuein,aparam,pLast);
+ mFreeMem(valuein);
+ case element.etype of
+ // Numbers - just get number values
+ SST_BYTE,
+ SST_WORD,
+ SST_DWORD,
+ SST_QWORD,
+ SST_NATIVE: begin
+ {
+ StrCopy(element.svalue,value,31);
+ element.value:=StrToInt(element.svalue);
+ }
+ element.value:=StrToInt(value);
+ mFreeMem(value);
+ end;
+ // Byte strings - replace Ansi value
+ SST_BARR,
+ SST_BPTR: begin
+ mFreeMem(element.text);
+ WideToAnsi(value,pAnsiChar(element.text),MirandaCP);
+ mFreeMem(value);
+ end;
+ // Wide strings - replace UTF8 by Wide
+ SST_WARR,
+ SST_WPTR: begin
+ // really, need to translate Wide to UTF8 again?
+ mFreeMem(element.text);
+ element.text:=value;
+ end;
+ end;
+{$ENDIF}
+ end;
+
+ AdjustSize(int_ptr(res),element.align,align);
+
+ tmpl^.etype :=element.etype;
+ tmpl^.flags :=element.flags;
+ tmpl^.offset:=uint_ptr(res)-uint_ptr(result);
+
+ case element.etype of
+ SST_LAST: begin
+ pint_ptr(res)^:=alast;
+ end;
+ SST_PARAM: begin
+ pint_ptr(res)^:=aparam;
+ end;
+ SST_BYTE: begin
+ pByte(res)^:=element.value;
+ end;
+ SST_WORD: begin
+ pWord(res)^:=element.value;
+ end;
+ SST_DWORD: begin
+ pDWord(res)^:=element.value;
+ end;
+ SST_QWORD: begin
+ pint64(res)^:=element.value;
+ end;
+ SST_NATIVE: begin
+ pint_ptr(res)^:=element.value;
+ end;
+ SST_BARR: begin
+ TranslateBlob(pByte(res),element);
+ end;
+ SST_WARR: begin
+ TranslateBlob(pByte(res),element);
+ end;
+ SST_BPTR: begin
+ if element.len=0 then
+ element.len:=StrLen(element.text);
+
+ if element.len=0 then
+ pint_ptr(res)^:=0
+ else
+ begin
+ inc(element.len); // with Zero at the end
+{$IFDEF Miranda}
+ if (element.flags and EF_MMI)<>0 then
+ lsrc:=mir_alloc(element.len*SizeOf(AnsiChar))
+ else
+{$ENDIF}
+ mGetMem (lsrc ,element.len*SizeOf(AnsiChar));
+ FillChar(lsrc^,element.len*SizeOf(AnsiChar),0);
+ TranslateBlob(pByte(lsrc),element);
+ pint_ptr(res)^:=uint_ptr(lsrc);
+ end;
+ end;
+ SST_WPTR: begin
+ if element.len=0 then
+ begin
+{$IFDEF Miranda}
+ if (element.flags and EF_SCRIPT)<>0 then
+ element.len:=StrLenW(element.text)
+ else
+{$ENDIF}
+ element.len:=UTF8Len(element.text);
+ end;
+
+ if element.len=0 then
+ pint_ptr(res)^:=0
+ else
+ begin
+ inc(element.len); // with Zero at the end
+{$IFDEF Miranda}
+ if (element.flags and EF_MMI)<>0 then
+ lsrc:=mir_alloc(element.len*SizeOf(WideChar))
+ else
+{$ENDIF}
+ mGetMem (lsrc ,element.len*SizeOf(WideChar));
+ FillChar(lsrc^,element.len*SizeOf(WideChar),0);
+//!!!!! variables script gives unicode, need to recognize it
+ TranslateBlob(pByte(lsrc),element);
+ pint_ptr(res)^:=uint_ptr(lsrc);
+ end;
+ end;
+ end;
+ if (element.etype=SST_BPTR) or (element.etype=SST_WPTR) then
+ inc(int_ptr(res),SizeOf(pointer))
+ else
+ inc(int_ptr(res),element.len);
+
+ FreeElement(element);
+ if p=nil then break;
+ pc:=p+1;
+ inc(tmpl);
+ end;
+ tmpl^.flags:=tmpl^.flags or EF_LAST;
+end;
+
+function GetStructureResult(var struct;atype:pinteger=nil;alen:pinteger=nil):int_ptr;
+var
+ loffset,ltype:integer;
+begin
+ with PStructResult(pAnsiChar(struct)-SizeOF(TStructResult))^ do
+ begin
+ ltype :=typ ;
+ loffset:=offset;
+ if atype<>nil then atype^:=typ;
+ if alen <>nil then alen ^:=len;
+ end;
+
+ case ltype of
+ SST_LAST : result:=0;
+ SST_PARAM: result:=0;
+
+ SST_BYTE : result:=pByte (pAnsiChar(struct)+loffset)^;
+ SST_WORD : result:=pWord (pAnsiChar(struct)+loffset)^;
+ SST_DWORD : result:=pDword (pAnsiChar(struct)+loffset)^;
+ SST_QWORD : result:=pint64 (pAnsiChar(struct)+loffset)^;
+ SST_NATIVE: result:=pint_ptr(pAnsiChar(struct)+loffset)^;
+
+ SST_BARR: result:=int_ptr(pAnsiChar(struct)+loffset); //??
+ SST_WARR: result:=int_ptr(pAnsiChar(struct)+loffset); //??
+
+ SST_BPTR: result:=pint_ptr(pAnsiChar(struct)+loffset)^; //??
+ SST_WPTR: result:=pint_ptr(pAnsiChar(struct)+loffset)^; //??
+ else
+ result:=0;
+ end;
+end;
+
+procedure FreeStructure(var struct);
+var
+ value:pAnsiChar;
+ tmpl:pShortTemplate;
+ num,lmod:integer;
+ tmp:pointer;
+begin
+ tmp:=pointer(pAnsiChar(struct)-SizeOF(TStructResult)-SizeOf(dword));
+ num:=pdword(tmp)^;
+ tmpl:=pointer(pAnsiChar(tmp)-num*SizeOf(tShortTemplate));
+ lmod:=uint_ptr(tmpl) mod SizeOf(pointer);
+ // align to pointer size border
+ if lmod<>0 then
+ tmpl:=pointer(pAnsiChar(tmpl)-(SizeOf(pointer)-lmod));
+
+ tmp:=tmpl;
+
+ repeat
+ case tmpl^.etype of
+ SST_BPTR,SST_WPTR: begin
+ //??
+ value:=pAnsiChar(pint_ptr(pAnsiChar(struct)+tmpl^.offset)^);
+{$IFDEF Miranda}
+ if (tmpl^.flags and EF_MMI)<>0 then
+ mir_free(value)
+ else
+{$ENDIF}
+ mFreeMem(value);
+ end;
+ end;
+ inc(tmpl);
+ until (tmpl^.flags and EF_LAST)<>0;
+
+ mFreeMem(tmp);
+end;
+
+end.
|