Category : Databases and related files
Archive   : MF-DB102.ZIP
Filename : BCARDS.FRM

VERSION 2.00
Begin Form bcard
BackColor = &H00C0C0C0&
Caption = "Business Cards"
Height = 5415
Left = 870
LinkTopic = "Form3"
ScaleHeight = 4755
ScaleWidth = 5475
Top = 1065
Width = 5565
Begin Frame gBox
BackColor = &H00C0C0C0&
Enabled = 0 'False
Height = 4695
Left = 60
TabIndex = 0
Top = 0
Width = 5355
Begin ComboBox Combo1
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 300
Left = 3180
Style = 2 'Dropdown List
TabIndex = 10
Top = 2940
Width = 1995
End
Begin TextBox Text1
Height = 285
Index = 0
Left = 180
TabIndex = 1
Top = 780
Width = 2115
End
Begin TextBox Text1
Height = 285
Index = 1
Left = 2340
TabIndex = 2
Top = 780
Width = 2835
End
Begin TextBox Text1
Height = 285
Index = 2
Left = 180
TabIndex = 4
Top = 1860
Width = 4995
End
Begin TextBox Text1
Height = 285
Index = 3
Left = 180
TabIndex = 5
Top = 2400
Width = 2595
End
Begin TextBox Text1
Height = 285
Index = 4
Left = 2880
TabIndex = 6
Top = 2400
Width = 435
End
Begin TextBox Text1
Height = 285
Index = 5
Left = 3660
TabIndex = 7
Top = 2400
Width = 1515
End
Begin TextBox Text1
Height = 285
Index = 6
Left = 180
TabIndex = 3
Top = 1320
Width = 4995
End
Begin CommandButton Command1
Caption = "&Next Card"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 375
Index = 0
Left = 120
TabIndex = 13
Top = 4140
Width = 1695
End
Begin CommandButton Command1
Caption = "&Previous Card"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 375
Index = 1
Left = 120
TabIndex = 12
Top = 3780
Width = 1695
End
Begin CommandButton Command2
Caption = "&Find Card"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 375
Left = 120
TabIndex = 11
Top = 3420
Width = 3315
End
Begin CommandButton Command3
Caption = "New &Card"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 375
Left = 1800
TabIndex = 14
Top = 3780
Width = 1635
End
Begin Frame Frame1
BackColor = &H00C0C0C0&
Caption = "Order by"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 1155
Left = 3660
TabIndex = 19
Top = 3360
Width = 1515
Begin OptionButton Option1
BackColor = &H00C0C0C0&
Caption = "Reference"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 255
Index = 2
Left = 180
TabIndex = 18
Top = 780
Width = 1215
End
Begin OptionButton Option1
BackColor = &H00C0C0C0&
Caption = "Person"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 255
Index = 0
Left = 180
TabIndex = 16
Top = 300
Value = -1 'True
Width = 1095
End
Begin OptionButton Option1
BackColor = &H00C0C0C0&
Caption = "Company"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 255
Index = 1
Left = 180
TabIndex = 17
Top = 540
Width = 1155
End
End
Begin TextBox Text1
Height = 285
Index = 7
Left = 180
TabIndex = 8
Top = 2940
Width = 1455
End
Begin TextBox Text1
Height = 285
Index = 8
Left = 1680
TabIndex = 9
Top = 2940
Width = 1455
End
Begin CommandButton Command4
Caption = "&Save Card"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 375
Left = 1800
TabIndex = 15
Top = 4140
Width = 1635
End
Begin Label LiveNum
BackColor = &H00C0C0C0&
Caption = "Live Records:"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 195
Left = 2580
TabIndex = 31
Top = 240
Width = 2175
End
Begin Label Label1
BackColor = &H00C0C0C0&
Caption = "Reference"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00FF0000&
Height = 255
Index = 9
Left = 3180
TabIndex = 30
Top = 2700
Width = 915
End
Begin Label Label1
BackColor = &H00C0C0C0&
Caption = "First Name"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00FF0000&
Height = 195
Index = 0
Left = 180
TabIndex = 29
Top = 540
Width = 915
End
Begin Label Label1
BackColor = &H00C0C0C0&
Caption = "Last Name"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00FF0000&
Height = 195
Index = 1
Left = 2340
TabIndex = 28
Top = 540
Width = 915
End
Begin Label Label1
BackColor = &H00C0C0C0&
Caption = "Address"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00FF0000&
Height = 255
Index = 2
Left = 180
TabIndex = 27
Top = 1620
Width = 915
End
Begin Label Label1
BackColor = &H00C0C0C0&
Caption = "City"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00FF0000&
Height = 255
Index = 3
Left = 180
TabIndex = 26
Top = 2160
Width = 915
End
Begin Label Label1
BackColor = &H00C0C0C0&
Caption = "State"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00FF0000&
Height = 255
Index = 4
Left = 2880
TabIndex = 25
Top = 2160
Width = 495
End
Begin Label Label1
BackColor = &H00C0C0C0&
Caption = "Zip Code"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00FF0000&
Height = 255
Index = 5
Left = 3660
TabIndex = 24
Top = 2160
Width = 915
End
Begin Label Label1
BackColor = &H00C0C0C0&
Caption = "Company"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00FF0000&
Height = 195
Index = 6
Left = 180
TabIndex = 23
Top = 1080
Width = 915
End
Begin Label Label1
BackColor = &H00C0C0C0&
Caption = "Voice"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00FF0000&
Height = 255
Index = 7
Left = 180
TabIndex = 22
Top = 2700
Width = 915
End
Begin Label Label1
BackColor = &H00C0C0C0&
Caption = "Fax"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00FF0000&
Height = 255
Index = 8
Left = 1680
TabIndex = 21
Top = 2700
Width = 915
End
Begin Label CardNum
BackColor = &H00C0C0C0&
Caption = "Card: 0/0"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 195
Left = 180
TabIndex = 20
Top = 240
Width = 2175
End
End
Begin Menu m_File
Caption = "&File"
Begin Menu m_InitDB
Caption = "&Create Card Databases..."
End
Begin Menu m_Sep1
Caption = "-"
End
Begin Menu m_Open
Caption = "&Open Cards..."
End
Begin Menu m_Close
Caption = "&Close Cards"
End
Begin Menu m_Sep2
Caption = "-"
End
Begin Menu m_Quit
Caption = "&Quit"
End
End
Begin Menu mOther
Caption = "&Other"
Begin Menu mLockRecord
Caption = "&Lock this record"
Shortcut = ^L
End
Begin Menu mSep1
Caption = "-"
End
Begin Menu mDelete
Caption = "&Delete current record"
Shortcut = ^D
End
Begin Menu mSepOther
Caption = "-"
End
Begin Menu mReIndex
Caption = "&ReIndex database"
End
Begin Menu mEditRefTbl
Caption = "&Edit Reference Table"
End
Begin Menu mSepOther2
Caption = "-"
End
Begin Menu mSevere
Caption = "&SP Demo"
Begin Menu mSevereLoad
Caption = "Load list using SP API"
End
Begin Menu mNormalLoad
Caption = "Load list using standard 'skips'"
End
Begin Menu SPSep
Caption = "-"
End
Begin Menu mSPCount
Caption = "Get COUNT- SP"
End
End
End
Begin Menu m_Test
Caption = "&Test"
Begin Menu m_AddXRnd
Caption = "&Add X - Random..."
End
Begin Menu m_RplXRandom
Caption = "&Replace X - Random..."
End
End
Begin Menu mHelp
Caption = "&Help"
Begin Menu mAbout
Caption = "&About..."
End
End
End
Option Explicit

