FATS - Fast Access Tree System
Table of Contents
Programming Interfaces
Visual Basic for Windows 95/NT


The following Visual Basic example demonstrates the use of the FATS  indexing commands:

 "C" Create Indexfile
(Creates a index file with the specified characteristics.)
 "B" Build Record
(Insert a new record.)
 "W" Write Page Map
(Flush cache buffers to disk.)
 "I" Insert Record
(Insert a new record.)
 "D" Delete Record
(Deletes the primary keys from the index file and makes the associated record number available for future inserts.)
 "R" Replace Single Key
(Updates the specified key to the new key value.)
 "G" Search Generic
(Gets the record number and key value of the first occurence of the left-justified partial key.)
 "F" Search First
(Gets the key value and record number of the data record with the first key value.)
 "L" Search Last
(Gets the key value and record number of the data record with the last key value.)
 "A" Search Next After
(Gets the key value and record number of the data record whose key value is greater than the requested key value.)
 "E" Search Previous Before
(Gets the key value and record number of the data record whose key value is less than the requested key value.)

VERSION 4.00
Begin VB.Form CustomerForm
   Appearance      =   0  'Flat
   BackColor       =   &H80000005&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "FATS Test program"
   ClientHeight    =   4308
   ClientLeft      =   1632
   ClientTop       =   1920
   ClientWidth     =   5376
   BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
      Name            =   "MS Sans Serif"
      Size            =   9.6
      Charset         =   0
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H80000008&
   Height          =   4680
   Left            =   1584
   LinkTopic       =   "KunStamm"
   ScaleHeight     =   4308
   ScaleWidth      =   5376
   Top             =   1596
   Width           =   5472
   Begin VB.ListBox List
      Appearance      =   0  'Flat
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Courier New"
         Size            =   9.6
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   120
      TabIndex        =   26
      Top             =   1440
      Visible         =   0   'False
      Width           =   5172
   End
   Begin VB.OptionButton Option3
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Zip/City"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Courier New"
         Size            =   9.6
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   375
      Left            =   2760
      TabIndex        =   25
      Top             =   960
      Visible         =   0   'False
      Width           =   1452
   End
   Begin VB.OptionButton Option2
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Job"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Courier New"
         Size            =   9.6
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   372
      Left            =   1440
      TabIndex        =   24
      Top             =   960
      Visible         =   0   'False
      Width           =   1332
   End
   Begin VB.OptionButton Option1
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Name"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Courier New"
         Size            =   9.6
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   375
      Left            =   120
      TabIndex        =   23
      Top             =   960
      Visible         =   0   'False
      Width           =   1215
   End
   Begin VB.CommandButton Lists
      Appearance      =   0  'Flat
      Caption         =   "List"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Courier New"
         Size            =   8.4
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   3240
      TabIndex        =   21
      Top             =   0
      Width           =   1060
   End
   Begin VB.CommandButton RecordDelete
      Appearance      =   0  'Flat
      Caption         =   "Delete"
      Enabled         =   0   'False
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Courier New"
         Size            =   8.4
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   2160
      TabIndex        =   20
      Top             =   0
      Width           =   1060
   End
   Begin VB.CommandButton RecordSave
      Appearance      =   0  'Flat
      Caption         =   "Save"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Courier New"
         Size            =   8.4
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1080
      TabIndex        =   19
      Top             =   0
      Width           =   1060
   End
   Begin VB.CommandButton RecordNew
      Appearance      =   0  'Flat
      Caption         =   "New"
      Enabled         =   0   'False
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Courier New"
         Size            =   8.4
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   0
      TabIndex        =   18
      Top             =   0
      Width           =   1065
   End
   Begin VB.CommandButton RecordLast
      Appearance      =   0  'Flat
      Caption         =   "Last"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Courier New"
         Size            =   8.4
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   4320
      TabIndex        =   17
      Top             =   370
      Width           =   1060
   End
   Begin VB.CommandButton RecordNext
      Appearance      =   0  'Flat
      Caption         =   ">>"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Courier New"
         Size            =   8.4
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   3240
      TabIndex        =   16
      Top             =   370
      Width           =   1060
   End
   Begin VB.CommandButton RecordSearch
      Appearance      =   0  'Flat
      Caption         =   "Search"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Courier New"
         Size            =   8.4
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   2160
      TabIndex        =   15
      Top             =   370
      Width           =   1060
   End
   Begin VB.CommandButton RecordPrev
      Appearance      =   0  'Flat
      Caption         =   "<<"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Courier New"
         Size            =   8.4
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1080
      TabIndex        =   14
      Top             =   370
      Width           =   1060
   End
   Begin VB.CommandButton RecordFirst
      Appearance      =   0  'Flat
      Caption         =   "First"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Courier New"
         Size            =   8.4
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   0
      TabIndex        =   13
      Top             =   370
      Width           =   1060
   End
   Begin VB.CommandButton Create
      Appearance      =   0  'Flat
      Caption         =   "Create"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Courier New"
         Size            =   8.4
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   4320
      TabIndex        =   12
      Top             =   0
      Width           =   1060
   End
   Begin VB.TextBox City
      Appearance      =   0  'Flat
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Courier New"
         Size            =   9.6
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   324
      Left            =   2280
      MaxLength       =   20
      TabIndex        =   11
      Top             =   3240
      Width           =   2655
   End
   Begin VB.TextBox ZIP
      Appearance      =   0  'Flat
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Courier New"
         Size            =   9.6
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   324
      Left            =   1440
      MaxLength       =   5
      TabIndex        =   10
      Top             =   3240
      Width           =   735
   End
   Begin VB.TextBox Street
      Appearance      =   0  'Flat
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Courier New"
         Size            =   9.6
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   324
      Left            =   1440
      MaxLength       =   25
      TabIndex        =   9
      Top             =   2880
      Width           =   3495
   End
   Begin VB.TextBox Job
      Appearance      =   0  'Flat
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Courier New"
         Size            =   9.6
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   324
      Left            =   1440
      MaxLength       =   25
      TabIndex        =   8
      Top             =   2520
      Width           =   3495
   End
   Begin VB.TextBox CName
      Appearance      =   0  'Flat
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Courier New"
         Size            =   9.6
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   324
      Left            =   1440
      MaxLength       =   25
      TabIndex        =   7
      Top             =   2160
      Width           =   3495
   End
   Begin VB.TextBox CustomerId
      Appearance      =   0  'Flat
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Courier New"
         Size            =   9.6
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   324
      Left            =   1440
      MaxLength       =   5
      TabIndex        =   6
      Top             =   1800
      Width           =   735
   End
   Begin VB.Label StateLabel
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Courier New"
         Size            =   9.6
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   120
      TabIndex        =   22
      Top             =   3960
      Width           =   5175
   End
   Begin VB.Label txtZipCity
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Zip/City"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Courier New"
         Size            =   9.6
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   120
      TabIndex        =   5
      Top             =   3240
      Width           =   1215
   End
   Begin VB.Label txtStreet
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Street"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Courier New"
         Size            =   9.6
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   120
      TabIndex        =   4
      Top             =   2880
      Width           =   1215
   End
   Begin VB.Label txtJob
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Job"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Courier New"
         Size            =   9.6
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   120
      TabIndex        =   3
      Top             =   2520
      Width           =   1215
   End
   Begin VB.Label txtName
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Name"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Courier New"
         Size            =   9.6
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   120
      TabIndex        =   2
      Top             =   2160
      Width           =   1215
   End
   Begin VB.Label txtCustomerId
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "ID"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Courier New"
         Size            =   9.6
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   120
      TabIndex        =   1
      Top             =   1800
      Width           =   1215
   End
   Begin VB.Label txtTitle
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Customers"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Courier New"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00800000&
      Height          =   375
      Left            =   1080
      TabIndex        =   0
      Top             =   960
      Width           =   3255
   End
