Código: /* In this example the following fields are written to a new dBASE file named "customer.dbf": customer.cust-num N ZZZZ9 customer.name C x(20) customer.address C x(20) ----- 45 bytes This means that the total header length equals 4 x 32 + 1 = 129 and the record length equals 45 + 1 */ def var count# as integer no-undo. def var nraw# as raw no-undo. def stream customer. /* count the customers first */ for each customer no-lock: assign count# = count# + 1. end. output stream customer to customer.dbf binary no-convert. /* byte 0: 0x03 identifies this file as a dBASE file */ put stream customer control "~003". /* bytes 1-3: Date of last update */ run makebinary (year(today) - 1900, 1, output nraw#). /* Y2K?!? */ put stream customer control nraw#. run makebinary (month(today), 1, output nraw#). put stream customer control nraw#. run makebinary (day(today), 1, output nraw#). put stream customer control nraw#. /* Put no of records (bytes 4-7) as a 4-byte binary number: */ run makebinary (count#, 4, output nraw#). put stream customer control nraw#. /* no of bytes in the header (bytes 8-9) */ run makebinary (129, 2, output nraw#). put stream customer control nraw#. /* bytes 10-11: record length */ run makebinary (46, 2, output nraw#). put stream customer control nraw#. /* bytes 12-31: null */ put stream customer control null(20). /* now the field descriptions */ put stream customer control "CUST_NUM" null(3) /* null filled */ "N" /* number */ null(4) /* reserved */ chr(5) /* field length in binary */ null /* decimal count in binary */ null(2) /* reserved */ chr(1) /* work area id */ null(11) /* reserved etc. */ "CUST_NAME" null(2) "C" null(4) chr(20) null(3) chr(1) null(11) "ADDRESS" null(4) "C" null(4) chr(20) null(3) chr(1) null(11) chr(13) /* field terminator */. /* and now the data */ for each customer no-lock: put stream customer " " /* delete flag */ customer.cust-num customer.name customer.address. end. put stream customer unformatted chr(26). /* EOF marker */ output stream customer close. PROCEDURE makebinary: /* This routine converts a Progress integer to a binary representation. No "C" needed! Input parameters: - number to be converted - no of desired bytes Output parameter - binary representation of number as a raw variable with the correct length */ def input parameter anumm# as integer no-undo. /* number */ def input parameter abyte# as integer no-undo. /* no of desired bytes */ def output parameter nraw# as raw no-undo. /* result of conversion */ def var acoun# as int no-undo. assign length(nraw#) = abyte#. if anumm# <0 then do: message program-name(1) + ": This routine works for positive integers only." "Received value of" anumm# "is invalid." view-as alert-box error title "Conversion to binary". return error. end. if anumm#> 0 and anumm# modulo anumm# / EXP(anumm#,abyte#) > 256 then do: message program-name(1) + ": received number" anumm# "does not fit in" abyte# "bytes." view-as alert-box error title "Conversion to binary". return error. end. do acoun# = abyte# to 1 by -1: put-byte(nraw#,acoun#) = int(truncate(anumm# / EXP(256,acoun# - 1),0)). if anumm# ne 0 then assign anumm# = anumm# modulo EXP(256,acoun# - 1). end. END PROCEDURE. /* makebinary */
