Power-Programmierung/CD1.mdf/basic/library/vb/pxengine/pxengine.txt

Text File | 1992-06-01 | 38.2 KB | 1,109 lines

' Visual Basic declarations for Paradox Engine Version 2.0
'
' Functions PXInit, PXNetInit & PXSetHWHandler not used under Windows.
'
' Initialization and finalization functions
'
Declare Function PXWinInit Lib "pxengwin.dll" (ByVal clientName$, ByVal ShareMode%) 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%, sortTable%) As Integer
'
' Utility Functions
'
Declare Function ISBLANKDOUBLE Lib "pxengwin.dll" (ByVal x#) As Integer
Declare Sub BLANKDOUBLE Lib "pxengwin.dll" (x#)
'
' 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
Declare Function PXTblCreate Lib "pxengwin.dll" (ByVal TblName$, ByVal nFields%, fields&, types&) 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%, precHandle%) 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
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
'
Declare Function PXKeyAdd Lib "pxengwin.dll" (ByVal TblName$, ByVal NFlds%, pfldHandles%, 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 PXdate&, 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%, precnum&) As Integer
Declare Function PXTblNRecs Lib "pxengwin.dll" (ByVal TblHandle%, pnRecs&) 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$, pfldHandle%) 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 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%, plckHandle%) 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
'
' SortOrder argument in PXSetDefaults
'
Const SortOrderAscii = "a"        'ASCII sort order
Const SortOrderIntl = "i"         'International sort order
Const SortOrderNorDan = "n"       'Norwegian/Danish sort order
Const SortOrderSwedFin = "s"      'Swedish/Finnish sort order
'
' Mode argument in PXKeyAdd
'
Const PRIMARY% = 0                'Primary index (key)
Const SECONDARY% = 1              'Not maintained secondary index
Const INCSECONDARY% = 2           'Maintained secondary index
'
' Mode argument in PXSrchFld & PXSrchKey
'
Const SEARCHFIRST% = 0            'Search from beginning of table
Const SEARCHNEXT% = 1             'Search from next record in table
Const CLOSESTRECORD% = 2          '(modifier) goto 'nearest' record if
'                                  no match found (ordered fields only)
' LockType argument in
' PXNetFileLock, PXNetFileUnlock, PXNetTblLock & PXNetTblUnlock
'
Const FL% = 1                     'Full lock, no concurrency
Const WL% = 2                     'Write lock
Const PWL% = 3                    'Prevent write lock
Const PFL% = 4                    'Prevent full lock, full concurrency
'
' ShareMode argument in PXWinInit
'
Const PXSINGLECLIENT% = 0         'Allow no other client access to Engine DLL
Const PXEXCLUSIVE% = 1            'Open all tables with FULL LOCK
Const PXSHARED% = 2               'Open all tables with PREVENT FULL LOCK
'
' Miscellaneous declarations
'
Const InternalVersion& = &H2000004 'Paradox Engine version number
Dim BLANKALPHA As String           'Blank string
Dim BLANKDATE As Long              'Blank date
Dim BLANKLONG As Long              'Blank long integer
Dim BLANKSHORT As Integer          'Blank short integer
'
' Paradox Engine return codes
'
Const PXSUCCESS% = 0
Const PXERR_DRIVENOTREADY% = 1
Const PXERR_DIRNOTFOUND% = 2
Const PXERR_FILEBUSY% = 3
Const PXERR_FILELOCKED% = 4
Const PXERR_FILENOTFOUND% = 5
Const PXERR_TABLECORRUPTED% = 6
Const PXERR_XCORRUPTED% = 7
Const PXERR_XOUTOFDATE% = 8
Const PXERR_RECLOCKED% = 9
Const PXERR_DIRBUSY% = 10
Const PXERR_DIRLOCKED% = 11
Const PXERR_DIRNOACCESS% = 12
Const PXERR_XSORTVERSION% = 13
Const PXERR_DIRNOTPRIVATE% = 14
Const PXERR_NETMULTIPLE% = 15
Const PXERR_INSUFRIGHTS% = 21
Const PXERR_TABLEWRITEPRO% = 22
Const PXERR_TYPEMISMATCH% = 30
Const PXERR_OUTOFRANGE% = 31
Const PXERR_INVPARAMETER% = 33
Const PXERR_OUTOFMEM% = 40
Const PXERR_OUTOFDISK% = 41
Const PXERR_RECDELETED% = 50
Const PXERR_OUTOFFILEHANDLES% = 70
Const PXERR_OUTOFTABLEHANDLES% = 72
Const PXERR_INVDATE% = 73
Const PXERR_INVFIELDNAME% = 74
Const PXERR_INVFIELDHANDLE% = 75
Const PXERR_INVTABLEHANDLE% = 76
Const PXERR_NOTINITERR% = 78
Const PXERR_INVENGINESTATE% = 79
Const PXERR_STRUCTDIFFER% = 81
Const PXERR_ALREADYINIT% = 82
Const PXERR_TABLEOPEN% = 83
Const PXERR_NOMORETMPNAMES% = 86
Const PXERR_RECNOTFOUND% = 89
Const PXERR_TABLEINDEXED% = 94
Const PXERR_TABLENOTINDEXED% = 95
Const PXERR_SXOUTOFDATE% = 96
Const PXERR_KEYVIOL% = 97
Const PXERR_NOTLOGGEDIN% = 98
Const PXERR_INVTABLENAME% = 99
Const PXERR_ENDOFTABLE% = 101
Const PXERR_STARTOFTABLE% = 102
Const PXERR_OUTOFRECHANDLES% = 103
Const PXERR_INVRECHANDLE% = 104
Const PXERR_TABLEEMPTY% = 105
Const PXERR_INVLOCKCODE% = 106
Const PXERR_NONETINIT% = 107
Const PXERR_INVFILENAME% = 108
Const PXERR_INVUNLOCK% = 109
Const PXERR_INVLOCKHANDLE% = 110
Const PXERR_OUTOFLOCKHANDLES% = 111
Const PXERR_INVSORTORDER% = 112
Const PXERR_INVNETTYPE% = 113
Const PXERR_INVDIRNAME% = 114
Const PXERR_TOOMANYPASSW% = 115
Const PXERR_INVPASSW% = 116
Const PXERR_BUFTOOSMALL% = 117
Const PXERR_TABLEBUSY% = 118
Const PXERR_TABLELOCKED% = 119
Const PXERR_TABLENOTFOUND% = 120
Const PXERR_SXNOTFOUND% = 121
Const PXERR_SXCORRUPTED% = 122
Const PXERR_SXOPEN% = 123
Const PXERR_DISKWRITEPRO% = 124
Const PXERR_RECTOOBIG% = 125
Const PXERR_GENERALFAILURE% = 126
Const PXERR_OUTOFSTACK% = 127
Const PXERR_TABLEFULL% = 128
Const PXERR_OUTOFSWAPBUF% = 129
Const PXERR_TABLESQL% = 130
Const PXERR_TOOMANYCLIENTS% = 131
Const PXERR_EXCEEDSCONFIGLIMITS% = 132
Const PXERR_CANTREMAPFILEHANDLE% = 133
Const PXERR_CANTSHAREPDOXNET% = 134
Const PXERR_WINDOWSREALMODE% = 135
Const PXERR_SXCANTUPDATE% = 136
'
' Paradox Engine message variables
'
Dim RC As Integer                 'Paradox Engine return code
Dim PXMsgPtr As Long              'Paradox Engine message address
Dim PXMsgLen As Integer           'Paradox Engine message length
Dim PXMsgTxt As String            'Paradox Engine message text
Dim Dummy As Long                 'Dummy work variable
'
' Windows API function declarations
'
Declare Function AnsiPrev Lib "User" (ByVal lpchStart As String, ByVal lpchCurrentChar As String) As Long
Declare Function lstrcpy Lib "Kernel" (ByVal lpszString1 As Any, ByVal lpszString2 As Any) As Long
Declare Function lstrlen Lib "Kernel" (ByVal lpszString As Any) As Integer
'
' Dynamic array declarations
'
Dim Field_Name() As Long          'Used by PXTblCreate
Dim Field_Type() As Long          'Used by PXTblCreate
Dim Field_Key() As Integer        'Used by PXKeyAdd
'
' Program variables
'
Dim CRLF As String                'Carriage Return/Line Feed
Dim Copy_Name As String           'Table path & name
Dim Day_ As Integer               'Date day component
Dim Field1_Name As String         'Field 1 name for create
Dim Field1_Type As String         'Field 1 type for create
Dim Field2_Name As String         'Field 2 name for create
Dim Field2_Type As String         'Field 2 type for create
Dim Field3_Name As String         'Field 3 name for create
Dim Field3_Type As String         'Field 3 type for create
Dim Field4_Name As String         'Field 4 name for create
Dim Field4_Type As String         'Field 4 type for create
Dim Field5_Name As String         'Field 5 name for create
Dim Field5_Type As String         'Field 5 type for create
Dim FieldName As String           'Field name
Dim FieldType As String           'Field type
Dim FldHnd As Integer             'Field handle
Dim Line1 As String               'Message box text line 1
Dim Line2 As String               'Message box text line 2
Dim Line3 As String               'Message box text line 3
Dim Line4 As String               'Message box text line 4
Dim Line5 As String               'Message box text line 5
Dim Line6 As String               'Message box text line 6
Dim LockHandle As Integer         'Lock handle
Dim MaxFiles As Integer           'Maximum number of files handles
Dim MaxLocks As Integer           'Maximum locks per table
Dim MaxRecBufs As Integer         'Maximum number of record buffers
Dim MaxTables As Integer          'Maximum number of open tables
Dim Month_ As Integer             'Date month component
Dim Msg As String                 'Message box message
Dim RecHandle1 As Integer         'Record handle
Dim RecHandle2 As Integer         'Record handle
Dim Rename_Name As String         'Table path & name
Dim SortOrder As Integer          'Current sort order
Dim Swapsize As Integer           'Internal swap buffer size
Dim Table_Name As String          'Table path & name
Dim TblHandle As Integer          'Table handle
Dim Title As String               'Message box title
Dim WorkDouble As Double          'Work variable
Dim WorkInteger As Integer        'Work variable
Dim WorkLong As Long              'Work variable
Dim WorkString As String          'Work variable
Dim Year_ As Integer              'Date year component

