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


The  FATS matchcode commands create a full-text index with the content of your data tables or -files.
Every word and every number is incorporated into the index, an "inverted list" is generated.

This index enables FATS to find each data record by specification of any terms in fractions of a second.

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

 "MC" Create Matchcode File
(Define, create and open a Matchcode-Index-File.)
 "MB" Build Matchcode
(Build the Matchcode-Index.)
 "O" Open Indexfile
(Makes a index file available for access.)
 "MI" Insert Matchcode
(Insert the contents of a record into the matchcode index.)
 "MD" Delete Matchcode
(Delete the contents of a record from the matchcode index.)
 "MS" Search in Matchcode
(Query the matchcode index, and setup an result set.)
 "MF" Get First Result
(Get the first record of the result set found by an Matchcode-Query.)
 "ML" Get Last Result
(Get the last record of the result set found by an Matchcode-Query.)
 "MN" Get Next Result
(Get the next record of the result set found by an Matchcode-Query.)
 "MA" Get Next Result After
(Get the next record of the result set found by an Matchcode-Query.)
 "ME" Get Previous Result Before
(Get the previous record of the result set found by an Matchcode-Query.)

VERSION 2.00
Begin Form CustomerForm
   BorderStyle     =   2
   Caption         =   "FATS test program"
   FontBold        =   -1  'True
   FontItalic      =   0   'False
   FontName        =   "MS Sans Serif"
   FontSize        =   9,6
   FontStrikethru  =   0   'False
   FontUnderline   =   0   'False
   Height          =   5664
   Left            =   1584
   LinkTopic       =   "KunStamm"
   ScaleHeight     =   5292
   ScaleWidth      =   5400
   Top             =   1596
   Width           =   5496
   Begin OptionButton txtSearchStatus
      Caption         =   "Primary Key Search:"
      Height          =   204
      Left            =   0
      TabIndex        =   30
      Top             =   380
      Width           =   5412
      Visible         =   0   'False
   End
   Begin CommandButton Lists
      Caption         =   "List &on"
      Height          =   375
      Left            =   3240
      TabIndex        =   29
      Top             =   0
      Width           =   1095
   End
   Begin CommandButton RecordDelete
      Caption         =   "Delete"
      Enabled         =   0   'False
      Height          =   375
      Left            =   2160
      TabIndex        =   28
      Top             =   0
      Width           =   1095
   End
   Begin CommandButton RecordSave
      Caption         =   "Save"
      Height          =   375
      Left            =   1080
      TabIndex        =   27
      Top             =   0
      Width           =   1095
   End
   Begin CommandButton RecordNew
      Caption         =   "New"
      Enabled         =   0   'False
      Height          =   375
      Left            =   0
      TabIndex        =   26
      Top             =   0
      Width           =   1095
   End
   Begin CommandButton RecordLast
      Caption         =   "&Last"
      Height          =   375
      Left            =   4320
      TabIndex        =   25
      Top             =   600
      Width           =   1095
   End
   Begin CommandButton RecordNext
      Caption         =   "&Next"
      Height          =   375
      Left            =   3240
      TabIndex        =   24
      Top             =   600
      Width           =   1095
   End
   Begin CommandButton RecordSearch
      Caption         =   "&Search"
      Height          =   375
      Left            =   2160
      TabIndex        =   23
      Top             =   600
      Width           =   1095
   End
   Begin CommandButton RecordPrev
      Caption         =   "&Prev"
      Height          =   375
      Left            =   1080
      TabIndex        =   22
      Top             =   600
      Width           =   1095
   End
   Begin CommandButton RecordFirst
      Caption         =   "&First"
      Height          =   375
      Left            =   0
      TabIndex        =   21
      Top             =   600
      Width           =   1095
   End
   Begin CommandButton CreateMatchcode
      Caption         =   "Create"
      Height          =   375
      Left            =   4320
      TabIndex        =   20
      Top             =   0
      Width           =   1095
   End
   Begin CommandButton CreateTestData
      Caption         =   "Create Test Data"
      Height          =   372
      Left            =   3720
      TabIndex        =   19
      Top             =   4920
      Width           =   1692
   End
   Begin ListBox List
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "Courier New"
      FontSize        =   9,6
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   270
      Left            =   120
      MultiSelect     =   0   'False
      TabIndex        =   18
      Top             =   2966
      Visible         =   0   'False
      Sorted          =   0   'False
      Width           =   5175
   End
   Begin Label txtMatchcode1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Matchcode Search in NAME:"
      Height          =   204
      Left            =   120
      TabIndex        =   1
      Top             =   1100
      Width           =   5172
   End
   Begin TextBox Matchcode1
      Height          =   288
      Left            =   120
      MaxLength       =   80
      TabIndex        =   9
      Top             =   1320
      Width           =   5172
   End
   Begin Label txtMatchcode2
      BackColor       =   &H00C0C0C0&
      Caption         =   "Matchcode Search in JOB:"
      Height          =   204
      Left            =   120
      TabIndex        =   2
      Top             =   1660
      Width           =   5172
   End
   Begin TextBox Matchcode2
      Height          =   288
      Left            =   120
      MaxLength       =   80
      TabIndex        =   10
      Top             =   1874
      Width           =   5172
   End
   Begin Label txtMatchcode3
      BackColor       =   &H00C0C0C0&
      Caption         =   "Matchcode Search in Zip + City:"
      Height          =   204
      Left            =   120
      TabIndex        =   3
      Top             =   2220
      Width           =   5172
   End
   Begin TextBox Matchcode3
      Height          =   288
      Left            =   120
      MaxLength       =   80
      TabIndex        =   11
      Top             =   2438
      Width           =   5172
   End
   Begin TextBox City
      Height          =   285
      Left            =   2280
      MaxLength       =   20
      TabIndex        =   17
      Top             =   4406
      Width           =   2655
   End
   Begin TextBox ZIP
      Height          =   285
      Left            =   1440
      MaxLength       =   5
      TabIndex        =   16
      Top             =   4406
      Width           =   735
   End
   Begin TextBox Street
      Height          =   285
      Left            =   1440
      MaxLength       =   25
      TabIndex        =   15
      Top             =   4046
      Width           =   3495
   End
   Begin TextBox Job
      Height          =   285
      Left            =   1440
      MaxLength       =   25
      TabIndex        =   14
      Top             =   3686
      Width           =   3495
   End
   Begin TextBox CName
      Height          =   285
      Left            =   1440
      MaxLength       =   25
      TabIndex        =   13
      Top             =   3326
      Width           =   3495
   End
   Begin TextBox CustomerId
      Height          =   285
      Left            =   1440
      MaxLength       =   5
      TabIndex        =   12
      Top             =   2966
      Width           =   735
   End
   Begin Label StateLabel
      Height          =   255
      Left            =   120
      TabIndex        =   22
      Top             =   4980
      Width           =   3492
   End
   Begin Label txtZipCity
      Caption         =   "Zip/City"
      Height          =   255
      Left            =   120
      TabIndex        =   8
      Top             =   4406
      Width           =   1215
   End
   Begin Label txtStreet
      Caption         =   "Street"
      Height          =   255
      Left            =   120
      TabIndex        =   7
      Top             =   4046
      Width           =   1215
   End
   Begin Label txtJob
      Caption         =   "Job"
      Height          =   255
      Left            =   120
      TabIndex        =   6
      Top             =   3686
      Width           =   1215
   End
   Begin Label txtName
      Caption         =   "Name"
      Height          =   255
      Left            =   120
      TabIndex        =   5
      Top             =   3326
      Width           =   1215
   End
   Begin Label txtCustomerId
      Caption         =   "Id"
      Height          =   255
      Left            =   120
      TabIndex        =   4
      Top             =   2966
      Width           =   1215
   End
