<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">Article 9047 of comp.lang.perl:
Xref: feenix.metronet.com comp.lang.perl:9047
Path: feenix.metronet.com!news.ecn.bgu.edu!usenet.ins.cwru.edu!gatech!swrinde!sgiblab!gatekeeper.us.oracle.com!oracle!unrepliable!bounce
Newsgroups: comp.lang.perl
From: ntools1@be.oracle.com (student1)
Subject: Re: read DBF3 files
In-Reply-To: louis@mobil.arc.ulaval.ca's message of Thu, 9 Dec 1993 06:31:24 GMT
Message-ID: &lt;NTOOLS1.93Dec20190259@berou1.be.oracle.com&gt;
Sender: usenet@oracle.us.oracle.com (Oracle News Poster)
Nntp-Posting-Host: berou1.be.oracle.com
Organization: Oracle University
References: &lt;louis.1105806324A@athena.ulaval.ca&gt;
Date: Mon, 20 Dec 1993 19:02:59 GMT
X-Disclaimer: This message was written by an unauthenticated user
              at Oracle Corporation.  The opinions expressed are those
              of the user and not necessarily those of Oracle.
Lines: 192

&gt;&gt;&gt;&gt;&gt; "Louis" == Louis Demers &lt;louis@mobil.arc.ulaval.ca&gt; writes:
In article &lt;louis.1105806324A@athena.ulaval.ca&gt; louis@mobil.arc.ulaval.ca (Louis Demers) writes:


  Louis&gt; Hello, Where can I find a script for transform DBF3 file into
  Louis&gt; a tab or coma file?

  Louis&gt; Merci !


Below, you find the solution.  The most important bug is that
the documentation is hidden in the source code.  :-)
(mail me on "pbijnens@be.oracle.com", if you need help with it.)


#!/bin/sh
# This is a shell archive (produced by shar 3.49)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#
# made 09/25/1993 10:38 UTC by polleke@triton
# Source directory /user/div/polleke/db3
#
# existing files will NOT be overwritten unless -c is specified
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#   2226 -rw-rw-r-- db3.pl
#    763 -rwxrwxr-x db3flat
#
# ============= db3.pl ==============
if test -f 'db3.pl' -a X"$1" != X"-c"; then
	echo 'x - skipping db3.pl (File already exists)'
