房地产评估软件2.frm

一个数据库应用程序

   End
   Begin VB.Menu help 
      Caption         =   "帮助"
   End
   Begin VB.Menu gx 
      Caption         =   "更新"
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim path As String
Dim strsql As String

Private Sub doshell()

If path <> "" Then

Call Shell(path, 1)
strsql = ""
path = ""
Else
MsgBox "对应的程序不存在!", vbCritical, "错误!"
strsql = ""
path = "'"
Exit Sub
End If




End Sub






Private Sub about_Click()
Form_about.Show

End Sub

Private Sub Cmd_exit_Click(Index As Integer)
End
End Sub

Private Sub Cmd_tsz_Click()

Dim msg As String
kl = Label5.Caption
msg = MsgBox("你真的要删除" & kl & "这个文件吗?删除文件请小心！！", vbYesNoCancel, "注意")
If msg = vbYes Then
 Kill kl
 MsgBox "文件顺利删除！", vbOKOnly, "删除成功"
 
 Else
MsgBox "想清楚了再删吧!!^_^", vbOKOnly, "删除失败"
End If
End Sub
Private Sub Cmdqtcx_Click()
Call Shell(App.path & "\mdb.exe", 1)
End Sub



Private Sub Cmdtj_Click()
Dim re As String
Dim aj As String
re = MsgBox("请确认已选择程序路径!!", vbYesNoCancel, "注意")

If re = vbYes Then
 Data1.RecordSource = "select * from yscx where anjian='" & Combo2(0).Text & "'"
  Data1.Refresh
 If Data1.Recordset.EOF Then
   Data1.Recordset.AddNew
   Data1.Recordset.Fields("anjian") = Combo2(0).Text
   Data1.Recordset.Fields("bieming") = txtbm.Text
   Data1.Recordset.Fields("lujing") = Label5.Caption
   MsgBox "顺利添加!!", vbCritical, "添加成功"
   Data1.Recordset.Update
   Data1.Refresh
    Data1.Recordset.MoveFirst
   Call locate
 Else
  
  Data1.Recordset.Edit
  Data1.Recordset.Fields("anjian") = Combo2(0).Text
  Data1.Recordset.Fields("bieming") = txtbm.Text
  Data1.Recordset.Fields("lujing") = Label5.Caption
  MsgBox "修改添加!!", vbCritical, "修改成功"
  Data1.Recordset.Update
  Data1.Refresh
  Data1.Recordset.MoveFirst
  Call locate
 End If

 Else
  MsgBox "请重新选择程序路径!!", vbCritical, "注意"
  Exit Sub
End If
End Sub

Private Sub Combo1_click()
File1.Pattern = Combo1.Text
End Sub


Private Sub Command1_Click()
Formsnow.Show
Me.Hide
End Sub

Private Sub Command2_Click(Index As Integer)
Select Case Index
 Case 0
   Data1.RecordSource = "select * from yscx where anjian = 'Command2(0)'"
   Data1.Refresh
  If Data1.Recordset.EOF Then
    MsgBox "文件不存在！！", vbCritical, "注意！！"
    Exit Sub
  Else
    path = Data1.Recordset.Fields("lujing")
    Call doshell
  End If
Case 1
   Data1.RecordSource = "select * from yscx where anjian = 'Command2(1)'"
   Data1.Refresh
   If Data1.Recordset.EOF Then                       '--------------------------------文件不存在判断
    MsgBox "文件不存在！！", vbCritical, "注意！！"
    Exit Sub
  Else
    path = Data1.Recordset.Fields("lujing")
    Call doshell
   End If
Case 2
   Data1.RecordSource = "select * from yscx where anjian = 'Command2(2)'"
   Data1.Refresh
 If Data1.Recordset.EOF Then
    MsgBox "文件不存在！！", vbCritical, "注意！！"
    Exit Sub
  Else
    path = Data1.Recordset.Fields("lujing")
    Call doshell
   End If