End
Attribute VB_Name = "CustomerForm"
Attribute VB_Creatable = False
Attribute VB_Exposed = False


Option Explicit

Dim customers As custrec
Dim dwCurrentRecno As Long
Dim nListMode As Integer



Sub Create_Click ()

    Dim szDemoFile As String
    Dim szKeyFile As String
    Dim szCmnd As String
    Dim szMsg As String

    If MsgBox("Do you want to rebuild the data file ?", 4) <> 6 Then Exit Sub

    szDemoFile = App.Path + "\..\..\..\DEMODATA\" + "CUSTOMER.ANS"
    szKeyFile = App.Path + "\" + "CUSTOMER.KEY"

    If Dir$(szDemoFile) = "" Then

        szMsg = "Datei " + szDemoFile + " not found"
        MsgBox (szMsg)
        Exit Sub
    End If

    '   "C" Create Indexfile
    '
    '  With this command you create an index file, whereby a possibly
    '  already existing file with the same name is deleted.
    '  After the file is created it will be opened with the opening
    '  flags defined with the command  Auto Refresh (Y) and can be
    '  accessed under the file number you specified.
    '
    '  Max. 200 primary keys per data record can be administered in an
    '  index file, the max. key length amounts to 240 characters.
    '
    '  Full path names must be specified using forward slashes (/)
    '  instead of Backslashes (\), because FATS normally uses the
    '  Backslash character as delimiter.
    '  You may change the delimiters by placing the desired character
    '  as the first character of the command string,
    '  e.g. szCmnd = "&C&C:\ARTICLES.KEY&1&1&A&1". Any character with
    '  an Ascii code less then 48 will be accepted.
    '
    '  The syntax of the command string:
    '
    '    szCmnd = "C\{Filename}\{KeyLength}\{KeyCount}\{KeyType}\{FileNo}"
    '
    '      FileName   filename, perhaps with an additional path
    '                 (e.g. C:/DATA/ARTICLES.KEY or ARTICLES.KEY)
    '
    '      KeyLength  Maximum key length (1-250)
    '                 If you choose to have more than one key for
    '                 this index file, you may specify the length
    '                 for each key (separated by a semicolon ";")
    '                 to conserve diskette space.
    '                 Otherwise, the maximum length applies to all
    '                 keys, i.e. every key will occupy the maximum
    '                 space.
    '
    '      KeyCount   Number of primary keys (1-200)
    '
    '      KeyType    Key type (A = Ascii text, I = Integer)
    '
    '      FileNo     File number (1-40)

    szCmnd = "&C&" + szKeyFile + "&5;25&4&A&1"
    Call FATSCall (szCmnd)

    Open szDemoFile For Random As #2 Len = 105

    Dim szDemoData As String * 105
    Dim nCounter As Integer

    For nCounter = 1 To 290

        Get #2, nCounter, szDemoData

        LSet customers.DeletedMark$ = " "
        LSet customers.CustomerId$ = Mid$(szDemoData, 1, 5)
        LSet customers.Name$ = Mid$(szDemoData, 6, 25)
        LSet customers.Job$ = Mid$(szDemoData, 31, 25)
        LSet customers.Street$ = Mid$(szDemoData, 56, 25)
        LSet customers.Zip$ = Mid$(szDemoData, 81, 5)
        LSet customers.City$ = Mid$(szDemoData, 86, 20)

        '   "B" Build Record
        '
        '  This command corresponds to the command Insert Record (I)
        '  except that FATS does not perform writes to the operation
        '  system until its cache is full and the least-recently-used
        '  algorithm controlling the I/O buffer cache selects a buffer
        '  for reuse. FATS never writes to the index file unless the
        '  cache buffers are entirely filled during the operation.
        '  All other FATS commands will update the index file before
        '  returning to the calling program (if this feature had not
        '  been disabled with the Auto Refresh (Y) command).
        '
        '  When using this command, you cannot assume that any of your
        '  updates have been written to the disk until you either perform
        '  a close operation or execute the command Write Page Map (W).
        '  In the network environment you should open the file in exclusive
        '  open mode before you operate with this instruction.
        '
        '  This command decreases the time required for insert operations,
        '  and is especially useful for loading a large number of records.
        '
        '  The syntax of the command string:
        '
        '    szCmnd = "B\{FileNo}\{KeyStr1}[\{KeyStr2}[\{KeyStr3}]]"
        '
        '      FileNo     File number
        '
        '      KeyStr#    Key value

        szCmnd = "B\" & Str$(nFileNoCustKey)
        szCmnd = szCmnd & "\" & UCase$(RTrim$(customers.CustomerId$))
        szCmnd = szCmnd & "\" & UCase$(RTrim$(customers.Name$))
        szCmnd = szCmnd & "\" & UCase$(RTrim$(customers.Job$))
        szCmnd = szCmnd & "\" & customers.Zip$ & UCase$(RTrim$(customers.City$))

        Call FATSCall (szCmnd)

        If nFATSError <> 0 Then

            szMsg = "FATS-Error: " + Str$(nFATSError)
            MsgBox (szMsg)
            Exit For
        End If

        CustomerForm.StateLabel = Str$(dwFATSRecno) + " records"
        If (nCounter And 8) Then CustomerForm.StateLabel.Refresh

        Put #1, dwFATSRecno, customers

    Next nCounter

    Close #2

    Call FATSCall ("W\" & Str$(nFileNoCustKey))

    Call RecordFirst_Click

End Sub



Sub DrawButtons ()

    If dwCurrentRecno = 0 Then

        RecordNew.Enabled = False
        RecordDelete.Enabled = False
    Else

        RecordNew.Enabled = True
        RecordDelete.Enabled = True
    End If

End Sub



Sub Lists_Click ()

    RecordNew.Enabled = nListMode
    RecordSave.Enabled = nListMode
    RecordDelete.Enabled = nListMode
    Create.Enabled = nListMode
    RecordFirst.Enabled = nListMode
    RecordNext.Enabled = nListMode
    RecordSearch.Enabled = nListMode
    RecordPrev.Enabled = nListMode
    RecordLast.Enabled = nListMode
    CustomerId.Enabled = nListMode
    CName.Enabled = nListMode
    Job.Enabled = nListMode
    Street.Enabled = nListMode
    Zip.Enabled = nListMode
    City.Enabled = nListMode
    txtTitle.Visible = nListMode

    If nListMode = False Then

        nListMode = True
        list.Height = 2370
        dwCurrentRecno = 0
    Else

        nListMode = False
        RecordFirst_Click
    End If

    Option1.Visible = nListMode
    Option2.Visible = nListMode
    Option3.Visible = nListMode
    list.Visible = nListMode

End Sub



Sub Option1_Click ()

    Dim szCmnd As String

    list.Clear
    CustomerForm.StateLabel = "sorted in ascending order by NAME"

    '   "F" Search First
    '
    '  This command enables your application to retrieve the
    '  record number corresponding to the first key value for
    '  the specified key number.
    '
    '  The syntax of the command string:
    '
    '    szCmnd = "F\{KeyNo}\{FileNo}"
    '
    '      KeyNo      Key number
    '
    '      FileNo     File number

    szCmnd = "F\2\" & Str$(nFileNoCustKey)

LOOP1:

    Call FATSCall (szCmnd)
    If nFATSError <> 0 GoTo LABEL1

    list.AddItem szFATSkey

    '   "A" Search Next After
    '
    '  With this command your application can retrieve the record
    '  number corresponding to the first key value which is greater
    '  than the key value you specify.
    '  If a duplicate key exists, the next higher record number of
    '  the next duplicate will be returned. The key value you specify
    '  with "KeyString" don't have to be a valid key in the index file.
    '
    '  Unlike the "Search Next" command, this command can be used in
    '  a network environment.
    '
    '  The syntax of the command string:
    '
    '    szCmnd = "A\{KeyNo}\{RecNo}\{FileNo}\{KeyString}"
    '
    '      KeyNo      Key number
    '
    '      RecNo      Record number
    '
    '      FileNo     File number
    '
    '      KeyString  Key value

    szCmnd = "A\2\" & Str$(dwFATSRecno) & "\" & Str$(nFileNoCustKey) & "\" & szFATSkey

    GoTo LOOP1
LABEL1:

End Sub



Sub Option2_Click ()

    Dim szCmnd As String

    list.Clear
    CustomerForm.StateLabel = "sorted in ascending order by JOB"

    szCmnd = "F\3\" & Str$(nFileNoCustKey)

LOOP2:

    Call FATSCall (szCmnd)
    If nFATSError <> 0 GoTo LABEL2

    Get #1, dwFATSRecno, customers

    list.AddItem customers.Job$ + customers.Name$

    szCmnd = "A\3\" & Str$(dwFATSRecno) & "\" & Str$(nFileNoCustKey) & "\" & szFATSkey
    GoTo LOOP2

LABEL2:

End Sub



Sub Option3_Click ()

    Dim szCmnd As String

    list.Clear
    CustomerForm.StateLabel = "sorted in descending order by ZIP then CITY"

    '   "L" Search Last
    '
    '  This command enables your application to retrieve the
    '  record number corresponding to the last key value for
    '  the specified key number. If duplicates exist for the
    '  last key value, the record number returned identifies
    '  the last duplicate, that is, the one inserted most
    '  recently.
    '
    '  The syntax of the command string:
    '
    '    szCmnd = "L\{KeyNo}\{FileNo}"
    '
    '      KeyNo      Key number
    '
    '      FileNo     File number

    szCmnd = "L\4\" & Str$(nFileNoCustKey)

LOOP3:

    Call FATSCall (szCmnd)
    If nFATSError <> 0 GoTo LABEL3

    Get #1, dwFATSRecno, customers

    list.AddItem customers.Zip$ + customers.City$ + customers.Name$

    '   "E" Search Previous Before
    '
    '  With this command your application can retrieve the record
    '  number corresponding to the first key value which is less
    '  than the key value you specify.
    '  If a duplicate key exists, the next lower record number of
    '  the previous duplicate will be returned. The key value you
    '  specify with "KeyString" don't have to be a valid key in the
    '  index file.
    '
    '  Unlike the "Search Prev" command, this command can be used in
    '  a network environment.
    '
    '  The syntax of the command string:
    '
    '    szCmnd = "E\{KeyNo}\{RecNo}\{FileNo}\{KeyString}"
    '
    '      KeyNo      Key number
    '
    '      RecNo      Record number
    '
    '      FileNo     File number
    '
    '      KeyString  Key value

    szCmnd = "E\4\" & Str$(dwFATSRecno) & "\" & Str$(nFileNoCustKey) & "\" & szFATSkey
    GoTo LOOP3

LABEL3:

End Sub



Function replacekey (keyold$, keynew$, keynr%) As Integer

    Dim szCmnd As String
    Dim szMsg As String

    If keyold$ <> keynew$ Then

        '   "R" Replace Single Key
        '
        '  This command changes the key value "KeyStrOld" of the
        '  record specified over the variable "RecNo" into the new
        '  key value "KeyStrNew" with the same record number.
        '
        '  The syntax of the command string:
        '
        '    szCmnd = "R\{KeyNo}\{RecNo}\{FileNo}\{KeyStrOld}\{KeyStrNew}"
        '
        '      KeyNo      Key number
        '
        '      RecNo      Record number
        '
        '      FileNo     File number
        '
        '      KeyStrOld  Old key value
        '
        '      KeyStrNew  New key value

        szCmnd = "R\" & Str$(keynr%) & "\" & Str$(dwCurrentRecno) + "\" & Str$(nFileNoCustKey) & "\" & keyold$ & "\" & keynew$
        Call FATSCall (szCmnd)

        If nFATSError <> 0 Then

            szMsg = "FATS-Error: " + Str$(nFATSError) + szCmnd
            MsgBox (szMsg)

            replacekey = 0
            Exit Function
        End If
    End If

    replacekey = 1

End Function



Sub RecordFirst_Click ()

    '   "F" Search First
    '
    '  This command enables your application to retrieve the
    '  record number corresponding to the first key value for
    '  the specified key number.
    '
    '  The syntax of the command string:
    '
    '    szCmnd = "F\{KeyNo}\{FileNo}"
    '
    '      KeyNo      Key number
    '
    '      FileNo     File number

    Call FATSCall ("F\2\" & Str$(nFileNoCustKey))

    If nFATSError = 0 Then

        RecordLoad
    Else

        RecordNew_Click
    End If

End Sub



Sub RecordLoad ()

    Get #1, dwFATSRecno, customers

    dwCurrentRecno = dwFATSRecno

    CustomerId.Text = RTrim$(customers.CustomerId)
    CName.Text = RTrim$(customers.Name)
    Job.Text = RTrim$(customers.Job)
    CustomerForm.Street = RTrim$(customers.Street)
    Zip.Text = RTrim$(customers.Zip)
    City.Text = RTrim$(customers.City)
    CustomerForm.StateLabel = "RecNo: " + Str$(dwCurrentRecno)

    Call DrawButtons

End Sub



Sub RecordLast_Click ()

    '   "L" Search Last
    '
    '  This command enables your application to retrieve the
    '  record number corresponding to the last key value for
    '  the specified key number. If duplicates exist for the
    '  last key value, the record number returned identifies
    '  the last duplicate, that is, the one inserted most
    '  recently.
    '
    '  The syntax of the command string:
    '
    '    szCmnd = "L\{KeyNo}\{FileNo}"
    '
    '      KeyNo      Key number
    '
    '      FileNo     File number

    Call FATSCall ("L\2\" & Str$(nFileNoCustKey))

    If nFATSError = 0 Then RecordLoad

End Sub



Sub RecordDelete_Click ()

    Dim szCmnd As String
    Dim szMsg As String

    If dwCurrentRecno <> 0 Then

        '   "D" Delete Record
        '
        '  This command removes all primary keys that you have
        '  specified with the  Create Indexfile (C) command and
        '  releases the associated record number.
        '  FATS remembers the record number of the deleted record
        '  so that it can be reused automatically on future
        '  Inserts on a last-in, first-out basis.
        '
        '  Note the fact that with this command only primary keys
        '  are deleted. Additional keys created with the Insert
        '  Single Key (1) command have to be deleted with the
        '  Delete Single Key (2) command.
        '
        '  The syntax of the command string:
        '
        '    szCmnd = "D\{RecNo}\{DelFlag}\{FileNo}\{KeyStr1}[\{KeyStr2}...]"
        '
        '      RecNo      Record number
        '
        '      DelFlag    Switch (Y/N)
        '                 With set switch ("Y") FATS checks the presence
        '                 of all transferred primary keys before any are
        '                 deleted. By this option the erasing process
        '                 needs somewhat more time
        '
        '      FileNo     File number
        '
        '      KeyStr#    Key value

        szCmnd = "D\" & Str$(dwCurrentRecno) & "\Y\" & Str$(nFileNoCustKey)
        szCmnd = szCmnd & "\" & UCase$(RTrim$(customers.CustomerId$))
        szCmnd = szCmnd & "\" & UCase$(RTrim$(customers.Name$))
        szCmnd = szCmnd & "\" & UCase$(RTrim$(customers.Job$))
        szCmnd = szCmnd & "\" & customers.Zip$ + UCase$(RTrim$(customers.City$))

        Call FATSCall (szCmnd)

        If nFATSError <> 0 Then

            szMsg = "FATS-Error: " + Str$(nFATSError)
            MsgBox (szMsg)
            Exit Sub
        End If

        customers.DeletedMark = "D"

        Put #1, dwFATSRecno, customers

        Call RecordNew_Click
    End If

End Sub



Sub RecordNext_Click ()

    '   "A" Search Next After
    '
    '  With this command your application can retrieve the record
    '  number corresponding to the first key value which is greater
    '  than the key value you specify.
    '  If a duplicate key exists, the next higher record number of
    '  the next duplicate will be returned. The key value you specify
    '  with "KeyString" don't have to be a valid key in the index file.
    '
    '  Unlike the "Search Next" command, this command can be used in
    '  a network environment.
    '
    '  The syntax of the command string:
    '
    '    szCmnd = "A\{KeyNo}\{RecNo}\{FileNo}\{KeyString}"
    '
    '      KeyNo      Key number
    '
    '      RecNo      Record number
    '
    '      FileNo     File number
    '
    '      KeyString  Key value

    Call FATSCall ("A\2\" & Str$(dwCurrentRecno) & "\" & Str$(nFileNoCustKey) & "\" + UCase$(RTrim$(CName.Text)))

    If nFATSError = 0 Then RecordLoad

End Sub



Sub RecordNew_Click ()

    dwCurrentRecno = 0
    CustomerId.Text = ""
    CName.Text = ""
    Job.Text = ""
    CustomerForm.Street = ""
    Zip.Text = ""
    City.Text = ""
    CustomerForm.StateLabel = "New Record"

    Call DrawButtons

End Sub



Sub RecordSave_Click ()

    Dim szCmnd As String
    Dim szStr1 As String
    Dim szStr2 As String
    Dim szMsg As String

    szStr2 = Zip.Text
    If Len(szStr2) < 5 Then szStr2 = szStr2 + Space$(5 - Len(szStr2))
    szStr2 = szStr2 + UCase$(RTrim$(City.Text))

    If dwCurrentRecno = 0 Then

        '   "I" Insert Record
        '
        '  This command is used to insert the primary keys of a new
        '  data record into the index file. After the insert, the
        '  record number of the new record is returned in the "RECNO"
        '  variable. You can use this record number to write the data
        '  record to the data file.
        '
        '  The number of keys included in the command string must equal
        '  the number of primary keys you specified in the
        '  Create Indexfile (C) command.
        '
        '  The length of the transferred keys may not exceed the maximum
        '  key length specified with the Create Indexfile (C) command.
        '  Variable length keys will be padded with the Ascii char 0 to
        '  the maximum key length.
        '
        '  The syntax of the command string:
        '
        '    szCmnd = "I\{FileNo}\{KeyStr1}[\{KeyStr2}[\{KeyStr3}]]"
        '
        '      FileNo     File number
        '
        '      KeyStr#    Key value

        szCmnd = "I\" & Str$(nFileNoCustKey)
        szCmnd = szCmnd & "\" & UCase$(RTrim$(CustomerId.Text))
        szCmnd = szCmnd & "\" & UCase$(RTrim$(CName.Text))
        szCmnd = szCmnd & "\" & UCase$(RTrim$(Job.Text))
        szCmnd = szCmnd & "\" & szStr2

        Call FATSCall (szCmnd)

        If nFATSError <> 0 Then

            szMsg = "FATS-Error: " + Str$(nFATSError) + szCmnd
            MsgBox (szMsg)
            Exit Sub
        End If

        LSet customers.Name = CName.Text
        LSet customers.Job = Job.Text
        LSet customers.Zip = Zip.Text
        LSet customers.City = City.Text
        dwCurrentRecno = dwFATSRecno
    Else

        If replacekey(UCase$(RTrim$(customers.CustomerId)), UCase$(RTrim$(CustomerId.Text)), 1) <> 0 Then LSet customers.CustomerId = CustomerId.Text
        If replacekey(UCase$(RTrim$(customers.Name)), UCase$(RTrim$(CName.Text)), 2) <> 0 Then LSet customers.Name = CName.Text
        If replacekey(UCase$(RTrim$(customers.Job)), UCase$(RTrim$(Job.Text)), 3) <> 0 Then LSet customers.Job = Job.Text

        szStr1 = customers.Zip + UCase$(RTrim$(customers.City))

        If replacekey(szStr1, szStr2, 4) <> 0 Then

            LSet customers.Zip = Zip.Text
            LSet customers.City = City.Text
        End If
    End If

    LSet customers.DeletedMark = " "
    LSet customers.CustomerId = CustomerId.Text
    LSet customers.Street = Street.Text

    Put #1, dwCurrentRecno, customers

    CustomerForm.StateLabel = "RecNo: " + Str$(dwCurrentRecno)
    Call DrawButtons

End Sub



Sub RecordSearch_Click ()

    '   "G" Search Generic
    '
    '  This command serves like the command Search (S) the search
    '  for a data record over the indicated key value, but no
    '  full information of the key is necessary here.
    '  FATS looks up for the first key, which begins with the
    '  characters specified over "KeyString".
    '
    '  With the commands Search Next (N) and Search Next After (A)
    '  you can determine the following data records, but you have
    '  to compare the value of "KeyString" with the returned key
    '  value each time.
    '
    '  If FATS finds the requested key, it returns the key value
    '  in the FATSKEY variable and a errorcode of 0. Otherwise, it
    '  returns a nonzero status in the ERRORCODE variable indicating
    '  why it cannot find the key:
    '
    '    12  There is no key which starts with the characters
    '        specified over "KeyString",FATS returns the record
    '        number of the adjacent smaller key
    '
    '    13  The specified key was not found because it is smaller
    '        than all keys in the index file. FATS returns the first
    '        key in the file.
    '
    '    15  The specified key was not found because it is greater
    '        than all keys in the index file. FATS returns the last
    '        key in the file.
    '
    '    16  There wasn't inserted any keys into the index file.
    '
    '
    '  The syntax of the command string:
    '
    '    szCmnd = "G\{KeyNo}\{FileNo}\{KeyString}"
    '
    '      KeyNo      Key number
    '
    '      FileNo     File number
    '
    '      KeyString  Key value

    Call FATSCall ("G\2\" & Str$(nFileNoCustKey) & "\" & UCase$(RTrim$(CName.Text)))

    If nFATSError = 0 Or (nFATSError > 11 And nFATSError < 15) Then RecordLoad

End Sub



Sub RecordPrev_Click ()

    '   "E" Search Previous Before
    '
    '  With this command your application can retrieve the record
    '  number corresponding to the first key value which is less
    '  than the key value you specify.
    '  If a duplicate key exists, the next lower record number of
    '  the previous duplicate will be returned. The key value you
    '  specify with "KeyString" don't have to be a valid key in the
    '  index file.
    '
    '  Unlike the "Search Prev" command, this command can be used in
    '  a network environment.
    '
    '  The syntax of the command string:
    '
    '    szCmnd = "E\{KeyNo}\{RecNo}\{FileNo}\{KeyString}"
    '
    '      KeyNo      Key number
    '
    '      RecNo      Record number
    '
    '      FileNo     File number
    '
    '      KeyString  Key value

    Call FATSCall ("E\2\" + Str$(dwCurrentRecno) & "\" & Str$(nFileNoCustKey) & "\" & UCase$(RTrim$(CName.Text)))

    If nFATSError = 0 Then RecordLoad

End Sub

© 2008  GCS Software, Udo Gertz