Liren Large Software Subsidy 5/05.iso/a/a006/1.ddi/PASSAMP.ZIP/IMPORT.PAS

Pascal/Delphi Source File | 1991-03-11 | 14.7 KB | 554 lines

{$N+,E+,V-}
(* Copyright (c) 1990 by Borland International, Inc. *)
program Import;

uses
  PXEngine;
(*
 *  IMPORT.PAS
 *  File Translation Example
 *
 *  Description:
 *    This example program demonstrates how to translate
 *    an ASCII file into an indexed Paradox File.
 *
 *  ASCII Files are expected to be in the following format
 *    Customer Number:     8 characters
 *    Part Number:         8 characters
 *    Quantity:            Double
 *    Date:                10 characters, format MM/DD/YYYY
 *
 *    Each field within the ASCII record should be separated by
 *    at least one space.
 *
 *    Each record within the ASCII file should be separated by
 *    a newline.
 *
 *  Compilation:
 *    To compile and link the example program, make sure that
 *    your Turbo Pascal (version 5.5 or 6.0) compiler has
 *    been correctly installed.
 *
 *  Execution:
 *    To run the example program enter the following command:
 *    IMPORT <AsciiFile> <ParadoxFile>
 *    Where:
 *    <AsciiFile>      is the name of an existing ASCII input file
 *
 *    <ParadoxFile>    is the name of a paradox file that will be created
 *                     by the example program.  Note that the example
 *                     program checks to make sure that this file does
 *                     not yet exist.
 *
 *
 *  If you are running on a network, uncomment the following
 *  compiler statement and check the network-related variables,
 *  such as NetUserName, NetPath, and NetType.
 *)
  (* {$DEFINE NETWORK } *)

const
  {$IFDEF NETWORK }
  NetUserName = 'username';             (* network username *)
  NetPath = '';                         (* net directory *)
  NetType = NOTONNET;                   (* network type *)
  {$ENDIF }
  (* Field numbers of Paradox Table Fields *)
  (* Sizes of ASCII table fields *)
  ASCIISIZECUSTNBR = 8;                 (* Customer Number Length *)
  ASCIISIZEPARTNBR = 8;                 (* Part Number Length *)
  ASCIISIZEDATE = 10;                   (* Date Length *)
  (* Function Returns *)
  SUCCESS = True;                       (* function succeeded *)
  FAILURE = False;                      (* function failed *)

  NBRFIELDS = 4;                        (* number of fields in one table record *)
  NBRKEYS = 2;                          (* number of fields for primary index *)

  FieldNames: array[1..NBRFIELDS] of NameString =
    ('Part Number', 'Cust Number', 'Quantity','Date');
  FieldTypes: array[1..NBRFIELDS] of NameString = ('A8', 'A8', 'N', 'D');

type
  (* Structure for an ASCII fixed-length record *)
  TAsciiRecord =
    record
      CustNbr: string[ASCIISIZECUSTNBR]; (* customer number *)
      PartNbr: string[ASCIISIZEPARTNBR]; (* part number *)
      Quantity: Double;                 (* quantity *)
      Date: string[ASCIISIZEDATE];     (* date *)
    end;


var
  F: Text;                              (* ASCII file *)
  TblHandle:   TableHandle;             (* table handle for paradox table *)
  Keys:        FieldHandleArray;
  FieldPartNbr,                         (* Part Number *)
  FieldCustNbr,                         (* Customer Number *)
  FieldQuantity,                        (* Quantity *)
  FieldDate:   FieldHandle;             (* Date *)



(*
 *    Procedure:
 *          Strip
 *
 *    Arguments:
 *          S       String to be stripped of white space.
 *
 *    Description:
 *          Strips a string of leading and trailing white space.
 *)