Sub Main ()
    CRLF = Chr$(&HD) + Chr$(&HA)  'Carriage return/Line feed
    Table_Name = "C:\PXEngine"    'Table path & name
    Copy_Name = "C:\Copied"       'Table path & name
    Rename_Name = "C:\Renamed"    'Table path & name
    BLANKALPHA = Space$(0)        'Blank string field
    BLANKSHORT = &H8000           'Blank short integer field
    BLANKLONG = &H80000000        'Blank long integer field
    BLANKDATE = &H80000000        'Blank date field
'
    Title$ = "ErrMsg"
    ErrMsg              'Reports error message
    SetDefaults         'Sets internal default values
    GetDefaults         'Returns internal defalt values
    WinInit             'Initializes Paradox Engine under Windows
    PswAdd              'Enters a password
    TblMaxSize          'Sets maximum size for any table
    TblCreate           'Creates a table
    TblOpen             'Opens a table
    RecBufOpen          'Creates a record transfer buffer
    RecInsert           'Inserts a record into a table
    FldHandle           'Gets the field handle for a given field name
    FldBlank            'Tests if a field is blank
    GetDoub             'Retrieves a double value from a field
    PutDoub             'Assigns a double value to a field
    GetDoub             'Retrieves a double value from a field
    RecUpdate           'Updates the current record in a table
    PutBlank            'Assigns a blank value to a field
    RecAppend           'Appends a record to a table
    RecFirst            'Moves to the first record of a table
    RecNext             'Moves to the next record of a table
    RecPrev             'Moves to the previous record in a table
    RecPrev             'Moves to the previous record in a table
    RecLast             'Moves to last record of a table
    RecPrev             'Moves to the previous record in a table
    RecNext             'Moves to the next record of a table
    RecNext             'Moves to the next record of a table
    RecGoto             'Moves to a specified record
    RecUpdate           'Updates the current record in a table
    RecBufCopy          'Copies source record buffer to destination record buffer
    RecNum              'Finds the current record number
    RecPrev             'Moves to the previous record in a table
    RecNum              'Finds the current record number
    RecNFlds            'Finds the number of fields in a table
    RecGet              'Transfers current record to the record transfer buffer
    RecBufEmpty         'Clears a record transfer buffer
    PutAlpha            'Assigns a string value to a field
    GetAlpha            'Retrieves a string from an alphanumeric field
    PutDate             'Assigns a DATE value to a field
    GetDate             'Retrieves a DATE value from a date field
    PutLong             'Assigns a long integer value to a field
    GetLong             'Retrieves a long value from a field
    PutShort            'Assigns a short integer value to a field
    GetShort            'Retrieves a short integer value from a field
    RecBufClose         'Removes a record transfer buffer
    TblClose            'Closes a table
    KeyAdd              'Creates a primary or secondary index on a table
    KeyDrop             'Deletes primary or secondary index
    TblOpen             'Opens a table
    RecBufOpen          'Creates a record transfer buffer
    DateEncode          'Converts calendar date to internal format
    DateDecode          'Converts internal date to calendar date
    SrchKey             'Searches a table for a key match
    SrchFld             'Searches a table on a specified field
    RecDelete           'Deletes the current record from a table
    TblProtected        'Tests if the table is encrypted
    TblExist            'Tests if a table exists
    TblName             'Finds table name corresponding to table handle
    TblNRecs            'Finds the number of records in a table
    KeyNFlds            'Finds the number of key fields in a table
    FldType             'Gets the field type for a given field handle
    FldName             'Gets the field name for a given field handle
    Save                'Flushes all buffers and writes them to disk
    NetUserName         'Obtains name of user
    NetFileLock         'Locks a file
    NetFileUnlock       'Unlocks a file
    NetTblLock          'Locks a table
    NetTblUnlock        'Unlocks a table
    NetRecLock          'Locks a record
    NetRecLocked        'Determines whether a record has been locked
    NetRecGotoLock      'Returns to a previously locked record
    NetRecUnlock        'Unlocks a record
    NetRecLocked        'Determines whether a record has been locked
    NetTblChanged       'Tests if a table has changed
    NetTblRefresh       'Resynchronizes a table
    NetErrUser          'Reports name of user causing locking error
    RecBufClose         'Removes a record transfer buffer
    TblClose            'Closes a table
    TblEncrypt          'Encrypts a table
    TblProtected        'Tests if the table is encrypted
    TblDecrypt          'Decrypts a table
    TblProtected        'Tests if the table is encrypted
    TblRename           'Changes the base name of a table family
    TblCopy             'Copies one table family to another
    TblCreate           'Creates a table
    TblOpen             'Opens a table
    RecBufOpen          'Creates a record transfer buffer
    TblAdd              'Adds records from one table to another table
    RecBufClose         'Removes a record transfer buffer
    TblClose            'Closes a table
    TblEmpty            'Removes all records from a table
    TblDelete           'Deletes a table and its family
    PswDel              'Removes a password
    Exit_PX             'Closes the Paradox environment