' Change this to a location better for you...
Const CARDFILE = "C:\source\bcard"

Dim PersonDBHndl As Integer ' Handle to person db
Dim PersonCurIndex As Integer ' Current index selected
Dim PersonCurRec As Long ' Record currently in use...
Dim PersonTotRecs As Long ' total # of recs in person db



Dim curFile As String ' Curretly open DB file name

' Take data from disply and store in tCard
Function bcFillData% (c As tCard)
c.Person.fname = text1(0).Text
c.Person.lname = text1(1).Text
c.data.street = text1(2).Text
c.data.city = text1(3).Text
c.data.state = text1(4).Text
c.data.zip = text1(5).Text

c.company.cName = text1(6).Text


c.ref.ref = Combo1.ListIndex



c.data.voice = text1(7).Text
c.data.fax = text1(8).Text



End Function

' take data from var and display it
Function bcShowData% (c As tCard)
text1(0).Text = c.Person.fname
text1(1).Text = c.Person.lname
text1(2).Text = c.data.street
text1(3).Text = c.data.city
text1(4).Text = c.data.state
text1(5).Text = c.data.zip

text1(6).Text = c.company.cName
' since the 'random add' functions don't
' set this value properly -- we have to check
' for an error condition...
On Error Resume Next
Combo1.ListIndex = c.ref.ref
On Error GoTo 0

