ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/WINDOWS/PROGRAM/VBPXEN.ZIP/VVDBMOD2.BAS

BASIC Source File | 1991-10-07 | 5.4 KB | 173 lines

'
'   Written by Steve Jackson
'              9152 Brabham Dr.
'              Huntington Beach, CA 92646
'
'   This is meant to be called from your form objects.  In turn, these
'   functions call routines in PXMODULE.BAS that access Paradox.  I
'   tried to isolate all Paradox specific code there in case you want
'   to change your app to some other DBMS later (SQL Server, xbase, etc.)
'   or it you don't like it and want to change it...
'
Function GetItemRec (ByVal Action%) As Integer
    '
    '   Get the item record and move all fields to
    '   a record buffer that is global
    '
    If Action% = DBKEYED Then
        rc = PutAlphaField(ITEM_TABLE, 1, itemrec.itemnumber)
    End If

    rc = GetRec(ITEM_TABLE, Action%)
    '
    '  Assume the error handling function traps fatal errors and
    '  ends the program.  Here we assume any error is of the expected
    '  variety, such as not-found, end-of-file, duplicate-key, etc.
    '
    If rc = DB_NOTFOUND Then
        GetItemRec = rc
        Beep
        Msg$ = "Item not found for this item number"
        MsgBox Msg$, MB_ICONINFORMATION, "Get Item"
        Exit Function
    End If
    '
    '  Assume that if there is still an error, it is at end or
    '  start of file.  Just beep, but do not display any msg
    '
    If rc Then
        GetItemRec = rc
        Beep
        Exit Function
    End If
    '
    '  Move fields from paradox to the record buffer
    '  The fields are NOT on the form at this point
    '
    rc = GetAlphaField(ITEM_TABLE, 1, itemrec.itemnumber)
    rc = GetAlphaField(ITEM_TABLE, 2, itemrec.itemdesc)
    rc = GetAlphaField(ITEM_TABLE, 3, itemrec.custnum)
    rc = GetAlphaField(ITEM_TABLE, 5, itemrec.inout_code)
    '
     GetItemRec = DB_OK
End Function

Function UpdateItemRec () As Integer
    '
    '  Write the current record back to the database.
    '  Assume no-one else has changed the positioning since
    '  the time we got the record, and when the update takes place.
    '  Note:  this may be a dangerous assumption in Windows...
    '
    rc = PutAlphaField(ITEM_TABLE, 1, itemrec.itemnumber)
    rc = PutAlphaField(ITEM_TABLE, 2, itemrec.itemdesc)
    rc = PutAlphaField(ITEM_TABLE, 3, itemrec.custnum)
    rc = PutAlphaField(ITEM_TABLE, 5, itemrec.inout_code)

    rc = UpdateRec(ITEM_TABLE)
    UpdateItemRec = rc

    If rc Then
        Beep
        Msg$ = "Update failed, reason code: " + Str$(rc)
        MsgBox Msg$, MB_ICONEXCLAMATION, "Update Item"
    End If

    rc = UnlockRec(ITEM_TABLE)
End Function

Function AddItemRec () As Integer
    '
    '  Write the record to the database.
    '  Assume no-one else has already added one with this key.
    '  Note:  this may be a dangerous assumption in Windows...
    '
    rc = PutAlphaField(ITEM_TABLE, 1, itemrec.itemnumber)
    rc = PutAlphaField(ITEM_TABLE, 2, itemrec.itemdesc)
    rc = PutAlphaField(ITEM_TABLE, 3, itemrec.custnum)
    rc = PutAlphaField(ITEM_TABLE, 5, itemrec.inout_code)

    rc = AddRec(ITEM_TABLE)
    AddItemRec = rc
    '
    '  assume serious errors were trapped in pxerror()
    '  if the add fails, assume it is a duplicate key
    '
    If rc Then
        Beep
        Msg$ = "ADD failed - there is already a item with this number"
        MsgBox Msg$, MB_ICONINFORMATION, "Add Item"
    End If

    AddItemRec = rc
End Function

Function DeleteItemRec () As Integer
    '
    '  Write the current record back to the database.
    '  Assume no-one else has changed the positioning since
    '  the time we got the record, and when the update takes place.
    '  Note:  this may be a dangerous assumption in Windows...
    '
    '  Just move the key field to the record buffer
    '
    rc = PutAlphaField(ITEM_TABLE, 1, itemrec.itemnumber)

    rc = DeleteRec(ITEM_TABLE)
    '
    '  assume serious errors were trapped in pxerror()
    '  if the delete fails, assume it was already deleted
    '
    If rc Then
        Beep
        Msg$ = "DELETE failed - Item was already deleted"
        MsgBox Msg$, MB_ICONEXLAMATION, "Delete Item"
    End If

    DeleteItemRec = rc
End Function

Function GetItemRecForUpdate () As Integer
    '
    '   Get the item record by key value,
    '   and place a record lock on it.
    '
    '   Move all fields to a record buffer that is global
    '
    rc = PutAlphaField(ITEM_TABLE, 1, itemrec.itemnumber)

    rc = GetRec(ITEM_TABLE, DB_KEYED)
    '
    '  Assume the error handling function traps fatal errors and
    '  ends the program.  Here we assume any error is of the expected
    '  variety, such as not-found, end-of-file, duplicate-key, etc.
    '
    If rc Then
        GetItemRecForUpdate = rc
        Beep
        Msg$ = "Item record was not found for this item number"
        MsgBox Msg$, MB_ICONINFORMATION, "Get Item"
        Exit Function
    End If
    '
    '  Place the lock,
    '    if it fails, try again until user quits
    '
    rc = LockRec(ITEM_TABLE)
    If rc Then
        GetItemRecForUpdate = rc
        Msg$ = "Item record is locked by someone else"
        MsgBox Msg$, MB_ICONINFORMATION, "Get Item"
        Exit Function
    End If


    rc = GetAlphaField(ITEM_TABLE, 1, itemrec.itemnumber)
    rc = GetAlphaField(ITEM_TABLE, 2, itemrec.itemdesc)
    rc = GetAlphaField(ITEM_TABLE, 3, itemrec.custnum)
    rc = GetAlphaField(ITEM_TABLE, 5, itemrec.inout_code)

    GetItemRecForUpdate = DB_OK
End Function