home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / vb_code2 / timetrak / ttrakpxg.bas < prev   
BASIC Source File  |  1991-09-10  |  15KB  |  344 lines
  1. '******* Declarations for Using the Paradox 3.5 Engine ******
  2. Declare Function PXWinInit Lib "Pxengwin.dll" (ByVal Application$, ByVal Mode%) As Integer
  3. Declare Function PXExit Lib "Pxengwin.dll" () As Integer
  4. '************ TABLE FUNCTIONS *****************
  5. Declare Function PXTblOpen Lib "Pxengwin.dll" (ByVal TblName$, TblHnd%, ByVal index%, ByVal change%) As Integer
  6. Declare Function PXTblClose Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  7. '************* RECORD FUNCTIONS *******************
  8. Declare Function PXRecAppend Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
  9. Declare Function PXRecInsert Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
  10. Declare Function PXRecUpdate Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
  11. Declare Function PXRecDelete Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  12. Declare Function PXRecBufOpen Lib "Pxengwin.dll" (ByVal TblHnd%, RecHnd%) As Integer
  13. Declare Function PXRecBufClose Lib "Pxengwin.dll" (ByVal RecHnd%) As Integer
  14. Declare Function PXRecBufEmpty Lib "Pxengwin.dll" (ByVal RecHnd%) As Integer
  15. Declare Function PXRecGet Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
  16. Declare Function PXRecFirst Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  17. Declare Function PXRecNext Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  18. Declare Function PXRecPrev Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  19. Declare Function PXRecNum Lib "Pxengwin.dll" (ByVal TblHnd%, RecNum%) As Integer
  20. Declare Function PXTblNRecs Lib "Pxengwin.dll" (ByVal TblHnd%, nRecs%) As Integer
  21. '**************** FIELD FUNCTIONS ****************
  22. Declare Function PXPutShort Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal sValue%) As Integer
  23. Declare Function PXPutDoub Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal dValue#) As Integer
  24. Declare Function PXPutLong Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal lValue&) As Integer
  25. Declare Function PXPutAlpha Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal aValue$) As Integer
  26. Declare Function PXPutBlank Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%) As Integer
  27. Declare Function PXPutDate Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal inDate As Any) As Integer
  28. Declare Function PXGetShort Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, sValue%) As Integer
  29. Declare Function PXGetDoub Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, dValue#) As Integer
  30. Declare Function PXGetLong Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, lValue&) As Integer
  31. Declare Function PXGetAlpha Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal bufSize%, ByVal aValue$) As Integer
  32. Declare Function PXFldBlank Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal Blank%) As Integer
  33. Declare Function PXGetDate Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, outDate As Any) As Integer
  34. Declare Function PXRecNFlds Lib "Pxengwin.dll" (ByVal TblHnd%, nFlds%) As Integer
  35. Declare Function PXFldHandle Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal FldName$, FldHnd%) As Integer
  36. Declare Function PXFldType Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal FldHnd%, ByVal BufSiz%, ByVal fldtype$) As Integer
  37. Declare Function PXFldName Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal FldHnd%, ByVal BufSiz%, ByVal FldName$) As Integer
  38. '*************** SEARCH FUNCTIONS *******************
  39. Declare Function PXSrchKey Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%, ByVal nFlds%, ByVal Mode%) As Integer
  40. Declare Function PXSrchFld Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%, ByVal FldNum%, ByVal Mode%) As Integer
  41. '***************** MISCELLANEOUS FUNCTIONS ****************
  42. Declare Function PXDateDecode Lib "Pxengwin.dll" (ByVal outDate As Any, mm%, dd%, yy%) As Integer
  43. Declare Function PXDateEncode Lib "Pxengwin.dll" (ByVal mm%, ByVal dd%, ByVal yy%, pDate&) As Integer
  44. '******************* NETWORK FUNCTIONS ******************
  45. Declare Function PXNetUserName Lib "Pxengwin.dll" (ByVal buffer%, UserName$) As Integer
  46. Declare Function PXNetFileLock Lib "Pxengwin.dll" (ByVal FileName$, ByVal lockType%) As Integer
  47. Declare Function PXNetFileUnlock Lib "Pxengwin.dll" (ByVal FileName$, ByVal lockType%) As Integer
  48. Declare Function PXNetTblLock Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal lockType%) As Integer
  49. Declare Function PXNetTblUnlock Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal lockType%) As Integer
  50. Declare Function PXNetRecLock Lib "Pxengwin.dll" (ByVal TblHnd%, LockHnd%) As Integer
  51. Declare Function PXNetRecLocked Lib "Pxengwin.dll" (ByVal TblHnd%, Locked%) As Integer
  52. Declare Function PXNetTblChanged Lib "Pxengwin.dll" (ByVal TblHnd%, Changed%) As Integer
  53. Declare Function PXNetTblRefresh Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  54.  
  55. Sub PXError ()
  56.     Dim msgbuf As String
  57.     If rc = 0 Then
  58.         Exit Sub
  59.     End If
  60. '   msgbuff = Code + "=" + Str$(rc)
  61. '   msgbuff = PXErrMsg(rc)
  62.     Select Case rc
  63.         Case Is = NOT_PROGRAMMED
  64.             msgbuf = " Code Not Finished"
  65.         Case Is = PXERR_NOTINITERR
  66.             msgbuf = " Engine not initialized"
  67.         Case Is = PXERR_ALREADYINIT
  68.             msgbuf = "Engine already initialized"
  69.         Case Is = PXERR_NOTLOGGEDIN
  70.             msgbuf = " Could not log onto network"
  71.         Case Is = PXERR_NONETINIT
  72.             msgbuf = " Engine not initialized"
  73.         Case Is = PXERR_NETMULTIPLE
  74.             msgbuf = " multiple PARADOX.NET files"
  75.         Case Is = PXERR_CANTSHAREPDOXNET
  76.             msgbuf = " can't lock PARADOX.NET-is SHARE.EXE loaded?"
  77.         Case Is = PXERR_WINDOWSREALMODE
  78.             msgbuf = " can't run Engine in Windows real mode"
  79.         Case Is = PXERR_DRIVENOTREADY
  80.             msgbuf = " Drive not ready"
  81.         Case Is = PXERR_DISKWRITEPRO
  82.             msgbuf = " Disk is write protected"
  83.         Case Is = PXERR_GENERALFAILURE
  84.             msgbuf = " General hardware error"
  85.         Case Is = PXERR_DIRNOTFOUND
  86.             msgbuf = " Directory not found"
  87.         Case Is = PXERR_DIRBUSY
  88.             msgbuf = " Sharing violation-directory busy"
  89.         Case Is = PXERR_DIRLOCKED
  90.             msgbuf = " Sharing violation-directory locked"
  91.         Case Is = PXERR_DIRNOACCESS
  92.             msgbuf = " No access to directory"
  93.         Case Is = PXERR_DIRNOTPRIVATE
  94.             msgbuf = " Single user, but directory is shared"
  95.         Case Is = PXERR_FILEBUSY
  96.             msgbuf = " File is busy"
  97.         Case Is = PXERR_FILELOCKED
  98.             msgbuf = " File is locked"
  99.         Case Is = PXERR_FILENOTFOUND
  100.             msgbuf = " Could not find file"
  101.         Case Is = PXERR_TABLEBUSY
  102.             msgbuf = " Table is busy"
  103.         Case Is = PXERR_TABLELOCKED
  104.             msgbuf = " Table is locked"
  105.         Case Is = PXERR_TABLENOTFOUND
  106.             msgbuf = " Table was not found"
  107.         Case Is = PXERR_TABLEOPEN
  108.             msgbuf = " Unable to perform operation on open table"
  109.         Case Is = PXERR_TABLEINDEXED
  110.             msgbuf = " Table is indexed"
  111.         Case Is = PXERR_TABLENOTINDEXED
  112.             msgbuf = " Table is not indexed"
  113.         Case Is = PXERR_TABLEEMPTY
  114.             msgbuf = " Operation on empty table"
  115.         Case Is = PXERR_TABLEWRITEPRO
  116.             msgbuf = " Table is write protected"
  117.         Case Is = PXERR_TABLECORRUPTED
  118.             msgbuf = " Table is corrupted"
  119.         Case Is = PXERR_TABLEFULL
  120.             msgbuf = " Table is full"
  121.         Case Is = PXERR_TABLESQL
  122.             msgbuf = " Table is SQL replica"
  123.         Case Is = PXERR_INSUFRIGHTS
  124.             msgbuf = " Insufficient password rights"
  125.         Case Is = PXERR_XCORRUPTED
  126.             msgbuf = " Primary index is corrupted"
  127.         Case Is = PXERR_XOUTOFDATE
  128.             msgbuf = " Primary index is out of date"
  129.         Case Is = PXERR_XSORTVERSION
  130.             msgbuf = " Sort for index different from table"
  131.         Case Is = PXERR_SXCORRUPTED
  132.             msgbuf = " Secondary index is corrupted"
  133.         Case Is = PXERR_SXOUTOFDATE
  134.             msgbuf = " Secondary index is out of date"
  135.         Case Is = PXERR_SXNOTFOUND
  136.             msgbuf = " Secondary index was not found"
  137.         Case Is = PXERR_SXOPEN
  138.             msgbuf = " Secondary index is already open"
  139.         Case Is = PXERR_SXCANTUPDATE
  140.             msgbuf = " Can't update table open on non-maintained secondary"                                                                         'maintained secondary"
  141.         Case Is = PXERR_RECTOOBIG
  142.             msgbuf = " Record too big for index"
  143.         Case Is = PXERR_RECDELETED
  144.             msgbuf = " Another user deleted record"
  145.         Case Is = PXERR_RECLOCKED
  146.             msgbuf = " Record is locked"
  147.         Case Is = PXERR_RECNOTFOUND
  148.             msgbuf = " Record was not found"
  149.         Case Is = PXERR_KEYVIOL
  150.             msgbuf = " Key violation"
  151.         Case Is = PXERR_ENDOFTABLE
  152.             msgbuf = " End of table"
  153.         Case Is = PXERR_STARTOFTABLE
  154.             msgbuf = " Start of table"
  155.         Case Is = PXERR_TOOMANYCLIENTS
  156.             msgbuf = " Too many clients"
  157.         Case Is = PXERR_EXCEEDSCONFIGLIMITS
  158.             msgbuf = " Exceeds table conflicts"
  159.         Case Is = PXERR_CANTREMAPFILEHANDLE
  160.             msgbuf = " Cant remap file handle"
  161.         Case Is = PXERR_OUTOFMEM
  162.             msgbuf = " Not enough memory to complete operation"
  163.         Case Is = PXERR_OUTOFDISK
  164.             msgbuf = " Not enough disk space to complete operation"
  165.         Case Is = PXERR_OUTOFSTACK
  166.             msgbuf = " Not enough stack space to complete operation"
  167.         Case Is = PXERR_OUTOFSWAPBUF
  168.             msgbuf = " Not enough swap buffer space to complete operation"
  169.         Case Is = PXERR_OUTOFFILEHANDLES
  170.             msgbuf = " No more file handles available"
  171.         Case Is = PXERR_OUTOFTABLEHANDLES
  172.             msgbuf = " No more table handles"                                                                                    'available
  173.         Case Is = PXERR_OUTOFRECHANDLES
  174.             msgbuf = " No more record handles"                                                                               'available
  175.         Case Is = PXERR_OUTOFLOCKHANDLES
  176.             msgbuf = " Too many locks on table"
  177.         Case Is = PXERR_NOMORETMPNAMES
  178.             msgbuf = " No more temporary names available"
  179.         Case Is = PXERR_TOOMANYPASSW
  180.             msgbuf = " Too many passwords specified"
  181.         Case Is = PXERR_TYPEMISMATCH
  182.             msgbuf = " Data type mismatch"
  183.         Case Is = PXERR_OUTOFRANGE
  184.             msgbuf = " Argument out of range"
  185.         Case Is = PXERR_INVPARAMETER
  186.             msgbuf = " Invalid argument"
  187.         Case Is = PXERR_INVDATE
  188.             msgbuf = " Invalid date given"
  189.         Case Is = PXERR_INVFIELDHANDLE
  190.             msgbuf = " Invalid field handle"
  191.         Case Is = PXERR_INVRECHANDLE
  192.             msgbuf = " Invalid record handle"
  193.         Case Is = PXERR_INVTABLEHANDLE
  194.             msgbuf = " Invalid table handle"
  195.         Case Is = PXERR_INVLOCKHANDLE
  196.             msgbuf = " Invalid lock handle"
  197.         Case Is = PXERR_INVDIRNAME
  198.             msgbuf = " Invalid directory name"
  199.         Case Is = PXERR_INVFILENAME
  200.             msgbuf = " Invalid file name"
  201.         Case Is = PXERR_INVTABLENAME
  202.             msgbuf = " Invalid table name"
  203.         Case Is = PXERR_INVFIELDNAME
  204.             msgbuf = " Invalid field name"
  205.         Case Is = PXERR_INVLOCKCODE
  206.             msgbuf = " Invalid lock code"
  207.         Case Is = PXERR_INVUNLOCK
  208.             msgbuf = " Invalid unlock"
  209.         Case Is = PXERR_INVSORTORDER
  210.             msgbuf = " Invalid sort order table"
  211.         Case Is = PXERR_INVPASSW
  212.             msgbuf = " Invalid password"
  213.         Case Is = PXERR_INVNETTYPE
  214.             msgbuf = " Invalid net type (PXNetInit)"
  215.         Case Is = PXERR_BUFTOOSMALL
  216.             msgbuf = " Buffer too small for result"
  217.         Case Is = PXERR_STRUCTDIFFER
  218.             msgbuf = " Table structures are different"
  219.         Case Is = PXERR_INVENGINESTATE
  220.             msgbuf = " Previous fatal error"
  221.     End Select
  222.     response% = MsgBox(msgbuf, 17, "Paradox Error")
  223.     If response% <> MBOK Then
  224.        rc = PXExit()
  225.        End
  226.     End If
  227. End Sub
  228.  
  229. Sub PXInit (AppName$, Mode%)
  230.     'mode can be any of: PXSINGLECLIENT,PXEXCLUSIVE,PXSHARED
  231.     rc = PXWinInit(AppName$, Mode%)
  232.     PXError
  233. End Sub
  234.  
  235. Sub PXOpen (TblName$, TblHnd%, RecHnd%)
  236.     rc = PXTblOpen(TblName$, TblHnd%, tIndex, TRUE)
  237.     PXError
  238.     rc = PXRecBufOpen(TblHnd%, RecHnd%)
  239.     PXError
  240.     rc = PXRecBufEmpty(RecHnd%)
  241.     PXError
  242. End Sub
  243.  
  244. Sub GetField (RecHnd%, FldHnd%, fldtype$)
  245.     returnFld = ""
  246.     aValue = ""
  247.     lValue = 0
  248.     dValue = 0
  249.     Select Case Mid$(fldtype$, 1, 1)
  250.         Case Is = "A"
  251.             rc = PXGetAlpha(RecHnd%, FldHnd%, 255, aValue)
  252.             PXError
  253.             returnFld = aValue
  254.         Case Is = "N"
  255.             rc = PXGetLong(RecHnd%, FldHnd%, lValue)
  256.             PXError
  257. '            If lValue < 0 Then
  258. '                lValue = 0
  259. '            End If
  260.             returnFld = Format$(lValue, "###0")
  261.         Case Is = "$"
  262.             rc = PXGetDoub(RecHnd%, FldHnd%, dValue)
  263.             PXError
  264. '            If dValue < 0 Then
  265. '                dValue = 0
  266. '            End If
  267.             returnFld = Format$(dValue, "###,##0.00")
  268.         Case Is = "D"
  269.             rc = PXGetDate(RecHnd%, FldHnd%, lValue)
  270.             PXError
  271.             rc = PXDateDecode(lValue, mm, dd, yy)
  272.             returnFld = LTrim$(Str$(mm)) + "/" + LTrim$(Str$(dd)) + "/" + LTrim$(Str$(yy))
  273.     End Select
  274.  
  275. End Sub
  276.  
  277. Sub PXNext (TblHnd%, RecHnd%)
  278.     rc = PXRecNext(TblHnd%)
  279.     If rc = PXERR_ENDOFTABLE Then
  280.       Exit Sub
  281.     End If
  282.     rc = PXRecGet(TblHnd%, RecHnd%)
  283. End Sub
  284.  
  285. Sub PXPrev (TblHnd%, RecHnd%)
  286.     rc = PXRecPrev(TblHnd)
  287.     If rc = PXERR_STARTOFTABLE Then
  288.       Exit Sub
  289.     End If
  290.     rc = PXRecGet(TblHnd%, RecHnd%)
  291. End Sub
  292.  
  293. Sub PutField (RecHnd%, FldHnd%, fldtype$)
  294.     Select Case Mid$(fldtype$, 1, 1)
  295.         Case Is = "A"
  296.             rc = PXPutAlpha(RecHnd%, FldHnd%, aValue)
  297.             PXError
  298.         Case Is = "N"
  299.             rc = PXPutBlank(RecHnd%, FldHnd%)
  300.             PXError
  301.             rc = PXPutLong(RecHnd%, FldHnd%, lValue)
  302.             PXError
  303.         Case Is = "$"
  304.             rc = PXPutBlank(RecHnd%, FldHnd%)
  305.             PXError
  306. '           rc = PXPutLong(RecHnd%, FldHnd%, lValue)
  307.             rc = PXPutDoub(RecHnd%, FldHnd%, dValue)
  308.             PXError
  309.         Case Is = "D"
  310.             rc = PXPutDate(RecHnd%, FldHnd%, lValue)
  311.             PXError
  312.     End Select
  313.  
  314. End Sub
  315.  
  316. Function Gen_Date (vDate As String)
  317.     pos1% = InStr(1, vDate, "/")
  318.     mm = Val(Mid$(vDate, 1, pos1% - 1))
  319.     pos2% = InStr(pos1% + 1, vDate, "/")
  320.     dd = Val(Mid$(vDate, pos1% + 1, pos2% - pos1% - 1))
  321.     temp$ = Mid$(vDate, pos2% + 1, 4)
  322.     If Len(temp$) = 4 Then
  323.         yy = Val(Mid$(temp$, 3, 2))
  324.     Else
  325.         yy = Val(temp$)
  326.     End If
  327.     If (mm < 1 Or mm > 12 Or dd < 1 Or yy < 1) Then
  328.         eflag% = 1
  329.     ElseIf mm = 2 And dd > 28 Then
  330.         eflag% = 1
  331.     ElseIf (mm = 4 Or 6 Or 9 Or 11) And dd > 30 Then
  332.         eflag% = 1
  333.     ElseIf dd > 31 Then
  334.         eflag% = 1
  335.     End If
  336.     If eflag% = 1 Then
  337.         Gen_Date = 1
  338.     Else
  339.         Gen_Date = 0
  340.         rc = PXDateEncode(mm, dd, yy, lValue)
  341.     End If
  342. End Function
  343.  
  344.