End Sub

Sub TblOpen ()
    Title$ = "PXTblOpen"
    RC% = PXTblOpen(Table_Name$, TblHandle%, 0, 0)
    ErrMsg
End Sub

Sub TblCreate ()
'
'   Create a Paradox table with one field of each type
'
    Title$ = "PXTblCreate"
    Field1_Name$ = "Numeric"            'Define 1st field name
    Field1_Type$ = "N"                  'Numeric data type
    Field2_Name$ = "Short_number"       'Define 2nd field name
    Field2_Type$ = "S"                  'Short number data type
    Field3_Name$ = "Currency"           'Define 3rd field name
    Field3_Type$ = "$"                  'Currency data type
    Field4_Name$ = "Alphanumeric"       'Define 4th field name
    Field4_Type$ = "A16"                '16 byte alphanumeric data type
    Field5_Name$ = "Date"               'Define 5th field name
    Field5_Type$ = "D"                  'Date data type
'
'   Load field name pointer array
'
    ReDim Field_Name(5) As Long
    Field_Name(0) = AnsiPrev(Field1_Name$, Field1_Name$)
    Field_Name(1) = AnsiPrev(Field2_Name$, Field2_Name$)
    Field_Name(2) = AnsiPrev(Field3_Name$, Field3_Name$)
    Field_Name(3) = AnsiPrev(Field4_Name$, Field4_Name$)
    Field_Name(4) = AnsiPrev(Field5_Name$, Field5_Name$)
