|
1
|
DEFINE TEMP-TABLE tt-1 NO-UNDO
|
|
2
|
NAMESPACE-URI "http://goldencode.com/testNamespace5"
|
|
3
|
FIELD a1char AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char-attr" XML-NODE-NAME 'pk' SERIALIZE-NAME 'char' XML-NODE-TYPE 'attribute'
|
|
4
|
FIELD a1int AS INT FORMAT "99999" INITIAL 1 LABEL "int-attr" XML-DATA-TYPE 'long' XML-NODE-TYPE 'attribute'
|
|
5
|
FIELD f1char AS CHAR FORMAT "XXXX" INITIAL '99aa' LABEL "char" XML-NODE-NAME 'char-node' SERIALIZE-NAME 'char-field'
|
|
6
|
FIELD f1charcs AS CHAR FORMAT "XXXX" INITIAL 'aa88' CASE-SENSITIVE LABEL "char-cs"
|
|
7
|
FIELD f1decimal AS DECIMAL FORMAT "->>,>>9.99" HELP 'help' DECIMALS 2 LABEL "decimal" COLUMN-LABEL "decimal-column"
|
|
8
|
FIELD f1int AS INT BGCOLOR 12 DCOLOR 9 FGCOLOR 14 PFCOLOR 16 FONT 1 MOUSE-POINTER 'cross' FORMAT "99999" INITIAL 1 LABEL "int"
|
|
9
|
FIELD f1int1 AS INT INITIAL 1 LABEL "int1" XML-NODE-TYPE 'hidden'
|
|
10
|
FIELD f1int64 AS INT64 FORMAT "99999" EXTENT 4 INITIAL 4 LABEL "int64" SERIALIZE-NAME 'int64-field'
|
|
11
|
FIELD f1bool AS LOGICAL INITIAL TRUE LABEL "bool" SERIALIZE-NAME 'logical'
|
|
12
|
FIELD f1date AS DATE INITIAL TODAY LABEL "date"
|
|
13
|
FIELD f1blob AS BLOB LABEL "blob" COLUMN-LABEL "blob-column"
|
|
14
|
FIELD f1clob1 AS CLOB LABEL "clob1" TTCODEPAGE XML-NODE-TYPE 'hidden'
|
|
15
|
FIELD f1clob2 AS CLOB LABEL "clob2" COLUMN-CODEPAGE 'ibm850'
|
|
16
|
FIELD f1recid AS RECID LABEL "recid" FORMAT "->,>>>,>>9"
|
|
17
|
FIELD f1handle AS HANDLE LABEL "handle" FORMAT ">>>>>>9"
|
|
18
|
FIELD f1com-handle AS COM-HANDLE LABEL "com-handle" FORMAT ">>>>>>9"
|
|
19
|
FIELD f1raw AS RAW
|
|
20
|
FIELD f1rowid AS ROWID
|
|
21
|
FIELD a1int1 AS INT FORMAT "99999" INITIAL 1 LABEL "int-attr" XML-NODE-TYPE 'attribute'
|
|
22
|
INDEX i1dx1 f1char
|
|
23
|
INDEX i1dx2 a1char DESC f1char DESC
|
|
24
|
INDEX i1dx3 AS UNIQUE f1int
|
|
25
|
.
|
|
26
|
|
|
27
|
DEF VAR tth1 AS HANDLE NO-UNDO.
|
|
28
|
DEF VAR ttdh AS HANDLE NO-UNDO.
|
|
29
|
DEF VAR lRet AS LOGICAL NO-UNDO.
|
|
30
|
DEF VAR nmsg AS INTEGER NO-UNDO.
|
|
31
|
DEF VAR n AS INTEGER NO-UNDO.
|
|
32
|
|
|
33
|
OUTPUT TO 'mptr.txt'.
|
|
34
|
|
|
35
|
CREATE tt-1. tt-1.f1char = '1.1111'. tt-1.f1int = 11. tt-1.f1decimal = 3.1465.
|
|
36
|
CREATE tt-1. tt-1.f1char = '1.2222'. tt-1.f1int = 12. tt-1.f1decimal = 3.1415926.
|
|
37
|
|
|
38
|
DEF VAR json-ptr AS MEMPTR NO-UNDO.
|
|
39
|
CREATE TEMP-TABLE ttdh.
|
|
40
|
|
|
41
|
tth1 = TEMP-TABLE tt-1:HANDLE.
|
|
42
|
|
|
43
|
// MEMPTR
|
|
44
|
lRet = tth1:WRITE-JSON('memptr', json-ptr, TRUE, ?, FALSE, FALSE) NO-ERROR.
|
|
45
|
RUN show-error('tth1:WRITE-JSON to MEMPTR').
|
|
46
|
MESSAGE 'tth1:WRITE-JSON to MEMPTR' lRet.
|
|
47
|
|
|
48
|
CREATE TEMP-TABLE ttdh.
|
|
49
|
lRet = ttdh:READ-JSON('memptr', json-ptr, 'empty') NO-ERROR.
|
|
50
|
RUN show-error('ttdh:READ-JSON from MEMPTR').
|
|
51
|
MESSAGE 'ttdh:READ-JSON from MEMPTR' lRet.
|
|
52
|
|
|
53
|
OUTPUT CLOSE.
|
|
54
|
|
|
55
|
PROCEDURE show-error:
|
|
56
|
DEF INPUT PARAM action AS CHAR.
|
|
57
|
|
|
58
|
MESSAGE "After" action ": error =" ERROR-STATUS:ERROR
|
|
59
|
"num-messages =" ERROR-STATUS:NUM-MESSAGES
|
|
60
|
"type =" ERROR-STATUS:TYPE
|
|
61
|
.
|
|
62
|
IF ERROR-STATUS:NUM-MESSAGES > 0 THEN DO:
|
|
63
|
DO nmsg = 1 TO ERROR-STATUS:NUM-MESSAGES:
|
|
64
|
MESSAGE "***" ERROR-STATUS:GET-NUMBER(nmsg) ':' ERROR-STATUS:GET-MESSAGE(nmsg).
|
|
65
|
END.
|
|
66
|
END.
|
|
67
|
END.
|