 | FATS - Fast Access Tree System | |||
| Table of Contents | |||
| Programming Interfaces | |||
| Visual Basic for Windows 3.x | |||
| | ||||||||||||||||||||
The 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:
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.
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 FATSXVBW FATS1
Left = 4920
Top = 3266
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:
'
' Declare Sub FATSBASIC Lib "FATSXVBW.VBX" (ByVal szCmnd As String, nErrorcode%, dwRecno&, szFATSkey$)
'
' 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.
'
' szReturnKey This variable will contain the key value of a found
' key after any normal search command (S,G,F,L,N,P,A,E).
'
' 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.
'
' K#:# This switch activates the management of a primary key
' for this matchcode index file. The first value after
' the 'K' is the position of the data column within the
' key (1 == first part), the second value specifies the
' length of the data column valid as the key.
'
' Further adjustments are possible and described in detail
' in the user manual.
szFATSFile = App.Path & "\" & "CUSTSORT.FTS"
szCmnd = "&MC&" + szFATSFile + "&&" + Str$(nFileNoCustMatchcode) + "&K1:5&I1&I2&I3"
Call FATSCall (szCmnd)
'
' "MC\{Filename}\\{FileNo}\K#:#\I1\I2\I3"
'
' The flag K#:# enables the management of a primary key within
' the matchcode file. FATS normaly only uses the record number
' during the generation of a result set. In specific situations,
' if e.g. the physical record number is not known, or does not
' correspond to the ID specified with the MB-command, the generation
' of a primary key becomes necessary. The browser commands then also
' make in addition to the record- or ID-number this key available via
' the FATSKEY-variable to the application.
'
' With the use of this flag, FATS generates a supplementary file with
' the file extension .FMK which is used for the sequential storage of
' the key.
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
szCmnd = "F\2\" & Str$(nFileNoCustKey)
'
Do
Call FATSCall ( szCmnd )
If uFATSError = 0 Then
Get #1, dwFATSRecno, customers
dwCurRecno = dwCurRecno + 1
szCmnd = "MB\" & Str$(nFileNoCustMatchcode) & "\" + Str$(dwCurRecno)
' Add the primary key to the command string
szCmnd = szCmnd & "\" & RTrim$(customers.CustomerId)
szCmnd = szCmnd & "\" & RTrim$(customers.Name)
szCmnd = szCmnd & "\" & RTrim$(customers.Job)
szCmnd = szCmnd & "\" & RTrim$(customers.Zip & " " & customers.City)
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
szCmnd = "N\" & Str$(nFileNoCustKey)
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)
Exit Do
End If
Loop While Not uFATSError
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)
'
'
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 FATSCall ( "S\1\" & Str$(nFileNoCustKey) & "\" & szFATSkey )
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))
If uFATSError = 0 Then
Call FATSCall ( "S\1\" & Str$(nFileNoCustKey) & "\" & szFATSkey )
End If
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))
If uFATSError = 0 Then
Call FATSCall ( "S\1\" & Str$(nFileNoCustKey) & "\" & szFATSkey )
End If
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
' "MP" Get Previous Result (Matchcode)
'
' This command enables your application to retrieve the record-
' resp. ID-number corresponding to the previous data record of
' the result set generated via a preceding Search Matchcode (MS)
' command.
'
' The syntax of the command string:
'
' szCmnd = "MP\{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 previous hit in sequence FATS will return an
' errorcode of #13.
Call FATSCall ("MP\" & Str$(nFileNoCustMatchcode))
If uFATSError = 0 Then
Call FATSCall ( "S\1\" & Str$(nFileNoCustKey) & "\" & szFATSkey )
End If
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
' "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))
If uFATSError = 0 Then
Call FATSCall ( "S\1\" & Str$(nFileNoCustKey) & "\" & szFATSkey )
End If
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$(CustomerId.Text)
szMCinsert = 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.CustomerId)
szMCdelete = 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.CustomerId)
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 & "\" & "CUSTSORT.FTS") <> "" Then
Call FATSCall ("K\" & Str$(nFileNoCustMatchcode))
Kill (App.Path & "\" & "CUSTSORT.FTS")
Kill (App.Path & "\" & "CUSTSORT.FMK")
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