'
'   Load field type pointer array
'
    ReDim Field_Type(5) As Long
    Field_Type(0) = AnsiPrev(Field1_Type$, Field1_Type$)
    Field_Type(1) = AnsiPrev(Field2_Type$, Field2_Type$)
    Field_Type(2) = AnsiPrev(Field3_Type$, Field3_Type$)
    Field_Type(3) = AnsiPrev(Field4_Type$, Field4_Type$)
    Field_Type(4) = AnsiPrev(Field5_Type$, Field5_Type$)
'
    RC% = PXTblCreate(Table_Name$, 5, Field_Name(0), Field_Type(0))
    ErrMsg
End Sub

Sub ErrMsg ()
    PXMsgPtr& = PXErrMsg(RC%)                   'Message address
    PXMsgLen% = lstrlen(PXMsgPtr&)              'Message length
    PXMsgTxt$ = String$(PXMsgLen% + 1, Chr$(0)) 'Allocate message buffer
    Dummy& = lstrcpy(PXMsgTxt$, PXMsgPtr&)      'Copy message text
    Line1$ = "Paradox Engine return code: " + Str$(RC%) + CRLF$
    Line2$ = PXMsgTxt$
    Msg$ = Line1$ + Line2$
    MsgBox Msg$, 64, Title$ + " function"
End Sub

Sub TblClose ()
    Title$ = "PXTblClose"
    RC% = PXTblClose(TblHandle%)
    ErrMsg
End Sub

Sub TblEmpty ()
    Title$ = "PXTblEmpty"
    RC% = PXTblEmpty(Table_Name$)
    ErrMsg
End Sub

Sub TblDelete ()
    Title$ = "PXTblDelete"
    RC% = PXTblDelete(Table_Name$)
    ErrMsg
    RC% = PXTblDelete(Copy_Name$)
    ErrMsg
    RC% = PXTblDelete(Rename_Name$)
    ErrMsg
End Sub

Sub TblRename ()
    Title$ = "PXTblRename"
    RC% = PXTblRename(Table_Name$, Rename_Name$)
    ErrMsg
End Sub

Sub TblCopy ()
    Title$ = "PXTblCopy"
    RC% = PXTblCopy(Rename_Name$, Copy_Name$)
    ErrMsg
End Sub

Sub TblAdd ()
    Title$ = "PXTblAdd"
    RC% = PXTblAdd(Rename_Name$, Copy_Name$)
    ErrMsg
End Sub

Sub SetDefaults ()
    Title$ = "PXSetDefaults"
    SortOrder% = Asc(SortOrderIntl)     'Sort order only under Windows
    RC% = PXSetDefaults(Swapsize%, MaxTables%, MaxRecBufs%, MaxLocks%, MaxFiles%, SortOrder%)
    ErrMsg
End Sub

Sub GetDefaults ()
    Title$ = "PXGetDefaults"
    RC% = PXGetDefaults(Swapsize%, MaxTables%, MaxRecBufs%, MaxLocks%, MaxFiles%, SortOrder%)
    ErrMsg
    Line1$ = "Swapsize: " + Str$(Swapsize%) + CRLF
    Line2$ = "MaxTables: " + Str$(MaxTables%) + CRLF
    Line3$ = "MaxRecBufs: " + Str$(MaxRecBufs%) + CRLF
    Line4$ = "MaxLocks: " + Str$(MaxLocks%) + CRLF
    Line5$ = "MaxFiles: " + Str$(MaxFiles%) + CRLF
    Line6$ = "SortOrder:  " + Chr$(SortOrder%)
    Title$ = "Internal Defaults"
    Msg$ = Line1$ + Line2$ + Line3$ + Line4$ + Line5$ + Line6$
    MsgBox Msg$, 0, Title
