Category : Windows 3.X Files
Archive   : MF-DB103.ZIP
Filename : BCARDS.FRM

 
Output of file : BCARDS.FRM contained in archive : MF-DB103.ZIP
VERSION 2.00
Begin Form bcard
BackColor = &H00C0C0C0&
Caption = "Business Cards"
ClientHeight = 4755
ClientLeft = 915
ClientTop = 1680
ClientWidth = 5475
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
Begin Menu mSep1121
Caption = "-"
End
Begin Menu mBottom
Caption = "&Bottom of index"
End
Begin Menu mTop
Caption = "&Top of index"
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 mBottom_Click ()
If PersonDBHndl = -1 Then
MsgBox "Open a database before trying this..."
Exit Sub
End If

PersonCurRec = mfBottom(TaskHndl, PersonDBHndl, PersonCurIndex)
' force refresh
Command1_Click 3
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 mTop_Click ()
If PersonDBHndl = -1 Then
MsgBox "Open a database before trying this..."
Exit Sub
End If

PersonCurRec = mfTop(TaskHndl, PersonDBHndl, PersonCurIndex)
' force refresh
Command1_Click 3

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



  3 Responses to “Category : Windows 3.X Files
Archive   : MF-DB103.ZIP
Filename : BCARDS.FRM

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/