End


Dim customers As custrec
Dim dwActualRecno As Long
Dim nListMode As Integer
Dim nSearchMode As Integer

Const nMaxHits = 20

'
'  Calling FATS
'
'  All commands provided by FATS can be executed with one function:
'
'    Private Declare Function dll_FATSCall Lib "FATSXW32.DLL" Alias "FATSLibCallA" (ByVal szCmnd As String, nErrorcode As Long, ByRef nKeylen As Long, ByVal dwFATSData As Long) As Long
'
'  The meaning of the used parameters:
'
'     szCmnd         With this command string you specify the actual
'                    FATS command. The available commands are described
'                    in the user manual.
'
'     nErrorcode     Your application must always pass this variable as
'                    the status parameter on a FATS call. After the
'                    FATS call, the application should always check the
'                    value of this variable. FATS returns a errorcode of
'                    0 after a successful operation. FATS indicates any
'                    errors which occur during processing by returning a
'                    nonzero value in the errorcode variable.
'                    In the manual you can find a list of all FATS
'                    errorcodes and their possible causes.
'
'     nKeyLen        This variable will contain the length of the key value
'                    of a found key after any normal search command (S,G,F..).
'
'                    To access the key value returned by FATS you have to code
'                    the following:
'
'                    If nKeylen > 0 Then
'                      szFATSkey = Space(nKeylen)
'                      Call dll_FATSGetKey(szFATSkey, 0)
'                    Else
'                      szFATSkey = ""
'                    End If
'
'                    in the case of a matchcode command:
'
'                    If a primary key was generated during the creation of
'                    the matchcode index file with the "K#:#" flag, it is
'                    made available via this variable to the application
'                    program.
'
'     Return Value:  Record Number
'



