!**********************************************************************
!* *
!* MODULE: TDUNPK.SQC *
!* AUTHOR: TONY DELIA. *
!* DATE: 08/18/1999. *
!* SYSTEM: TD SQR UTILITY SERIES. *
!* DESC: UNPACK STRING VARIABLE. *
!* *
!**********************************************************************
!* *
!* USAGE: PACKED TO UNPACKED FORMAT. *
!* *
!* EXAMPLE #1: let $I_fld = '()*' *
!* do Unpack-String($I_fld, $O_fld, #O_amt, $O_ind) *
!* . *
!* EXAMPLE #2: let $I_fld = '()+' *
!* do Unpack-String($I_fld, $O_fld, #O_amt, $O_ind) *
!* . *
!* EXAMPLE #3: let $I_fld = 'Hello' *
!* do Unpack-String($I_fld, $O_fld, #O_amt, $O_ind) *
!* . *
!* EXAMPLE #4: let $I_fld = 'Goodbye' *
!* do Unpack-String($I_fld, $O_fld, #O_amt, $O_ind) *
!* . *
!* EXAMPLE #5: let $I_fld = '0123456789:' *
!* do Unpack-String($I_fld, $O_fld, #O_amt, $O_ind) *
!* . *
!* . *
!* . *
!* #Include 'tdunpk.sqc' *
!* *
!**********************************************************************
!* *
!* RESULTS: *
!* *
!* EXAMPLE $O_fld #O_amt $O_ind *
!* ======= ================ ====== ====== *
!* #1 '28292A' 28292 'Y' *
!* #2 '28292B' -28292 'Y' *
!* #3 '48656C6C6F' 0 'N' *
!* #4 '476F6F64627965' 0 'N' *
!* #5 '303132333435363738393A' 0 'N' *
!* *
!* NOTE: #5 failed numeric validation because of variable *
!* length. Packed numeric data cannot exceed 8 bytes *
!* (which yields 15 or 16 unpacked bytes depending if *
!* it's packed-signed or packed-unsigned). *
!* *
!**********************************************************************
!* *
!* PASS: $I_fld => Input String (Assumed Packed) *
!* *
!**********************************************************************
!* *
!* RETURNS: $O_fld => Unpacked Hex Representation *
!* #O_amt => Signed Numeric Value (or zero) *
!* $O_ind => Valid Numeric Indicator (Y/N) *
!* *
!**********************************************************************
!* *
!* LEGAL: CONFIDENTIALITY INFORMATION. *
!* *
!* This module is the original work of Tony DeLia. It *
!* can be considered ShareWare under the following *
!* conditions. *
!* *
!* A - The author's name (Tony DeLia) remains on any *
!* and all versions of this module. *
!* B - Any modifications must be clearly identified. *
!* C - A "vanilla" copy of this module must be kept *
!* alongside any revised versions. *
!* *
!**********************************************************************
!* *
!* WEBSITE: http://www.sqrtools.com *
!* *
!* Questions/Comments: tdelia@erols.com *
!* *
!**********************************************************************
!**********************************************************************
!* Unpack String Variable *
!**********************************************************************
begin-procedure Unpack-String($I_fld, :$O_fld, :#O_amt, :$O_ind)
let #O_amt = ''
let $O_fld = ''
let $O_ind = 'N'
let #err = 0
let #len = length($I_fld)
let #pos = 1
let $hex_val = '0123456789ABCDEF'
let $sgn_val = '...........-.-..'
while #pos <= #len
let #ascii = ascii(substr($I_fld, #pos, 1))
let #hi = floor(#ascii/16)
let #lo = mod(#ascii,16)
let $hi = substr($hex_val, #hi + 1, 1)
let $lo = substr($hex_val, #lo + 1, 1)
let $O_fld = $O_fld || $hi || $lo
! Validate hi-order digit (1st 4-bits)
if #hi > 9
let #err = #err + 1
end-if
! Validate lo-order digit (2nd 4-bits)
if #lo > 9
and #pos < #len
let #err = #err + 1
end-if
let #pos = #pos + 1
end-while
! If numeric validation passed convert to signed-numeric variable
if #err = 0
and #len <= 8
let #ptr = #len * 2
if #lo > 9
let #ptr = #ptr - 1
end-if
let #O_amt = to_number(substr($O_fld, 1, #ptr))
! Last 4-bits of string determine sign
if substr($sgn_val, #lo + 1, 1) = '-'
let #O_amt = #O_amt * -1
end-if
let $O_ind = 'Y'
end-if
end-procedure
!**********************************************************************
!* End of Program *
!**********************************************************************
|
