View source for Manipulating Buffer Data

[[Category:RPG]]
[[Category:Sample Code]]
__FORCETOC__
== Summary ==
Have you ever needed to manipulate "field" data in a flat file or in a buffer—e.g. a trigger buffer—where the "fields" are not already broken out for you?  Perhaps for fixed-length character data this was easy to do.  But what about variable-length character data, with 2-byte or 4-byte length prefixes, and signed numeric data—e.g., negative binary data, negative packed data with decimals, or even negative zoned data with or without decimals?

This sample code demonstrates the use of three procedures to accomplish this (which you can even put the procedures into a service program—to make them more generally available across your shop).  If you do put them into a service program, you will need to create the RPG prototypes for them.  Simply copy the procedure interfaces given in order to create the associated prototypes.

By [[User:DaveLClarkI|Dave Clark]]

== Demo Program ==
This program simply demonstrates how you can call the two main procedures to get or put field data from or into a buffer—in this case, a data structure is used with subfields that represent the test data.  But this was only for debugging purposes when I created the program.  In a real case scenario, there would be no subfields and, perhaps, you would use information retrieved from SYSCOLUMNS to describe the field data you need.
<pre>
**free
ctl-opt main(demopgm) dftactgrp(*no);

dcl-ds buffer      len(1024);
  b_char           char(50);
  b_bigint         int(20);
  b_integer        int(10);
  b_packed         packed(11:2);
  b_smallint       int(5);
  b_varchar2       varchar(256);
  b_varchar4       varchar(256:4);
  b_zoned          zoned(11:2);
end-ds;

dcl-s pos          packed(5:0);
dcl-s r_result     varchar(50);

dcl-proc demopgm;
// build the buffer
  pos = 1;
  PutBufferPiece( buffer: 'This is a character string test.'
                : 'C': pos: %size(b_char) );

  pos += %size(b_char);
  PutBufferPiece( buffer: %char(-9223372036854775807)
                : 'B': pos: %size(b_bigint) );

  pos += %size(b_bigint);
  PutBufferPiece( buffer: %char(-2147483647)
                : 'I': pos: %size(b_integer) );

  pos += %size(b_integer);
  PutBufferPiece( buffer: %char(-1234567.89)
                : 'P': pos: %size(b_packed): %decpos(b_packed) );

  pos += %size(b_packed);
  PutBufferPiece( buffer: %char(-32767)
                : 'S': pos: %size(b_smallint) );

  pos += %size(b_smallint);
  PutBufferPiece( buffer: 'This is a variable-character2 string test.'
                : 'V': pos: %size(b_varchar2) );

  pos += %size(b_varchar2);
  PutBufferPiece( buffer: 'This is a variable-character4 string test.'
                : 'V': pos: %size(b_varchar4): 4 );

  pos += %size(b_varchar4);
  PutBufferPiece( buffer: %char(-1234567.89)
                : 'Z': pos: %size(b_zoned): %decpos(b_zoned) );

// now test the buffer
  pos = 1;
  r_result = GetBufferPiece( buffer: 'C': pos: %size(b_char) );

  pos += %size(b_char);
  r_result = GetBufferPiece( buffer: 'B': pos: %size(b_bigint) );

  pos += %size(b_bigint);
  r_result = GetBufferPiece( buffer: 'I': pos: %size(b_integer) );

  pos += %size(b_integer);
  r_result = GetBufferPiece( buffer: 'P': pos: %size(b_packed)
                                             : %decpos(b_packed) );

  pos += %size(b_packed);
  r_result = GetBufferPiece( buffer: 'S': pos: %size(b_smallint) );

  pos += %size(b_smallint);
  r_result = GetBufferPiece( buffer: 'V': pos: %size(b_varchar2): 2 );

  pos += %size(b_varchar2);
  r_result = GetBufferPiece( buffer: 'V': pos: %size(b_varchar4): 4 );

  pos += %size(b_varchar4);
  r_result = GetBufferPiece( buffer: 'Z': pos: %size(b_zoned)
                                             : %decpos(b_zoned) );
  return;
end-proc;
</pre>