End Sub

Function ISBLANKSHORT (x As Integer) As Integer
    If x = BLANKSHORT Then
        ISBLANKSHORT = 1            'Return Paradox Engine TRUE value
    Else
        ISBLANKSHORT = 0            'Return Paradox Engine FALSE value
    End If
End Function

Function ISBLANKLONG (x As Long) As Integer
    If x = BLANKLONG Then
        ISBLANKLONG = 1             'Return Paradox Engine TRUE value
    Else
        ISBLANKLONG = 0             'Return Paradox Engine FALSE value
    End If
End Function

Function ISBLANKDATE (x As Long) As Integer
    If x = BLANKDATE Then
        ISBLANKDATE = 1             'Return Paradox Engine TRUE value
    Else
        ISBLANKDATE = 0             'Return Paradox Engine FALSE value
    End If
End Function

Function ISBLANKALPHA (x As String) As Integer
    If x = BLANKALPHA Then
        ISBLANKALPHA = 1            'Return Paradox Engine TRUE value
    Else
        ISBLANKALPHA = 0            'Return Paradox Engine FALSE value
    End If
End Function

Sub RecBufOpen ()
    Title$ = "PXRecBufOpen"
    RC% = PXRecBufOpen(TblHandle%, RecHandle1%)
    ErrMsg
End Sub

Sub FldHandle ()
    Title$ = "PXFldHandle"
    FieldName$ = "Numeric"
    RC% = PXFldHandle(TblHandle%, FieldName$, FldHnd%)
    ErrMsg
End Sub

Sub FldBlank ()
    Title$ = "PXFldBlank"
    RC% = PXFldBlank(RecHandle1%, FldHnd%, WorkInteger%)
    ErrMsg
    Msg$ = "Return value: " + Str$(WorkInteger%)
    MsgBox Msg$, 0, "Blank field test"
End Sub

