home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Programming Tool Box
/
SIMS_2.iso
/
vb_code2
/
timetrak
/
ttrakpxg.bas
< prev
Wrap
BASIC Source File
|
1991-09-10
|
15KB
|
344 lines
'******* Declarations for Using the Paradox 3.5 Engine ******
Declare Function PXWinInit Lib "Pxengwin.dll" (ByVal Application$, ByVal Mode%) As Integer
Declare Function PXExit Lib "Pxengwin.dll" () As Integer
'************ TABLE FUNCTIONS *****************
Declare Function PXTblOpen Lib "Pxengwin.dll" (ByVal TblName$, TblHnd%, ByVal index%, ByVal change%) As Integer
Declare Function PXTblClose Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
'************* RECORD FUNCTIONS *******************
Declare Function PXRecAppend Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
Declare Function PXRecInsert Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
Declare Function PXRecUpdate Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
Declare Function PXRecDelete Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
Declare Function PXRecBufOpen Lib "Pxengwin.dll" (ByVal TblHnd%, RecHnd%) As Integer
Declare Function PXRecBufClose Lib "Pxengwin.dll" (ByVal RecHnd%) As Integer
Declare Function PXRecBufEmpty Lib "Pxengwin.dll" (ByVal RecHnd%) As Integer
Declare Function PXRecGet Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
Declare Function PXRecFirst Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
Declare Function PXRecNext Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
Declare Function PXRecPrev Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
Declare Function PXRecNum Lib "Pxengwin.dll" (ByVal TblHnd%, RecNum%) As Integer
Declare Function PXTblNRecs Lib "Pxengwin.dll" (ByVal TblHnd%, nRecs%) As Integer
'**************** FIELD FUNCTIONS ****************
Declare Function PXPutShort Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal sValue%) As Integer
Declare Function PXPutDoub Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal dValue#) As Integer
Declare Function PXPutLong Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal lValue&) As Integer
Declare Function PXPutAlpha Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal aValue$) As Integer
Declare Function PXPutBlank Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%) As Integer
Declare Function PXPutDate Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal inDate As Any) As Integer
Declare Function PXGetShort Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, sValue%) As Integer
Declare Function PXGetDoub Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, dValue#) As Integer
Declare Function PXGetLong Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, lValue&) As Integer
Declare Function PXGetAlpha Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal bufSize%, ByVal aValue$) As Integer
Declare Function PXFldBlank Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal Blank%) As Integer
Declare Function PXGetDate Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, outDate As Any) As Integer
Declare Function PXRecNFlds Lib "Pxengwin.dll" (ByVal TblHnd%, nFlds%) As Integer
Declare Function PXFldHandle Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal FldName$, FldHnd%) As Integer
Declare Function PXFldType Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal FldHnd%, ByVal BufSiz%, ByVal fldtype$) As Integer
Declare Function PXFldName Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal FldHnd%, ByVal BufSiz%, ByVal FldName$) As Integer
'*************** SEARCH FUNCTIONS *******************
Declare Function PXSrchKey Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%, ByVal nFlds%, ByVal Mode%) As Integer
Declare Function PXSrchFld Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%, ByVal FldNum%, ByVal Mode%) As Integer
'***************** MISCELLANEOUS FUNCTIONS ****************
Declare Function PXDateDecode Lib "Pxengwin.dll" (ByVal outDate As Any, mm%, dd%, yy%) As Integer
Declare Function PXDateEncode Lib "Pxengwin.dll" (ByVal mm%, ByVal dd%, ByVal yy%, pDate&) As Integer
'******************* NETWORK FUNCTIONS ******************
Declare Function PXNetUserName Lib "Pxengwin.dll" (ByVal buffer%, 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 TblHnd%, ByVal lockType%) As Integer
Declare Function PXNetTblUnlock Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal lockType%) As Integer
Declare Function PXNetRecLock Lib "Pxengwin.dll" (ByVal TblHnd%, LockHnd%) As Integer
Declare Function PXNetRecLocked Lib "Pxengwin.dll" (ByVal TblHnd%, Locked%) As Integer
Declare Function PXNetTblChanged Lib "Pxengwin.dll" (ByVal TblHnd%, Changed%) As Integer
Declare Function PXNetTblRefresh Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
Sub PXError ()
Dim msgbuf As String
If rc = 0 Then
Exit Sub
End If
' msgbuff = Code + "=" + Str$(rc)
' msgbuff = PXErrMsg(rc)
Select Case rc
Case Is = NOT_PROGRAMMED
msgbuf = " Code Not Finished"
Case Is = PXERR_NOTINITERR
msgbuf = " Engine not initialized"
Case Is = PXERR_ALREADYINIT
msgbuf = "Engine already initialized"
Case Is = PXERR_NOTLOGGEDIN
msgbuf = " Could not log onto network"
Case Is = PXERR_NONETINIT
msgbuf = " Engine not initialized"
Case Is = PXERR_NETMULTIPLE
msgbuf = " multiple PARADOX.NET files"
Case Is = PXERR_CANTSHAREPDOXNET
msgbuf = " can't lock PARADOX.NET-is SHARE.EXE loaded?"
Case Is = PXERR_WINDOWSREALMODE
msgbuf = " can't run Engine in Windows real mode"
Case Is = PXERR_DRIVENOTREADY
msgbuf = " Drive not ready"
Case Is = PXERR_DISKWRITEPRO
msgbuf = " Disk is write protected"
Case Is = PXERR_GENERALFAILURE
msgbuf = " General hardware error"
Case Is = PXERR_DIRNOTFOUND
msgbuf = " Directory not found"
Case Is = PXERR_DIRBUSY
msgbuf = " Sharing violation-directory busy"
Case Is = PXERR_DIRLOCKED
msgbuf = " Sharing violation-directory locked"
Case Is = PXERR_DIRNOACCESS
msgbuf = " No access to directory"
Case Is = PXERR_DIRNOTPRIVATE
msgbuf = " Single user, but directory is shared"
Case Is = PXERR_FILEBUSY
msgbuf = " File is busy"
Case Is = PXERR_FILELOCKED
msgbuf = " File is locked"
Case Is = PXERR_FILENOTFOUND
msgbuf = " Could not find file"
Case Is = PXERR_TABLEBUSY
msgbuf = " Table is busy"
Case Is = PXERR_TABLELOCKED
msgbuf = " Table is locked"
Case Is = PXERR_TABLENOTFOUND
msgbuf = " Table was not found"
Case Is = PXERR_TABLEOPEN
msgbuf = " Unable to perform operation on open table"
Case Is = PXERR_TABLEINDEXED
msgbuf = " Table is indexed"
Case Is = PXERR_TABLENOTINDEXED
msgbuf = " Table is not indexed"
Case Is = PXERR_TABLEEMPTY
msgbuf = " Operation on empty table"
Case Is = PXERR_TABLEWRITEPRO
msgbuf = " Table is write protected"
Case Is = PXERR_TABLECORRUPTED
msgbuf = " Table is corrupted"
Case Is = PXERR_TABLEFULL
msgbuf = " Table is full"
Case Is = PXERR_TABLESQL
msgbuf = " Table is SQL replica"
Case Is = PXERR_INSUFRIGHTS
msgbuf = " Insufficient password rights"
Case Is = PXERR_XCORRUPTED
msgbuf = " Primary index is corrupted"
Case Is = PXERR_XOUTOFDATE
msgbuf = " Primary index is out of date"
Case Is = PXERR_XSORTVERSION
msgbuf = " Sort for index different from table"
Case Is = PXERR_SXCORRUPTED
msgbuf = " Secondary index is corrupted"
Case Is = PXERR_SXOUTOFDATE
msgbuf = " Secondary index is out of date"
Case Is = PXERR_SXNOTFOUND
msgbuf = " Secondary index was not found"
Case Is = PXERR_SXOPEN
msgbuf = " Secondary index is already open"
Case Is = PXERR_SXCANTUPDATE
msgbuf = " Can't update table open on non-maintained secondary" 'maintained secondary"
Case Is = PXERR_RECTOOBIG
msgbuf = " Record too big for index"
Case Is = PXERR_RECDELETED
msgbuf = " Another user deleted record"
Case Is = PXERR_RECLOCKED
msgbuf = " Record is locked"
Case Is = PXERR_RECNOTFOUND
msgbuf = " Record was not found"
Case Is = PXERR_KEYVIOL
msgbuf = " Key violation"
Case Is = PXERR_ENDOFTABLE
msgbuf = " End of table"
Case Is = PXERR_STARTOFTABLE
msgbuf = " Start of table"
Case Is = PXERR_TOOMANYCLIENTS
msgbuf = " Too many clients"
Case Is = PXERR_EXCEEDSCONFIGLIMITS
msgbuf = " Exceeds table conflicts"
Case Is = PXERR_CANTREMAPFILEHANDLE
msgbuf = " Cant remap file handle"
Case Is = PXERR_OUTOFMEM
msgbuf = " Not enough memory to complete operation"
Case Is = PXERR_OUTOFDISK
msgbuf = " Not enough disk space to complete operation"
Case Is = PXERR_OUTOFSTACK
msgbuf = " Not enough stack space to complete operation"
Case Is = PXERR_OUTOFSWAPBUF
msgbuf = " Not enough swap buffer space to complete operation"
Case Is = PXERR_OUTOFFILEHANDLES
msgbuf = " No more file handles available"
Case Is = PXERR_OUTOFTABLEHANDLES
msgbuf = " No more table handles" 'available
Case Is = PXERR_OUTOFRECHANDLES
msgbuf = " No more record handles" 'available
Case Is = PXERR_OUTOFLOCKHANDLES
msgbuf = " Too many locks on table"
Case Is = PXERR_NOMORETMPNAMES
msgbuf = " No more temporary names available"
Case Is = PXERR_TOOMANYPASSW
msgbuf = " Too many passwords specified"
Case Is = PXERR_TYPEMISMATCH
msgbuf = " Data type mismatch"
Case Is = PXERR_OUTOFRANGE
msgbuf = " Argument out of range"
Case Is = PXERR_INVPARAMETER
msgbuf = " Invalid argument"
Case Is = PXERR_INVDATE
msgbuf = " Invalid date given"
Case Is = PXERR_INVFIELDHANDLE
msgbuf = " Invalid field handle"
Case Is = PXERR_INVRECHANDLE
msgbuf = " Invalid record handle"
Case Is = PXERR_INVTABLEHANDLE
msgbuf = " Invalid table handle"
Case Is = PXERR_INVLOCKHANDLE
msgbuf = " Invalid lock handle"
Case Is = PXERR_INVDIRNAME
msgbuf = " Invalid directory name"
Case Is = PXERR_INVFILENAME
msgbuf = " Invalid file name"
Case Is = PXERR_INVTABLENAME
msgbuf = " Invalid table name"
Case Is = PXERR_INVFIELDNAME
msgbuf = " Invalid field name"
Case Is = PXERR_INVLOCKCODE
msgbuf = " Invalid lock code"
Case Is = PXERR_INVUNLOCK
msgbuf = " Invalid unlock"
Case Is = PXERR_INVSORTORDER
msgbuf = " Invalid sort order table"
Case Is = PXERR_INVPASSW
msgbuf = " Invalid password"
Case Is = PXERR_INVNETTYPE
msgbuf = " Invalid net type (PXNetInit)"
Case Is = PXERR_BUFTOOSMALL
msgbuf = " Buffer too small for result"
Case Is = PXERR_STRUCTDIFFER
msgbuf = " Table structures are different"
Case Is = PXERR_INVENGINESTATE
msgbuf = " Previous fatal error"
End Select
response% = MsgBox(msgbuf, 17, "Paradox Error")
If response% <> MBOK Then
rc = PXExit()
End
End If
End Sub
Sub PXInit (AppName$, Mode%)
'mode can be any of: PXSINGLECLIENT,PXEXCLUSIVE,PXSHARED
rc = PXWinInit(AppName$, Mode%)
PXError
End Sub
Sub PXOpen (TblName$, TblHnd%, RecHnd%)
rc = PXTblOpen(TblName$, TblHnd%, tIndex, TRUE)
PXError
rc = PXRecBufOpen(TblHnd%, RecHnd%)
PXError
rc = PXRecBufEmpty(RecHnd%)
PXError
End Sub
Sub GetField (RecHnd%, FldHnd%, fldtype$)
returnFld = ""
aValue = ""
lValue = 0
dValue = 0
Select Case Mid$(fldtype$, 1, 1)
Case Is = "A"
rc = PXGetAlpha(RecHnd%, FldHnd%, 255, aValue)
PXError
returnFld = aValue
Case Is = "N"
rc = PXGetLong(RecHnd%, FldHnd%, lValue)
PXError
' If lValue < 0 Then
' lValue = 0
' End If
returnFld = Format$(lValue, "###0")
Case Is = "$"
rc = PXGetDoub(RecHnd%, FldHnd%, dValue)
PXError
' If dValue < 0 Then
' dValue = 0
' End If
returnFld = Format$(dValue, "###,##0.00")
Case Is = "D"
rc = PXGetDate(RecHnd%, FldHnd%, lValue)
PXError
rc = PXDateDecode(lValue, mm, dd, yy)
returnFld = LTrim$(Str$(mm)) + "/" + LTrim$(Str$(dd)) + "/" + LTrim$(Str$(yy))
End Select
End Sub
Sub PXNext (TblHnd%, RecHnd%)
rc = PXRecNext(TblHnd%)
If rc = PXERR_ENDOFTABLE Then
Exit Sub
End If
rc = PXRecGet(TblHnd%, RecHnd%)
End Sub
Sub PXPrev (TblHnd%, RecHnd%)
rc = PXRecPrev(TblHnd)
If rc = PXERR_STARTOFTABLE Then
Exit Sub
End If
rc = PXRecGet(TblHnd%, RecHnd%)
End Sub
Sub PutField (RecHnd%, FldHnd%, fldtype$)
Select Case Mid$(fldtype$, 1, 1)
Case Is = "A"
rc = PXPutAlpha(RecHnd%, FldHnd%, aValue)
PXError
Case Is = "N"
rc = PXPutBlank(RecHnd%, FldHnd%)
PXError
rc = PXPutLong(RecHnd%, FldHnd%, lValue)
PXError
Case Is = "$"
rc = PXPutBlank(RecHnd%, FldHnd%)
PXError
' rc = PXPutLong(RecHnd%, FldHnd%, lValue)
rc = PXPutDoub(RecHnd%, FldHnd%, dValue)
PXError
Case Is = "D"
rc = PXPutDate(RecHnd%, FldHnd%, lValue)
PXError
End Select
End Sub
Function Gen_Date (vDate As String)
pos1% = InStr(1, vDate, "/")
mm = Val(Mid$(vDate, 1, pos1% - 1))
pos2% = InStr(pos1% + 1, vDate, "/")
dd = Val(Mid$(vDate, pos1% + 1, pos2% - pos1% - 1))
temp$ = Mid$(vDate, pos2% + 1, 4)
If Len(temp$) = 4 Then
yy = Val(Mid$(temp$, 3, 2))
Else
yy = Val(temp$)
End If
If (mm < 1 Or mm > 12 Or dd < 1 Or yy < 1) Then
eflag% = 1
ElseIf mm = 2 And dd > 28 Then
eflag% = 1
ElseIf (mm = 4 Or 6 Or 9 Or 11) And dd > 30 Then
eflag% = 1
ElseIf dd > 31 Then
eflag% = 1
End If
If eflag% = 1 Then
Gen_Date = 1
Else
Gen_Date = 0
rc = PXDateEncode(mm, dd, yy, lValue)
End If
End Function