| ![]() | ||||||||||||||||||||
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