VERSION 5.00
Begin VB.Form frmUser 
   Appearance      =   0  'Flat
   BackColor       =   &H80000005&
   Caption         =   "CodeBase 6.0 Basic User's Guide Examples"
   ClientHeight    =   6210
   ClientLeft      =   1650
   ClientTop       =   1440
   ClientWidth     =   6420
   BeginProperty Font 
      Name            =   "MS Sans Serif"
      Size            =   8.25
      Charset         =   0
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H80000008&
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   6210
   ScaleWidth      =   6420
   Begin VB.ListBox List2 
      Appearance      =   0  'Flat
      Height          =   225
      Left            =   5580
      TabIndex        =   1
      Top             =   5712
      Visible         =   0   'False
      Width           =   735
   End
   Begin VB.ListBox List1 
      Appearance      =   0  'Flat
      Height          =   225
      Left            =   5580
      TabIndex        =   0
      Top             =   5520
      Width           =   735
   End
End
Attribute VB_Name = "frmUser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim bStandAlone, bClientServer As Integer

Private Sub Form_Load()
   
   Dim rc As Integer
   lf = Chr$(10) + Chr$(13)

   configCode = u4switch()

   'By default, look for data files in the EXAMPLES
   'directory under stand-alone, and the server's
   'executing directory under client/server
   
   If configCode And &H80 Then
      bStandAlone = True      'stand-alone
      fPath = App.Path + "\"
   Else
      bClientServer = True
      fPath = ""                 'client/server
   End If

   'Attempt a connection under client/server using all
   'default values. Change these settings as needed
   If bClientServer Then
      rc = code4connect(cb, "", "", "", "", "")
      If rc < 0 Then
         MsgBox "Cannot continue without Server connection." + lf + "Check the 'code4connect()' function in the" + lf + "Form Load event of USER.FRM", MB_OK + MB_ICONSTOP
         Exit Sub
      End If
   End If

   List1.AddItem "Append"
   List1.AddItem "CopyData"
   List1.AddItem "CopyData2"
   List1.AddItem "CustList"
   List1.AddItem "DataInfo"
   List1.AddItem "Date"
   List1.AddItem "Deletion"
   List1.AddItem "Descend"
   List1.AddItem "Multi"
   List1.AddItem "NewList"
   List1.AddItem "NewList2"
   List1.AddItem "NoGroup"
   List1.AddItem "NoGroup2"
   List1.AddItem "Relate1"
   List1.AddItem "Relate2"
   List1.AddItem "Relate3"
   List1.AddItem "Relate4"
   List1.AddItem "Seeker"
   List1.AddItem "ShowData"
   List1.AddItem "ShowData2"
   List1.AddItem "ShowData3"
   List1.AddItem "Transfer"

End Sub

Private Sub Form_Resize()

   Dim listHt As Integer, listWd As Integer
   Dim listTp As Integer, list1Lft As Integer, list2Lft As Integer

   listHt = Form1.Height * 0.7
   listWd = Form1.Width * 0.32
   listTp = Form1.ScaleHeight * 0.95 - listHt
   list1Lft = Form1.Width * 0.95 - listWd
   list2Lft = Form1.ScaleWidth * 0.05
   

   List1.Height = listHt
   List1.Width = listWd
   List1.Top = listTp
   List1.Left = list1Lft

   List2.Height = listHt
   List2.Width = listWd
   List2.Top = listTp
   List2.Left = list2Lft


End Sub

Private Sub List1_DblClick()

   'FIELD4 pointers
   Dim fName As Long, lname As Long, address As Long
   Dim age As Long, birthdate As Long, married As Long
   Dim amount As Long, comment As Long

   'TAG4 pointers
   Dim nameTag As Long, ageTag As Long, amtTag As Long, birthTag As Long
   Dim addrTag As Long

   'INDEX4 pointers
   Dim ind1 As Long

   'Field value holders
   Dim ageVal As Integer, amtVal As Double
   Dim fnameStr As String, lnameStr As String
   Dim addressStr As String, marriedStr As String
   Dim birthdateStr As String, commentStr As String

   'Others
   Dim fldArray As Long, tagArray As Long
   Dim fileName As String, db2 As Long

   Dim save1 As Integer, save2 As Integer, save3 As Integer, save4 As Integer, save5 As Integer
   Dim rc1 As Integer, rc2 As Integer