Sub CreateMatchcode_Click ()

    Dim szCmnd As String
    Dim szMsg As String
    Dim szFATSFile As String
    Dim dwCurRecno As Long

    '  ========================================================================
    '            Creating Matchcode Index
    '  ========================================================================

    If MsgBox("Do you want to rebuild the matchcode index ?", 260) <> 6 Then Exit Sub

    Call FATSCall ("K\" & Str$(nFileNoCustMatchcode))

    '  -------> Creating Matchcode Index File
    '
    '  With the command  "MC" Create Matchcode File, the most important
    '  query facilities are determined already while creating the
    '  matchcode index file. With the search-group flag ("I#"), several
    '  logically related data columns can be registered in a common index
    '  so that a query to this index resp. search group extends automatically
    '  over all these columns. A matchcode file manages up to 32 search
    '  groups that can be used for joined queries (using the "AND"-operator).
    '
    '  In this example the following search groups are defined:
    '
    '    Search Group    Fields
    '
    '        I1          NAME
    '        I2          JOB
    '        I3          ZIP & CITY
    '
    '  The syntax of the command string:
    '
    '    szCmnd = "MC\{FileName}\{Flags}\{FileNo}\{Col1def}[\{Col2def}]"
    '
    '      FileName   Filename, perhaps with an additional path
    '                 (i.e. C:/DATA/CUSTOMER.FMS or CUSTOMER.FMS)
    '
    '      Flags      Reserved, not used at the moment
    '
    '      FileNo     File number
    '
    '      Col#def    Definition of data column # (flags, separated by comma).
    '                 The content of the corresponding data columns is transferred
    '                 the commands "MB", "MI" and "MD" later in the order determined
    '                 by this command.
    '
    '                 I#  The content of the data column becomes part of search
    '                     group #. You can combine several columns into a logical
    '                     search group (e.g. first name, surname).
    '
    '                 C   The content of the data column is edited for word overall
    '                     searching, i.e. a search for "motorca" e.g. finds
    '                     "motorcar" and "motor caravan".
    '
    '                 N   Numbers are handled as words, i.e. during a search
    '                     according to "150", "12150" e.g. is also found.
    '
    '                 Further adjustments are possible and described in detail
    '                 in the user manual.

    szFATSFile = App.Path & "\" & "CUSTOMER.FTS"
    szCmnd = "&MC&" + szFATSFile + "&&" + Str$(nFileNoCustMatchcode) + "&I1&I2&I3"
    Call FATSCall (szCmnd)

    If uFATSError <> 0 Then

      szMsg = "FATS errorcode: " & Str$(uFATSError) & " (command: MC)"
      MsgBox (szMsg)
      Exit Sub
    End If

    Call DrawButtons(False)

    '  -------> Insert text into the matchcode index
    '
    '  After the matchcode file was generated, the content of the
    '  data columns may be with the command  "MB" Build Matchcode
    '  inserted into the matchcode index. The position of the
    '  data columns within the command string ("Col#data") corresponds
    '  to that with the call of command Create Matchcode File ("MC")
    '  determined definition.
    '
    '  The syntax of the command string:
    '
    '    szCmnd = "MB\{FileNo}\{RecNo}\{Col1data}[\{Col2data}[\{Col3data}]]"
    '
    '      FileNo     File number
    '
    '      RecNo      <> 0 Record- resp. id-number
    '                 == 0 Stop Build, no more records
    '
    '      Col#data   Content of data column #
    '
    '
    '  The following sample program code indexes contents of the
    '  entire data file within a loop:

    dwCurRecno = 0

    '  While indexing sequential data resources, the number specified
    '  via "RecNo" should correspond to the physical record number
    '  i.e. the first data record has number 1, the second record number 2..,
    '  in the case of data records marked as deleted, the content of the
    '  data columns is not specified ("MB\{FileNo}\{RecNo}").
    '
    '  The Build Matchcode (MB) command demands an ascending number as a
    '  "RecNo" argument i.e. the matchcode can not usually be indexed in
    '  the logical order of an index-key.
    '  The example program MCSORT shows how an application
    '  program might use the "MC" command to create the
    '  matchcode index in sorted order.

    Do

      Get #1, dwCurRecno + 1, customers

      If Not EOF(1) Then

        dwCurRecno = dwCurRecno + 1

        szCmnd = "MB\" & Str$(nFileNoCustMatchcode) & "\" + Str$(dwCurRecno)

        If customers.DeletedMark = " " Then

          szCmnd = szCmnd & "\" & RTrim$(customers.Name)
          szCmnd = szCmnd & "\" & RTrim$(customers.Job)
          szCmnd = szCmnd & "\" & RTrim$(customers.Zip & " " & customers.City)
        End If

        Call FATSCall (szCmnd)

        If uFATSError <> 0 Then

          szMsg = "FATS errorcode: " & Str$(uFATSError) & " (command: MB)"
          MsgBox (szMsg)
          Exit Sub
        End If

        CustomerForm.StateLabel = Str$(dwCurRecno) & " records"
        If ((dwCurRecno And 31) = 0) Then CustomerForm.StateLabel.Refresh

      Else

        '  After the last record was inserted the creating process
        '  has to be terminated with the command "MB\{FileNo}\0".
        '  Because this command closes the matchcode index file you don't
        '  have to do a close command.

        Call FATSCall ("MB\" & Str$(nFileNoCustMatchcode) & "\0")

        '  -------> Open matchcode index file
        '
        '  With the command  "O" Open Indexfile you open an existing
        '  matchcode index file with the opening flags defined with
        '  the command  "Y" Auto Refresh. After the file was opened
        '  it can be accessed under the file number you specified.

        szCmnd = "&O&" + szFATSFile + "&" + Str$(nFileNoCustMatchcode)
        Call FATSCall(szCmnd)

      End If

    Loop While Not EOF(1)

    Call DrawButtons(True)
    Call RecordFirst_Click

End Sub



Sub RecordLoad (dwNewRecno As Long, nListIndex As Integer)

    Get #1, dwNewRecno, customers

    If nListIndex >= 0 Then

      list.AddItem customers.Name & "|" & customers.Job & "|" & customers.Zip & " " & customers.City
      list.ItemData(nListIndex) = dwNewRecno
    End If

    If nListIndex <= 0 Then

      dwActualRecno = dwNewRecno

      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$(dwActualRecno)
      Call DrawButtons(True)
   End If

End Sub



Sub RecordSearch_Click ()

    Dim szCmnd As String

    '  ========================================================================
    '            Matchcode Search
    '  ========================================================================

    szCmnd = RTrim$(Matchcode1.Text)
    szCmnd = szCmnd & "\" & RTrim$(Matchcode2.Text)
    szCmnd = szCmnd & "\" & RTrim$(Matchcode3.Text)

    If (nListMode = True) Or (Len(szCmnd) > 2) Then

      nSearchMode = True

      '  -------> Search in Search-Group 1 (NAME)
      '
      '  The command   "MS" Search in Matchcode searches the matchcode
      '  index and fills the result set with the record- resp. ID-numbers
      '  of data records which include the searched terms. If FATS finds
      '  the requested terms, it returns the record- resp. ID-number of
      '  the first hit in the "dwRecno" variable and a errorcode of 0.
      '  The result set can then be read out with the browser commands
      '  ("MA", "ME", "MN", "MP" ...).
      '
      '  The syntax of the command string:
      '
      '    szCmnd = "MS\{FileNo}\{Flags}\{Total}\{SearchGrp1}[\{SearchGrp2}...]"
      '
      '    FileNo     File number
      '
      '    Flags      The search procedure can be adjusted by the specification
      '               of different flags. You find a description of the flags
      '               in the command reference.
      '
      '    Total      Maximum number of hits in the result set:
      '
      '                 0  All hits are set into the result set. This regulation
      '                    works very fast, however, no sorting occurs by means of
      '                    hit quality.
      '
      '                >0  It is attempted to put the specified number of hits into
      '                    the result set. These hits are subjected to a sorting
      '                    concerning their quality and then put into one of
      '                    7 sorting groups.
      '
      '    SearchGrp#  The in search group # searched terms.
      '
      '
      '  Different FATS commands can be used for further processing
      '  of the result table, depending on the program logic.
      '  The following example prints all hits on the output device:

      szCmnd = "MS\" & Str$(nFileNoCustMatchcode) & "\\0\" & szCmnd

    Else

      nSearchMode = False

      szCmnd = "G\2\" & Str$(nFileNoCustKey) & "\" & UCase$(RTrim$(CName.Text))

    End If

    CustomerForm.list.Clear

    Call FATSCall (szCmnd)

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

      Do

        Call RecordLoad(dwFATSRecno, CInt(list.ListCount))

        If (nSearchMode = True) And (list.ListCount < nMaxHits) Then

          '   "MN" Get Next Result (Matchcode)
          '
          '  This command enables your application to retrieve the record-
          '  resp. ID-number corresponding to the next data record of the
          '  result set generated via a preceding Search in Matchcode (MS)
          '  command.
          '
          '  The syntax of the command string:
          '
          '    szCmnd = "MN\{FileNo}"
          '
          '      FileNo     File number
          '
          '
          '  This command is reliable only if the last matchcode-command
          '  was either "MA", "ME", "MF", "MN", "MP" or "MS".
          '  If there is no hit in sequence FATS will return an errorcode
          '  of #15.

          Call FATSCall ("MN\" & Str$(nFileNoCustMatchcode))
        Else

          Exit Do
        End If
      Loop While uFATSError = 0

      '  The following browser commands are supported by FATS:
      '
      '    "MF" - Get First Result
      '    "ML" - Get Last Result
      '    "MP" - Get Previous Result
      '    "MN" - Get Next Result
      '    "MA" - Get Next Result After
      '    "ME" - Get Previous Result Before

      list.ListIndex = 0

      If (list.ListCount > 1) And (nListMode = False) Then Call Lists_Click
    Else

      If nSearchMode = True Then

        CustomerForm.RecordFirst.Enabled = False
        CustomerForm.RecordNext.Enabled = False
        CustomerForm.RecordPrev.Enabled = False
        CustomerForm.RecordLast.Enabled = False
        CustomerForm.StateLabel = "no records found"

        If uFATSError = 11 Then

          Call CreateMatchcode_Click

        ElseIf uFATSError = 241 Then

          MsgBox ( "Trial Version: Matchcode Index expired. Please rebuild Matchcode Index" )
        End If
      End If
    End If

    If nSearchMode = True Then

      CustomerForm.txtSearchStatus.Value = False
      CustomerForm.txtSearchStatus.Visible = True
      CustomerForm.txtSearchStatus.Caption = "Matchcode Search: ('" & RTrim$(Matchcode1.Text) & "','"  + RTrim$(Matchcode2.Text) & "','" & RTrim$(Matchcode3.Text) & "')"
    Else

      CustomerForm.txtSearchStatus.Visible = False
    End If

    CustomerForm.txtSearchStatus.Refresh

    If nListMode = False Then

      CustomerForm.Matchcode1.SetFocus
    Else

      CustomerForm.List.SetFocus
    End If

End Sub



Sub RecordFirst_Click ()

    If nSearchMode = True Then

      '   "MF" Get First Result (Matchcode)
      '
      '  This command enables your application to retrieve the record-
      '  resp. ID-number corresponding to the first data record of the
      '  result set generated via a preceding Search in Matchcode (MS)
      '  command.
      '
      '  The syntax of the command string:
      '
      '    szCmnd = "MF\{FileNo}"
      '
      '      FileNo     File number

      Call FATSCall ("MF\" & Str$(nFileNoCustMatchcode))
    Else

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

    End If

    If uFATSError = 0 Then

      Call RecordLoad(dwFATSRecno, -1)

    Else

      Call RecordNew_Click

    End If

End Sub



Sub RecordLast_Click ()

    If nSearchMode = True Then

      '   "ML" Get Last Result (Matchcode)
      '
      '  This command enables your application to retrieve the record-
      '  resp. ID-number corresponding to the last data record of the
      '  result set generated via a preceding Search in Matchcode (MS)
      '  command.
      '
      '  The syntax of the command string:
      '
      '    szCmnd = "ML\{FileNo}"
      '
      '      FileNo     File number

      Call FATSCall ("ML\" & Str$(nFileNoCustMatchcode))
    Else

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

    If uFATSError = 0 Then

      Call RecordLoad(dwFATSRecno, -1)
    End If

End Sub



Sub RecordPrev_Click ()

    If nSearchMode = True Then

      '   "ME" Get Previous Result Before (Matchcode)
      '
      '  This command searches in the result set generated via a preceding
      '  Search in Matchcode ("MS") command for the data record specified
      '  via "RecNo" and then scrolls to the previous hit. As a result,
      '  the record- resp. ID-number of the data record before the specified
      '  data record (in the result set) is given back to the application
      '  program.
      '
      '  The syntax of the command string:
      '
      '    szCmnd = "ME\{FileNo}\{RecNo}"
      '
      '      FileNo     File number
      '
      '      RecNo      Record- resp. id-number

      Call FATSCall ("ME\" & Str$(nFileNoCustMatchcode) & "\" & Str$(dwActualRecno))
    Else

      Call FATSCall ("E\2\" & Str$(dwActualRecno) & "\" & Str$(nFileNoCustKey) & "\" & UCase$(RTrim$(CName.Text)))
    End If

    If uFATSError = 0 Then

      Call RecordLoad(dwFATSRecno, -1)
    End If

End Sub



Sub RecordNext_Click ()

    If nSearchMode = True Then

      '   "MA" Get Next Result After (Matchcode)
      '
      '  The command 'MA' searches in the result set generated via a
      '  preceding Search in Matchcode ("MS") command for the data record
      '  specified via "RecNo" and then scrolls to the next hit. As a
      '  result, the record- resp. ID-number of the data record following
      '  the specified data record (in the result set) is given back to
      '  the application program.
      '
      '  The syntax of the command string:
      '
      '    szCmnd = "MA\{FileNo}\{RecNo}"
      '
      '      FileNo     File number
      '
      '      RecNo      Record- resp. id-number

      Call FATSCall ("MA\" & Str$(nFileNoCustMatchcode) & "\" & Str$(dwActualRecno))
    Else

      Call FATSCall ("A\2\" & Str$(dwActualRecno) & "\" & Str$(nFileNoCustKey) & "\" & UCase$(RTrim$(CName.Text)))
    End If

    If uFATSError = 0 Then

      Call RecordLoad(dwFATSRecno, -1)
    End If

End Sub



Sub RecordNew_Click ()

    dwActualRecno = 0
    CustomerForm.CustomerId.Text = ""
    CustomerForm.CName.Text = ""
    CustomerForm.Job.Text = ""
    CustomerForm.Street = ""
    CustomerForm.Zip.Text = ""
    CustomerForm.City.Text = ""

    CustomerForm.StateLabel = "New Record"
    Call txtSearchStatus_Click

End Sub



Sub RecordSave_Click ()

    Dim szCmnd As String
    Dim szKey3old As String
    Dim szKey3new As String
    Dim szMCinsert As String
    Dim szMCdelete As String
    Dim szMsg As String

    If Len(RTrim$(CustomerForm.CName.Text)) = 0 Then

      MsgBox ( "Please enter a customer name" )
      Exit Sub
    End If

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

    szMCinsert = RTrim$(CName.Text)
    szMCinsert = szMCinsert & "\" & RTrim$(Job.Text)
    szMCinsert = szMCinsert & "\" & RTrim$(Zip.Text) & " " & RTrim$(City.Text)

    If dwActualRecno = 0 Then

      szMCdelete = ""

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

      If uFATSError <> 0 Then

        szMsg = "FATS-Error: " & Str$(uFATSError) + 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
      dwActualRecno = dwFATSRecno

    Else

      szMCdelete = RTrim$(customers.Name)
      szMCdelete = szMCdelete & "\" & RTrim$(customers.Job)
      szMCdelete = szMCdelete & "\" & RTrim$(customers.Zip) & " " & RTrim$(customers.City)

      If szMCdelete = szMCinsert Then

        ' nothing has changed and we don't need to update the matchcode

        szMCdelete = ""
        szMCinsert = ""

      End If

      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

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

      If replacekey(szKey3old, szKey3new, 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, dwActualRecno, customers

    If Len(szMCdelete) Then

      Call FATSCall ("MD\" & Str$(nFileNoCustMatchcode) & "\" & Str$(dwActualRecno) & "\" & szMCdelete)
      If uFATSError <> 0 Then MsgBox ( "FATS-Error: " & Str$(uFATSError) & " (command MD)" )
    End If

    If Len(szMCinsert) Then

      '   "MI" Insert Matchcode
      '
      '  This command inserts the content of the data columns ("Col#data")
      '  of the specified data record ("RecNo") into the matchcode index.
      '
      '  The syntax of the command string:
      '
      '    szCmnd = "MI\{FileNo}\{RecNo}\{Col1data}[\{Col2data}[\{Col3data}]]"
      '
      '      FileNo     File number
      '
      '      RecNo      Record- resp. id-number
      '
      '      Col#data   Contents of data column #
      '
      '
      '  The position of the data columns within the command string ("Col#data")
      '  corresponds to that with the call of command Create Matchcode File ("MC")
      '  determined definition. The syntax of the command string corresponds to
      '  that of the Build Matchcode ("MB") command.
      '
      '  NOTE: If you want to change the content of a data record that has already
      '  been indexed, its previous content (before modification) must at first be
      '  removed from the matchcode index with the Delete Matchcode ("MD") command
      '  before the new content is inserted with this command.
      '
      '  In the case of recreation or reorganisation of the matchcode index file,
      '  the "Build Matchcode" (MB) command should be used instead of this command
      '  by reasons of speed.
      '
      '  If a primary key was defined during the generation of the matchcode
      '  index file (flag "K#:#"), the record number specified via "RecNo" then
      '  has no importance, i.e. the primary key must be specified (via "Col#data")
      '  as with the "MB"-command.

      Call FATSCall ("MI\" & Str$(nFileNoCustMatchcode) & "\" & Str$(dwActualRecno) & "\" & szMCinsert)
      If uFATSError <> 0 Then MsgBox ( "FATS-Error: " & Str$(uFATSError) & " (command MI)" )
    End If

    CustomerForm.StateLabel = "RecNo: " & Str$(dwActualRecno)
    Call txtSearchStatus_Click

End Sub



Function replacekey (szKeyold As String , szKeynew As String, nKeyno As Integer) As Integer

    Dim szCmnd As String
    Dim szMsg As String

    If szKeyold <> szKeynew Then

      szCmnd = "R\" & Str$(nKeyno) & "\" & Str$(dwActualRecno) & "\" & Str$(nFileNoCustKey) & "\" & szKeyold & "\" & szKeynew
      Call FATSCall (szCmnd)

      If uFATSError <> 0 Then

        szMsg = "FATS-Error: " & Str$(uFATSError) & szCmnd
        MsgBox (szMsg)
        replacekey = 0
        Exit Function

      End If
    End If

    replacekey = 1

End Function



Sub RecordDelete_Click ()

    Dim szCmnd As String
    Dim szMsg As String

    If dwActualRecno <> 0 Then

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

      If uFATSError <> 0 Then

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

      customers.DeletedMark = "D"
      Put #1, dwFATSRecno, customers

      '   "MD" Delete Matchcode
      '
      '  This command removes the content of the data columns ("Col#data")
      '  of the specified data record ("RecNo") from the matchcode index.
      '
      '  The syntax of the command string:
      '
      '    szCmnd = "MD\{FileNo}\{RecNo}\{Col1data}[\{Col2data}[\{Col3data}]]"
      '
      '      FileNo     File number
      '
      '      RecNo      Record- resp. id-number
      '
      '      Col#data   Contents of data column #
      '
      '
      '  The position of the data columns within the command string ("Col#data")
      '  corresponds to that with the call of command Create Matchcode File ("MC")
      '  determined definition. The syntax of the command string corresponds to
      '  that of the Build Matchcode ("MB") command.
      '
      '  An result set generated before calling of this command remains unchanged
      '  from this command, i.e. can possibly contain subsequently deleted data
      '  records.
      '
      '  If a primary key was defined during the generation of the matchcode
      '  index file (flag "K#:#"), the record number specified via "RecNo" then
      '  has no importance, i.e. the primary key must be specified (via "Col#data")
      '  as with the "MB"-command.

      szCmnd = "MD\" & Str$(nFileNoCustMatchcode) & "\" & Str$(dwFATSRecno)
      szCmnd = szCmnd & "\" & RTrim$(customers.Name)
      szCmnd = szCmnd & "\" & RTrim$(customers.Job)
      szCmnd = szCmnd & "\" & RTrim$(customers.Zip & " " & customers.City)

      Call FATSCall (szCmnd)
      If uFATSError <> 0 Then MsgBox ( "FATS-Error: " & Str$(uFATSError) + szCmnd )

      Call RecordNew_Click

    End If

End Sub



Sub CreateTestData_Click ()

    Dim szCmnd As String
    Dim szMsg As String
    Dim dwCurRecno As Long
    Dim szDemoFile As String
    Dim szKeyFile As String

    If MsgBox("Do you want to rebuild the data file ?", 260) <> 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

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

    Open szDemoFile For Random As #2 Len = 105
    Dim szDemodata As String * 105

    Call DrawButtons(False)

    dwCurRecno = 0

    Do

      Get #2, dwCurRecno + 1, szDemodata

      If Not EOF(2) Then

        dwCurRecno = dwCurRecno + 1

        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)

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

        If uFATSError <> 0 Then

          szMsg = "FATS-Error: " & Str$(uFATSError)
          MsgBox (szMsg)
          Exit Do
        End If

        Put #1, dwFATSRecno, customers

        CustomerForm.StateLabel = Str$(dwFATSRecno) & " records"
        If ((dwCurRecno And 31) = 0) Then CustomerForm.StateLabel.Refresh

      End If

    Loop While Not EOF(2)

    Close #2

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

    If Dir$(App.Path & "\" & "CUSTOMER.FTS") <> "" Then

      Call FATSCall ("K\" & Str$(nFileNoCustMatchcode))
      Kill (App.Path & "\" & "CUSTOMER.FTS")
    End If

    Call DrawButtons(True)
    Call RecordFirst_Click

End Sub



Sub DrawButtons (nEnable As Integer)

    If dwActualRecno = 0 Then

      CustomerForm.RecordNew.Enabled = False
      CustomerForm.RecordDelete.Enabled = False
    Else

      CustomerForm.RecordNew.Enabled = nEnable
      CustomerForm.RecordDelete.Enabled = nEnable
    End If

    CustomerForm.RecordFirst.Enabled = nEnable
    CustomerForm.RecordNext.Enabled = nEnable
    CustomerForm.RecordPrev.Enabled = nEnable
    CustomerForm.RecordLast.Enabled = nEnable
    CustomerForm.RecordSearch.Enabled = nEnable
    CustomerForm.RecordSave.Enabled = nEnable
    CustomerForm.CreateMatchcode.Enabled = nEnable
    CustomerForm.CreateTestData.Enabled = nEnable
    CustomerForm.Lists.Enabled = nEnable

End Sub



Sub Lists_Click ()

    Call DrawButtons(nListMode)
    CustomerForm.Lists.Enabled = True
    CustomerForm.RecordSearch.Enabled = True
    CustomerForm.CustomerId.Enabled = nListMode
    CustomerForm.CName.Enabled = nListMode
    CustomerForm.Job.Enabled = nListMode
    CustomerForm.Street.Enabled = nListMode
    CustomerForm.Zip.Enabled = nListMode
    CustomerForm.City.Enabled = nListMode

    If nListMode = False Then

      nListMode = True
      CustomerForm.Lists.Caption = "List &off"
      CustomerForm.List.Height = 1860
    Else

      nListMode = False
      CustomerForm.Lists.Caption = "List &on"
      CustomerForm.List.Clear

      If dwActualRecno <> 0 Then

        Call RecordLoad(dwActualRecno, -1)
        CustomerForm.CustomerId.SetFocus
      Else
        Call RecordNew_Click
      End If

    End If

    CustomerForm.list.Visible = nListMode

End Sub



Sub txtSearchStatus_Click ()

    nSearchMode = False
    CustomerForm.Matchcode1.Text = ""
    CustomerForm.Matchcode2.Text = ""
    CustomerForm.Matchcode3.Text = ""
    CustomerForm.txtSearchStatus.Visible = False

    If nListMode = False Then

      Call DrawButtons(True)
    End If

    CustomerForm.Matchcode1.SetFocus

End Sub



Sub Form_Resize ()

    CustomerForm.List.Width = 5175 + (CustomerForm.Width - 5496)

End Sub



Sub Matchcode1_KeyUp (KeyCode As Integer, Shift As Integer)

    If KeyCode = &HD Then CustomerForm.Matchcode2.SetFocus

End Sub


Sub Matchcode2_KeyUp (KeyCode As Integer, Shift As Integer)

    If KeyCode = &HD Then CustomerForm.Matchcode3.SetFocus

End Sub


Sub Matchcode3_KeyUp (KeyCode As Integer, Shift As Integer)

    If KeyCode = &HD Then Call RecordSearch_Click

End Sub


Sub List_Click ()

    Dim szState As String

    dwActualRecno = List.ItemData(List.ListIndex)

    szState = "Hit " & Str$(List.ListIndex + 1)
    If (list.ListCount < nMaxHits) Then

      szState = szState & " of " & Str$(list.ListCount)
    Else

      szState = szState & " of more than " & Str$(nMaxHits)
    End If
    CustomerForm.StateLabel = szState

End Sub


Sub List_DblClick ()

    Call Lists_Click

End Sub


Sub List_KeyUp (KeyCode As Integer, Shift As Integer)

    If KeyCode = &HD Then Call Lists_Click

End Sub

© 2008  GCS Software, Udo Gertz