text1(7).Text = c.data.voice
text1(8).Text = c.data.fax
'Command4.Enabled = False
'command3.Enabled = False

' Updates statistics at the top of the screen...
UpdateStats



End Function

Sub Command1_Click (Index As Integer)
Dim PlusMinus As Integer
Dim NextRec As Long
Dim bcard As tCard

' Are They going FORWARD or BACKWARD
If Index = 0 Then
PlusMinus = 1 ' Next Record
ElseIf Index = 1 Then
PlusMinus = -1
Else
PlusMinus = 0 ' just force a re-display
End If
If PersonCurRec > 0 Then

PersonCurRec = mfSkip(PersonCurRec, PlusMinus, TaskHndl, PersonDBHndl, PersonCurIndex)
If PersonCurRec = MFSEEK_BOF Then
Beep
' They tried to skip past the begining of the file. Since we already
' overwrote the ptr to the previous record, we need to find out
' what the first record was...
PersonCurRec = mfTop(TaskHndl, PersonDBHndl, PersonCurIndex)
ElseIf PersonCurRec = MFSEEK_EOF Then
Beep
' They tried to skip past the END of the file. Since we already
' overwrote the ptr to the previous record, we need to find out
' what the first record was...
PersonCurRec = mfBottom(TaskHndl, PersonDBHndl, PersonCurIndex)
End If
junk = mfRead(PersonCurRec, bcard, TaskHndl, PersonDBHndl, MFRW_ALL)
Else
' We end up here if it's an empty database
PersonCurRec = 0
End If

If junk < 0 Then
' This shouldn't happen...
MsgBox "Bad Read"
End If
cardnum.Caption = curFile + " " + Format$(PersonCurRec) + " of " + Format$(PersonTotRecs) + " cards"
junk = bcShowData(bcard)

End Sub

' Find a record
Sub Command2_Click ()
Dim jump$, code%, jumpto&, s$, jumpint%

' Which Index do they have active? (Order by box)
If PersonCurIndex = 0 Then
s = "Seek String for Last/First name"
ElseIf PersonCurIndex = 1 Then
s = "Seek String for Company"
Else
s = "Seek String for Reference #"
End If
jump = InputBox$(s, "Record")

' NOTE: ALL seeks are SOFT. If you need an
' exact match, then assume if you fully specify
' a key, it will be an exact...
If PersonCurIndex = 2 Then ' search for a int...
' INTS/LONGS/ data types are passed with the
' MFSEEKO structure. Since STRINGS (mfseeks) don't pass well
' using the as ANY keyword, there is a special mfseeks. This
' is only a problem in VB. Any language that supports passing
' ptrs to data will work fine with mf.
jumpint = Val(jump)
PersonCurRec = mfSeekO(jumpint, code, TaskHndl, PersonDBHndl, PersonCurIndex)
Else
' SHOULD be padded to the length of the key
' else, it will probably not seek correctly
' (NOTE: Any padding you use for character keys
' should be consistent so you won't have to have
' alot of routines to do the seeking...
' (NOTE: MF doesn't care if you OVERPAD something. However, if you
' UNDERPAD something -- you could get a GPF. This is just the nature of
' the C language )
jump = jump + Pad(128, " ")
PersonCurRec = mfSeekS(jump, code, TaskHndl, PersonDBHndl, PersonCurIndex)
End If