Cls
List2.Visible = False

Select Case List1.Text

Case "Append"
   'Append sample code

   Dim dbTo As Long, dbFrom As Long
   Dim infoTo As Long, infoFrom As Long

   Dim rcl As Long

   rc = code4optimize(cb, 1)
   rc = code4optimizeWrite(cb, 1)
   rcl = code4memStartMax(cb, 262140)

   dbTo = d4open(cb, fPath + "TO_DBF")
   dbFrom = d4open(cb, fPath + "FROM_DBF")

   Print "Record count TO_DBF: "; d4recCount(dbTo)

   If cbError() Then Exit Sub

   rc = code4optStart(cb)

   infoTo = d4field(dbTo, "INFO")
   infoFrom = d4field(dbFrom, "INFO")

   rc = code4lockAttempts(cb, 1)
   rc1 = d4lockFile(dbTo)
   rc2 = d4lockFile(dbFrom)

   If rc1 Or rc2 Then
      MsgBox "Locking Failed"
      Exit Sub
   End If

   rc = d4top(dbFrom)

   Do While rc = r4success
      rc = d4appendStart(dbTo, 0)
      Call f4assignField(infoTo, infoFrom)
      rc = d4append(dbTo)
      rc = d4skip(dbFrom, 1)
   Loop

   rc = d4unlock(dbTo)
   rc = d4unlock(dbFrom)

   Print "Record count TO_DBF: "; d4recCount(dbTo)
   
   rc = code4close(cb)


Case "CopyData"
   'CopyData sample code

   fileName = InputBox$("Enter file name to copy", "CopyData", "DATA1")

   If fileName = "" Then Exit Sub

   db = d4open(cb, fPath + fileName)      'Open original

   If cbError() Then Exit Sub             'Check for error

   save1 = code4safety(cb, 0)             'Overwrite existing file

   fldArray = d4fieldInfo(db)             'Get 'C' field info

   db2 = d4createCB(cb, fPath + "DATA2", ByVal fldArray, ByVal 0&)

   If db2 > 0 Then MsgBox "Successful File copy"

   Call u4free(fldArray)                     'Free field info

   rc = code4close(cb)

   rc = code4safety(cb, save1)               'Reset to initial status

Case "CopyData2"
   'CopyData2 sample code

   save1 = code4autoOpen(cb, 0)
   save2 = code4safety(cb, 0)

   fileName = InputBox$("Enter file name to copy", "CopyData", "DATA1")

   If fileName = "" Then Exit Sub

   db = d4open(cb, fPath + fileName)         'Open source data file

   If cbError() Then Exit Sub

   ind1 = i4open(db, "")                     'Open index

   If cbError() Then                         'Check for error
      rc = code4close(cb)
      Exit Sub
   End If

   fldArray = d4fieldInfo(db)                'Get 'C' field and tag info
   tagArray = i4tagInfo(ind1)

   db2 = d4createCB(cb, fPath + "DATA3", ByVal fldArray, ByVal tagArray)

   If db2 > 0 Then MsgBox "Successful File copy"

   Call u4free(fldArray)                     'Free field info
   Call u4free(tagArray)                     'Free tag info
   
   rc = code4close(cb)

   rc = code4autoOpen(cb, save1)             'Reset to initial status
   rc = code4safety(cb, save2)

