'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