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

Pascal/Delphi Source File | 1991-03-11 | 6.0 KB | 327 lines

{$M 20000,0,655360}
{$DEFINE SearchMain}

{$IFDEF SearchMain}

program Search;

{$ELSE}

unit Search;

interface

function PxPartialSearch( TblHandle: TableHandle; SearchString: String;
                          FldHandle: FieldHandle; Mode: Integer;
                          CaseSensitive: Boolean): Integer;

implementation
{$ENDIF}

uses PxEngine;
const
   CaseSensitive = TRUE;
   NetDir        = '';
   NetType       = NotOnNet;

(*
** Function:        UpCaseStr
**
** Parameters:
**
**        S string to convert to upper case
**
** Returns:
**        Upper case equivalent of the passed parameter
**
*)
function UpCaseStr(S: String): String;
var
   Result: String;
   I: Integer;

begin

  Result := '';
  for I := 1 to Length(S) do
    Result := Result + UpCase(S[I]);

  UpCaseStr := Result;

end;


(*
** Function:        PxPartialSearch
**
** Parameters:
**
**                      TblHandle    table to search
**
**            SearchString    string to locate
**
**            FldHandle    field to search
**
**            Mode        SEARCHFIRST or SEARCHNEXT
**
**                      CaseSensitive    True if CaseSensitive
**
** Returns:
**
**            PXSUCCESS if record found
**            PXERR_RECNOTFOUND if record not found
**
*)
function PxPartialSearch( TblHandle: TableHandle; SearchString: String;
                          FldHandle: FieldHandle; Mode: Integer;
                          CaseSensitive: Boolean): Integer;
const
   Found: Boolean = FALSE;

var
   PxErr: Integer;
   Buf, Buf2: String;
   RecHandle: RecordHandle;
   LckHandle: LockHandle;

begin

(* Make a copy of the search string, switch to uppercase if case-insensitive
   search *)
  Buf := SearchString;

  if CaseSensitive then
    Buf := UpCaseStr(Buf);

(* Lock the table so no changes can occur while we search *)
  PxErr := PxNetTblLock(TblHandle,WL);
  if PxErr<>PxSuccess then
    begin

      PxPartialSearch := PxErr;
      Exit;

    end;

(* save current record in case we need to return if string not found *)
  PxErr := PxNetRecLock(TblHandle, LckHandle);
  if PxErr = PxSuccess then
    if Mode = SearchFirst then
      PxErr := PxRecFirst(TblHandle)
    else
      PxErr := PxRecNext(TblHandle);

  if PxErr = PxSuccess then

    begin

      PxErr := PxRecBufOpen(TblHandle,RecHandle);

      if PxErr = PxSuccess then

        repeat

          PxErr := PxRecGet(TblHandle,RecHandle);
          if PxErr = PxSuccess then
            begin

            PxErr := PxGetAlpha(RecHandle,FldHandle,Buf2);
            if PxErr = PxSuccess then
              begin

                if CaseSensitive then
                  Buf2 := UpCaseStr(Buf2);

                if Pos(Buf,Buf2)<>0 then
                  Found := True
                else
                  PxErr := PxRecNext(TblHandle);
                end;

              end;

        until Found or (PxErr<>PxSuccess);

   end;

  if Found then

    begin

      PxPartialSearch := PxSuccess;
      Exit;

    end

  else
    if PxErr = PxErr_EndofTable then
       PxPartialSearch := PXErr_RecNotFound

    else

       PxPartialSearch := PxErr;

  end; { of Function PxPartialSearch }

{$IFDEF SEARCHMAIN}
const
     Data: array[0..6] of String = ( 'Paradox','Engine','Leveraging',
                                     'The','Power','Of','Paradox!' );
const
     NumberOfElements = 7;

(*
**    Function:    AddRecords
**
**    Parameters:
**            TblName        Name of table to append records to
**
**    Returns:
**            PXSUCCESS if successful
**            Appropriate PXERR_... if unsuccessful
**
*)
function AddRecords( TblName: String ): Integer;

var
   TblHandle: TableHandle;
   RecHandle: RecordHandle;
   PxErr, I: Integer;

begin

  PxErr := PxTblOpen(TblName,TblHandle,0,FALSE);
  if PxErr = PxSuccess then

    begin

      PxErr := PxRecBufOpen(TblHandle,RecHandle);
      if PxErr = PxSuccess then
      I := 0;
      while (I<NumberOfElements) and (PxErr=PxSuccess) do

        begin

          PxErr := PxPutAlpha(RecHandle,1,Data[I]);
          if PxErr = PxSuccess then
            PxErr := PxRecAppend(TblHandle,RecHandle);
          Inc(I);

        end;

    end;

  if PxErr = PxSuccess then

    begin

      PxErr := PxRecBufClose(RecHandle);
      if PxErr = PxSuccess then
        PxErr := PxTblClose(TblHandle);

    end;

  AddRecords := PxErr;

end;

(*
**    Function:     MakeTable
**
**    Parameters:
**            TableName    Name of table to create
**
**    Return Value:
**
**            PXSUCCESS if successful
**            Appropriate PXERR_... if unsuccessful
**
*)
function MakeTable(TableName: String): Integer;

var
   PxErr: Integer;
   Fields: NameArray;
   Types: NameArray;
   F: WordArray;
   TblSize: Word;

begin

  Fields[1] := 'Field 1';
  Fields[2] := 'Field 2';
  Types[1] := 'A20';
  Types[2] := 'A20';
  F[1] := 1;
  TblSize := 2;
  PxErr := PxTblCreate(TableName, TblSize, @Fields, @Types);
  if PxErr = PxSuccess then

    begin

      PxErr := PxKeyAdd(TableName,1,f,PRIMARY);
      if PxErr = PxSuccess then
        PxErr := AddRecords(TableName);

    end;

  MakeTable := PxErr;

end;

var

   TblHandle: TableHandle;
   RecHandle: RecordHandle;
   Buf: String;
   PxErr: Integer;

begin{ of Main Program}

PxErr := PxNetInit(NetDir,NetType,DefUserName);

if PxErr = PxSuccess then

   begin

     PxErr := MakeTable('Table');
     if PxErr = PxSuccess then

       begin

         PxErr := PxTblOpen('Table',TblHandle,0,FALSE);
         if PxErr = PxSuccess then
           PxErr := PxRecBufOpen(TblHandle,RecHandle);

        end;

   end;

if PxErr <> PxSuccess then

  begin

    Writeln('Error ',PxErrMsg(PxErr));
    Halt;

  end;

PxErr := PxPartialSearch(TblHandle,'aging',1,SEARCHFIRST,CASESENSITIVE);
if PxErr = PxSuccess then

  begin

    PxErr := PxRecGet(TblHandle,RecHandle);
    PxErr := PxGetAlpha(RecHandle,1,Buf);
    Writeln('Found [',Buf,']');

  end

else

  Writeln('Search: ',PxErrMsg(PxErr));

{$ENDIF}

end.