Case "CustList"
  'CustList sample code

  db = d4open(cb, fPath + "DATA1")           'Open file
  If code4errorCode(cb, 0) < 0 Then          'Check & reset errror code
     rc = code4close(cb)
     Exit Sub
  End If

  fName = d4field(db, "F_NAME")              'Get field pointers
  lname = d4field(db, "L_NAME")
  address = d4field(db, "ADDRESS")
  age = d4field(db, "AGE")
  birthdate = d4field(db, "BIRTH_DATE")      'Date field
  married = d4field(db, "MARRIED")           'Logical
  amount = d4field(db, "AMOUNT")             'Numeric
  comment = d4field(db, "COMMENT")           'Memo

  If d4top(db) = r4success Then
     Do
       lnameStr = f4str(lname)                  'Copy contents of field
       fnameStr = f4str(fName)
       addressStr = f4str(address)
       ageVal = f4int(age)
       birthdateStr = f4str(birthdate)
       marriedStr = f4str(married)
       amtVal = f4double(amount)
       commentStr = f4memoStr(comment)
   
       Print "Name:    "; fnameStr; " "; lnameStr
       Print "Address: "; addressStr; " "
       Print "Age:     "; ageVal; Space(5); "Married: "; marriedStr
       Print "Amount:  "; amtVal
       Print "Comment: "; commentStr
       Print
       rc = d4skip(db, 1)
     Loop While rc = r4success
  Else
     If d4recCount(db) = 0 Then Print "No records in data file"
  End If

  rc = code4close(cb)

Case "DataInfo"
   'DataInfo sample code

   Dim dbname As String, fldRef As Long, y As Integer
   y = 17

   dbname = InputBox$("Enter Name of File to Examine", "Open File", "DATA1")
   If dbname = "" Then Exit Sub
   db = d4open(cb, fPath + dbname)
   If cbError() Then Exit Sub                       'Check for error

   Print "Data File:"; Tab(y); dbname               'Print data file information
   Print "Alias:"; Tab(y); d4alias(db)
   Print "Record Count:"; Tab(y); d4recCount(db)
   Print "Record Length:"; Tab(y); d4recWidth(db)
   Print "Field Count:"; Tab(y); d4numFields(db)
   
   List2.Visible = True
   List2.Clear

   For i = 1 To d4numFields(db)                      'Loop through each field
      fldRef = d4fieldJ(db, i)                       'Get next field pointer
      List2.AddItem "Field " + Str$(i)               'Add field info
      List2.AddItem f4name(fldRef)
      List2.AddItem Chr$(f4type(fldRef))
      List2.AddItem Str$(f4len(fldRef))
      List2.AddItem Str$(f4decimals(fldRef))
      List2.AddItem ""
   Next i
      
   rc = code4close(cb)

Case "Date"
   'Date sample code

   Dim request As String, standard As String
   Dim birth As String

   request = "Please enter your birthday" + lf
   request = request + "in MMM DD/CCYY format"
   request = request + lf + "eg Dec 23/1993"

   Call HowLongUntil(12, 25, "Christmas")

   Do
      birth = InputBox$(request, "Date", "Jan 01/1980")
      If birth = "" Then Exit Sub

      Call date4init(standard, birth, "MMM DD/CCYY")

   Loop While Not ValidDate(standard)

   Call HowLongUntil(date4month(standard), date4day(standard), "your next birthday")


Case "Deletion"
  'Deletion sample code

  Dim count As Integer

  'Create test file
  If Not CreateDeleteFile() Then Exit Sub

  'Append 5 blank records
  For i = 1 To 5
    rc = d4appendBlank(db)
  Next i

  PrintRecordsStatus            'Print status of records

  rc = d4go(db, 3)              'Go to record 3
  Call d4delete(db)             'Delete the record
  rc = d4go(db, 1)
  Call d4delete(db)
  rc = d4go(db, 4)
  Call d4delete(db)
  PrintRecordsStatus

  rc = d4go(db, 3)
  Call d4recall(db)
  PrintRecordsStatus

  rc = d4pack(db)               'Remove deleted records
  rc = d4memoCompress(db)       'Compress memo file
  PrintRecordsStatus

  rc = code4close(cb)