[[#top|[top]]]

== Get Procedure ==
This procedure gets field data from the flat file record or from the buffer you specify.  The result is always returned as a variable-length character string.  But, in the case of numeric data, this is easily turned back into actual numbers via the use of the RPG/ILE %INT or %DEC built-in functions.
<pre>
**free
ctl-opt NoMain DecPres(63);

//**********************************************************************
// This procedure will return a piece of a data buffer -- whether that
// piece is a character string, integer (binary numeric) data, packed
// numeric data, zoned numeric data, or variable-length character data.
// All types are returned as a variable length string with the numeric
// types converted from their buffer form to a (zoned) character string
// with leading sign.  For data type, pass:
//      C = character (default)
//      B = big integer
//      I = integer
//      P = packed numeric (max 46 precision)
//      S = small integer
//      V = varchar (scale 4, or 2 by default)
//      Z = zoned numeric (max 46 precision)
//**********************************************************************
dcl-proc GetBufferPiece export;
  dcl-pi *n             varchar(256);
    string_buffer       char(65536)    options(*varsize);
    piece_type          char(1)        const;
    beg_byte_pos        packed(5:0)    const;
    max_byte_len        packed(3:0)    const;
    max_scale           packed(2:0)    const options(*nopass);
  end-pi;

  dcl-ds char_area                     len(260);
    varchar2_data       varchar(256)   pos(1);
    varchar4_data       varchar(256:4) pos(1);
    packed_data         packed(46:0)   pos(1);
    zoned_data          zoned(46:0)    pos(1);
    bigint_data         int(20)        pos(1);
    integer_data        int(10)        pos(1);
    smallint_data       int(5)         pos(1);
  end-ds;

  dcl-c t_char          'C';
  dcl-c t_bigint        'B';
  dcl-c t_integer       'I';
  dcl-c t_packed        'P';
  dcl-c t_smallint      'S';
  dcl-c t_varchar       'V';
  dcl-c t_zoned         'Z';

  dcl-s use_scale       like(max_scale);
  dcl-s d_shift         packed(17:0);

  if %parms < %parmnum(max_scale)
  or %addr(max_scale) = *null
  or piece_type = t_varchar
  and max_scale <> 4;
    if piece_type = t_varchar;
      use_scale = 2;
    else;
      use_scale = 0;
    endif;
  else;
    use_scale = max_scale;
  endif;

  d_shift = %int(10 ** use_scale);

  select;
    when piece_type = t_bigint;
      char_area = %subst(string_buffer:beg_byte_pos:max_byte_len);
      return %char(bigint_data);

    when piece_type = t_integer;
      char_area = %subst(string_buffer:beg_byte_pos:max_byte_len);
      return %char(integer_data);

    when piece_type = t_packed;
      packed_data = *zero;
      %subst(char_area:%size(packed_data)-max_byte_len+1:max_byte_len)
        = %subst(string_buffer:beg_byte_pos:max_byte_len);
      return Dec2CharFormat(packed_data/d_shift:use_scale);

    when piece_type = t_smallint;
      char_area = %subst(string_buffer:beg_byte_pos:max_byte_len);
      return %char(smallint_data);

    when piece_type = t_varchar and use_scale = 2;
      char_area = %subst(string_buffer:beg_byte_pos:max_byte_len);
      return varchar2_data;

    when piece_type = t_varchar and use_scale = 4;
      char_area = %subst(string_buffer:beg_byte_pos:max_byte_len);
      return varchar4_data;

    when piece_type = t_zoned;
      zoned_data = *zero;
      %subst(char_area:%size(zoned_data)-max_byte_len+1:max_byte_len)
        = %subst(string_buffer:beg_byte_pos:max_byte_len);
      return Dec2CharFormat(zoned_data/d_shift:use_scale);
  endsl;

  char_area = %subst(string_buffer:beg_byte_pos:max_byte_len);
  return %subst(char_area:1:max_byte_len);
end-proc;
</pre>

[[#top|[top]]]

== Dec2CharFmt Procedure ==
The Get Procedure, above, needed a little help with returning packed and zoned data—because of the variable number of decimal positions possible (since %DEC won't accept true variable values for the second and third parameters).  This procedure takes care of that.
<pre>
**free
ctl-opt NoMain DecPres(63);

//**********************************************************************
// This procedure formats the result of a numeric expression as a
// variable-length numeric character string with the maximum scale
// requested.  (Precision can be up to 46 and scale up to 15.)
//**********************************************************************
dcl-proc Dec2CharFormat export;
  dcl-pi *n             varchar(50);
    number_data         zoned(46:15)   const;
    max_scale           packed(2:0)    const options(*nopass);
  end-pi;

  dcl-s use_scale       like(max_scale);

  if %parms < %parmnum(max_scale)
  or %addr(max_scale) = *null;
    use_scale = 0;
  else;
    use_scale = max_scale;
  endif;

  select;
    when use_scale = 15;
      return %char(%dech(number_data:46:15));
    when use_scale = 14;
      return %char(%dech(number_data:46:14));
    when use_scale = 13;
      return %char(%dech(number_data:46:13));
    when use_scale = 12;
      return %char(%dech(number_data:46:12));
    when use_scale = 11;
      return %char(%dech(number_data:46:11));
    when use_scale = 10;
      return %char(%dech(number_data:46:10));
    when use_scale = 9;
      return %char(%dech(number_data:46:9));
    when use_scale = 8;
      return %char(%dech(number_data:46:8));
    when use_scale = 7;
      return %char(%dech(number_data:46:7));
    when use_scale = 6;
      return %char(%dech(number_data:46:6));
    when use_scale = 5;
      return %char(%dech(number_data:46:5));
    when use_scale = 4;
      return %char(%dech(number_data:46:4));
    when use_scale = 3;
      return %char(%dech(number_data:46:3));
    when use_scale = 2;
      return %char(%dech(number_data:46:2));
    when use_scale = 1;
      return %char(%dech(number_data:46:1));
  endsl;

  return %char(%dech(number_data:46:0));
end-proc;
</pre>

== Put Procedure ==
Now, occasionally, you might also have a need to put field data back '''into''' a flat file record or into a buffer—or to build one from scratch.  This procedure will do that.  Note that there is nothing returned from this procedure.
<pre>
**free
ctl-opt NoMain DecPres(63);

//**********************************************************************
// This procedure will update a piece of a data buffer -- whether that
// piece is a character string, integer (binary numeric) data, packed
// numeric data, zoned numeric data, or variable-length character data.
// For data type, pass:
//      C = character (default)
//      B = big integer
//      I = integer
//      P = packed numeric (max 46 precision)
//      S = small integer
//      V = varchar (scale 4, or 2 by default)
//      Z = zoned numeric (max 46 precision)
//**********************************************************************
dcl-proc PutBufferPiece export;
  dcl-pi *n;
    string_buffer       char(65536)    options(*varsize);
    data_piece          varchar(256)   const;
    piece_type          char(1)        const;
    beg_byte_pos        packed(5:0)    const;
    max_byte_len        packed(3:0)    const;
    max_scale           packed(2:0)    const options(*nopass);
  end-pi;

  dcl-ds char_area                     len(260);
    varchar2_data       varchar(256)   pos(1);
    varchar4_data       varchar(256:4) pos(1);
    packed_data         packed(46:0)   pos(1);
    zoned_data          zoned(46:0)    pos(1);
    bigint_data         int(20)        pos(1);
    integer_data        int(10)        pos(1);
    smallint_data       int(5)         pos(1);
  end-ds;

  dcl-c t_char          'C';
  dcl-c t_bigint        'B';
  dcl-c t_integer       'I';
  dcl-c t_packed        'P';
  dcl-c t_smallint      'S';
  dcl-c t_varchar       'V';
  dcl-c t_zoned         'Z';

  dcl-s use_scale       like(max_scale);
  dcl-s d_shift         packed(17:0);

  if %parms < %parmnum(max_scale)
  or %addr(max_scale) = *null
  or piece_type = t_varchar
  and max_scale <> 4;
    if piece_type = t_varchar;
      use_scale = 2;
    else;
      use_scale = 0;
    endif;
  else;
    use_scale = max_scale;
  endif;

  d_shift = %int(10 ** use_scale);

  select;
    when piece_type = t_bigint;
      bigint_data = %int(%dec(data_piece:61:15) * d_shift);
      %subst(string_buffer:beg_byte_pos:max_byte_len)
        = %subst(char_area:1:max_byte_len);

    when piece_type = t_integer;
      integer_data = %int(%dec(data_piece:61:15) * d_shift);
      %subst(string_buffer:beg_byte_pos:max_byte_len)
        = %subst(char_area:1:max_byte_len);

    when piece_type = t_packed;
      packed_data = %int(%dec(data_piece:61:15) * d_shift);
      %subst(string_buffer:beg_byte_pos:max_byte_len)
        = %subst(char_area:%size(packed_data)-max_byte_len+1:max_byte_len);

    when piece_type = t_smallint;
      smallint_data = %int(%dec(data_piece:61:15) * d_shift);
      %subst(string_buffer:beg_byte_pos:max_byte_len)
        = %subst(char_area:1:max_byte_len);

    when piece_type = t_varchar and use_scale = 2;
      varchar2_data = data_piece;
      %subst(string_buffer:beg_byte_pos:max_byte_len)
        = %subst(char_area:1:max_byte_len);

    when piece_type = t_varchar and use_scale = 4;
      varchar4_data = data_piece;
      %subst(string_buffer:beg_byte_pos:max_byte_len)
        = %subst(char_area:1:max_byte_len);

    when piece_type = t_zoned;
      zoned_data = %int(%dec(data_piece:61:15) * d_shift);
      %subst(string_buffer:beg_byte_pos:max_byte_len)
        = %subst(char_area:%size(zoned_data)-max_byte_len+1:max_byte_len);

    other;
      char_area = data_piece;
      %subst(string_buffer:beg_byte_pos:max_byte_len)
        = %subst(char_area:1:max_byte_len);
  endsl;

  return;
end-proc;
</pre>