Sub GetDoub ()
    Title$ = "PXGetDoub"
    RC% = PXGetDoub(RecHandle1%, FldHnd%, WorkDouble#)
    ErrMsg
    RC% = ISBLANKDOUBLE(WorkDouble#) 'Tests if the argument is blank
    Line1$ = "ISBLANKDOUBLE: " + Str$(RC%) + CRLF
    Line2$ = "Value: " + Str$(WorkDouble#) + CRLF
    Line3$ = "Length: " + Str$(Len(WorkDouble#))
    MsgBox Line1$ + Line2$ + Line3$, 0, "Double field"
End Sub

Sub PutDoub ()
    Title$ = "PXPutDoub"
    WorkDouble# = 73150
    RC% = PXPutDoub(RecHandle1%, FldHnd%, WorkDouble#)
    ErrMsg
End Sub

Sub WinInit ()
    Title$ = "PXWinInit"
    RC% = PXWinInit("PXEngine", PXSHARED)
    ErrMsg
End Sub

Sub RecBufClose ()
    Title$ = "PXRecBufClose"
    RC% = PXRecBufClose(RecHandle1%)
    ErrMsg
End Sub

Sub RecBufEmpty ()
    Title$ = "PXRecBufEmpty"
    RC% = PXRecBufEmpty(RecHandle1%)
    ErrMsg
End Sub

Sub RecAppend ()
    Title$ = "PXRecAppend"
    RC% = PXRecAppend(TblHandle%, RecHandle1%)
    ErrMsg
End Sub

Sub RecInsert ()
    Title$ = "PXRecInsert"
    RC% = PXRecInsert(TblHandle%, RecHandle1%)
    ErrMsg
End Sub

Sub RecUpdate ()
    Title$ = "PXRecUpdate"
    RC% = PXRecUpdate(TblHandle%, RecHandle1%)
    ErrMsg
End Sub

Sub RecDelete ()
    Title$ = "PXRecDelete"
    RC% = PXRecDelete(TblHandle%)
    ErrMsg
End Sub

Sub RecBufCopy ()
    Title$ = "PXRecBufOpen"
    RC% = PXRecBufOpen(TblHandle%, RecHandle2%)
    ErrMsg
    Title$ = "PXRecBufCopy"
    RC% = PXRecBufCopy(RecHandle1%, RecHandle2%)
    ErrMsg
    Title$ = "PXRecBufClose"
    RC% = PXRecBufClose(RecHandle2%)
    ErrMsg
End Sub

Sub RecGet ()
    Title$ = "PXRecGet"
    RC% = PXRecGet(TblHandle%, RecHandle1%)
    ErrMsg
End Sub

Sub RecFirst ()
    Title$ = "PXRecFirst"
    RC% = PXRecFirst(TblHandle%)
    ErrMsg
End Sub

Sub RecLast ()
    Title$ = "PXRecLast"
    RC% = PXRecLast(TblHandle%)
    ErrMsg
End Sub

Sub RecNext ()
    Title$ = "PXRecNext"
    RC% = PXRecNext(TblHandle%)
    ErrMsg
End Sub

Sub RecPrev ()
    Title$ = "PXRecPrev"
    RC% = PXRecPrev(TblHandle%)
    ErrMsg
End Sub

Sub RecGoto ()
    Title$ = "PXRecGoto"
    WorkLong& = 1
    RC% = PXRecGoto(TblHandle%, WorkLong&)
    ErrMsg
    Title$ = "PXRecGoto"
    WorkLong& = 2
    RC% = PXRecGoto(TblHandle%, WorkLong&)
    ErrMsg
    Title$ = "PXRecGoto"
    WorkLong& = 3
    RC% = PXRecGoto(TblHandle%, WorkLong&)
    ErrMsg
End Sub

Sub RecNFlds ()
    Title$ = "PXRecNFlds"
    RC% = PXRecNFlds(TblHandle%, WorkInteger%)
    Msg$ = "Field count: " + Str$(WorkInteger%)
    MsgBox Msg$, 0, Title$
    ErrMsg
End Sub

Sub RecNum ()
    Title$ = "PXRecNum"
    RC% = PXRecNum(TblHandle%, WorkLong&)
    ErrMsg
    Msg$ = Str$(WorkLong&)
    MsgBox Msg$, 0, "Record number"
End Sub

Sub PutShort ()
    Title$ = "PXFldHandle"
    FieldName$ = "Short_number"
    RC% = PXFldHandle(TblHandle%, FieldName$, FldHnd%)
    ErrMsg
    Title$ = "PXPutShort"
    WorkInteger% = 1234
    RC% = PXPutShort(RecHandle1%, FldHnd%, WorkInteger%)
    ErrMsg
    Title$ = "PXFldHandle"
    FieldName$ = "Currency"
    RC% = PXFldHandle(TblHandle%, FieldName$, FldHnd%)
    ErrMsg
    Title$ = "PXPutShort"
    WorkInteger% = 5678
    RC% = PXPutShort(RecHandle1%, FldHnd%, WorkInteger%)
    ErrMsg
End Sub

Sub PutLong ()
    Title$ = "PXFldHandle"
    FieldName$ = "Numeric"
    RC% = PXFldHandle(TblHandle%, FieldName$, FldHnd%)
    ErrMsg
    Title$ = "PXPutLong"
    WorkLong& = 73150
    RC% = PXPutLong(RecHandle1%, FldHnd%, WorkLong&)
    ErrMsg
End Sub

Sub PutDate ()
    Title$ = "PXFldHandle"
    FieldName$ = "Date"
    RC% = PXFldHandle(TblHandle%, FieldName$, FldHnd%)
    ErrMsg
    Title$ = "PXPutDate"
    WorkLong& = 712069
    RC% = PXPutDate(RecHandle1%, FldHnd%, WorkLong&)
    ErrMsg
End Sub

Sub PutAlpha ()
    Title$ = "PXFldHandle"
    FieldName$ = "Alphanumeric"
    RC% = PXFldHandle(TblHandle%, FieldName$, FldHnd%)
    ErrMsg
    Title$ = "PXPutAlpha"
    WorkString$ = "ABCDabcd"
    RC% = PXPutAlpha(RecHandle1%, FldHnd%, WorkString$)
    ErrMsg
End Sub

Sub PutBlank ()
    Title$ = "PXPutBlank"
    RC% = PXPutBlank(RecHandle1%, FldHnd%)
    ErrMsg
End Sub

Sub GetShort ()
    Title$ = "PXFldHandle"
    FieldName$ = "Short_number"
    RC% = PXFldHandle(TblHandle%, FieldName$, FldHnd%)
    ErrMsg
    Title$ = "PXGetShort"
    RC% = PXGetShort(RecHandle1%, FldHnd%, WorkInteger%)
    ErrMsg
    Line1$ = "Value: " + Str$(WorkInteger%) + CRLF
    Line2$ = "Length: " + Str$(Len(WorkInteger%))
    MsgBox Line1$ + Line2$, 0, "Short integer field"
    Title$ = "PXFldHandle"
    FieldName$ = "Currency"
    RC% = PXFldHandle(TblHandle%, FieldName$, FldHnd%)
    ErrMsg
    Title$ = "PXGetShort"
    RC% = PXGetShort(RecHandle1%, FldHnd%, WorkInteger%)
    ErrMsg
    Line1$ = "Value: " + Str$(WorkInteger%) + CRLF
    Line2$ = "Length: " + Str$(Len(WorkInteger%))
    MsgBox Line1$ + Line2$, 0, "Currency field"
End Sub

Sub GetLong ()
    Title$ = "PXFldHandle"
    FieldName$ = "Numeric"
    RC% = PXFldHandle(TblHandle%, FieldName$, FldHnd%)
    ErrMsg
    Title$ = "PXGetLong"
    RC% = PXGetLong(RecHandle1%, FldHnd%, WorkLong&)
    ErrMsg
    Line1$ = "Value: " + Str$(WorkLong&) + CRLF
    Line2$ = "Length: " + Str$(Len(WorkLong&))
    MsgBox Line1$ + Line2$, 0, "Long field"
End Sub

Sub GetAlpha ()
    Title$ = "PXFldHandle"
    FieldName$ = "Alphanumeric"
    RC% = PXFldHandle(TblHandle%, FieldName$, FldHnd%)
    ErrMsg
    Title$ = "PXGetAlpha"
    WorkString$ = Space$(13)
    RC% = PXGetAlpha(RecHandle1%, FldHnd%, Len(WorkString$), WorkString$)
    ErrMsg
    Line1$ = "Value: " + WorkString$ + CRLF
    Line2$ = "Length: " + Str$(Len(WorkString$))
    MsgBox Line1$ + Line2$, 0, "Alphanumeric field"
End Sub

Sub GetDate ()
    Title$ = "PXFldHandle"
    FieldName$ = "Date"
    RC% = PXFldHandle(TblHandle%, FieldName$, FldHnd%)
    ErrMsg
    Title$ = "PXGetDate"
    RC% = PXGetDate(RecHandle1%, FldHnd%, WorkLong&)
    ErrMsg
    Line1$ = "Value: " + Str$(WorkLong&) + CRLF
    Line2$ = "Length: " + Str$(Len(WorkLong&))
    MsgBox Line1$ + Line2$, 0, "Date field"
End Sub

Sub KeyAdd ()
    Title$ = "PXKeyAdd"
    WorkInteger% = 3
    ReDim Field_Key(5) As Integer
    Field_Key%(0) = 1
    Field_Key%(1) = 2
    Field_Key%(2) = 3
    Field_Key%(3) = 4
    Field_Key%(4) = 5
    RC% = PXKeyAdd(Table_Name$, WorkInteger%, Field_Key%(0), PRIMARY)
    ErrMsg
    WorkInteger% = 1
    RC% = PXKeyAdd(Table_Name$, WorkInteger%, Field_Key%(3), SECONDARY)
    ErrMsg
    WorkInteger% = 1
    RC% = PXKeyAdd(Table_Name$, WorkInteger%, Field_Key%(4), INCSECONDARY)
    ErrMsg
End Sub

Sub KeyDrop ()
    Title$ = "PXKeyDrop"
    WorkInteger% = 5
    RC% = PXKeyDrop(Table_Name$, WorkInteger%)
    ErrMsg
    WorkInteger% = 4
    RC% = PXKeyDrop(Table_Name$, WorkInteger%)
    ErrMsg
    WorkInteger% = 0
    RC% = PXKeyDrop(Table_Name$, WorkInteger%)
    ErrMsg
End Sub

Sub DateEncode ()
    Title$ = "PXDateEncode"
    Month_% = 7
    Day_% = 31
    Year_% = 1950
    RC% = PXDateEncode(Month_%, Day_%, Year_%, WorkLong&)
    ErrMsg
    Msg$ = "PXdate: " + Str$(WorkLong&)
    MsgBox Msg$, 0, "Encoded date"
End Sub

Sub DateDecode ()
    Title$ = "PXDateDecode"
    WorkLong& = 712069                          'Paradox date format
    RC% = PXDateDecode(WorkLong&, Month_%, Day_%, Year_%)
    ErrMsg
    Line1$ = "Month: " + Str$(Month_%) + CRLF
    Line2$ = "Day: " + Str$(Day_%) + CRLF
    Line3$ = "Year: " + Str$(Year_%)
    Msg$ = Line1$ + Line2$ + Line3$
    MsgBox Msg$, 0, "Decoded date"
End Sub

Sub SrchKey ()
    Title$ = "PXFldHandle"
    FieldName$ = "Numeric"
    RC% = PXFldHandle(TblHandle%, FieldName$, FldHnd%)
    ErrMsg
    Title$ = "PXPutDoub"
    WorkDouble# = 73150
    RC% = PXPutDoub(RecHandle1%, FldHnd%, WorkDouble#)
    ErrMsg
    Title$ = "PXSrchKey"
    WorkInteger% = 1
    RC% = PXSrchKey(TblHandle%, RecHandle1%, WorkInteger%, SEARCHFIRST)
    ErrMsg
End Sub

Sub SrchFld ()
    Title$ = "PXFldHandle"
    FieldName$ = "Numeric"
    RC% = PXFldHandle(TblHandle%, FieldName$, FldHnd%)
    ErrMsg
    Title$ = "PXPutDoub"
    WorkDouble# = 73150
    RC% = PXPutDoub(RecHandle1%, FldHnd%, WorkDouble#)
    ErrMsg
    Title$ = "PXSrchFld"
    RC% = PXSrchFld(TblHandle%, RecHandle1%, FldHnd%, SEARCHFIRST)
    ErrMsg
End Sub

Sub TblProtected ()
    Title$ = "PXTblProtected"
    RC% = PXTblProtected(Table_Name$, WorkInteger%)
    ErrMsg
    Msg$ = "Return value: " + Str$(WorkInteger%)
    MsgBox Msg$, 0, "Protect Mode"
End Sub

Sub PswAdd ()
    Title$ = "PXPswAdd"
    WorkString$ = "Password"
    RC% = PXPswAdd(WorkString$)
    ErrMsg
End Sub

Sub PswDel ()
    Title$ = "PXPswDel"
    WorkString$ = "Password"
    RC% = PXPswDel(WorkString$)
    ErrMsg
End Sub

Sub TblEncrypt ()
    Title$ = "PXTblEncrypt"
    WorkString$ = "Password"
    RC% = PXTblEncrypt(Table_Name$, WorkString$)
    ErrMsg
End Sub

Sub TblDecrypt ()
    Title$ = "PXTblDecrypt"
    RC% = PXTblDecrypt(Table_Name$)
    ErrMsg
End Sub

Sub TblExist ()
    Title$ = "PXTblExist"
    RC% = PXTblExist(Table_Name$, WorkInteger%)
    ErrMsg
    Msg$ = "Return value: " + Str$(WorkInteger%)
    MsgBox Msg$, 0, "Table exists?"
End Sub

Sub TblName ()
    Title$ = "PXTblName"
    WorkString$ = Space$(16)
    RC% = PXTblName(TblHandle%, Len(WorkString$), WorkString$)
    ErrMsg
    Msg$ = WorkString$
    MsgBox Msg$, 0, "Table Name"
End Sub

Sub TblNRecs ()
    Title$ = "PXTblNRecs"
    RC% = PXTblNRecs(TblHandle%, WorkLong&)
    ErrMsg
    Msg$ = Str$(WorkLong&)
    MsgBox Msg$, 0, "Record Count"
End Sub

Sub KeyNFlds ()
    Title$ = "PXKeyNFlds"
    RC% = PXKeyNFlds(TblHandle%, WorkInteger%)
    ErrMsg
    Msg$ = Str$(WorkInteger%)
    MsgBox Msg$, 0, "Key Field Count"
End Sub

Sub FldType ()
    Title$ = "PXFldType"
    FieldType$ = Space$(6)
    RC% = PXFldType(TblHandle%, FldHnd%, Len(FieldType$), FieldType$)
    ErrMsg
    Msg$ = FieldType$
    MsgBox Msg$, 0, "Field Type"
End Sub

Sub FldName ()
    Title$ = "PXFldName"
    FieldName$ = Space$(26)
    RC% = PXFldName(TblHandle%, FldHnd%, Len(FieldName$), FieldName$)
    ErrMsg
    Msg$ = FieldName$
    MsgBox Msg$, 0, "Field Name"
End Sub

Sub TblMaxSize ()
    Title$ = "PXTblMaxSize"
    WorkInteger% = 64
    RC% = PXTblMaxSize(WorkInteger%)
    ErrMsg
End Sub

Sub Save ()
    Title$ = "PXSave"
    RC% = PXSave()
    ErrMsg
End Sub

Sub NetUserName ()
    Title$ = "PXNetUserName"
    WorkString$ = Space$(33)
    RC% = PXNetUserName(Len(WorkString$), WorkString$)
    ErrMsg
    Msg$ = WorkString$
    MsgBox Msg$, 0, "User Name"
End Sub

Sub NetFileLock ()
    Title$ = "PXNetFileLock"
    RC% = PXNetFileLock(Table_Name$, FL%)
    ErrMsg
End Sub

Sub NetFileUnlock ()
    Title$ = "PXNetFileUnlock"
    RC% = PXNetFileUnlock(Table_Name$, FL%)
    ErrMsg
End Sub

Sub NetTblLock ()
    Title$ = "PXNetTblLock"
    RC% = PXNetTblLock(TblHandle%, FL%)
    ErrMsg
End Sub

Sub NetTblUnlock ()
    Title$ = "PXNetTblUnlock"
    RC% = PXNetTblUnlock(TblHandle%, FL%)
    ErrMsg
End Sub

Sub NetRecLock ()
    Title$ = "PXNetRecLock"
    RC% = PXNetRecLock(TblHandle%, LockHandle%)
    ErrMsg
End Sub

Sub NetRecUnlock ()
    Title$ = "PXNetRecUnlock"
    RC% = PXNetRecUnlock(TblHandle%, LockHandle%)
    ErrMsg
End Sub

Sub NetRecLocked ()
    Title$ = "PXNetRecLocked"
    RC% = PXNetRecLocked(TblHandle%, WorkInteger%)
    ErrMsg
    Msg$ = "Return value: " + Str$(WorkInteger%)
    MsgBox Msg$, 0, "Record Lock Status"
End Sub

Sub NetRecGotoLock ()
    Title$ = "PXNetRecGotoLock"
    RC% = PXNetRecGotoLock(TblHandle%, LockHandle%)
    ErrMsg
End Sub

Sub NetTblChanged ()
    Title$ = "PXNetTblChanged"
    RC% = PXNetTblChanged(TblHandle%, WorkInteger%)
    ErrMsg
    Msg$ = "Return value: " + Str$(WorkInteger%)
    MsgBox Msg$, 0, "Table Change Status"
End Sub

Sub NetTblRefresh ()
    Title$ = "PXNetTblRefresh"
    RC% = PXNetTblRefresh(TblHandle%)
    ErrMsg
End Sub

Sub NetErrUser ()
    Title$ = "PXNetErrUser"
    WorkString$ = Space$(33)
    RC% = PXNetErrUser(Len(WorkString$), WorkString$)
    ErrMsg
    Msg$ = WorkString$
    MsgBox Msg$, 0, "Locking Error User Name"
End Sub

Sub Exit_PX ()
    Title$ = "PXExit"
    RC% = PXExit()
    ErrMsg
End Sub