VB编程-查询修改自己的数据库

VB编程-查询修改自己的数据库 Option Explicit Dim Employee As Person Dim OldContents As Person Dim Position As Long ' Position describes presentation order. Dim LastRecord As Long Dim FileName As String Dim FileNum As Integer Dim FieldDirty As Boolean Private Sub AddRecord_Click() Dim Ind As Integer If FileNum = 0 Then Exit Sub SaveRecordChanges For Ind = 0 To 6 Form1.FieldBoxes(Ind).Text = "" Next Ind GetFields LastRecord = LastRecord + 1 Put #FileNum, LastRecord, Employee Position = LastRecord ShowRecord End Sub Private Sub CleanUpFile() Dim CleanFileNum As Integer Dim Ind As Long Dim Confirm As Integer If FileNum = 0 Then Exit Sub Confirm = False CleanFileNum = FileOpener("~~Tmp~~.Tmp", conRandomFile, Len(Employee), Confirm) For Ind = 1 To LastRecord Get #FileNum, Ind, Employee ' Debug.print Ind; Employee.FirstName Put #CleanFileNum, Ind, Employee Next Ind Close ' Close all files. FileCopy "~~Tmp~~.Tmp", FileName FileNum = FileOpener(FileName, conRandomFile, Len(Employee), Confirm) Kill "~~Tmp~~.Tmp" End Sub Private Sub DeleteRecord_Click() Dim TempVar As Person Dim Ind As Integer Dim Msg As String If FileNum = 0 Then Exit Sub If LastRecord = 1 Then Msg = "This is the last record in the file. Deleting it will delete" Msg = Msg + " the entire file." Msg = Msg + " Record Editor will also be closed." Msg = Msg + " Choose OK to delete the file." Ind = MsgBox(Msg, 65, "About to delete file!") If Ind = vbOK Then Close (FileNum) On Error Resume Next Kill FileName Unload Form1 Else Exit Sub ' Cancel pressed. End If End If For Ind = Position To LastRecord - 1 Get #FileNum, Ind + 1, TempVar Put #FileNum, Ind, TempVar Next Ind LastRecord = LastRecord - 1 If Position > LastRecord Then Position = LastRecord End If CleanUpFile ShowRecord ' This displays the record that follows the deleted record. Exit Sub End Sub Private Sub ExitButton_Click() If FieldDirty Then SaveRecordChanges CleanUpFile Unload Form1 End Sub Private Sub FieldBoxes_Change(Index As Integer) FieldDirty = True End Sub Private Sub FieldBoxes_GotFocus(Index As Integer) FieldBoxes(Index).SelStart = 0 FieldBoxes(Index).SelLength = Len(FieldBoxes(Index).Text) End Sub Private Sub FieldBoxes_LostFocus(Index As Integer) If Val(FieldBoxes(2).Text) > 32767 Then MsgBox "Enter a number less than 32,768" FieldBoxes(2).SetFocus End If End Sub Private Sub Form_Load() Dim BoxCaption As String Dim NL As String Dim Msg As String ChDrive App.Path ChDir App.Path Form1.Show OpenFile_Click End Sub Private Sub Form_Unload(Cancel As Integer) End End Sub Private Sub GetFields() Employee.FirstName = Form1.FieldBoxes(0).Text Employee.LastName = Form1.FieldBoxes(1).Text If IsNumeric(Form1.FieldBoxes(2).Text) Then Employee.ID = CInt(Form1.FieldBoxes(2).Text) Else Employee.ID = 0 End If Employee.Title = Form1.FieldBoxes(3).Text If IsNumeric(Form1.FieldBoxes(4).Text) Then Employee.MonthlySalary = CDbl(CCur(Form1.FieldBoxes(4).Text)) Else Employee.MonthlySalary = CDbl(CCur(0)) End If If IsDate(Form1.FieldBoxes(5).Text) Then Employee.LastReviewDate = CLng(DateValue(Form1.FieldBoxes(5).Text)) Else Employee.LastReviewDate = CLng(DateValue("1/1/1753")) End If Employee.ReviewComments = Form1.FieldBoxes(6).Text End Sub Private Sub Initialize() LastRecord = LOF(FileNum) \ Len(Employee) ' Debug.print LOF(FileNum), Len(Employee), LastRecord Position = 1 If LastRecord < 1 Then GetFields OldContents = Employee AddRecord_Click Else ShowRecord End If End Sub Private Sub NextRecord_Click() Dim Msg As String SaveRecordChanges If Position = LastRecord Then Msg = "There are no records greater than " + Str(LastRecord) + "." MsgBox (Msg) Else Position = Position + 1 End If ShowRecord FieldDirty = False End Sub Private Sub OpenFile_Click() Dim Confirm As Integer Confirm = True If LastRecord > 0 Then SaveRecordChanges CleanUpFile End If FileNum = 0 Do While FileNum = 0 FileName = GetFileName("Enter the name of a file to create or open.") If FileName = "" Then FileIOFrame.Enabled = False If LastRecord > 0 Then Exit Sub Else End End If Else FileNum = FileOpener(FileName, conRandomFile, Len(Employee), Confirm) FileIOFrame.Enabled = True End If Loop Initialize FieldDirty = False End Sub Private Sub PreviousRecord_Click() SaveRecordChanges If Position = 1 Then MsgBox ("There are no records less than 1.") Else Position = Position - 1 End If ShowRecord End Sub Private Sub SaveRecordChanges() Dim ConvertVariant As Variant Dim Equal As Integer Equal = True If FileNum = 0 Then Exit Sub GetFields If Employee.FirstName <> OldContents.FirstName Then Equal = False If Employee.LastName <> OldContents.LastName Then Equal = False If Employee.ID <> OldContents.ID Then Equal = False If Employee.Title <> OldContents.Title Then Equal = False If Employee.MonthlySalary <> OldContents.MonthlySalary Then Equal = False If Employee.LastReviewDate <> OldContents.LastReviewDate Then Equal = False If Employee.ReviewComments <> OldContents.ReviewComments Then Equal = False If Not Equal Then ' Debug.print "Position:"; Position; " Name:"; Employee.FirstName Put #FileNum, Position, Employee End If End Sub Private Sub ShowRecord() If FileNum = 0 Then Exit Sub Get #FileNum, Position, Employee Dim ConvertVariant As Variant Form1.FieldBoxes(0).Text = Trim(Employee.FirstName) Form1.FieldBoxes(1).Text = Trim(Employee.LastName) If Employee.ID > 0 Then Form1.FieldBoxes(2).Text = LTrim(Str(Employee.ID)) Else Form1.FieldBoxes(2).Text = "" End If Form1.FieldBoxes(3) = Trim(Employee.Title) ConvertVariant = Employee.MonthlySalary ConvertVariant = CCur(ConvertVariant) If ConvertVariant > 0 Then Form1.FieldBoxes(4) = Format(ConvertVariant, "$#,##0.00;(#,##0.00)") Else Form1.FieldBoxes(4) = "" End If ConvertVariant = CDate(Employee.LastReviewDate) If ConvertVariant <> DateValue("1/1/1753") Then Form1.FieldBoxes(5).Text = ConvertVariant Else FieldBoxes(5) = "" End If Form1.FieldBoxes(6) = Trim(Employee.ReviewComments) GetFields OldContents = Employee UpdateCaption FieldBoxes(0).SetFocus End Sub Private Sub UpdateCaption() Dim Caption As String Caption = FileName + ": Record " + Str$(Position) Caption = Caption + " of " + Str$(LastRecord) Form1.Caption = Caption End Sub