Case "Descend"
   'Descend sample Code
   
   'Note: This example has been modified from the printed
   '      documentation to accomodate the fact that in
   '      client/server applications, a production index
   '      file cannot be re-created over an existing file,
   '      as can be done in stand-alone applications.
   '      Refer to the i4create() function in the
   '      Reference Guide for more information.

   save1 = code4autoOpen(cb, 0)    'no effect under client/server
   save2 = code4accessMode(cb, OPEN4DENY_RW)

   If bStandAlone Then
      rc = OpenDataFile()
   Else
      rc = CreateDataOnly(True)
   End If

   If rc Then

      If d4recCount(db) = 0 Then
         Call AddNewRecord("Sarah", "Webber", "132-32 St.", 32, "19610523", True, 147.99, "New Customer")
         Call AddNewRecord("John", "Albridge", "1232-76 Ave.", 55, "19381212", False, 98.99, "")
      End If

      If CreateIndexDescend() Then
         nameTag = d4tag(db, "NAME_TAG")
         addrTag = d4tag(db, "ADDR_TAG")
         ageTag = d4tag(db, "AGE_TAG")
         birthTag = d4tag(db, "DATE_TAG")
   
         Call d4tagSelect(db, nameTag)
         PrintRecordsDescend
   
         Call d4tagSelect(db, addrTag)
         PrintRecordsDescend
   
         Call d4tagSelect(db, ageTag)
         PrintRecordsDescend
   
         Call d4tagSelect(db, birthTag)
         PrintRecordsDescend
      Else
         rc = code4errorCode(cb, 0)
      End If
   Else
      rc = code4errorCode(cb, 0)
   End If
   
   rc = code4autoOpen(cb, save1)
   rc = code4accessMode(cb, save2)

   rc = code4close(cb)

Case "Multi"
   'Multi sample code

   Dim opt As String, choice As String

   save1 = code4accessMode(cb, OPEN4DENY_NONE)     'Open in shared mode
   save2 = code4readOnly(cb, 0)                    'Read and Write
   save3 = code4readLock(cb, 0)                    'Don't lock when reading
   save4 = code4lockAttempts(cb, WAIT4EVER)        'Try forever on locks
   save5 = code4lockEnforce(cb, 1)                 'lock when modifying record

   db = d4open(cb, fPath + "NAMES")

   If code4errorCode(cb, 0) < 0 Then Exit Sub

   fName = d4field(db, "NAME")
   nameTag = d4tag(db, "NAME")
   Call d4tagSelect(db, nameTag)

   opt$ = "Enter a Command:" + lf
   opt$ = opt$ + "'a', 'f', 'l', 'm', or 'x'"

   rc = d4top(db)

   Do
      Cls
      rc = code4errorCode(cb, 0)

      Print "Record #:"; d4recNo(db); Tab(25); "Name: "; f4str(fName)
      Print
      choice$ = InputBox(opt$, "Multi")
      Select Case choice$
      Case "a", "A"
         Call AddRecord(db, fName)
      Case "f", "F"
         Call FindRecord(db)
      Case "l", "L"
         Call ListData(db, fName)
         List2.Visible = True
         Exit Do
      Case "m", "M"
         Call ModifyRecord(db, fName)
      Case "x", "X", ""
         rc = code4close(cb)
         Cls
         Exit Do
      Case Else
         MsgBox "Invalid Option", MB_OK, "Error"
      End Select
   Loop

   rc = code4accessMode(cb, save1)
   rc = code4readOnly(cb, save2)
   rc = code4readLock(cb, save3)
   rc = code4lockAttempts(cb, save4)
   rc = code4lockEnforce(cb, save5)

