'I am placing this code and documentation in the public 
'domain in the hopes that others may find it useful. You are 
'free to use, modify and distribute it as you see fit. This 
'code is provided on an as-is basis; I have tested much of it 
'but it is not guaranteed to be bug-free. If you find errors 
'or have suggestions for improvement, you can send them to me 
'if you'd like. 
'Sharon F. Dooley
'January 2, 1992
'CompuServe ID 70740,2330
'PAL and PARADOX are trademarks of Borland.  Visual Basic is 
'a trademark of Microsoft.

' Declare a TRUE and FALSE in case they didn't do it in their global
 Const TRUE = -1
 Const FALSE = 0
' Constants used in this module only
' Paradox uses 1 for true
 Const PXTRUE = 1
' Paradox blank values
 Const PXBLANKDATE = &H80000000
 Const PXBLANKLONG = &H80000000
 Const PXBLANKSHORT = &H8000
'   Paradox Engine Function Declarations

'   INITIALIZATION AND FINALIZATION FUNCTIONS

				    
Declare Function PXWinInit Lib "pxengwin.dll" (ByVal ClientName$, ByVal ShareMode%) As Integer
Declare Function PXNetInit Lib "pxengwin.dll" (ByVal netNamePath$, ByVal netType%, ByVal UserName$) As Integer
Declare Function PXExit Lib "pxengwin.dll" () As Integer
Declare Function PXSetDefaults Lib "pxengwin.dll" (ByVal bufSize%, ByVal maxTables%, ByVal maxRecBufs%, ByVal maxLocks%, ByVal maxFiles%, ByVal sortOrder%) As Integer
Declare Function PXGetDefaults Lib "pxengwin.dll" (swapSize%, maxTables%, maxRecBufs%, maxLocks%, maxFiles%, ByVal sortOrder$) As Integer


