home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / VISUAL_B / CODIGO_1 / PARADOX / PXENGWIN.BAS < prev    next >
Encoding:
BASIC Source File  |  1991-08-09  |  15.2 KB  |  402 lines
  1. '******* Declarations for Using the Paradox 3.5 Engine ******
  2.  
  3. 'initialize engine connection
  4. Declare Function PXWinInit Lib "Pxengwin.dll" (ByVal Application$, ByVal Mode%) As Integer
  5.  
  6. 'exit and deallocate
  7. Declare Function PXExit Lib "Pxengwin.dll" () As Integer
  8.  
  9. 'open table for access; return table handle
  10. Declare Function PXTblOpen Lib "Pxengwin.dll" (ByVal TblName$, TblHnd%, ByVal index%, ByVal change%) As Integer
  11.  
  12. 'close access to table
  13. Declare Function PXTblClose Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  14.  
  15. 'create empty table
  16. Declare Function PXTblCreate Lib "Pxengwin.dll" (ByVal TblName$, ByVal nFields%, FldNames As Any, FldTypes As Any) As Integer
  17.  
  18. 'delete table and its family
  19. Declare Function PXTblDelete Lib "Pxengwin.dll" (ByVal TblName$) As Integer
  20.  
  21. 'append record to end of database
  22. Declare Function PXRecAppend Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
  23.  
  24. 'insert record into database
  25. Declare Function PXRecInsert Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
  26.  
  27. 'update current record
  28. Declare Function PXRecUpdate Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
  29.  
  30. 'delete current record
  31. Declare Function PXRecDelete Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  32.  
  33. 'create record buffer for table
  34. Declare Function PXRecBufOpen Lib "Pxengwin.dll" (ByVal TblHnd%, RecHnd%) As Integer
  35.  
  36. 'delete record buffer for table
  37. Declare Function PXRecBufClose Lib "Pxengwin.dll" (ByVal RecHnd%) As Integer
  38.  
  39. 'clear record buffer to spaces
  40. Declare Function PXRecBufEmpty Lib "Pxengwin.dll" (ByVal RecHnd%) As Integer
  41.  
  42. 'copy from one rec buffer to another
  43. Declare Function PXRecBufCopy Lib "Pxengwin.dll" (ByVal FromRecHnd%, ByVal ToRecHnd%) As Integer
  44.  
  45. 'get current record into buffer
  46. Declare Function PXRecGet Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
  47.  
  48. 'put short value
  49. Declare Function PXPutShort Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal sValue%) As Integer
  50.  
  51. 'put double value
  52. Declare Function PXPutDoub Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal dValue) As Integer
  53.  
  54. 'put long value
  55. Declare Function PXPutLong Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal lValue&) As Integer
  56.  
  57. 'put alpha value
  58. Declare Function PXPutAlpha Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal aValue$) As Integer
  59.  
  60. 'put blank value
  61. Declare Function PXPutBlank Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%) As Integer
  62.  
  63. 'put date value
  64. Declare Function PXPutDate Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal inDate As Any) As Integer
  65.  
  66. 'get short value
  67. Declare Function PXGetShort Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, sValue%) As Integer
  68.  
  69. 'get double value
  70. Declare Function PXGetDoub Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, dValue#) As Integer
  71.  
  72. 'get long value
  73. Declare Function PXGetLong Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, lValue&) As Integer
  74.  
  75. 'get alpha value
  76. Declare Function PXGetAlpha Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal bufSize%, ByVal aValue$) As Integer
  77.  
  78. 'is field blank?
  79. Declare Function PXFldBlank Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal Blank%) As Integer
  80.  
  81. 'get date value
  82. Declare Function PXGetDate Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, outDate As Any) As Integer
  83.  
  84. 'goto specified record number
  85. Declare Function PXRecGoto Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecNum%) As Integer
  86.  
  87. 'goto first record
  88. Declare Function PXRecFirst Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  89.  
  90. 'goto last record
  91. Declare Function PXRecLast Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  92.  
  93. 'goto next record
  94. Declare Function PXRecNext Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  95.  
  96. 'goto previous record
  97. Declare Function PXRecPrev Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  98.  
  99. 'add index to table
  100. Declare Function PXKeyAdd Lib "Pxengwin.dll" (ByVal TblName$, ByVal nFlds%, ByVal FldHand As Any, ByVal Mode%) As Integer
  101.  
  102. 'drop index from table
  103. Declare Function PXKeyDrop Lib "Pxengwin.dll" (ByVal TblName$, ByVal index%) As Integer
  104.  
  105. 'search for a given key
  106. Declare Function PXSrchKey Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%, ByVal nFlds%, ByVal Mode%) As Integer
  107.  
  108. 'search for a given field
  109. Declare Function PXSrchFld Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%, ByVal FldNum%, ByVal Mode%) As Integer
  110.  
  111. 'check if table exists
  112. Declare Function PXTblExist Lib "Pxengwin.dll" (ByVal TblName$, ByVal exist%) As Integer
  113.  
  114. 'return current record number
  115. Declare Function PXRecNum Lib "Pxengwin.dll" (ByVal TblHnd%, RecNum%) As Integer
  116.  
  117. 'return number of recs in table
  118. Declare Function PXTblNRecs Lib "Pxengwin.dll" (ByVal TblHnd%, nRecs%) As Integer
  119.  
  120. 'return number of fields in record
  121. Declare Function PXRecNFlds Lib "Pxengwin.dll" (ByVal TblHnd%, nFlds%) As Integer
  122.  
  123. 'return field number of given field name in table
  124. Declare Function PXFldHandle Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal FldName$, FldHnd%) As Integer
  125.  
  126. 'return field type of given field in table
  127. Declare Function pxFldType Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal FldHnd%, ByVal BufSiz%, ByVal fldtype$) As Integer
  128.  
  129. 'return field name of given field in table
  130. Declare Function PXFldName Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal FldHnd%, ByVal BufSiz%, ByVal FldName$) As Integer
  131.  
  132. 'return error text associated with error number
  133. Declare Function PXErrMsg Lib "Pxengwin.dll" (ByVal rc%) As String
  134.  
  135. 'decode a date field from table
  136. Declare Function PXDateDecode Lib "Pxengwin.dll" (ByVal outDate&, mm%, dd%, yy%) As Integer
  137.  
  138. 'encode a date to field
  139. Declare Function PXDateEncode Lib "Pxengwin.dll" (ByVal mm%, ByVal dd%, ByVal yy%, pDate&) As Integer
  140.  
  141. Sub PXError ()
  142.     Dim msgbuf As String
  143.     If rc = 0 Then
  144.         Exit Sub
  145.     End If
  146. '   msgbuff = Code + "=" + Str$(rc)
  147. '   msgbuff = PXErrMsg(rc)
  148.     Select Case rc
  149.         Case Is = PXERR_NOTINITERR
  150.             msgbuf = " Engine not initialized"
  151.         Case Is = PXERR_ALREADYINIT
  152.             msgbuf = "Engine already initialized"
  153.         Case Is = PXERR_NOTLOGGEDIN
  154.             msgbuf = " Could not log onto network"
  155.         Case Is = PXERR_NONETINIT
  156.             msgbuf = " Engine not initialized"
  157.         Case Is = PXERR_NETMULTIPLE
  158.             msgbuf = " multiple PARADOX.NET files"
  159.         Case Is = PXERR_CANTSHAREPDOXNET
  160.             msgbuf = " can't lock PARADOX.NET-is SHARE.EXE loaded?"
  161.         Case Is = PXERR_WINDOWSREALMODE
  162.             msgbuf = " can't run Engine in Windows real mode"
  163.         Case Is = PXERR_DRIVENOTREADY
  164.             msgbuf = " Drive not ready"
  165.         Case Is = PXERR_DISKWRITEPRO
  166.             msgbuf = " Disk is write protected"
  167.         Case Is = PXERR_GENERALFAILURE
  168.             msgbuf = " General hardware error"
  169.         Case Is = PXERR_DIRNOTFOUND
  170.             msgbuf = " Directory not found"
  171.         Case Is = PXERR_DIRBUSY
  172.             msgbuf = " Sharing violation-directory busy"
  173.         Case Is = PXERR_DIRLOCKED
  174.             msgbuf = " Sharing violation-directory locked"
  175.         Case Is = PXERR_DIRNOACCESS
  176.             msgbuf = " No access to directory"
  177.         Case Is = PXERR_DIRNOTPRIVATE
  178.             msgbuf = " Single user, but directory is shared"
  179.         Case Is = PXERR_FILEBUSY
  180.             msgbuf = " File is busy"
  181.         Case Is = PXERR_FILELOCKED
  182.             msgbuf = " File is locked"
  183.         Case Is = PXERR_FILENOTFOUND
  184.             msgbuf = " Could not find file"
  185.         Case Is = PXERR_TABLEBUSY
  186.             msgbuf = " Table is busy"
  187.         Case Is = PXERR_TABLELOCKED
  188.             msgbuf = " Table is locked"
  189.         Case Is = PXERR_TABLENOTFOUND
  190.             msgbuf = " Table was not found"
  191.         Case Is = PXERR_TABLEOPEN
  192.             msgbuf = " Unable to perform operation on open table"
  193.         Case Is = PXERR_TABLEINDEXED
  194.             msgbuf = " Table is indexed"
  195.         Case Is = PXERR_TABLENOTINDEXED
  196.             msgbuf = " Table is not indexed"
  197.         Case Is = PXERR_TABLEEMPTY
  198.             msgbuf = " Operation on empty table"
  199.         Case Is = PXERR_TABLEWRITEPRO
  200.             msgbuf = " Table is write protected"
  201.         Case Is = PXERR_TABLECORRUPTED
  202.             msgbuf = " Table is corrupted"
  203.         Case Is = PXERR_TABLEFULL
  204.             msgbuf = " Table is full"
  205.         Case Is = PXERR_TABLESQL
  206.             msgbuf = " Table is SQL replica"
  207.         Case Is = PXERR_INSUFRIGHTS
  208.             msgbuf = " Insufficient password rights"
  209.         Case Is = PXERR_XCORRUPTED
  210.             msgbuf = " Primary index is corrupted"
  211.         Case Is = PXERR_XOUTOFDATE
  212.             msgbuf = " Primary index is out of date"
  213.         Case Is = PXERR_XSORTVERSION
  214.             msgbuf = " Sort for index different from table"
  215.         Case Is = PXERR_SXCORRUPTED
  216.             msgbuf = " Secondary index is corrupted"
  217.         Case Is = PXERR_SXOUTOFDATE
  218.             msgbuf = " Secondary index is out of date"
  219.         Case Is = PXERR_SXNOTFOUND
  220.             msgbuf = " Secondary index was not found"
  221.         Case Is = PXERR_SXOPEN
  222.             msgbuf = " Secondary index is already open"
  223.         Case Is = PXERR_SXCANTUPDATE
  224.             msgbuf = " Can't update table open on non-maintained secondary"                                                                         'maintained secondary"
  225.         Case Is = PXERR_RECTOOBIG
  226.             msgbuf = " Record too big for index"
  227.         Case Is = PXERR_RECDELETED
  228.             msgbuf = " Another user deleted record"
  229.         Case Is = PXERR_RECLOCKED
  230.             msgbuf = " Record is locked"
  231.         Case Is = PXERR_RECNOTFOUND
  232.             msgbuf = " Record was not found"
  233.         Case Is = PXERR_KEYVIOL
  234.             msgbuf = " Key violation"
  235.         Case Is = PXERR_ENDOFTABLE
  236.             msgbuf = " End of table"
  237.         Case Is = PXERR_STARTOFTABLE
  238.             msgbuf = " Start of table"
  239.         Case Is = PXERR_TOOMANYCLIENTS
  240.             msgbuf = " Too many clients"
  241.         Case Is = PXERR_EXCEEDSCONFIGLIMITS
  242.             msgbuf = " Exceeds table conflicts"
  243.         Case Is = PXERR_CANTREMAPFILEHANDLE
  244.             msgbuf = " Cant remap file handle"
  245.         Case Is = PXERR_OUTOFMEM
  246.             msgbuf = " Not enough memory to complete operation"
  247.         Case Is = PXERR_OUTOFDISK
  248.             msgbuf = " Not enough disk space to complete operation"
  249.         Case Is = PXERR_OUTOFSTACK
  250.             msgbuf = " Not enough stack space to complete operation"
  251.         Case Is = PXERR_OUTOFSWAPBUF
  252.             msgbuf = " Not enough swap buffer space to complete operation"
  253.         Case Is = PXERR_OUTOFFILEHANDLES
  254.             msgbuf = " No more file handles available"
  255.         Case Is = PXERR_OUTOFTABLEHANDLES
  256.             msgbuf = " No more table handles"                                                                                    'available
  257.         Case Is = PXERR_OUTOFRECHANDLES
  258.             msgbuf = " No more record handles"                                                                               'available
  259.         Case Is = PXERR_OUTOFLOCKHANDLES
  260.             msgbuf = " Too many locks on table"
  261.         Case Is = PXERR_NOMORETMPNAMES
  262.             msgbuf = " No more temporary names available"
  263.         Case Is = PXERR_TOOMANYPASSW
  264.             msgbuf = " Too many passwords specified"
  265.         Case Is = PXERR_TYPEMISMATCH
  266.             msgbuf = " Data type mismatch"
  267.         Case Is = PXERR_OUTOFRANGE
  268.             msgbuf = " Argument out of range"
  269.         Case Is = PXERR_INVPARAMETER
  270.             msgbuf = " Invalid argument"
  271.         Case Is = PXERR_INVDATE
  272.             msgbuf = " Invalid date given"
  273.         Case Is = PXERR_INVFIELDHANDLE
  274.             msgbuf = " Invalid field handle"
  275.         Case Is = PXERR_INVRECHANDLE
  276.             msgbuf = " Invalid record handle"
  277.         Case Is = PXERR_INVTABLEHANDLE
  278.             msgbuf = " Invalid table handle"
  279.         Case Is = PXERR_INVLOCKHANDLE
  280.             msgbuf = " Invalid lock handle"
  281.         Case Is = PXERR_INVDIRNAME
  282.             msgbuf = " Invalid directory name"
  283.         Case Is = PXERR_INVFILENAME
  284.             msgbuf = " Invalid file name"
  285.         Case Is = PXERR_INVTABLENAME
  286.             msgbuf = " Invalid table name"
  287.         Case Is = PXERR_INVFIELDNAME
  288.             msgbuf = " Invalid field name"
  289.         Case Is = PXERR_INVLOCKCODE
  290.             msgbuf = " Invalid lock code"
  291.         Case Is = PXERR_INVUNLOCK
  292.             msgbuf = " Invalid unlock"
  293.         Case Is = PXERR_INVSORTORDER
  294.             msgbuf = " Invalid sort order table"
  295.         Case Is = PXERR_INVPASSW
  296.             msgbuf = " Invalid password"
  297.         Case Is = PXERR_INVNETTYPE
  298.             msgbuf = " Invalid net type (PXNetInit)"
  299.         Case Is = PXERR_BUFTOOSMALL
  300.             msgbuf = " Buffer too small for result"
  301.         Case Is = PXERR_STRUCTDIFFER
  302.             msgbuf = " Table structures are different"
  303.         Case Is = PXERR_INVENGINESTATE
  304.             msgbuf = " Previous fatal error"
  305.     End Select
  306.     response% = MsgBox(msgbuf, 17, "Paradox Error")
  307.     If response% <> MBOK Then
  308.        rc = PXExit()
  309.        End
  310.     End If
  311.  
  312.        
  313. End Sub
  314.  
  315. Sub PXInit (AppName$, Mode%)
  316.     'mode can be any of: PXSINGLECLIENT,PXEXCLUSIVE,PXSHARED
  317.     rc = PXWinInit(AppName$, Mode%)
  318.     PXError
  319. End Sub
  320.  
  321. Sub PXOpen (TblName$, TblHnd%, RecHnd%)
  322.     rc = PXTblOpen(TblName$, TblHnd%, tIndex, TRUE)
  323.     PXError
  324.     rc = PXRecBufOpen(TblHnd%, RecHnd%)
  325.     PXError
  326.     rc = PXRecBufEmpty(RecHnd%)
  327.     PXError
  328. End Sub
  329.  
  330. Sub GetField (RecHnd%, FldHnd%, fldtype$)
  331.     returnFld = String$(255, 0)
  332.     aValue = ""
  333.     lValue = 0
  334.     dValue = 0
  335.     Select Case Mid$(fldtype$, 1, 1)
  336.         Case Is = "A"
  337.             rc = PXGetAlpha(RecHnd%, FldHnd%, 255, aValue)
  338.             PXError
  339.             returnFld = aValue
  340.         Case Is = "N"
  341.             rc = PXGetLong(RecHnd%, FldHnd%, lValue)
  342.             PXError
  343.             If lValue < 0 Then
  344.                 lValue = 0
  345.             End If
  346.             returnFld = Format$(lValue, "###0")
  347.         Case Is = "$"
  348.             rc = PXGetDoub(RecHnd%, FldHnd%, dValue)
  349.             PXError
  350.             If dValue < 0 Then
  351.                 dValue = 0
  352.             End If
  353.             returnFld = Format$(dValue, "###,##0.00")
  354.         Case Is = "D"
  355.             rc = PXGetDate(RecHnd%, FldHnd%, lValue)
  356.             PXError
  357.             rc = PXDateDecode(lValue, mm, dd, yy)
  358.             returnFld = Format$(lValue, "##/##/##")
  359.     End Select
  360.  
  361. End Sub
  362.  
  363. Sub PXNext (TblHnd%, RecHnd%)
  364.     rc = PXRecNext(TblHnd%)
  365.     If rc = PXERR_ENDOFTABLE Then
  366.       Exit Sub
  367.     End If
  368.     rc = PXRecGet(TblHnd%, RecHnd%)
  369. End Sub
  370.  
  371. Sub PXPrev (TblHnd%, RecHnd%)
  372.     rc = PXRecPrev(TblHnd)
  373.     If rc = PXERR_STARTOFTABLE Then
  374.       Exit Sub
  375.     End If
  376.     rc = PXRecGet(TblHnd%, RecHnd%)
  377. End Sub
  378.  
  379. Sub PutField (RecHnd%, FldHnd%, fldtype$)
  380.     Select Case Mid$(fldtype$, 1, 1)
  381.         Case Is = "A"
  382.             rc = PXPutAlpha(RecHnd%, FldHnd%, aValue)
  383.             PXError
  384.         Case Is = "N"
  385.             rc = PXPutBlank(RecHnd%, FldHnd%)
  386.             PXError
  387.             rc = PXPutLong(RecHnd%, FldHnd%, lValue)
  388.             PXError
  389.         Case Is = "$"
  390.             rc = PXPutBlank(RecHnd%, FldHnd%)
  391.             PXError
  392.             rc = PXPutLong(RecHnd%, FldHnd%, lValue)
  393. '            rc = PXPutDoub(RecHnd%, FldHnd%, dValue)
  394.             PXError
  395.         Case Is = "D"
  396.             rc = PXPutDate(RecHnd%, FldHnd%, lValue)
  397.             PXError
  398.     End Select
  399.  
  400. End Sub
  401.  
  402.