|
midrange.com
David,
here are a few functions i wrote/plagerized. it assumes you know the field
names and data type, and can load them in order. it doesn't handle date
data types.
if you improve upon it, send it back to me ;)
in a service program:
* ParseDelimAlph()
* usage: returns length of delimited field found.
* parms: delimeter (comma, pipe, whatever)
* index (the number of the field in the string (1, 2, 3, etc)
* record (pointer to the data portion of a variable length
* field containing. - %addr() + 2
* length of record
* pointer to allocated variable containing data.
D ParseDelimAlph PR 10i 0
D peDelim 1a const
D peIndx 5i 0 const
D peRecord * const
D peRecLen 10i 0 const
D peVariable * const
* ParseDelimNumb()
* usage: returns a 30p 9d numeric representation of an edited
* numeric, from a delimited record.
* parms: delimeter (comma, pipe, whatever)
* index (the number of the field in the string (1, 2, 3, etc)
* record (pointer to the data portion of a variable length
* field containing. - %addr() + 2
* length of record
D ParseDelimNumb PR 30p 9
D peDelim 1a const
D peIndx 5i 0 const
D peRecord * const
D peRecLen 10i 0 const
P ParseDelimAlph B EXPORT
D ParseDelimAlph PI 10i 0
D peDelim 1a const
D peIndx 5i 0 const
D peRecord * const
D peRecLen 10i 0 const
D peVariable * const
D RecAddr S *
D Rec S 32765a based(RecAddr)
D VarAddr S *
D Var S 512a based(VarAddr)
D $beg S 3s 0 inz(0)
D $len S 3s 0 inz(0)
D $y S 3s 0 inz(0)
D $x S 10i 0 inz(1)
/FREE
// position variable to allocated space reserved for
// record and return variable
RecAddr = peRecord;
VarAddr = peVariable;
// check for valid field index
if peIndx < 1;
return 0;
endif;
// if first field in record, $beg = 1
if peIndx = 1;
$beg = 1;
endif;
// place 2 delimiters at end of record to limit scan
%subst(Rec:peRecLen+1:2) = peDelim + peDelim;
// do until beginning and ending commas found
dou $x > peIndx;
// scan for delimiter
$y = %scan(peDelim:Rec:$y+1);
// if past end of record + 1, not found
if $y > peRecLen + 1;
return 0;
endif;
// beginning of field found
if $x = peIndx - 1;
$beg = $y + 1;
// else if end of record found
elseif $x = peIndx;
// calc length of field
$len = $y - $beg;
endif;
$x = $x + 1;
enddo;
// if no beginning or length, error
if $len = 0 or $beg = 0;
return 0;
endif;
// substring out variable
Var = %subst(Rec:$beg:$len);
// if first char of variable is ", remove it
if %subst(Var:1:1) = '"';
$len = $len-1;
%subst(Var:1:$len) = %subst(Var:2:$len);
endif;
// if last char of variable is ", remove it
if %subst(Var:$len:1) = '"';
$len = $len-1;
endif;
return $len;
/END-FREE
P E
P ParseDelimNumb B EXPORT
D ParseDelimNumb PI 30p 9
D peDelim 1a const
D peIndx 5i 0 const
D peRecord * const
D peRecLen 10i 0 const
D Alph S 512a varying
D negative S n inz(*OFF)
D string DS 30
D decnum 30s 9 inz(0)
D len S 10i 0 inz(0)
D i S 10i 0 inz(1)
D digits S 10i 0 inz(0)
D decpos S 10i 0 inz(0)
D dec S 10i 0 inz(0)
D ch S 1a
D chtemp S 30a varying
/free
// Allocate all space for Alph
%len(Alph) = 512;
// Parse field to alpha string
%len(Alph) = ParseDelimAlph(peDelim:peIndx:
peRecord:
peRecLen:
%addr(Alph)+2);
// if no data, return 0
if %Len(Alph) < 1;
return 0;
endif;
// Skip leading blanks (if any)
i = 1;
dow i <= %len(Alph) and %subst(Alph:i:1) = ' ';
i = i + 1;
enddo;
// Is string blanks or null? then return 0
if i > %len(Alph);
return 0;
endif;
// Is first non-blank char a minus sign?
if %subst(Alph:i:1) = '-';
negative = *ON;
i = i + 1;
endif;
// Skip leading zeros (if any)
dow i <= %len(Alph) and %subst(Alph:i:1) = '0';
i = i + 1;
enddo;
// Is string all zeros and blanks? then return 0
if i > %len(Alph);
return 0;
endif;
// Loop through digits of string to be converted
dow i <= %len(Alph);
ch = %subst(Alph:i:1);
if ch = '.';
// We've reached the decimal point - only
// one allowed
if decpos <> 0;
// We've already read a decimal point
leave;
endif;
// Indicate decimal position just after last
// digit read.
decpos = digits + 1;
elseif ch >= '0' and ch <= '9';
// We've read a digit - save it
digits = digits + 1;
chtemp = chtemp + ch;
// Have we read enough digits?
if digits = 30;
leave;
endif;
else;
// Anything other than a digit or decimal point
// ends the number
leave;
endif;
// Advance to the next character
i = i + 1;
enddo;
// Adjust decimal positions
if decpos = 0;
// If no decimal point coded, assume one after all digits
decpos = %len(chtemp) + 1;
else;
// drop excess decimal digits
dec = %len(chtemp) - decpos + 1;
if dec > 9;
%len(chtemp) = %len(chtemp) - (dec - 9);
endif;
endif;
// Scale number appropriately
%subst(string: 23-decpos: %len(chtemp)) = chtemp;
// Set sign of result
if negative;
decnum = - decnum;
endif;
// Return pointer to answer
return decnum;
/end-free
P E
*********usage - Assumes you know the field names, type and order.
* this contains your delimited string - make it as big as you want
D Str S 32765A varying
*return variable of a single alpha field
D Alph S 512a varying
* parseDelimNumb returns a 30p9d number
C eval (h) CLOC = ParseDelimNumb(',':1:
C %addr(Str)+2:
C %len(str))
* allocate size of Alpha to max (you could set this to field length)
C eval %len(Alph) = 512
* parseDelimAlph returns the new size of the field found and put in Alph
C eval %len(Alph) = ParseDelimAlph(',':2:
C %addr(Str)+2:
C %len(str):
C %addr(Alph)+2)
* put Alph into alpha field.
C eval CBADATE = Alph
C eval %len(Alph) = 512
C eval %len(Alph) = ParseDelimAlph(',':3:
C %addr(Str)+2:
C %len(str):
C %addr(Alph)+2)
C eval CEDATE = Alph
C eval (h) CITEMNUM = ParseDelimNumb(',':4:
C %addr(Str)+2:
C eval (h) CLOC = ParseDelimNumb(',':1:
C %addr(Str)+2:
C %len(str))
C eval %len(Alph) = 512
C eval %len(Alph) = ParseDelimAlph(',':2:
C %addr(Str)+2:
C %len(str):
C %addr(Alph)+2)
C eval CBDATE = Alph
C eval %len(Alph) = 512
C eval %len(Alph) = ParseDelimAlph(',':3:
C %addr(Str)+2:
C %len(str):
C %addr(Alph)+2)
C eval CEDATE = Alph
C eval (h) CITEMNUM = ParseDelimNumb(',':4:
C %addr(Str)+2:
C %len(str))
C eval (h) CQTYSOLD = ParseDelimNumb(',':5:
C %addr(Str)+2:
C %len(str))
C eval (h) CEXTPR = ParseDelimNumb(',':6:
C %addr(Str)+2:
C %len(str))
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