else
echo 'x - extracting db3.pl (Text)'
sed 's/^X//' &lt;&lt; 'SHAR_EOF' &gt; 'db3.pl' &amp;&amp;
X# db3.pl -- routines to read dBaseIII-files
X# (c) 1992 Paul Bijnens
X
X
Xpackage db3;
X
X
X# initialise db3-structures from header of the file
X# usage: db3init(FH);
Xsub main'db3init {
X    local(*Db3) = shift(@_);
X    local($rec, $pos);
X
X    seek(Db3, 0, 0);
X    read(Db3, $rec, 32);
X    $db3version = &amp;endian(substr($rec,0,1));
X    $db3totrec  = &amp;endian(substr($rec,4,4));
X    $db3lenhead = &amp;endian(substr($rec,8,2)) - 1;
X    $db3lenrec  = &amp;endian(substr($rec,10,2));
X
X    if ($db3version == 0x83) {
X	warn("Cannot handle memo-fields\n");
X    } elsif ($db3version != 0x03) {
X	warn("Not a db3-file\n");
X	return 0;
X    }
X
X    $db3nf = $[;
X    $db3fmt = "a1";
X    for ($pos = 32; $pos &lt; $db3lenhead; $pos += 32) {
X	read(Db3, $rec, 32);
X	$db3fn[$db3nf] = unpack("A11", $rec);
X	$db3fn[$db3nf] =~ s/\000.*//;	# sometimes trailing garbage!!!
X	$db3ft[$db3nf] = substr($rec,11,1);
X	$db3fl[$db3nf] = &amp;endian(substr($rec,16,2));
X	$db3fi{$db3fn[$db3nf]} = $db3nf;	# name -&gt; field index
X	$db3fmt .= "A$db3fl[$db3nf]";
X	#if ($db3ft[$db3nf] eq "C") {
X	#    $db3fmt .= "a$db3fl[$db3nf]";
X	#} elsif ($db3ft[$db3nf] eq "N") {
X	#    $db3fmt .= "A$db3fl[$db3nf]";
X	#}
X	$db3nf++;
X    }
X
X    if (($c = getc(Db3)) != "\r") {
X	print "Header korrupt...\n";
X    }
X    1;
X}
X
X
X# read the next record in the db3-file
X# usage:  db3read(FH)
X# return: list of fields, or () on eof or error;
Xsub main'db3read {
X    local(*Db3) = shift(@_);
X    local($rec, $del, @res);
X
X    do {
X	read(Db3, $rec, $db3lenrec)  ||  return ();
X	($del, @res) = unpack($db3fmt, $rec);
X    } while ($del ne " ");
X    return @res;
X}
X
X
X# print db3-record in flatfile-record format
X# usage: db3_flat_str
Xsub main'db3_flat_str {
X    local($,) = "\t";
X    local($\) = "\n";
X
X    print @db3fn;
X    print @db3fl;
X    print @db3ft;
X}
X
X
X# convert to flatfile-like database
X# usage: db3_flat(DBHANDLE)
Xsub main'db3_flat {
X    local(*Db3) = shift(@_);
X    local($,) = "\t";
X    local($\) = "\n";
X    local(@flds);
X
X    while (@flds = &amp;main'db3read(*Db3)) {
X	print @flds;
X    }
X}
X
X
X# convert little-endian to native machine order
X# (intel = big-endian  -&gt;  mc68k = big-endian)
X# usage
Xsub endian
X{
X    local($n) = 0;
X    foreach (reverse(split('', $_[0]))) {
X	$n = $n * 256 + ord;
X    }
X    $n;
X}
X
X1;
SHAR_EOF
chmod 0664 db3.pl ||
echo 'restore of db3.pl failed'
Wc_c="`wc -c &lt; 'db3.pl'`"
test 2226 -eq "$Wc_c" ||
	echo 'db3.pl: original size 2226, current size' "c" ||
	echo 'db3.pl: original size 2226, current size' "$Wc_c"
fi
# ============= db3flat ==============
if test -f 'db3flat' -a X"$1" != X"-c"; then
	echo 'x - skipping db3flat (File already exists)'
else
echo 'x - extracting db3flat (Text)'
sed 's/^X//' &lt;&lt; 'SHAR_EOF' &gt; 'db3flat' &amp;&amp;
X#!/usr/bin/perl
X
X
X# convert db3-file to a flatfile (ascii-file with records consisting
X# of 1 line, and fields separated by a fieldseparator (tab) character)
X
Xrequire 'db3.pl';
X
Xforeach $infile (@ARGV) {
X
X    ($basename) = ($infile =~ /(.*)\.dbf$/i);
X    die("$infile: name not like 'name.DBF'\n")  unless $basename;
X
X    open(DB, "&lt; $infile")  ||  die("$infile: cannot open: $!\n");
X    open(OUT, "| repl -t pc2ascii &gt; $basename")  ||
X	    die("$basename: cannot open: $!\n");
X    select(OUT);
X
X    &amp;db3init(*DB)  ||  die("$infile: cannot initialise db3-format\n");
X
X    &amp;db3_flat_str;		# print out the structure
X    &amp;db3_flat(*DB);		# followed by the records
X
X    close(DB)  ||  die("$infile: close: $!\n");
X    close(OUT)  ||  die("$basename: close: $!\n");
X}
SHAR_EOF
chmod 0775 db3flat ||
echo 'restore of db3flat failed'
Wc_c="`wc -c &lt; 'db3flat'`"
test 763 -eq "$Wc_c" ||
	echo 'db3flat: original size 763, current size' "$Wc_c"
fi
exit 0



</pre></body></html>