Case 3
   Data1.RecordSource = "select * from yscx where anjian = 'Command2(3)'"
   Data1.Refresh
   If Data1.Recordset.EOF Then
     MsgBox "文件不存在！！", vbCritical, "注意！！"
     Exit Sub
   Else
     path = Data1.Recordset.Fields("lujing")
     Call doshell
   End If
Case 4
   Data1.RecordSource = "select * from yscx where anjian = 'Command2(4)'"
   Data1.Refresh
    If Data1.Recordset.EOF Then
     MsgBox "文件不存在！！", vbCritical, "注意！！"
     Exit Sub
   Else
     path = Data1.Recordset.Fields("lujing")
     Call doshell
   End If
 Case 5
   Data1.RecordSource = "select * from yscx where anjian = 'Command2(5)'"
   Data1.Refresh
    If Data1.Recordset.EOF Then
     MsgBox "文件不存在！！", vbCritical, "注意！！"
     Exit Sub
   Else
     path = Data1.Recordset.Fields("lujing")
     Call doshell
   End If
Case 6
   Data1.RecordSource = "select * from yscx where anjian = 'Command2(6)'"
   Data1.Refresh
    If Data1.Recordset.EOF Then
     MsgBox "文件不存在！！", vbCritical, "注意！！"
     Exit Sub
   Else
     path = Data1.Recordset.Fields("lujing")
     Call doshell
   End If
Case 7
   Data1.RecordSource = "select * from yscx where anjian = 'Command2(7)'"
   Data1.Refresh
    If Data1.Recordset.EOF Then
     MsgBox "文件不存在！！", vbCritical, "注意！！"
     Exit Sub
   Else
     path = Data1.Recordset.Fields("lujing")
     Call doshell
   End If
Case 8
   Data1.RecordSource = "select * from yscx where anjian = 'Command2(8)'"
   Data1.Refresh
    If Data1.Recordset.EOF Then
     MsgBox "文件不存在！！", vbCritical, "注意！！"
     Exit Sub
   Else
     path = Data1.Recordset.Fields("lujing")
     Call doshell
   End If
Case 9
   Data1.RecordSource = "select * from yscx where anjian = 'Command2(9)'"
   Data1.Refresh
    If Data1.Recordset.EOF Then
     MsgBox "文件不存在！！", vbCritical, "注意！！"
     Exit Sub
   Else
     path = Data1.Recordset.Fields("lujing")
     Call doshell
   End If
 Case 10
   Data1.RecordSource = "select * from yscx where anjian = 'Command2(10)'"
   Data1.Refresh
    If Data1.Recordset.EOF Then
     MsgBox "文件不存在！！", vbCritical, "注意！！"
     Exit Sub
   Else
     path = Data1.Recordset.Fields("lujing")
     Call doshell
   End If
Case 11
   Data1.RecordSource = "select * from yscx where anjian = 'Command2(11)'"
   Data1.Refresh
    If Data1.Recordset.EOF Then
     MsgBox "文件不存在！！", vbCritical, "注意！！"
     Exit Sub
   Else
     path = Data1.Recordset.Fields("lujing")
     Call doshell
   End If
Case 12
   Data1.RecordSource = "select * from yscx where anjian = 'Command2(12)'"
   Data1.Refresh
     If Data1.Recordset.EOF Then
       MsgBox "文件不存在！！", vbCritical, "注意！！"
     Exit Sub
   Else
     path = Data1.Recordset.Fields("lujing")
     Call doshell
   End If
Case 13
   Data1.RecordSource = "select * from yscx where anjian = 'Command2(13)'"
   Data1.Refresh
    If Data1.Recordset.EOF Then
     MsgBox "文件不存在！！", vbCritical, "注意！！"
     Exit Sub
   Else
     path = Data1.Recordset.Fields("lujing")
     Call doshell
   End If
Case 14
   Data1.RecordSource = "select * from yscx where anjian = 'Command2(14)'"
   Data1.Refresh
    If Data1.Recordset.EOF Then
     MsgBox "文件不存在！！", vbCritical, "注意！！"
     Exit Sub
   Else
     path = Data1.Recordset.Fields("lujing")
     Call doshell
   End If
 Case 15
   Data1.RecordSource = "select * from yscx where anjian = 'Command2(15)'"
   Data1.Refresh
    If Data1.Recordset.EOF Then
     MsgBox "文件不存在！！", vbCritical, "注意！！"
     Exit Sub
   Else
     path = Data1.Recordset.Fields("lujing")
     Call doshell
   End If