'   UTILITY FUNCTIONS
Declare Function ISBLANKDOUBLE Lib "pxengwin.dll" (ByVal X#) As Integer
Declare Function BLANKDOUBLE Lib "pxengwin.dll" (X#) As Integer

'   TABLE FUNCTIONS
Declare Function PXTblOpen Lib "pxengwin.dll" (ByVal tblName$, ptblHandle%, ByVal indexId%, ByVal saveEveryChange%) As Integer
Declare Function PXTblClose Lib "pxengwin.dll" (ByVal tblHandle%) As Integer
'NOTE: VB does not easily handle the arrays of pointers to char required by
'this routine.  See the information in the readme about how to use this
'routine from VB
Declare Function PXTblCreate Lib "pxengwin.dll" (ByVal tblName$, ByVal nFields%, fieldptrs As Long, typeptrs As Long) As Integer
Declare Function PXTblEmpty Lib "pxengwin.dll" (ByVal tblName$) As Integer
Declare Function PXTblDelete Lib "pxengwin.dll" (ByVal tblName$) As Integer
Declare Function PXTblCopy Lib "pxengwin.dll" (ByVal fromName$, ByVal toName$) As Integer
Declare Function PXTblRename Lib "pxengwin.dll" (ByVal fromName$, ByVal toName$) As Integer
Declare Function PXTblAdd Lib "pxengwin.dll" (ByVal srcName$, ByVal destName$) As Integer


'   RECORD FUNCTIONS

Declare Function PXRecAppend Lib "pxengwin.dll" (ByVal tblHandle%, ByVal recHandle%) As Integer
Declare Function PXRecInsert Lib "pxengwin.dll" (ByVal tblHandle%, ByVal recHandle%) As Integer
Declare Function PXRecUpdate Lib "pxengwin.dll" (ByVal tblHandle%, ByVal recHandle%) As Integer
Declare Function PXRecDelete Lib "pxengwin.dll" (ByVal tblHandle%) As Integer
Declare Function PXRecBufOpen Lib "pxengwin.dll" (ByVal tblHandle%, recHandle%) As Integer
Declare Function PXRecBufClose Lib "pxengwin.dll" (ByVal recHandle%) As Integer
Declare Function PxRecBufEmpty Lib "pxengwin.dll" (ByVal recHandle%) As Integer
Declare Function PXRecBufCopy Lib "pxengwin.dll" (ByVal fromHandle%, ByVal toHandle%) As Integer
Declare Function PXRecGet Lib "pxengwin.dll" (ByVal tblHandle%, ByVal recHandle%) As Integer

'   FIELD FUNCTIONS

Declare Function PXPutShort Lib "pxengwin.dll" (ByVal recHandle%, ByVal fldHandle%, ByVal Value%) As Integer
Declare Function PXPutDoub Lib "pxengwin.dll" (ByVal recHandle%, ByVal fldHandle%, ByVal Value#) As Integer
Declare Function PXPutLong Lib "pxengwin.dll" (ByVal recHandle%, ByVal fldHandle%, ByVal Value&) As Integer
Declare Function PXPutAlpha Lib "pxengwin.dll" (ByVal recHandle%, ByVal fldHandle%, ByVal Value$) As Integer
Declare Function PXPutDate Lib "pxengwin.dll" (ByVal recHandle%, ByVal fldHandle%, ByVal Value&) As Integer
Declare Function PXPutBlank Lib "pxengwin.dll" (ByVal recHandle%, ByVal fldHandle%) As Integer
Declare Function PXGetShort Lib "pxengwin.dll" (ByVal recHandle%, ByVal fldHandle%, Svalue%) As Integer
Declare Function PXGetDoub Lib "pxengwin.dll" (ByVal recHandle%, ByVal fldHandle%, Dvalue#) As Integer
Declare Function PXGetLong Lib "pxengwin.dll" (ByVal recHandle%, ByVal fldHandle%, Lvalue&) As Integer
Declare Function PXGetAlpha Lib "pxengwin.dll" (ByVal recHandle%, ByVal fldHandle%, ByVal bufSize%, ByVal dest$) As Integer
Declare Function PXGetDate Lib "pxengwin.dll" (ByVal recHandle%, ByVal fldHandle%, pvalue&) As Integer
Declare Function PXFldBlank Lib "pxengwin.dll" (ByVal recHandle%, ByVal fldHandle%, Blank%) As Integer


'  NAVIGATION FUNCTIONS

Declare Function PXRecGoto Lib "pxengwin.dll" (ByVal tblHandle%, ByVal recnum&) As Integer
Declare Function PxRecFirst Lib "pxengwin.dll" (ByVal tblHandle%) As Integer
Declare Function PXRecLast Lib "pxengwin.dll" (ByVal tblHandle%) As Integer
Declare Function PXRecNext Lib "pxengwin.dll" (ByVal tblHandle%) As Integer
Declare Function PXRecPrev Lib "pxengwin.dll" (ByVal tblHandle%) As Integer


'   INDEX FUNCTIONS

				 '   PRIMARY/SECONDARY/INCSECONDARY
Declare Function PXKeyAdd Lib "pxengwin.dll" (ByVal tblName$, ByVal nflds%, ByVal fldHandle%, ByVal Mode%) As Integer
Declare Function PXKeyDrop Lib "pxengwin.dll" (ByVal tblName$, ByVal indexId%) As Integer

'   DATE FUNCTIONS

Declare Function PXDateDecode Lib "pxengwin.dll" (ByVal dateval&, Mo%, da%, Yr%) As Integer
Declare Function PXDateEncode Lib "pxengwin.dll" (ByVal Mo%, ByVal da%, ByVal Yr%, pdate&) As Integer

'   SEARCH FUNCTIONS
Declare Function PXSrchKey Lib "pxengwin.dll" (ByVal tblHandle%, ByVal recHandle%, ByVal nflds%, ByVal Mode%) As Integer
Declare Function PXSrchFld Lib "pxengwin.dll" (ByVal tblHandle%, ByVal recHandle%, ByVal fldHandle%, ByVal Mode%) As Integer

'   PASSWORD FUNCTIONS
Declare Function PXTblProtected Lib "pxengwin.dll" (ByVal tblName$, Protected%) As Integer
Declare Function PXPswAdd Lib "pxengwin.dll" (ByVal Password$) As Integer
Declare Function PXPswDel Lib "pxengwin.dll" (ByVal Password$) As Integer
Declare Function PXTblEncrypt Lib "pxengwin.dll" (ByVal tblName$, ByVal Password$) As Integer
Declare Function PXTblDecrypt Lib "pxengwin.dll" (ByVal tblName$) As Integer

'   INFORMATIONAL FUNCTIONS

Declare Function PXTblExist Lib "pxengwin.dll" (ByVal tblName$, Exist%) As Integer
Declare Function PXTblName Lib "pxengwin.dll" (ByVal tblHandle%, ByVal bufSize%, ByVal tblName$) As Integer
Declare Function PXRecNum Lib "pxengwin.dll" (ByVal tblHandle%, recnum&) As Integer
Declare Function PXTblNRecs Lib "pxengwin.dll" (ByVal tblHandle%, NRecs&) As Integer
Declare Function PXRecNFlds Lib "pxengwin.dll" (ByVal tblHandle%, nflds%) As Integer
Declare Function PXKeyNFlds Lib "pxengwin.dll" (ByVal tblHandle%, nKeyFlds%) As Integer
Declare Function PXFldHandle Lib "pxengwin.dll" (ByVal tblHandle%, ByVal fieldName$, fldHandle%) As Integer
Declare Function PXFldType Lib "pxengwin.dll" (ByVal tblHandle%, ByVal fldHandle%, ByVal bufSize%, ByVal fldType$) As Integer
Declare Function PXFldName Lib "pxengwin.dll" (ByVal tblHandle%, ByVal fldHandle%, ByVal bufSize%, ByVal fldName$) As Integer


'   MISCELLANEOUS FUNCTIONS
Declare Function PXTblMaxSize Lib "pxengwin.dll" (ByVal maxsize%) As Integer
Declare Function PXSave Lib "pxengwin.dll" () As Integer

'   CONCURRENCY FUNCTIONS
'   can be used only if PXNetInit() or PXWinInit() was successful

Declare Function PXNetUserName Lib "pxengwin.dll" (ByVal bufSize%, ByVal UserName$) As Integer
Declare Function PXNetFileLock Lib "pxengwin.dll" (ByVal fileName$, ByVal lockType%) As Integer
Declare Function PXNetFileUnlock Lib "pxengwin.dll" (ByVal fileName$, ByVal lockType%) As Integer
Declare Function PXNetTblLock Lib "pxengwin.dll" (ByVal tblHandle%, ByVal lockType%) As Integer
Declare Function PXNetTblUnlock Lib "pxengwin.dll" (ByVal tblHandle%, ByVal lockType%) As Integer
Declare Function PXNetRecLock Lib "pxengwin.dll" (ByVal tblHandle%, lckHandle%) As Integer
Declare Function PXNetRecUnlock Lib "pxengwin.dll" (ByVal tblHandle%, ByVal lckHandle%) As Integer
Declare Function PXNetRecLocked Lib "pxengwin.dll" (ByVal tblHandle%, Locked%) As Integer
Declare Function PXNetRecGotoLock Lib "pxengwin.dll" (ByVal tblHandle%, ByVal lckHandle%) As Integer
Declare Function PXNetTblChanged Lib "pxengwin.dll" (ByVal tblHandle%, Changed%) As Integer
Declare Function PXNetTblRefresh Lib "pxengwin.dll" (ByVal tblHandle%) As Integer


'   ERROR FUNCTIONS
Declare Function PXErrMsg Lib "pxengwin.dll" (ByVal errcode%) As Long
Declare Function PXNetErrUser Lib "pxengwin.dll" (ByVal bufSize%, ByVal UserName$) As Integer
'********************************************************************************************


'*************************************************************************************
' Windows API Declarations for API functions used in the interface
Declare Function lstrcpy Lib "Kernel" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long

'The following declaration is modified from the declaration provided in
' WINAPI.TXT so that it can be used to trick VB into building the
' arrays of pointers required by PXTblCreate. It normally returns String
' Hence the Alias
Declare Function PXAnsiUpper Lib "User" Alias "AnsiUpper" (ByVal lpString As String) As Long


'**************************************************************************************
' VB-Paradox Interface Layer.  This section contains the VB routines that
' invoke the actual Paradox Engine DLL.  This interface layer serves to
' mask some of the nitty-gritty details like Paradox data types from the
' VB programmer.  Note that VB.... routines return VB values for TRUE and
' FALSE, not Paradox values.

Sub BLANKSHORT (X As Integer)
    X = PXBLANKSHORT
End Sub

Sub BLANKDATE (X As Double)
    X = VBPXBLANKDATE
End Sub

Sub BLANKLONG (X As Long)
    X = PXBLANKLONG
End Sub

Function VBISBLANKSHORT (X As Integer) As Integer
    If X = PXISBLANKSHORT Then
    VBISBLANKSHORT = TRUE
    Else
    VBISBLANKSHORT = FALSE
    End If

End Function

Function VBISBLANKLONG (X As Long) As Integer
    If X = PXBLANKLONG Then
    VBISBLANKLONG = TRUE
    Else
    VBISBLANKLONG = FALSE
    End If
End Function

Function VBISBLANKDOUBLE (X As Double) As Integer
    If ISBLANKDOUBLE(X) = PXTRUE Then
    VBISBLANKDOUBLE = TRUE
    Else
    VBISBLANKDOUBLE = FALSE
    End If
End Function

Function VBISBLANKDATE (X As Double) As Integer
    If X = VBPXBLANKDATE Then
	VBISBLANKDATE = TRUE
    Else
	VBISBLANKDATE = FALSE
    End If
End Function

Function VBPXERRMSG (errcode As Integer) As String
' Returns the text for a Paradox Error code
    Dim Dummy As Long
    Dim MsgPtr As Long
    ErrMsg$ = String$(255, 0)
    MsgPtr = PXErrMsg(errcode)
    Dummy = lstrcpy(ErrMsg$, MsgPtr)
    Dummy = InStr(ErrMsg$, Chr$(0))
    VBPXERRMSG = Left$(ErrMsg$, Dummy)
End Function

Function VBPXExit ()
    VBPXExit = PXExit()
End Function

Function VBPXFldBlank (Record As RECORDHANDLE, Field As FIELDHANDLE) As Integer
'returns TRUE (-1) if field is blank, 0 if field is not blank, error code otherwise
    Dim Result As Integer
    Dim Status As Integer
    Status = PXFldBlank(Record.rHandle, Field.fHandle, Result)
    If Status = PXSUCCESS Then
       If Result = PXTRUE Then
	VBPXFldBlank = TRUE
       Else
	VBPXFldBlank = FALSE
       End If
    Else
       Status = showPDOXError(Status)
    End If
End Function

Function VBPXFldHandle (table As TABLEHANDLE, fldName As String, Field As FIELDHANDLE) As Integer
    VBPXFldHandle = PXFldHandle(table.thandle, fldName, Field.fHandle)
End Function

Function VBPXFldName (table As TABLEHANDLE, Field As FIELDHANDLE, fldName As String) As Integer
    fldName = String$(FldNameLen + 1, 0)
    VBPXFldName = PXFldName(table.thandle, Field.fHandle, FldNameLen, fldName)
End Function

Function showPDOXError (errcode As Integer) As Integer
    showPDOXError = MsgBox(VBPXERRMSG(errcode), MB_ICONSTOP, "Paradox Error")
    Stop
    Status = VBPXExit()
    End
End Function

Function VBPXFldType (table As TABLEHANDLE, Field As FIELDHANDLE, fldType As String) As Integer
    fldType = String$(fldTypeLen + 1, 0)
    VBPXFldType = PXFldType(table.thandle, Field.fHandle, fldTypeLen, fldType)
End Function

Function VBPXGetAlpha (Record As RECORDHANDLE, Field As FIELDHANDLE, dest As String) As Integer
    Dim Status As Integer
    Dim WorkLen As Integer
    Dim WorkStr As String
    Dim NullPos As Integer
    WorkLen = Len(dest) + 1
    WorkStr = String$(WorkLen, 0)
    Status = PXGetAlpha(Record.rHandle, Field.fHandle, WorkLen, WorkStr)
    If Status = PXSUCCESS Then
'       Find the first null and truncate the string from
'       there on
	NullPos = InStr(1, WorkStr, Chr$(0))

	dest = Mid$(WorkStr, 1, NullPos - 1)
    End If
    VBPXGetAlpha = Status
End Function

Function VBPXGetDefaults (swapSize As Integer, maxTables As Integer, maxRecBufs As Integer, maxLocks As Integer, maxFiles As Integer, sortOrder As String) As Integer
    VBPXGetDefaults = PXGetDefaults(swapSize, maxTables, maxRecBufs, maxLocks, maxFiles, sortOrder)
End Function

Function VBPXGetDoub (Record As RECORDHANDLE, Field As FIELDHANDLE, Value As Double) As Integer
    VBPXGetDoub = PXGetDoub(Record.rHandle, Field.fHandle, Value)
End Function

Function VBPXGetLong (Record As RECORDHANDLE, Field As FIELDHANDLE, Value As Long) As Integer
    VBPXGetLong = PXGetLong(Record.rHandle, Field.fHandle, Value)
End Function

Function VBPXGetShort (Record As RECORDHANDLE, Field As FIELDHANDLE, Value As Integer) As Integer
    VBPXGetShort = PXGetShort(Record.rHandle, Field.fHandle, Value)
End Function

Function VBPXKeyDrop (tblName As String, indexId As Integer) As Integer
    VBPXKeyDrop = PXKeyDrop(tblName, indexId)
End Function

Function VBPXKeyNFlds (table As TABLEHANDLE, nKeyFlds As Integer) As Integer
    VBPXKeyNFlds = PXKeyNFlds(table.thandle, nKeyFlds)
End Function

Function VBPXNetErrUser (UserName As String) As Integer
Dim WorkName As String
Dim Status As Integer
Dim NullPos As Integer
WorkLen = UserNetNameLen + 1
WorkName = String$(WorkLen, 0)
Status = PXNetErrUser(WorkLen, WorkName)
If Status = PXSUCCESS Then
'       trim the null terminator
    NullPos = InStr(1, WorkName, Chr$(0))
    UserName = Mid$(WorkName, 1, NullPos - 1)
End If
VBPXNetErrUser = Status
End Function

Function VBPXWinInit (ClientName As String, ShareMode As Integer) As Integer
    VBPXWinInit = PXWinInit(ClientName, ShareMode)
End Function

Function VBPXNetFileLock (fileName As String, lockType As Integer) As Integer
    VBPXNetFileLock = PXNetFileLock(fileName, lockType)
End Function

Function VBPXNetFileUnlock (fileName As String, lockType As Integer) As Integer
    VBPXNetFileUnlock = PXNetFileUnlock(fileName, lockType)
End Function

Function VBPXNetInit (netNamePath As String, netType As Integer, UserName As String) As Integer
    VBPXNetInit = PXNetInit(netNamePath, netType, UserName)
End Function

Function VBPXNetRecGotoLock (table As TABLEHANDLE, PXlock As LOCKHANDLE) As Integer
    VBPXNetRecGotoLock = PXNetRecGotoLock(table.thandle, PXlock.lhandle)
End Function

Function VBPXNetRecLock (table As TABLEHANDLE, PXlock As LOCKHANDLE) As Integer
    VBPXNetRecLock = PXNetRecLock(table.thandle, PXlock.lhandle)
End Function

Function VBPXNetRecUnlock (table As TABLEHANDLE, PXlock As LOCKHANDLE) As Integer
    VBPXNetRecUnlock = PXNetRecUnlock(table.thandle, PXlock.lhandle)
End Function

Function VBPXNetRecLocked (table As TABLEHANDLE) As Integer
'returns TRUE (-1) if the current record of table is locked
    Dim Result As Integer
    Dim Status As Integer
    Status = PXNetRecLocked(table.thandle, Result)
    If Status = PXSUCCESS Then
       If Result = PXTRUE Then
	VBPXNetRecLocked = TRUE
       Else
	VBPXNetRecLocked = FALSE
       End If
    Else
       Status = showPDOXError(Status)
    End If
End Function

Function VBPXNetTblChanged (table As TABLEHANDLE) As Integer
'returns TRUE (-1) if table has changed
    Dim Result As Integer
    Dim Status As Integer
    Status = PXNetTblChanged(table.thandle, Result)
    If Status = PXSUCCESS Then
       If Result = PXTRUE Then
	VBPXNetTblChanged = TRUE
       Else
	VBPXNetTblChanged = FALSE
       End If
    Else
       Status = showPDOXError(Status)
    End If
End Function

Function VBPXNetTblLock (table As TABLEHANDLE, lockType As Integer) As Integer
    VBPXNetTblLock = PXNetTblLock(table.thandle, lockType)
End Function

Function VBPXNetTblRefresh (table As TABLEHANDLE) As Integer
    VBPXNetTblRefresh = PXNetTblRefresh(table.thandle)
End Function

Function VBPXNetTblUnlock (table As TABLEHANDLE, lockType As Integer) As Integer
    VBPXNetTblUnlock = PXNetTblUnlock(table.thandle, lockType)
End Function

Function VBPXNetUserName (UserName As String) As Integer
Dim WorkName As String
Dim Status As Integer
Dim NullPos As Integer
WorkLen = UserNetNameLen + 1
WorkName = String$(WorkLen, 0)
Status = PXNetUserName(WorkLen, WorkName)
If Status = PXSUCCESS Then
'       trim the null terminator
    NullPos = InStr(1, WorkName, Chr$(0))
    UserName = Mid$(WorkName, 1, NullPos - 1)
End If
VBPXNetUserName = Status
End Function

Function VBPXPswAdd (Password As String) As Integer
    VBPXPswAdd = PXPswAdd(Password)
End Function

Function VBPXPswDel (Password As String) As Integer
    VBPXPswDel = PXPswDel(Password)
End Function

Function VBPXPutAlpha (Record As RECORDHANDLE, Field As FIELDHANDLE, Value As String) As Integer
    VBPXPutAlpha = PXPutAlpha(Record.rHandle, Field.fHandle, Value)
End Function

Function VBPXPutBlank (Record As RECORDHANDLE, Field As FIELDHANDLE) As Integer
    VBPXPutBlank = PXPutBlank(Record.rHandle, Field.fHandle)
End Function

Function VBPXPutDoub (Record As RECORDHANDLE, Field As FIELDHANDLE, Value As Double) As Integer
    VBPXPutDoub = PXPutDoub(Record.rHandle, Field.fHandle, Value)
End Function

Function VBPXPutLong (Record As RECORDHANDLE, Field As FIELDHANDLE, Value As Long) As Integer
    VBPXPutLong = PXPutLong(Record.rHandle, Field.fHandle, Value)
End Function

Function VBPXPutShort (Record As RECORDHANDLE, Field As FIELDHANDLE, Value As Integer) As Integer
    VBPXPutShort = PXPutShort(Record.rHandle, Field.fHandle, Value)
End Function

Function VBPXRecAppend (table As TABLEHANDLE, Record As RECORDHANDLE) As Integer
    VBPXRecAppend = PXRecAppend(table.thandle, Record.rHandle)
End Function

Function VBPXRecBufClose (Record As RECORDHANDLE) As Integer
    VBPXRecBufClose = PXRecBufClose(Record.rHandle)
End Function

Function VBPXRecBufCopy (SrcRecord As RECORDHANDLE, DestRecord As RECORDHANDLE) As Integer
    VBPXRecBufCopy = PXRecBufCopy(SrcRecord.rHandle, DestRecord.rHandle)
End Function

Function VBPXRecBufEmpty (Record As RECORDHANDLE) As Integer
    VBPXRecBufEmpty = PxRecBufEmpty(Record.rHandle)
End Function

Function VBPXRecBufOpen (table As TABLEHANDLE, Record As RECORDHANDLE) As Integer
    VBPXRecBufOpen = PXRecBufOpen(table.thandle, Record.rHandle)
End Function

Function VBPXRecDelete (table As TABLEHANDLE) As Integer
    VBPXRecDelete = PXRecDelete(table.thandle)
End Function

Function VBPXRecFirst (table As TABLEHANDLE) As Integer
    VBPXRecFirst = PxRecFirst(table.thandle)
End Function

Function VBPXRecGet (table As TABLEHANDLE, Record As RECORDHANDLE) As Integer
    VBPXRecGet = PXRecGet(table.thandle, Record.rHandle)
End Function

Function VBPXRecGoto (table As TABLEHANDLE, Record As RECORDHANDLE) As Integer
    VBPXRecGoto = PXRecGoto(table.thandle, Record.rHandle)
End Function

Function VBPXRecInsert (table As TABLEHANDLE, Record As RECORDHANDLE) As Integer
    VBPXRecInsert = PXRecInsert(table.thandle, Record.rHandle)
End Function

Function VBPXRecLast (table As TABLEHANDLE) As Integer
    VBPXRecLast = PXRecLast(table.thandle)
End Function

Function VBPXRecNext (table As TABLEHANDLE) As Integer
    VBPXRecNext = PXRecNext(table.thandle)
End Function

Function VBPXRecNFlds (table As TABLEHANDLE, nflds As Integer) As Integer
    VBPXRecNFlds = PXRecNFlds(table.thandle, nflds)
End Function

Function VBPXRecNum (table As TABLEHANDLE, RNum As RECORDNUMBER) As Integer
    VBPXRecNum = PXRecNum(table.thandle, RNum.recnum)
End Function

Function VBPXRecPrev (table As TABLEHANDLE) As Integer
    VBPXRecPrev = PXRecPrev(table.thandle)
End Function

Function VBPXSave () As Integer
    VBPXSave = PXSave()
End Function

Function VBPXSetDefaults (bufSize As Integer, maxTables As Integer, maxRecBufs As Integer, maxLocks As Integer, maxFiles As Integer, sortOrder As String) As Integer
    Dim PXSORT As Integer
'       The engine wants a C single character, not a string for the sort order
'       VB doesn't know from single characters.  So put its ascii code in an int, and
'       the engine will be happy and so will VB
    PXSORT = Asc(sortOrder)
    VBPXSetDefaults = PXSetDefaults(bufSize, maxTables, maxRecBufs, maxLocks, maxFiles, PXSORT)
End Function

Function VBPXSrchFld (table As TABLEHANDLE, Record As RECORDHANDLE, Field As FIELDHANDLE, SearchMode As Integer) As Integer
    VBPXSrchFld = PXSrchFld(table.thandle, Record.rHandle, Field.fHandle, SearchType)
End Function

Function VBPXSrchKey (table As TABLEHANDLE, Record As RECORDHANDLE, nflds As Integer, SearchMode As Integer) As Integer
    VBPXSrchKey = PXSrchKey(table.thandle, Record.rHandle, nflds, SearchMode)
End Function

Function VBPXTblAdd (srcTableName As String, destTableName As String) As Integer
    VBPXTblAdd = PXTblAdd(srcTableName, destTableName)
End Function

Function VBPXTblClose (table As TABLEHANDLE) As Integer
    VBPXTblClose = PXTblClose(table.thandle)
End Function

Function VBPXTblCopy (srcTableName As String, destTableName As String) As Integer
    VBPXTblCopy = PXTblCopy(srcTableName, destTableName)
End Function

Function VBPXTblCreate (TableName As String, NumFields As Integer, Fields() As String, Types() As String) As Integer
' This function uses a technique provided by Jim Nech of OutRider Systems.
' This was posted on Compuserve last Fall ('91)
'
' I needed a way to use The Paradox Engine to create Paradox tables in
' VB. At  first this seemed impossible because VB doesn't provide for
' arrays of  pointers to strings. The solution is to use arrays of
' longs. The problem  with this is that basic will not allow conversion
' of one type to another.   This had me stumped because I could not get
' the address of a string into  the elements of an array of longs. The
' solution was to make a Windows API  call that accepts a pointer to a
' string, and a return value that is also a  pointer to that same
' string. When you declare the function within VB you  have to LIE to
' VB about its return value. Instead of declaring it as  returning a
' string value you declare it as returning a long. This is not  a
' problem since they are both the same size. You can now assign the
' returned  long value to an element of an array of longs and VB will
' not complain.   When you call the PXTblCreate function you can pass
' the array to it. Since  arrays are passed by reference you end up
' passing a pointer to an array  of pointers to strings.
'

' Jim Nech
' OutRider Systems  -   (Producers of Custom Controls for Visual Basic)
' 3701 Kirby DR. STE. 1196
' Houston, TX 77098
' Voice:(713)521-0486    Fax:(713)523-0386

    ReDim PXFieldPtrs(NumFields) As Long
    ReDim PXTypePtrs(NumFields) As Long
    Dim i As Integer

    For i = 0 To NumFields - 1 Step 1
    '   Make the field and type null terminated
	Fields(i) = Fields(i) + Chr$(0)
	Types(i) = Types(i) + Chr$(0)
'               Asssign the addresses of the field names and the field
'               types to the field and type arrays
	PXFieldPtrs(i) = PXAnsiUpper(Fields(i))
	PXTypePtrs(i) = PXAnsiUpper(Types(i))
    Next
    VBPXTblCreate = PXTblCreate(TableName, NumFields, PXFieldPtrs(0), PXTypePtrs(0))
End Function

Function VBPXTblDecrypt (TableName As String) As Integer
    VBPXTblDecrypt = PXTblDecrypt(TableName)
End Function

Function VBPXTblDelete (TableName As String) As Integer
    VBPXTblDelete = PXTblDelete(TableName)
End Function

Function VBPXTblEmpty (TableName As String) As Integer
    VBPXTblEmpty = PXTblEmpty(TableName)
End Function

Function VBPXTblEncrypt (TableName As String, Password As String) As Integer
    VBPXTblEncrypt = PXTblEncrypt(TableName, Password)
End Function

Function VBPXTblExist (TableName As String) As Integer
    Dim Result As Integer
    Dim Status As Integer
    Status = PXTblExist(TableName, Result)
    If Status = PXSUCCESS Then
	If Result = PXTRUE Then
	    VBPXTblExist = TRUE
	Else
	    VBPXTblExist = FALSE
	End If
    Else
	Status = showPDOXError(Status)
    End If
End Function

Function VBPXTblMaxSize (maxTblSize As Integer) As Integer
    VBPXTblMaxSize = PXTblMaxSize(maxTblSize)
End Function

Function VBPXTblName (table As TABLEHANDLE, TableName As String) As Integer
    Dim NullPos As Integer
    Dim WorkName As String
    Dim Status As Integer
    WorkName = String$(TblNameLen + 1, 0)
    Status = PXTblName(table.thandle, TblNameLen + 1, WorkName)
    If Status = PXSUCCESS Then
    	NullPos = InStr(WorkName, Chr$(0))
    	TableName = Mid$(WorkName, 1, NullPos - 1)
    End If
    VBPXTblName = Status
End Function

Function VBPXTblNRecs (table As TABLEHANDLE, NRecs As RECORDNUMBER) As Integer
    VBPXTblNRecs = PXTblNRecs(table.thandle, NRecs.recnum)
End Function

Function VBPXTblOpen (TableName As String, table As TABLEHANDLE, indexId As Integer, saveEveryChange As Integer) As Integer
    VBPXTblOpen = PXTblOpen(TableName, table.thandle, indexId, saveEveryChange)
End Function

Function VBPXTblProtected (TableName As String) As Integer
    Dim Result As Integer
    Dim Status As Integer
    Status = PXTblProtected(TableName, Result)
    If Status = PXSUCCESS Then
	If Result = PXTRUE Then
	    VBPXTblProtected = TRUE
	Else
	    VBPXTblProtected = FALSE
	End If
    Else
	Status = showPDOXError(Status)
    End If
End Function

Function VBPXTblRename (srcTableName As String, destTableName As String) As Integer
    VBPXTblRename = PXTblRename(srcTableName, destTableName)
End Function

Function VBPXGetDate (Record As RECORDHANDLE, Field As FIELDHANDLE, dateval As Double)
'VB Dates are Double Serial numbers; Paradox dates are some bizzare internal format
' Manage the conversion from PDOX to VB here.  See also VBPXPutDate
    Dim pxdate As Long
    Dim Mo As Integer
    Dim Dy As Integer
    Dim Yr As Integer
    Dim Status As Integer
'   See if we have a blank date
    If VBPXFldBlank(Record, Field) Then
	dateval = VBPXBLANKDATE
	VBPXGetDate = PX_SUCCESS
    Else
'        Have a non-blank, get the value
	Status = PXGetDate(Record.rHandle, Field.fHandle, pxdate)
	If Status = PXSUCCESS Then
'               now, get the mo, day & year out of it
	    Status = PXDateDecode(pxdate, Mo, Dy, Yr)
	    If Status = PXSUCCESS Then
'                       turn it into a VB date
		dateval = DateSerial(Yr, Mo, Dy)
	    End If
	End If
	VBPXGetDate = Status
    End If

End Function

Function VBPXPutDate (Record As RECORDHANDLE, Field As FIELDHANDLE, dateval As Double) As Integer
    Dim pxdate As Long
    Dim Mo As Integer
    Dim Dy As Integer
    Dim Yr As Integer
    Dim Status As Integer
    If dateval = VBPXBLANKDATE Then
	Status = PXPutBlank(Record.rHandle, Field.fHandle)
	If Status <> PXSUCCESS Then
	    Status = showPDOXError(Status)
	End If
    Else
'       have valid date
'       now, decompose the VB date into mo, day, yr
	Dy = Day(dateval)
	Mo = Month(dateval)
	Yr = Year(dateval)
'       Now let paradox encode the date
	Status = PXDateEncode(Mo, Dy, Yr, pxdate)
	If Status = PXSUCCESS Then
'               Now shove the date into the database
	    Status = PXPutDate(Record.rHandle, Field.fHandle, pxdate)
	End If
    End If
    VBPXPutDate = Status
End Function

Function VBPXKeyAdd (tblName As String, nflds As Integer, Fields() As FIELDHANDLE, IndexType As Integer) As Integer
    VBPXKeyAdd = PXKeyAdd(tblName, nflds, Fields(1).fHandle, IndexType)
End Function

Function VBPXRecUpdate (table As TABLEHANDLE, Record As RECORDHANDLE) As Integer
    VBPXRecUpdate = PXRecUpdate(table.thandle, Record.rHandle)
End Function

Function VBPXGetCurrency (Record As RECORDHANDLE, Field As FIELDHANDLE, Value As Currency) As Integer
    Dim Result As Double
    Dim Status As Integer
    Status = PXGetDoub(Record.rHandle, Field.fHandle, Result)
    If Status <> PXSUCCESS Then
	Status = showPDOXError(Status)
    End If
    Value = Result
    VBPXGetCurrency = Status
End Function

Function VBPXPutCurrency (Record As RECORDHANDLE, Field As FIELDHANDLE, Value As Currency) As Integer
    Dim Result As Double
    Dim Status As Integer
    Result = Value
    Status = PXPutDoub(Record.rHandle, Field.fHandle, Result)
    If Status <> PXSUCCESS Then
	Status = showPDOXError(Status)
    End If
    VBPXPutCurrency = Status
End Function