Case "NewList"
   'NewList sample code
   
   save1 = code4errOpen(cb, 0)         'Disable error message
   save2 = code4safety(cb, 0)          'Disable overwrite safety
                                       
   If Not OpenDataFile() Then Exit Sub 'Open the file
   
   If d4recCount(db) > 0 Then          'Not a new file
      PrintRecordsNewList              'Print Records
   Else
      Call AddNewRecord("Sarah", "Webber", "132-32 St.", 32, "19610523", True, 147.99, "New Customer")
      Call AddNewRecord("John", "Albridge", "1232-76 Ave.", 55, "19381212", False, 98.99, "")
      PrintRecordsNewList
   End If                              'Add records, then print
   
   rc = code4errOpen(cb, save1)        'Restore initial settings
   rc = code4safety(cb, save2)
   
   rc = code4close(cb)                 'Close files
   

Case "NewList2"
  'NewList2 sample code

  Dim overWrite As Integer
  
  overWrite = True

  'Create the data and index file
  If Not CreateDataFile(overWrite) Then Exit Sub
    
  'Get TAG4 pointers
  nameTag = d4tag(db, "NAME_TAG")
  ageTag = d4tag(db, "AGE_TAG")
  amtTag = d4tag(db, "AMT_TAG")

  Call AddNewRecord("Sarah", "Webber", "132-32 St.", 32, "19610523", True, 147.99, "New Customer")
  Call AddNewRecord("John", "Albridge", "1232-76 Ave.", 55, "19381212", False, 98.99, "")
  
  Print "Natural Order:"
  PrintRecordsNewList
  Print

  Print "Sorted by Name:"
  Call d4tagSelect(db, nameTag)
  PrintRecordsNewList
  
  'And so on...

  rc = code4close(cb)                  'Close files

Case "NoGroup"
   'NoGroup sample code

   'Note: This example has been modified from the printed
   '      documentation to accomodate the fact that in
   '      client/server applications, a production index
   '      file cannot be re-created over an existing file,
   '      as can be done in stand-alone applications.
   '      Refer to the i4create() function in the
   '      Reference Guide for more information.

   rc1 = MsgBox("Are you using a CodeBase Clipper DLL?", MB_YESNO + MB_ICONQUESTION, "NoGroup")
   
   save1 = code4autoOpen(cb, 0)
   save2 = code4safety(cb, 0)
   save3 = code4accessMode(cb, OPEN4DENY_RW)

   If bStandAlone Then
      rc2 = OpenDataFile()
   Else
      rc2 = CreateDataOnly(True)
   End If

   If rc2 Then
      InitTag4
      
      ind1 = i4create(db, "", tagInfo())
   
      If ind1 > 0 Then
         If rc1 = IDYES Then
            MsgBox "Index created with no Group file"
         Else
            MsgBox "Index created"
         End If
      Else
         rc = code4errorCode(cb, 0)
      End If
   Else
      rc = code4errorCode(cb, 0)
   End If

   rc = code4close(cb)

   rc = code4autoOpen(cb, save1)
   rc = code4safety(cb, save2)
   rc = code4accessMode(cb, save3)

   rc = code4accessMode(cb, save1)

Case "NoGroup2"
   'NoGroup2 sample code

   rc = MsgBox("Are you using a CodeBase Clipper DLL?", MB_YESNO + MB_ICONQUESTION, "NoGroup")
   
   If rc <> IDYES Then
      MsgBox "Cannot continue this example"
      Exit Sub
   End If

   save1 = code4autoOpen(cb, 0)
   save2 = code4safety(cb, 0)

   If OpenDataFile() Then
   
      InitTag4
   
      nameTag = t4open(db, "NAME")
      addrTag = t4open(db, "ADDRESS")
      ageTag = t4open(db, "AGE")
   
      If cbError() Then
         rc = code4errorCode(cb, 0)
      Else
         Call d4tagSelect(db, nameTag)
         GenericPrint
      End If
   Else
      rc = code4errorCode(cb, 0)
   End If

   rc = d4close(db)

   rc = code4autoOpen(cb, save1)
   rc = code4autoOpen(cb, save2)