Case 16
   Data1.RecordSource = "select * from yscx where anjian = 'Command2(16)'"
   Data1.Refresh
    If Data1.Recordset.EOF Then
     MsgBox "文件不存在！！", vbCritical, "注意！！"
     Exit Sub
   Else
     path = Data1.Recordset.Fields("lujing")
     Call doshell
   End If
Case 17
   Data1.RecordSource = "select * from yscx where anjian = 'Command2(17)'"
   Data1.Refresh
    If Data1.Recordset.EOF Then
     MsgBox "文件不存在！！", vbCritical, "注意！！"
     Exit Sub
   Else
     path = Data1.Recordset.Fields("lujing")
     Call doshell
   End If
Case 18
   Data1.RecordSource = "select * from yscx where anjian = 'Command2(18)'"
   Data1.Refresh
    If Data1.Recordset.EOF Then
     MsgBox "文件不存在！！", vbCritical, "注意！！"
     Exit Sub
   Else
     path = Data1.Recordset.Fields("lujing")
     Call doshell
   End If
Case 19
   Data1.RecordSource = "select * from yscx where anjian = 'Command2(19)'"
   Data1.Refresh
  If Data1.Recordset.EOF Then
    MsgBox "文件不存在！！", vbCritical, "注意！！"
    Exit Sub
  Else
   path = Data1.Recordset.Fields("lujing")
   Call doshell
  End If
 End Select
End Sub

Private Sub Dir1_Change()
    File1 = Dir1
End Sub

Private Sub Drive1_Change()
Dir1 = Drive1
End Sub



Private Sub Exit_Click()
End
End Sub

Private Sub File1_Click()
If Right(File1.path, 1) = "\" Then
        Label5.Caption = File1.path & File1.FileName
    Else
        Label5.Caption = File1.path & "\" & File1.FileName
    End If
End Sub

Private Sub File1_DblClick()
Call Shell("rundll32.exe url.dll,FileProtocolHandler " & Label5.Caption, 1)
End Sub

Private Sub Form_Load()
Call locate


End Sub

Private Sub gx_Click()
MsgBox "此功能尚未开放", vbCritical, "注意"   ' Call Shell(App.path & "\read.txt", 1)
End Sub

Private Sub help_Click()
    MsgBox "添加程序时请确保输入的按键名称和命令按钮上面的一样,否则将导致程序不能运行!此程序尚未添加命令按钮的修改程序故不能修改!将再以后的版本中添加!!详细请看read文档!!", vbOKOnly, "注意!"
       
End Sub

Private Sub Opt1_Click()
    Dir1 = "\\Works\D盘\杭州集体土地数据库"
    Drive1.Enabled = False
End Sub

Private Sub Opt2_Click()
    Drive1.Enabled = True
    Dir1 = "d:"

End Sub
Sub locate()

    Data1.DatabaseName = App.path & "\yscx.mdb"
    Data1.RecordSource = "select * from yscx"
    File1.Pattern = Combo1.Text
    
    Dim Command2(19) As Integer
    Dim i As Integer
    Data1.RecordSource = "select * from yscx"
    Data1.Refresh
    
    For i = 0 To 19                                                            '必须再do while  外面
    Data1.Recordset.MoveFirst
    Do While Not Data1.Recordset.EOF
      If Form1.Command2(i).Caption = Data1.Recordset.Fields("anjian") Then
        Form1.Command2(i).Caption = Data1.Recordset.Fields("bieming")
        Form1.Command2(i).ToolTipText = "Command2(" & i & ")"
    Exit Do                                               '如果不加  就容易执行else中的代码,把已经修改的数据重新改回去
        Else
        Form1.Command2(i).Caption = "Command2(" & i & ")"
       End If
    
    Data1.Recordset.MoveNext
    
    Loop
    Next i
    

End Sub