If PersonCurRec = MFSEEK_EOF Then
MsgBox ("Search key was greater than any key in the database")
Else
If code = MFSEEK_EXACT_MATCH Then
MsgBox ("Exact Match")
Else ' code will equal 2...
MsgBox ("Closest Match")
End If
End If


' will update display with current record
Command1_Click -1

End Sub

Sub Command3_Click ()
' Add a new record
Dim bcard As tCard

junk = bcFillData(bcard)

' First, append a new record to the database.
' NOTE: ON APPENDS:
' PASS >>ONLY<< the DATA portion of the record. Do NOT pass the
' key along with the record.
PersonCurRec = mfAppendData(bcard.data, TaskHndl, PersonDBHndl)
' Now, we have a reference to the new record. We should proably
' verify that it is a good # (not negative).
If PersonCurRec > 0 Then

' The MFRW_ALL flag tells it to update ALL index fields. If we want
' to enhance the SPEED and we know we have blank fields, then we
' could have specified a specific index to update...
junki = mfWrite(PersonCurRec, bcard, TaskHndl, PersonDBHndl, MFRW_ALL)
If junki < 0 Then
MsgBox "Error on write:" + Format$(junki)
End If

' This will tell us how many records are now in the database
' The size of a record, and the number of index's
Dim vRecSize%, vNumIndex%, vNumRecs&, vLiveRecs&
junk = mfInfoDB(vRecSize, vNumIndex, vNumRecs, vLiveRecs, TaskHndl, PersonDBHndl)

PersonTotRecs = vNumRecs

Else
If junkl < 0 Then
MsgBox "Error on add: " + Format$(junkl)
End If
End If

cardnum.Caption = CARDFILE + " " + Format$(PersonCurRec) + "/" + Format$(PersonTotRecs)
LiveNum.Caption = "Live Records:" + Format$(vLiveRecs)

End Sub

Sub Command4_Click ()
' Re-write current record...
Dim bcard As tCard
If PersonCurRec > 0 Then
' General function to get TEXT fields into a structure
junk = bcFillData(bcard)

junkl = mfWrite(PersonCurRec, bcard, TaskHndl, PersonDBHndl, MFRW_ALL)

If junkl < 0 Then
MsgBox "Error on write:" + Format$(junkl)
End If
Else
MsgBox "Not a valid record to SAVE to"
End If


End Sub

Sub Command5_Click ()
' To see the 'size' (# of bytes in the key) of a particular index, just add a button (called command5) and
' this will show you the 'size' of the active index...
MsgBox "Index Size:" + Format$(mfInfoIndex(TaskHndl, PersonDBHndl, PersonCurIndex))

End Sub

Sub Form_Load ()
mfBeginRun

PersonDBHndl = -1

End Sub

Sub Form_Unload (Cancel As Integer)
' Will auto-close any open db's
mfEndRun


End Sub

' Place some sample data in the Reference database
Sub LoadSampleData (file$)
Dim ref As tReference

refDBHndl = mfOpen(file, TaskHndl)
ref.ref = 1
ref.refsub = 0
ref.name = "Stores"
junk = mfWrite(mfAppendData(ref.name, TaskHndl, refDBHndl), ref, TaskHndl, refDBHndl, MFRW_ALL)

ref.ref = 1
ref.refsub = 1
ref.name = "Pizza"
junk = mfWrite(mfAppendData(ref.name, TaskHndl, refDBHndl), ref, TaskHndl, refDBHndl, MFRW_ALL)