Case "Relate1"
   'Relation1 sample code

   If Not OpenFileRelate1() Then Exit Sub

   If SetRelation1() Then

      List2.Visible = True
      List2.Clear
   
      ListRecsRelate1
   
      rc = code4unlock(cb)
   
      rc = relate4free(master, 0)

   End If

   rc = code4close(cb)

Case "Relate2"
   'Relation2 sample code

   db = d4open(cb, fPath + "STUDENT")

   If cbError() Then Exit Sub

   List2.Visible = True
   List2.Clear

   Call Query(db, "AGE > 30", "")

   Call Query(db, "UPPER(L_NAME) = 'MILLER'", "L_NAME + F_NAME")

   rc = code4close(cb)

Case "Relate3"
   'Relate3 sample code

   List2.Clear

   If Not OpenFileRelate3() Then Exit Sub
   
   If SetRelation3() Then
   
      Call ListRecsRelate3("CODE = 'MATH114 '", 1)
   
      Call ListRecsRelate3("CODE = 'CMPT411 '", -1)
   
      List2.Visible = True
      List2.Refresh
   
      rc = code4unlock(cb)
      rc = relate4free(classRel, 0)
   End If

   rc = code4close(cb)

Case "Relate4"
   'Relate4 sample code

   If Not OpenFileRelate4() Then Exit Sub
   
   If SetRelation4() Then

      '                 <---   15  ---><---   15  --->
      Call SeekRelate4("Tyler          Harvey         ")
   
      Print "Seek #1"
      PrintRecRelate4
      Print
   
      Print "Seek #2"
      Call SeekRelate4("Miller         Albert         ")
      PrintRecRelate4
   End If

   rc = code4close(cb)

Case "Seeker"
   'Seeker sample code
  
   If Not CreateDataFile(True) Then Exit Sub

   If d4recCount(db) = 0 Then
     Call AddNewRecord("Sarah", "Webber", "132-32 St.", 32, "19610523", True, 147.99, "New Customer")
     Call AddNewRecord("John", "Albridge", "1232-76 Ave.", 55, "19381212", False, 98.99, "")
   End If

   'Get TAG4 pointers
   nameTag = d4tag(db, "NAME_TAG")
   amtTag = d4tag(db, "AMT_TAG")
   birthTag = d4tag(db, "DATE_TAG")

   Call d4tagSelect(db, nameTag)

   '                12345678901234567890     Full Key, 20 characters
   rc = d4seek(db, "Sarah     Webber    ")
   PrintRecordSeek (rc)

   rc = d4seek(db, "Sar")                   'Partial Key
   PrintRecordSeek (rc)

   rc = d4seek(db, "Sar                 ")  'Exact Match
   PrintRecordSeek (rc)

   Call d4tagSelect(db, birthTag)

   rc = d4seek(db, "19381212")
   PrintRecordSeek (rc)

   Call d4tagSelect(db, amtTag)

   rc = d4seekDouble(db, 35.75)
   PrintRecordSeek (rc)

   rc = d4seek(db, "250.75")
   PrintRecordSeek (rc)

'The following code finds all the occurrences of John Albridge in the tag

   Call d4tagSelect(db, nameTag)
   rc = d4seekNext(db, "John      Albridge  ")
   Do Until rc <> r4success
       PrintRecordSeek (rc)
       rc = d4seekNext(db, "John      Albridge  ")
   Loop
   
   rc = code4close(cb)

Case "ShowData"
  'ShowData sample code

  Dim fldPtr As Long

  db = d4open(cb, fPath + "SHOWDATA") 'Open file
  If db = 0 Then
    MsgBox "Open Failed"
    rc = code4errorCode(cb, 0)        'Reset error code
    Exit Sub
  End If
   
  rc = d4top(db)
  For i = 1 To d4recCount(db)         'Loop through records
    For j = 1 To d4numFields(db)      'Loop through each field
       fldPtr = d4fieldJ(db, j)       'Get Field pointer
       Print f4memoStr(fldPtr)        'Print field contents
    Next j
    Print                             'Blank line between recs.
    rc = d4skip(db, 1)                'Go to next record
  Next i

  rc = d4close(db)                    'Close file