procedure Strip(var S: String );

  var
    L1, L2: Byte;

  begin
    L1 := 1;
    while (L1 < Length(S)) and (S[L1] in [#9..#13, ' ']) do
      Inc(L1);
    L2 := Length(S);
    while (L2 > 0) and (S[L2] in [#9..#13, ' ']) do
      Dec(L2);
    S := Copy(S, L1, L2 - L1 + 1);
  end; (* Strip *)


(*
 *    Function:
 *      Error
 *
 *    Arguments:
 *        RC                  return code from a PX... function
 *
 *    Description:
 *        Writes error message if an error has occurred.
 *
 *    Returns:
 *        True if Error
 *        else False
 *)
function Error(RC: Integer): Boolean;

  begin
    if RC <> PXSUCCESS then
      WriteLn('IMPORT: ', PXErrMsg(RC));
    Error := RC <> PXSUCCESS;
  end; (* Error *)


(*
 *    Function:
 *        OpenAsciiFile
 *
 *    Arguments:
 *        FileName            ASCII input file
 *        F                   Text file
 *
 *    Description:
 *        Attemps to open the ASCII file for reading
 *
 *    Returns:
 *        SUCCESS             File was opened
 *        FAILURE             Could not open file
 *)

function OpenAsciiFile(FileName: String ;
                       var F: Text): Boolean;

  begin
    Assign(F, FileName);
{$I-}
    Reset(F);
{$I+}
    if IoResult <> 0 then
      begin
        WriteLn('Can''t open file : ', FileName);
        OpenAsciiFile := FAILURE;
      end
    else
      OpenAsciiFile := SUCCESS;
  end; (* OpenAsciiFile *)

(*    Function:
 *        InitFields
 *
 *    Arguments:
 *        TblHandle       Paradox Table Handle
 *
 *    Description:
 *        InitFields initializes global variables representing the correct
 *        field handles for the table's fields.
 *
 *    Returns:
 *        SUCCESS   If all field handles were initialized
 *        FAILURE   If any of the field handles was not initialized
 *
 *)
function InitFields(TblHandle: TABLEHANDLE):  boolean;

  begin

    InitFields := FAILURE;   (* default value for easy exit *)
    if Error(PXFldHandle(tblHandle,'Part Number',FieldPartNbr)) then
      Exit;
    if Error(PXFldHandle(tblHandle,'Cust Number',FieldCustNbr)) then
      Exit;
    if Error(PXFldHandle(tblHandle,'Quantity',FieldQuantity)) then
      Exit;
    if Error(PXFldHandle(tblHandle,'Date',FieldDate)) then
      Exit;
  end;


(*
 *    Function:
 *        OpenFiles
 *
 *    Arguments:
 *        TblHandle       Paradox Table Handle
 *        F               text file
 *
 *    Description:
 *        OpenFiles verifies the existence of two command line
 *        arguments expected to be file names and then attempts to
 *        open the ASCII files as well as the Paradox file.
 *
 *    Returns:
 *        SUCCESS         Files opened
 *        FAILURE         Error has occurred
 *
 *)
function OpenFiles(var TblHandle: TableHandle;
                   var F: Text): Boolean;

  begin
    if OpenAsciiFile(ParamStr(1), F) = FAILURE then
      OpenFiles := FAILURE
    else (* Open the Paradox file *)
      if Error(PXTblOpen(ParamStr(2), TblHandle, 0, False)) then
        OpenFiles := FAILURE
      else
      begin
        OpenFiles := SUCCESS;
        if InitFields(TblHandle) = FAILURE then
          OpenFiles := FAILURE;
      end;
  end; (* OpenFiles *)


(*
 *    Function:
 *        CreateParadoxFile
 *
 *    Arguments:
 *        FileName            Paradox file names
 *
 *    Description:
 *        CreateParadoxFile has three steps:
 *            1. Make sure the file doesn't already exist.
 *            2. Create the file
 *            3. Create a primary index file
 *
 *    Returns:
 *        FAILURE             Error has occurred
 *        SUCCESS             File create successful
 *)
function CreateParadoxFile(FileName: String ): Boolean;

  var
    Exist: Boolean;

  begin
    (* Do not create if it already exists *)
    if Error(PXTblExist(FileName, Exist)) then
      CreateParadoxFile := FAILURE
    else if Exist then
      begin
        WriteLn('IMPORT: Table ', FileName, ' already exists');
        CreateParadoxFile := FAILURE
      end
    else (* Now attempt to create the table *)
    if Error(PXTblCreate(FileName, NBRFIELDS,@ FieldNames,@ FieldTypes)) then
      CreateParadoxFile := FAILURE
    else (* Add first two fields as primary key *)
      begin
        Keys[1] := FieldPartNbr;
        Keys[2] := FieldCustNbr;
        if Error(PXKeyAdd(FileName, NBRKEYS, Keys, PRIMARY)) then
          CreateParadoxFile := FAILURE
        else
          CreateParadoxFile := SUCCESS;
      end;
  end; (* CreateParadoxFile *)


(*
 *    Function:
 *        TranslateBuffer
 *
 *    Arguments:
 *        Buf        AsciiRecord buffer
 *        RecHandle  Paradox Record Handle
 *
 *    Description:
 *        Translates a single ASCII table record into a Paradox
 *        record buffer
 *
 *    Returns:
 *        SUCCESS                 Translation successful
 *        FAILURE                 Translation failed
 *)
function TranslateBuffer(var Buf: TAsciiRecord;
                         RecHandle: RecordHandle): Boolean;

  var
    PXDate: TDate;
    Month, Day, Year: Integer;



  function GetNextWVal(var S: String ): Word;

    const
      Delim = '/';

    var
      L: Byte;
      Help: Word;
      Code: Integer;

    begin
      L := Pos(Delim, S);
      if L = 0 then
        L := Length(S) + 1;
      Val(Copy(S, 1, L - 1), Help, Code);
      S := Copy(S, L + 1, Length(S));
      if Code = 0 then
        GetNextWVal := Help
      else
        GetNextWVal := 0;
    end; (* GetNextWVal *)
  begin

    TranslateBuffer := FAILURE; (* default value for easy exit *)

    (* First the Customer Number *)
    if Error(PXPutAlpha(RecHandle, FieldCustNbr, Buf.CustNbr)) then
      Exit;

    (* Next the Part Number *)
    if Error(PXPutAlpha(RecHandle, FieldPartNbr, Buf.PartNbr)) then
      Exit;

    (* Quantity *)
    if Error(PXPutDoub(RecHandle, FieldQuantity, Buf.Quantity)) then
      Exit;

    (* To translate the date, first get month, day, and year from buffer
       then use PXEncode to translate into a Paradox date format. *)

    Month := GetNextWVal(Buf.Date);
    Day := GetNextWVal(Buf.Date);
    Year := GetNextWVal(Buf.Date);
    if Error(PXDateEncode(Month, Day, Year, PXDate)) then
      Exit;


    (* Now put the date into the record buffer *)
    if Error(PXPutDate(RecHandle, FieldDate, PXDate)) then
      Exit;
    TranslateBuffer := SUCCESS;

  end; (* TranslateBuffer *)


(*
 *    Function:
 *        Translate
 *
 *    Arguments:
 *        TblHandle       Handle to a Paradox table
 *        F               ASCII input file
 *
 *    Description:
 *        translate is the translation driver.    While there is still
 *        data available in the ASCII input file, it reads records from
 *        it, translates them into its Paradox counterpart and writes
 *        the translated record out to the Paradox table
 *
 *    Returns:
 *        SUCCESS         Translation successful
 *        FAILURE         Error in translation
 *)

function Translate(TblHandle: TableHandle;
                   var F: Text): Boolean;

  var
    AsciiBuf: TAsciiRecord;
    RecHandle: RecordHandle;
    StrBuf: String;


  function Split4(S: String ;
                  var S1, S2: String ;
                  var I1: Double;
                  var S3: String ): Boolean;
    (* extracts the first four values from a string separated by spaces
     * these valuse are : 1. String
     *                    2. String
     *                    3. Double
     *                    4. String
     * returns False if it wasn't possible to get these values
     *)

    var
      Help: String ;
      Code: Integer;



    function GetNextStr(var S: String ): String ;

      const
        Delim = ' ';

      var
        L: Byte;

      begin
        Strip(S); (* remove leading and trailing blanks if any *)
        L := Pos(Delim, S);
        if L = 0 then
          L := Length(S) + 1;
        GetNextStr := Copy(S, 1, L - 1);
        S := Copy(S, L + 1, Length(S));
      end; (* GetNextStr *)
    begin
      S1 := '';
      S2 := '';
      S3 := '';
      I1 := 0;
      S1 := GetNextStr(S);
      S2 := GetNextStr(S);
      Help := GetNextStr(S);
      Val(Help, I1, Code);
      S3 := GetNextStr(S);
      Split4 := (S3 <> '') and (Code = 0);
    end; (* Split4 *)
  begin
    Translate := FAILURE;
    (* Setup a record handle *)
    if Error(PXRecBufOpen(TblHandle, RecHandle)) then
      Translate := FAILURE
    else
      begin
        (* Read records until end of ASCII file *)
        while not Eof(F) do
          begin
          (* Read the buffer and make sure we do not encounter an unexpected
             end-of-file *)
            ReadLn(F, StrBuf);
            if Split4(StrBuf, AsciiBuf.PartNbr, AsciiBuf.CustNbr,
                      AsciiBuf.Quantity, AsciiBuf.Date)


            (* only a complete record will be processed *)
               then
              begin
                if not TranslateBuffer(AsciiBuf, RecHandle) then
                  Exit;
                (* And write it to the Paradox table *)
                if Error(PXRecAppend(TblHandle, RecHandle)) then
                  Exit;
              end; (* then *)

          end; (* while *)
      end; (* else *)
    (* File translated, close the record buffer *)

    if Error(PXRecBufClose(RecHandle)) then
      Translate := FAILURE
    else
      Translate := SUCCESS;

  end; (* Translate *)


(*
 *    Procedure:
 *        CloseFiles
 *
 *    Arguments:
 *        None
 *
 *    Description:
 *        Closes ASCII and Paradox files.    CloseFiles indicates any
 *        problems by reporting an error condition
 *
 *    Returns:
 *        None
 *)

procedure CloseFiles(TblHandle: TableHandle;
                     var F: Text);

  begin
{$I-}
    Close(F);
{$I+}
    if IoResult <> 0 then
      WriteLn('cannot close ascii file');
    if Error(PXTblClose(TblHandle)) then; (* ignore return code *)
  end; (* CloseFiles *)


(*
 *  Main program
 *
 *  Description:
 *    The following steps accomplish file translation:
 *      1.    Initialize Engine specific variables
 *      2.    Initialize the Engine
 *      3.    Open the ASCII data file
 *      4.    Create and open the Paradox File
 *      5.    Translate the data
 *      6.    Close All Files
 *      7.    Exit the Engine
 *
 *  Returns:
 *    Dos exitcode 0  : if IMPORT has done a good job
 *                 1  : if IMPORT was unsuccessful
 *)
begin
  (* Expect two filenames on the command line *)
  if ParamCount <> 2 then
    begin
      WriteLn('usage: IMPORT <AsciiFile> <ParadoxFile>');
      Halt(1);
    end;
  (* Initialize the Engine *)
  {$IFNDEF NETWORK }
  if Error( PXInit )
  {$ELSE }
  if Error(PXNetInit(NetPath, NetType, NetUserName))
  {$ENDIF }
     then
    Halt(1);
  if CreateParadoxFile(ParamStr(2)) = FAILURE then
    Halt(1);
  (* Open ASCII file and paradox file *)
  if OpenFiles(TblHandle, F) = SUCCESS then
    begin
      if not Translate(TblHandle, F) then
        WriteLn('can''t import');
      CloseFiles(TblHandle, F);
    end;
  if Error(PXExit) then
    Halt(1);
end.