EDS I/O
This is a multi-part message in MIME format.
------=_NextPart_000_004A_01C3921F.4D4C66C0
charset="iso-8859-1"
Ron, I wrote a Theos equivalent set of some functions as well as a readNext,
readPrev.. etc, more like what you're used to using. I've attached them.
I've used the I/O routines a lot and the're pretty solid. Use them if you
like. I wrote this when I was learning so some of them could use a lot of
improvement.
Setup to use:
-- open files and setup record --
sequence dbNames
dbNames= {
{"ar", "arCompany"}, --{DBname, TBname}
{"gl", "glChart"}
}
global constant
arComp = 1, -- you could just use 1 and 2 ..
glChart = 2 -- if you like.
openDb(dbNames) -- open the DB's and setup some tables
example:
record = readNextDb(arComp) -- record[1] has the key read, [2] the
record
if EOF[arComp] then
record = blankRecord
else
record = record[2]
end if
example:
dbRec = readDb(arOpen," 1"&lpad(customer,6)) -- position for readnext
while 1 do
dbRec = readNextDb (arOpen)
if EOF[arOpen] or dbRec[2][arotCustNbr] != custNbr then
setText(sb,"------ sorting date order ------")
tsort()
setText(sb,"")
exit
else
key = dbRec[1]
dbRec = dbRec[2]
george
------=_NextPart_000_004A_01C3921F.4D4C66C0
Content-Type: application/octet-stream;
name="string.e"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment;
filename="string.e"
--These are functions were useful in the THEOS basic environment. These =
are written
-- to make conversion easier and provide some of the same funcionality =
in EUPHORIA.
with trace
global function ltrim(object s)
--trims leading blanks from the sequence s
if atom(s) then
return s
end if
for i =3D 1 to length(s) do
if s[1] =3D ' ' then
s =3D s[2..length(s)]
else
exit
end if
end for
return s
end function
-------------------------------------------------------------------------=
-----------------
global function rtrim(object s)
--trims trailing blanks from the sequence s
if atom(s) then
return s
end if
for i =3D length(s) to 1 by -1 do
if s[length(s)] =3D ' ' then
s =3D s[1..i-1]
else
exit
end if
end for
return s
end function
-------------------------------------------------------------------------=
-----------------
global function trim(object s)
-- trims leading blanks off, trims trailing blanks off and trims all but =
one blank
-- between internal words/letters.
object o
o =3D ""
if atom(s) then
return s
end if
s =3D ltrim(s)
s =3D rtrim(s)
for i =3D 1 to length(s) do
if s[i]!=3D' ' then
o =3D o & s[i]
else
if s[i+1]!=3D' ' then
o =3D o & s[i]
end if
end if
end for
return o
end function
-------------------------------------------------------------------------=
-----------------
global function rpt(integer a, object s)
-- replicates string s a times.... rpt(5,'a')--->'aaaaa'
object o
o =3D ""
for i =3D 1 to a do
o =3D o & s
end for
return o
end function
-------------------------------------------------------------------------=
-----------------
global function space(integer a)
-- returns a number of spaces
object s
s=3D""
for i =3D 1 to a do
s =3D s & ' '
end for
return s
end function
-------------------------------------------------------------------------=
-----------------
global function rpad(object s, integer a)
-- rpad returns string s with a spaces appended to right
object o
integer len
len=3Dlength(s)
if len >=3D a then
return s
else
o =3D s & space(a - len)
end if
return o
end function
-------------------------------------------------------------------------=
-----------------
global function lpad(object s, integer a)
-- rpad returns string s with a spaces prepended on the left
object o
integer len
len=3Dlength(s)
if len >=3D a then
return s
else
o =3D space(a - len) & s
end if
return o
end function
-------------------------------------------------------------------------=
-----------------
constant TO_LOWER =3D 'a' - 'A'
global function lcase(object x)
-- convert atom or sequence to lower case THEOS synonym
return x + (x >=3D 'A' and x <=3D 'Z') * TO_LOWER
end function
-------------------------------------------------------------------------=
-----------------
global function ucase(object x)
-- convert atom or sequence to upper case THEOS synonym
return x - (x >=3D 'a' and x <=3D 'z') * TO_LOWER
end function
-------------------------------------------------------------------------=
-----------------
global function len(object x)
-- theos synonym to euphoria length(s)
return length(x)
end function
-------------------------------------------------------------------------=
-----------------
global function sch(integer r, sequence s, sequence p)
------------find pattern p in string s beginning at r ---
integer sch_a
if length(s)=3D0 then
return 0
elsif length(p)=3D0 then
return 0
elsif length(s)-r+1 >=3D length(p) then
sch_a =3D match(p,s[r..length(s)])
if sch_a>0 then
return sch_a + r -1
else
return 0
end if
elsif s[r] =3D p[1] then
return r
else
return 0
end if
end function
-------------------------------------------------------------------------=
-----------------
global function str(object x)
-- Return the string representation of any Euphoria data object.
-- This is the same as the output from print(1, x) or '?', but it's
-- returned as a string sequence rather than printed.
sequence s
if atom(x) then
return sprintf("%.10g", x)
else
s =3D "{"
for i =3D 1 to length(x) do
s &=3D sprintf("%.10g",x[i])
if i < length(x) then
s &=3D ','
end if
end for
s &=3D "}"
return s
end if
end function
------------------------------------ Center Text =
------------------------------------
global function center(sequence a, integer b)
-- string a is returned centered in a blank string of length b --
sequence out
integer tmp
if b<=3D len(a) then
tmp =3D message_box("String longer than space allowed ","",0)
else
out =3D rpt(b,' ')
tmp =3D floor((b-len(a))/2)
out[tmp..len(a)+tmp-1] =3D a
end if
return out
end function
---------------------------------- String Date =
--------------------------------------
global function Tdate(integer a)
sequence day,yy,mm,dd
if a =3D 0 then
day =3D date()
yy =3D sprintf("%02d",{day[1]-100})
mm =3D sprintf("%02d",{day[2]})
dd =3D sprintf("%02d",{day[3]})
return mm&"/"&dd&"/"&yy
else
-- not yet
return "01/01/01"
end if
end function
----------------------------------- String Current Time =
-----------------------------
global function Ttime()
sequence day,hh,mm
day =3D date()
hh =3D sprintf("%02d",{day[4]})
mm =3D sprintf("%02d",{day[5]})
return hh&":"&mm
end function
--------------------------------- Convert date to mm/dd/yy =
-------------------------
global function cdate(sequence a)
-- convert date to a string date for display mm/dd/yy format --
sequence tmp
tmp =3D ""
tmp =3D sprintf("%02d/%02d/%02d",{a[2],a[3],a[1] - =
100*floor(a[1]/100)})
return tmp
end function
-------------------------------------------------------------------------=
-----------
global function ODBCdate(sequence a)
-- convert yyyy-mm-dd to date mm/dd/yy format --
sequence tmp
tmp =3D ""
tmp =3D a[6..7]&"/"&a[9..10]&"/"&a[3..4]
return tmp
end function
-------------------------------------------------------------------------=
-----------------
------=_NextPart_000_004A_01C3921F.4D4C66C0
Content-Type: application/octet-stream;
name="numeric.e"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment;
filename="numeric.e"
-- THEOS equivalent synonyms for EUPHORIA numeric functions.=20
-- (THEOS/numeric.e)
-------------------------------------------------------------------------=
-----------------
-- Returns the absolute value of a number or a sequence of numbers
global function tabs(object n)
if atom(n) then
if n<0 then=20
return (-n)
else
return n
end if
else
for i =3D 1 to length(n) do
if n[i]<0 then
n[i] =3D -n[i]
end if
end for
end if
return n
end function
-------------------------------------------------------------------------=
-----------------
-- Returns the greater of 2 numbers or sequence of numbers
global function max(object a, object b)
object o
if atom (a) then
if a > b then
return a
else
return b
end if
else
o=3D{}=09
for i =3D 1 to length(a) do
if a[i]>b[i] then=20
o &=3Da[i]
else
o &=3Db[i]
end if
end for
end if
return o
end function
-------------------------------------------------------------------------=
----------------- =09
-- THEOS floor function returns the smaller of 2 numbers or a sequence =
of the smaller=20
-- elements collected from both sequences.
global function min(object a, object b)
object o
if atom (a) then
if a < b then
return a
else
return b
end if
else
o=3D{}=09
for i =3D 1 to length(a) do
if a[i]<b[i] then=20
o &=3Da[i]
else
o &=3Db[i]
end if
end for
end if
return o
end function
-------------------------------------------------------------------------=
-----------------
-- Theos CEIL function --- FLOOR already native to EUPHORIA
global function ceil(object a)
return floor(a) + 1
end function
-------------------------------------------------------------------------=
-----------------
-- Theos FP function (fractional part)
global function fp(object a)
return a - floor(a)
end function
-------------------------------------------------------------------------=
-----------------
-- Theos MOD function -- same as EUPHORIA remainder
global function mod(object a, object b)
return remainder(a,b)
end function
-------------------------------------------------------------------------=
-----------------
-- Theos IP (integer part)-- same as EUPHORIA floor
global function ip(object a)
return floor(a)
end function
-------------------------------------------------------------------------=
-----------------
-- Theos MSEC (close equivalent, ticks since midnight) - no EUPORIA =
equivalent
-- seconds since midnight
global function msec()
object t
t=3Ddate()
return t[4]*3600 + t[5]*60 + t[6]
end function
-------------------------------------------------------------------------=
-----------------
-- Theos INT (integer part)
global function tint(object a)
return floor(a)
end function
-------------------------------------------------------------------------=
-----------------
-- Theos ROUND to round a number (or sequence) to the specified =
significance
-- i.e. round(12.34567,2) --> 12.35
global function round(object a, integer b)
object f
if b < 0 then=20
return a -- invalid argument, do nothing to a
elsif b =3D 0 then
return floor(a)
else
f =3D power(10,b)
return floor(a * f + .5) / f
end if
end function
-------------------------------------------------------------------------=
----------------- =09
-- Theos value function
global function val(sequence a)
object f
f =3D value(a)
return f[2]
=09
end function=09
=09
=09
=09
=09
=09
------=_NextPart_000_004A_01C3921F.4D4C66C0
Content-Type: application/octet-stream;
name="dbFile.e"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment;
filename="dbFile.e"
------------------- CBS's file handeling rtns =
------------------------------------
-- dbFile.e
-------------------------------------------------------------------------=
---------
include Database.e
include lib/numeric.e
global sequence=20
openDbNames,
openTbNames,
fileHandle,
recordPtr,
currentDb,
currentTb,
EOF
global object keyDb
=20
global integer Yes, No
Yes =3D 1
No =3D 0
-- init EOF table --
EOF =3D {No}
for i =3D 1 to 24 do
EOF &=3D No
end for=20
=20
object recordDb
=20
integer a, loc
=20
=20
------------------- open DB's and build list of open DB's =
------------------------
-- note that all db's must be opened together --
global procedure openDb(sequence dbNames)
=20
openDbNames =3D {}
openTbNames =3D {}
fileHandle =3D {}
recordPtr =3D {}
for i =3D 1 to length(dbNames) do
loc =3D find(dbPath&dbNames[i][1],openDbNames)
if loc =3D 0 then
a =3D db_open(dbPath&dbNames[i][1],DB_LOCK_NO)
if a !=3D DB_OK then
a =3D message_box("Can't open DataBase =
"&dbNames[i][1],"",0)
abort(1)
end if
currentDb=3DdbPath&dbNames[i][1]
fileHandle =3D append(fileHandle, {length(fileHandle)+1,0})
else
fileHandle =3D append(fileHandle,{loc,0})
end if
loc =3D match(dbNames[i][2],openTbNames)
if loc =3D 0 then
a =3D db_select_table(dbNames[i][2])
if a !=3D DB_OK then
a =3D message_box("Can't open table =
"&dbNames[i][2],"",0)
abort(1)
end if
currentTb =3D dbNames[i][2]
openDbNames =3D append(openDbNames,dbPath&dbNames[i][1]) =
=20
openTbNames=3Dappend(openTbNames,dbNames[i][2])
recordPtr =3D append(recordPtr,0)
fileHandle[i][2] =3D i
else
fileHandle[i][2] =3D loc
end if
end for
end procedure
---------------------------- select DB and Table =
------------------------------------
global procedure selectTable(integer t)
if match(openDbNames[fileHandle[t][1]], currentDb) then
-- already selected
else
a =3D db_select(openDbNames[fileHandle[t][1]])
if a !=3D DB_OK then
a =3D message_box("Can't select DB =
"&openDbNames[fileHandle[t][1]],"",0)=20
abort(1)
else
currentDb=3DopenDbNames[fileHandle[t][1]]
end if
end if
if match(openTbNames[fileHandle[t][2]], currentTb) then
-- already selected
else
a =3D db_select_table(openTbNames[fileHandle[t][2]])
if a !=3D DB_OK then
a =3D message_box("Can't select Table =
"&openTbNames[fileHandle[t][2]],"",0)
a =3D gets(0)
abort(1)
else
currentTb =3DopenTbNames[fileHandle[t][2]]
end if
end if
end procedure=20
---------------------------- Clear Table =
--------------------------------------------
-- a table is clear'ed by deleting it and re-creating it
global procedure clearDbTable(integer t)
selectTable(t)
if a =3D DB_OK then
db_delete_table(openTbNames[fileHandle[t][2]])
a =3D db_create_table(openTbNames[fileHandle[t][2]])
end if
end procedure
---------------------------- Read Record =
--------------------------------------------
global function readDb(integer t, sequence fileKey)
-- t is the fileHandle index --
-- fileKey is the key value for the record to be found
=20
selectTable(t)
a =3D db_find_key(fileKey)
if a < 1 then
recordPtr[t] =3D -a -.5
recordDb=3D""
EOF[t] =3D Yes
else
recordPtr[t] =3D a
recordDb =3D db_record_data(a)
EOF[t] =3D No =20
end if
return recordDb=20
end function
------------------------------------ read next =
-------------------------------------
global function readNextDb(integer t)
keyDb =3D ""
selectTable(t)
recordPtr[t] =3D floor(recordPtr[t] + 1)
if recordPtr[t] <=3D db_table_size() then
keyDb =3D db_record_key(recordPtr[t])=20
a =3D db_find_key(keyDb)
recordDb =3D db_record_data(a)
EOF[t] =3D No
else
recordPtr[t] =3D db_table_size()
if recordPtr[t] !=3D0 then
recordDb =3D db_record_data(db_table_size())
else
recordDb =3D ""
end if
EOF[t] =3D Yes
end if
return {keyDb,recordDb}
end function
----------------------------------- read previous =
----------------------------------
global function readPrevDb(integer t)
sequence keyDb
atom a
keyDb =3D ""
selectTable(t)
recordPtr[t] =3D ceil(recordPtr[t] - 1.1)
if recordPtr[t] >=3D 1 then
keyDb =3D db_record_key(recordPtr[t])=20
a =3D db_find_key(keyDb)
recordDb =3D db_record_data(a)
EOF[t] =3D No
else
recordPtr[t] =3D 0
recordDb =3D ""
EOF[t] =3D Yes
end if
return {keyDb,recordDb}
end function
----------------------------------- update old record =
-------------------------------
global procedure updateDb(integer t, sequence recordKey, sequence =
recordDb)
selectTable(t)
a =3D db_find_key(recordKey)
if a > 0 then
recordPtr[t] =3D a
db_replace_data(a, recordDb)
else
a =3D message_box("Can't find record "&recordKey&" to =
update.","",0)
abort(1)
end if
end procedure
----------------------------------- add new record =
----------------------------------
global procedure addDb(integer t, sequence recordKey, sequence recordDb)
selectTable(t)
a =3D db_insert(recordKey, recordDb)
recordPtr[t] =3D db_find_key(recordKey)
if a !=3D DB_OK then
if a =3D DB_EXISTS_ALREADY then
updateDb(t, recordKey, recordDb)
else
a =3D message_box("Can't add record "&recordKey,"",0)
abort(1)
end if
end if
end procedure
------------------------------------ delete record =
----------------------------------
global procedure deleteDb(integer t, sequence recordKey)
selectTable(t)
a =3D db_find_key(recordKey)
recordPtr[t] =3D a - .5
if a > 0 then
db_delete_record(a)
else
a =3D message_box("Can't find record "&recordKey&" to =
delete.","",0)
a =3D gets(0)
abort(1)
end if
end procedure
-------------------------------------------------------------------------=
------------
------=_NextPart_000_004A_01C3921F.4D4C66C0--
|
Not Categorized, Please Help
|
|