Case "ShowData2"
   'ShowData2 sample code

   Dim tagPtr As Long, DbfName As String

   DbfName = InputBox$("Enter File Name", "ShowData2", "DATA1")

   If RTrim$(DbfName) = "" Then Exit Sub

   db = d4open(cb, fPath + DbfName)    'Open file
   If db = 0 Then
      rc = code4errorCode(cb, 0)       'Reset error code
      Exit Sub
   End If

   Print "Natural Order"
   Print
   GenericPrint                        'Natural Order
   tagPtr = d4tagNext(db, 0&)          'Get first tag, if any

   Do Until tagPtr = 0
      Call d4tagSelect(db, tagPtr)     'Select ordering
      Print "Datafile sorted by tag: "; t4Alias(d4tagSelected(db))
      Print
      GenericPrint
      tagPtr = d4tagNext(db, tagPtr)   'Look for next tag
   Loop

   rc = d4close(db)                    'Close file

Case "ShowData3"
   'ShowData3 sample code

   'Note: This example has been modified from the printed
   '      documentation to accomodate the fact that in
   '      client/server applications, a production index
   '      file cannot be re-created over an existing file,
   '      as can be done in stand-alone applications.
   '      Refer to the i4create() function in the
   '      Reference Guide for more information.

   save1 = code4autoOpen(cb, 0)
   If bStandAlone Then
      save2 = code4errOpen(cb, 0)
   Else
      save2 = code4errCreate(cb, 0)
   End If
   save3 = code4accessMode(cb, OPEN4DENY_RW)  'Open exclusively so production
                                              'index file can be created with
                                              'i4create
   If bStandAlone Then
      rc = OpenDataFile()
   Else
      rc = CreateDataOnly(True)
   End If

   If rc Then
      If d4recCount(db) = 0 Then
        Call AddNewRecord("Sarah", "Webber", "132-32 St.", 32, "19610523", True, 147.99, "New Customer")
        Call AddNewRecord("John", "Albridge", "1232-76 Ave.", 55, "19381212", False, 98.99, "")
      End If
      
      If CreateIndexFile() Then
      
         tagPtr = d4tagNext(db, 0&)          'Get first tag, if any
   
         Do Until tagPtr = 0
            Call d4tagSelect(db, tagPtr)     'Select ordering
            Print "Datafile sorted by tag: "; t4Alias(d4tagSelected(db))
            Print "With filter: "; t4filter(d4tagSelected(db))
            Print
            GenericPrint
            tagPtr = d4tagNext(db, tagPtr)   'Look for next tag
         Loop
      End If
   End If

   rc = code4autoOpen(cb, save1)        'Restore initial settings
   If bStandAlone Then
      rc = code4errOpen(cb, save2)
   Else
      rc = code4errCreate(cb, save2)
   End If
   rc = code4accessMode(cb, save3)

   rc = code4close(cb)

Case "Transfer"
'Transfer sample code

    rc = code4errOpen(cb, 0)        'Suppress errors when opening files
    rc = code4safety(cb, 0)
    rc = code4lockAttempts(cb, 5)

    If u4switch() And &H80 Then        'Stand-alone
        If Not OpenLogFile() Then Exit Sub
    End If

    If Not OpenDataFileTransfer() Then Exit Sub
    PrintRecords
    'The account number 56789 doesn't exist in the data file
    'the transfer is aborted and the data file is not changed
    Call Transfer(12345, 56789, 200#)
    PrintRecords

    'Both accounts exist so the transfer is completed and
    'the data file is updated
    Call Transfer(12345, 55555, 150.5)
    PrintRecords

    rc = code4close(cb)

End Select


End Sub