ref.ref = 1
ref.refsub = 2
ref.name = "Computer"
junk = mfWrite(mfAppendData(ref.name, TaskHndl, refDBHndl), ref, TaskHndl, refDBHndl, MFRW_ALL)

ref.ref = 1
ref.refsub = 3
ref.name = "Movies"
junk = mfWrite(mfAppendData(ref.name, TaskHndl, refDBHndl), ref, TaskHndl, refDBHndl, MFRW_ALL)

ref.ref = 2
ref.refsub = 0
ref.name = "Personal"
junk = mfWrite(mfAppendData(ref.name, TaskHndl, refDBHndl), ref, TaskHndl, refDBHndl, MFRW_ALL)

ref.ref = 2
ref.refsub = 1
ref.name = "Relatives"
junk = mfWrite(mfAppendData(ref.name, TaskHndl, refDBHndl), ref, TaskHndl, refDBHndl, MFRW_ALL)

ref.ref = 2
ref.refsub = 2
ref.name = "Friends"
junk = mfWrite(mfAppendData(ref.name, TaskHndl, refDBHndl), ref, TaskHndl, refDBHndl, MFRW_ALL)

junk = mfClose(refDBHndl, TaskHndl)

End Sub

Sub m_AddXRnd_Click ()
' Tests Adding X # of random cards to the database.
' This is mostly for data-verifaction/system stress test
' (Since we know the first thing you'll want to do is
' see if you can crash it, we left this in here...)
' If you are going to compare the 'speed' of MF with
' this function, feel free. We would like to offer
' the results, though, right now:
'
' We tested: 3 index's (2 characer, 1 integer... of same
' size)
' Clipper: (DOS)
' Recs/Second: 5 with LOCK, UNLOCK, FLUSHing
' (however, we were totally amazed that taking out the 'flush' brought around 150 records/second)
' unfortunately, the records weren't 'REAL' records and it wasn't a REAL network... oh well)
'
' vxBase: Recs/Second: 15 with LOCK, UNLOCK, WRITE
'
' mf: Generally, 20-30...

If PersonDBHndl = -1 Then
MsgBox "Open a database before trying this..."
Exit Sub
End If
Dim jump&, n&
Dim c As tCard

jump = Val(InputBox$("# of records to add?", "Add"))

c.data.street = ""
c.data.city = ""
c.data.state = "<>"
c.data.zip = ""
c.data.voice = ""
c.data.fax = ""
Randomize

screen.MousePointer = 11 ' Hourglass

For n = 1 To jump

c.Person.fname = Format$(Rnd)
c.Person.lname = Format$(Rnd)
c.company.cName = Format$(Rnd)
c.ref.ref = Rnd * 32000

PersonTotRecs = mfAppendData(c.data, TaskHndl, PersonDBHndl)

' NOTE: To see the 'effect' of INDEXING overhead (described in the
' Docs), comment out this line...and step back...
junkl = mfWrite(PersonTotRecs, c, TaskHndl, PersonDBHndl, MFRW_ALL)

If junkl < 0 Then
MsgBox "Error on add:" + Format$(junkl)
End If
If Int(n / 10) = n / 10 Then
cardnum.Caption = "Processed: " + Format$(n)
cardnum.Refresh
End If
' This creates, in effect, background processing...
junk = DoEvents()

Next n

screen.MousePointer = 0 ' Default
'PersonCurRec = PersonTotRecs
cardnum.Caption = CARDFILE + " " + Format$(PersonCurRec) + "/" + Format$(PersonTotRecs)


End Sub

' Closing database...
Sub m_Close_Click ()
m_Open.Enabled = True
m_Close.Enabled = False
gBox.Enabled = False

junk = mfClose(TaskHndl, PersonDBHndl)
junk = mfClose(TaskHndl, refDBHndl)
PersonDBHndl = -1


End Sub

' This demostrates creating a database
Sub m_InitDB_Click ()
Dim file$, recsize%
Dim Person As tPerson
Dim company As tCompany
Dim ref As tref
Dim bcard As tCard

If PersonDBHndl <> -1 Then
MsgBox "Close all databases before doing this..."
Exit Sub
End If


file = InputBox$("Enter File Name (7 character max -- no extension)", "Create CardFile", CARDFILE)
If Len(file) > 0 Then
screen.MousePointer = PHOURGLASS

' CREATE CARD DATABASE

' Calculate the size of an individual records 'data'
recsize = Len(bcard) - Len(Person) - Len(company) - Len(ref)

' Fill arrays with index parameters
' Note: we have 3 index's for this database
ReDim indSize(0 To 2) As tintArray
ReDim indType(0 To 2) As tintArray
indSize(0).i = Len(Person) ' Key 0 (index 0...)
indSize(1).i = Len(company) ' Key 1
indSize(2).i = Len(ref) ' Key 2

' This tells mf the TYPE of the index
indType(0).i = MFCOMP_CHARIC ' CHAR key - case insensitive
indType(1).i = 1001 ' UDK (user-defined key) - Sorts in 'reverse' order...
' (see mfUDK.c for example)
indType(2).i = MFCOMP_INT ' An integer key...

If mfCreateDB(file, recsize, 3, indSize(0), indType(0)) < 0 Then
MsgBox "Error creating card database"
End If

'**************************************
' CREATE REFERENCE DATABASE

file = file + "r"
' Calculate the size of an individual records 'data'
recsize = 25 ' size of the data portion of the record

' Fill arrays with index parameters
' Note: we have 1 index for this database
ReDim indSize(0 To 0) As tintArray
ReDim indType(0 To 0) As tintArray
indSize(0).i = 4 ' length of 2 integer keys...

' This tells mf the TYPE of the index
indType(0).i = MFCOMP_INT ' Integer key

If mfCreateDB(file, recsize, 1, indSize(0), indType(0)) > -1 Then
' Let's put some sample data into the REF database
LoadSampleData file

MsgBox "Databases Created Successfully"
Else
MsgBox "Error creating reference database"
End If
screen.MousePointer = PNORMAL

End If

End Sub

' Demostrates opening a couple of databases
Sub m_Open_Click ()
Dim vRecSize%, vNumIndex%, vNumRecs&, vLiveRecs&
Dim file$

file = InputBox$("Enter File Name", "Open CardFile", CARDFILE)
If Len(file) > 0 Then
' Call the open routine with the TASKhndl we recieved
' when the application started...
' PersonDBHndl will be > -1 if it can open a file...
PersonDBHndl = mfOpen(file, TaskHndl)
refDBHndl = mfOpen(file + "r", TaskHndl)

If PersonDBHndl > -1 Then
curFile = file

junk = mfInfoDB(vRecSize, vNumIndex, vNumRecs, vLiveRecs, TaskHndl, PersonDBHndl)
PersonTotRecs = vNumRecs
m_Open.Enabled = False
m_Close.Enabled = True
gBox.Enabled = True
PersonCurRec = mfTop(TaskHndl, PersonDBHndl, PersonCurIndex)

' Load the 'references' combo box
load_refs Combo1




Command1_Click -1 ' Force disply of top record...


Else
MsgBox "Error on open: " + Str$(PersonDBHndl)
End If
End If

End Sub

Sub m_Quit_Click ()
Unload bCardREf
Unload bcard

End Sub

Sub m_RplXRandom_Click ()
' Tests changing the key for X # of random cards to the database.
' This is mostly for data-verifaction/system stress test
' NOTE: Don't use this code as a SAMPLE! IT won't work in the real world.

If PersonDBHndl = -1 Then
MsgBox "Open a database before trying this..."
Exit Sub
End If


Dim jump&, n&
Dim c As tCard

jump = Val(InputBox$("# of records to replace?", "Add"))

c.data.street = ""
c.data.city = ""
c.data.state = "<>"
c.data.zip = ""
c.data.voice = ""
c.data.fax = ""
Randomize

screen.MousePointer = 11 ' Hourglass

For n = 1 To jump

c.Person.fname = Format$(Rnd)
c.Person.lname = Format$(Rnd)
c.company.cName = Format$(Rnd)
c.ref.ref = Rnd * 32000

junkl = mfWrite(n + PersonCurRec, c, TaskHndl, PersonDBHndl, MFRW_ALL)

If junkl < 0 Then
MsgBox "Error on replace:" + Format$(junkl)
End If
If Int(n / 10) = n / 10 Then
cardnum.Caption = "Processed: " + Format$(n)
cardnum.Refresh
End If


Next n

screen.MousePointer = 0 ' Default
'PersonCurRec = PersonTotRecs
cardnum.Caption = CARDFILE + " " + Format$(PersonCurRec) + "/" + Format$(PersonTotRecs)

End Sub

Sub mAbout_Click ()
MsgBox "Business Cards -- This application is freeware. All source code may be used for any purpose you see fit. However, the mf.BAS file is copyright 1993 by Carl Brown"
End Sub

Sub mDelete_Click ()
If PersonDBHndl = -1 Then
MsgBox "Open a database before trying this..."
Exit Sub
End If
If PersonCurRec < 1 Then
MsgBox "Move to a record before selecting this option..."
Exit Sub
End If

' Delete selected record
junki = mfDelete(PersonCurRec, TaskHndl, PersonDBHndl)
PersonCurRec = mfTop(TaskHndl, PersonDBHndl, PersonCurIndex)
Command1_Click 2 ' update display
End Sub

Sub mEditRefTbl_Click ()
bCardREf.Show
End Sub

Sub mLockRecord_Click ()

' In a real world app, you would probably 'enable'
' the edit controls so the user could change
' the record without worrying about someone
' overwriting their changes.
If mfLock(PersonCurRec, TaskHndl, PersonDBHndl) = 0 Then
MsgBox "Record Locked!"
If mfUnLock(PersonCurRec, TaskHndl, PersonDBHndl) <> 0 Then
MsgBox "Unable to unlock record!"
End If
Else
MsgBox "Record already locked by another user!"
End If


End Sub

' This demonstrates the difference in speed between the
' severe-performance functions in mf and the 'standard' performance
' functions in mf (and other databases...)
' NOTE: This is JUST meant to give you a general idea...
Sub mNormalLoad_Click ()
If PersonDBHndl = -1 Then
MsgBox "Open a database before trying this..."
Exit Sub
End If
Dim hits&, MAX_HITS&, startTime As Variant, n%, startRec&, rCode%, skStr$

MAX_HITS = 1000
screen.MousePointer = PHOURGLASS
startTime = Time
' NOTE:
' We MUST have a 'seek' string padded to AT LEAST the maximum length of
' the index we are about to seek into. If we don't, MF MAY GPF on us
' because it will be trying to look at memory that could straddle a segment
' boundary. Space(100) forces plenty of extra padding at the end of the seek string
skStr = "0" + Space$(100)
startRec = mfSeekS("0", rCode, TaskHndl, PersonDBHndl, 0)
If startRec > 0 Then
For n = 0 To MAX_HITS
' First off, in order to get a 'partial-key', we would have to 'read' each record to see if it matched
' but, the point of this demo is to show the difference in 'skips' vs. readlists...
' So, these two are not equal. The readlist is actually even FASTER than this
' because readlist returns the actual 'matching' list...
startRec = mfSkip(startRec, 1, TaskHndl, PersonDBHndl, 0)
' make sure we don't hit EOF
If startRec < 1 Then
Exit For
End If

Next n
Else
MsgBox "Unable to start processing because nothing 'matched' the starting position..."
End If

MsgBox "Elapsed time: " + Format$(Time - startTime) + " # of (potential) records read: " + Format$(n)
screen.MousePointer = PNORMAL

End Sub

' Demonstration of reindexing
Sub mReIndex_Click ()

' Make a 'form' that will supply screen updates
' The form actually contains the code to perform
' the reindexing (see the Form_Load stuff...)
junki = PersonDBHndl

' Since the form unloads in it's LOAD procedure,
' we need to trap the error...
On Error Resume Next
IndexForm.Show asmodal
On Error GoTo 0
If junki < 0 Then
MsgBox "Reindexing failed! Restart BCards..."
End If

PersonDBHndl = junki



End Sub

' Demonstrates using a 'severe-performance' function
' Use the 'Add X random records' (menu option)
' to add a bunch of records that will be retrieved by
' this function...
Sub mSevereLoad_Click ()

If PersonDBHndl = -1 Then
MsgBox "Open a database before trying this..."
Exit Sub
End If
Dim hits&, MAX_HITS&, startTime As Variant, TopRecord&

MAX_HITS = 1000
ReDim hitList(0 To MAX_HITS) As tLongArray
' This example reads UP TO 1000 records (in sequential order) that start with
' the character "0". The THIRD parm (a '1') tells the read API call to only
' process the FIRST character in the index field.
' Since we are seeking on a STRING index, we must use the readListS api call...
' NOTE: The reason we use the "0" as the example is: If you use the random
' ADD functions (under TEST) alot of "0.xxxxxxxx" names get created...
screen.MousePointer = PHOURGLASS ' This is SO fast, you may not need this...
startTime = Time
hits = mfReadListS(0, "0", 1, hitList(0), MAX_HITS, TaskHndl, PersonDBHndl, 0)
screen.MousePointer = PNORMAL
MsgBox "Elapsed time: " + Format$(Time - startTime) + " " + "# of records read: " + Format$(hits)

' Demos a 'continuation set' read. e.g. lets say there are too many hits to
' load in RAM. You would have to continue the process using a second read...
' This is here just to show 'HOW' it would be done. This wont actually work unless you
' have over 1000 hits to retrieve. If you would like to see it work, make sure you put
' over 1000 records in your database (or cut back on the 'MAX_HITS' value...)

'hits = mfReadListS(hitList(MAX_HITS), "0", 1, hitList(0), MAX_HITS, TaskHndl, personDBHndl, 0)


' Demos a 'list' of sequential records. If you just want the first '1000' records, and
' don't care about a particular 'key', use this.
'ReDim hitList(0 To MAX_HITS) As tLongArray
'TopRecord = mfTop(TaskHndl, personDBHndl, 0)
'hits = mfReadListNull(TopRecord, 0&, -1, hitList(0), MAX_HITS, TaskHndl, personDBHndl, 0)

End Sub

' Demos using the readlist COUNT option
' See the mSevereLoad for more comments
Sub mSPCount_Click ()

If PersonDBHndl = -1 Then
MsgBox "Open a database before trying this..."
Exit Sub
End If
Dim hits&, startTime As Variant


ReDim hitList(0 To 0) As tLongArray
screen.MousePointer = PHOURGLASS ' This is SO fast, you may not need this...
startTime = Time
hits = mfReadListS(0, "0", 1, hitList(0), MF_SP_COUNT, TaskHndl, PersonDBHndl, 0)
screen.MousePointer = PNORMAL
MsgBox "Elapsed time: " + Format$(Time - startTime) + " " + "# of records matching filter: " + Format$(hits)


End Sub

Sub Option1_Click (Index As Integer)
PersonCurIndex = Index
End Sub

Sub Text1_Change (Index As Integer)
Command4.Enabled = True
command3.Enabled = True
End Sub

' Displays database information
Sub UpdateStats ()
Dim vRecSize%, vNumIndex%, vNumRecs&, vLiveRecs&
junk = mfInfoDB(vRecSize, vNumIndex, vNumRecs, vLiveRecs, TaskHndl, PersonDBHndl)

cardnum.Caption = CARDFILE + " " + Format$(PersonCurRec) + "/" + Format$(PersonTotRecs)
LiveNum.Caption = "Live Records:" + Format$(vLiveRecs)

End Sub