vcdview.frm

原创VB+SQL影音租赁系统 醮简单 具体看里边的文本文档

'rst.Close
End Sub
Private Sub Cartoondataview_Click()
CartoonData.rsComCartoon.Requery
Set Cartoondataview.DataSource = CartoonData
rows = Cartoondataview.Row
id = VCDAdd.getid(rows - 2)
Call idTRS
'MsgBox id
On Error GoTo err
rst.Open "select '名称'=cName,'语言'=cLanguage,'片长'=iLenth,'出版日期'=dPublishDate,'租金'=mPrice,'库存'=iStock,'主演'=cParts,'导演'=cDirector,'故事概述'=cStory,'图片路径'=cPicpath, '级别'=cLevel from cartoon", con, adOpenDynamic, adLockOptimistic
rst.Move (id)
Call display
rst.Close
Exit Sub
err:
ii = MsgBox("数据表为空！没有记录可以显示！", vbInformation, "系统提示") = vbOK
'MsgBox err.Description
'rst.Close
End Sub

Private Sub MemberViewBT_Click()
Call MemberEditer.ReceiveID(Trim(MemberIDText.Text))
MemberEditer.First.Enabled = False
MemberEditer.Last.Enabled = False
MemberEditer.Previours.Enabled = False
MemberEditer.Next.Enabled = False
MemberEditer.Show
End Sub

Public Sub MoneyOKBT_Click()
moneyadd = MoneyAddText.Text
MoneyListText.Text = CDbl(MoneyListText.Text) + CDbl(MoneyAddText.Text)
newmoney = Trim(MoneyListText.Text)
'MsgBox newmoney
'On Error GoTo err
rst.Open "update member set mMoney=" & newmoney & " where cMemberID='" & memid & " '", con, adOpenDynamic, adLockBatchOptimistic
'rst.Close
oo = MsgBox("您的账户已添加了" & moneyadd & "元", vbInformation, "系统提示") = vbOK

rst.Open "select * from member where cmemberid='" & memid & "'", con, adOpenDynamic, adLockBatchOptimistic
MoneyListText.Text = rst(2)
rst.Close
MoneyOKBT.Enabled = False
MoneyAddText.Text = ""
MoneyAddText.Enabled = False
MoneyListText.Text = MoneyAddText.Text + MoneyListText.Text
Exit Sub
err:
pp = MsgBox("帐户资金添加失败！", vbInformation, "系统提示") = vbOK
End Sub

Public Sub RentBT_Click()
instatus = 1
addid
OrderNo = Trim(RentID.Text)
vcdType = tablename
'MsgBox tablename
'MsgBox tbname
'rentnum = 1
Lendtime = Format(Now, "yy-mm-dd hh:mm:ss")
Lyear = Year(Lendtime)
Lmonth = Month(Lendtime)
Lday = Day(Lendtime)
SReturnDate = Lyear & "-" & Lmonth & "-" & Lday + 2
rental = Trim(Text5.Text)
vcdname = Trim(Text1.Text)
vcdlevel = Trim(Text7.Text)
If vcdlevel <> "限制" Then
   LE = "5"
Else
   LE = "18"
End If

rst.Open "select * from orderdetails ", con, adOpenDynamic, adLockBatchOptimistic
If rst.EOF = True Then
   'aa = MsgBox("orderdetails表为空！", vbInformation, "系统提示") = vbOK
   rst.Close
   If Text6.Text = 0 Then
        ss = MsgBox("抱歉！影片《" & Trim(vcdname) & "》的库存不够！请选择其他影片！", vbInformation, "系统提示") = vbOK
        'instatus = 0
        Exit Sub
        ElseIf MoneyListText.Text < 20 Then
               dd = MsgBox("抱歉！您的账户余额不够！请续费！", vbInformation, "系统提示") = vbOK
               'instatus = 0
               Exit Sub
               Else
                   'MsgBox vcdlevel
                   'LE = level(vcdlevel)
                   'MsgBox LE
                   rst.Open "select * from member where cmemberid='" & memid & "'", con, adOpenDynamic, adLockBatchOptimistic
                   memberage = rst(3)
                   'MsgBox memberage
                   rst.Close
                   If CInt(Trim(memberage)) < CInt(LE) Then
                      ff = MsgBox("小子，你才" & Trim(memberage) & "岁！不许看成人影片！：（", vbInformation, "系统提示") = vbOK
                      'instatus = 0
                      Exit Sub
                      Else
                          
                          rst.Open "insert orderdetails values('" & OrderNo & "','" & memid & "','" & vcdname & "','" & tablename & "',1,'" & Lendtime & "','" & SReturnDate & "',NULL," & rental & ")", con, adOpenDynamic, adLockBatchOptimistic
                          'rst.Close
                          gg = MsgBox("影片《" & Trim(vcdname) & "》已放入您的租借表！我们将从您的账户里扣去" & Trim(rental) & "元！如还需要其他影片，请重复操作。", vbInformation, "系统提示") = vbOK
                          MoneyListText.Text = CDbl(MoneyListText.Text) - CDbl(Text5.Text)
                          ViewRentBT.Enabled = True
                          rst.Open "update " & tbname & " set istock=istock-1 where cname='" & Trim(vcdname) & "'", con, adOpenDynamic, adLockBatchOptimistic
                          hh = MsgBox("请单击标签来刷新窗口！", vbInformation, "系统提示") = vbOK
                          'addid
                          
                          'rst.Open "update "
                          'rst.open"update "
                   End If
    End If
    'rst.Close
   
Else
'MsgBox tablename
'MsgBox tbname
rst.Close
rst.Open "select * from orderdetails ", con, adOpenDynamic, adLockBatchOptimistic
Do While rst.EOF = False
      If Trim(rst!cvcdname) = Trim(vcdname) Then
         instatus = 1
         Exit Do
      Else
         instatus = 0
         rst.MoveNext
      End If
Loop
If instatus = 1 Then
       jj = MsgBox("您已借过《" & Trim(vcdname) & "》这部影片！请选择其他的影片！", vbInformation, "系统提示") = vbOK
       rst.Close
       'instatus = 0
       Exit Sub
       ElseIf Text6.Text = 0 Then
            kk = MsgBox("抱歉！影片《" & Trim(vcdname) & "》的库存不够！请选择其他影片！", vbInformation, "系统提示") = vbOK
            'instatus = 0
            rst.Close
            Exit Sub
            ElseIf MoneyListText.Text < 20 Then
                   ll = MsgBox("抱歉！您的账户余额不够！请续费！", vbInformation, "系统提示") = vbOK
                   'instatus = 0
                   rst.Close
                   Exit Sub
                   Else
                       rst.Close
                       'MsgBox vcdlevel
                       'LE = level(vcdlevel)
                       'MsgBox LE
                       rst.Open "select * from member where cmemberid='" & memid & "'", con, adOpenDynamic, adLockBatchOptimistic
                       memberage = rst(3)
                       'MsgBox memberage
                       rst.Close
                       If CInt(Trim(memberage)) < CInt(LE) Then
                          zz = MsgBox("小子，你才" & Trim(memberage) & "岁！不许看成人影片！：（", vbInformation, "系统提示") = vbOK
                          'instatus = 0
                          Exit Sub
                          Else
                              rst.Open "insert orderdetails values('" & OrderNo & "','" & memid & "','" & vcdname & "','" & tablename & "',1,'" & Lendtime & "','" & SReturnDate & "',NULL," & rental & ")", con, adOpenDynamic, adLockBatchOptimistic
                              'rst.Close
                              xx = MsgBox("影片《" & Trim(vcdname) & "》已放入您的租借表！我们将从您的账户里扣去" & Trim(rental) & "元！如还需要其他影片，请重复操作。", vbInformation, "系统提示") = vbOK
                              MoneyListText.Text = CDbl(MoneyListText.Text) - CDbl(Text5.Text)
                              ViewRentBT.Enabled = True
                              rst.Open "update " & tbname & " set istock=istock-1 where cname='" & Trim(vcdname) & "'", con, adOpenDynamic, adLockBatchOptimistic
                              cc = MsgBox("请单击表前来刷新窗口！", vbInformation, "系统提示") = vbOK
                              'tabstrip1.SelectedItem.Index
                              'rst.Close
                       End If
    'rst.Close
End If
End If
'rst.Close
'addid
'rst.Open "select "
'rst.Open "insert orders vlaues('" & orderNo & "','" & memberID & "','" & vcdname & "','" & tbname & "',1,getdate(),dateadd(dd,2,getdate()),rental)", con, adOpenDynamic, adLockBatchOptimistic
'rst.Close
'MsgBox "租借成功！"

'rst.Close
End Sub

Private Sub ScienceDataView_Click()
ScienceData.rsComScience.Requery
Set ScienceDataView.DataSource = ScienceData
rows = ScienceDataView.Row
id = VCDAdd.getid(rows - 2)
Call idTRS
'MsgBox id
On Error GoTo err
rst.Open "select '名称'=cName,'语言'=cLanguage,'片长'=iLenth,'出版日期'=dPublishDate,'租金'=mPrice,'库存'=iStock,'主演'=cParts,'导演'=cDirector,'故事概述'=cStory,'图片路径'=cPicpath, '级别'=cLevel from science", con, adOpenDynamic, adLockOptimistic
rst.Move (id)
Call display
rst.Close
Exit Sub
err:
vv = MsgBox("数据表为空！没有记录可以显示！", vbInformation, "系统提示") = vbOK
'MsgBox err.Description
'rst.Close
End Sub

Private Sub SearchBT_Click()
'ClickRow = 1
SearchDataView.Visible = True
LoveDataView.Visible = False
AdvertisementDataView.Visible = False
TerrorDataView.Visible = False
ActionDataView.Visible = False
VentureDataView.Visible = False
ScienceDataView.Visible = False
ComedyDataView.Visible = False
Cartoondataview.Visible = False
WarDataView.Visible = False
ArtDataView.Visible = False
If ComboVCDType.Text = "" Then
   bb = MsgBox("请选择查询影片类型！", vbInformation, "系统提示") = vbOK
ElseIf ComboSearch.Text = "" Then
   nn = MsgBox("请选择查询条件！", vbInformation, "系统提示") = vbOK
ElseIf SearchText.Text = "" Then
   mm = MsgBox("请输入查询关键字！", vbInformation, "系统提示") = vbOK
Else
   Select Case ComboVCDType.Text
       Case "爱情"
          vcdType = "love"
       Case "喜剧"
          vcdType = "comedy"
       Case "卡通"
          vcdType = "cartoon"
       Case "科幻"
          vcdType = "science"
       Case "冒险"
          vcdType = "venture"
       Case "动作"
          vcdType = "action"
       Case "文艺"
          vcdType = "art"
       Case "战争"
          vcdType = "war"
       Case "广告"
          vcdType = "advertisement"
       Case "恐怖"
          vcdType = "terror"
   End Select
   Select Case ComboSearch.Text
       Case "名称"
          SearchCon = "cname"
       Case "语言"
          SearchCon = "clanguage"
       Case "出版日期"
          SearchCon = "dpublishdate"
       Case "主演"
          SearchCon = "cparts"
       Case "导演"
          SearchCon = "cdirector"
       Case "故事概述"
          SearchCon = "cstory"
       Case "级别"
          SearchCon = "clevel"
   End Select
   SearchKey = SearchText.Text
   'MsgBox vcdType
   'MsgBox SearchCon
   'rst.Close
   rst.Open "select '名称'=cName,'语言'=cLanguage,'主演'=cParts,'导演'=cDirector,'出版日期'=dPublishDate,'租金'=mPrice,'库存'=iStock,'片长'=iLenth,'级别'=cLevel,'故事概述'=cStory,'图片路径'=cPicpath from " & vcdType & " where " & SearchCon & "  like '%" & Trim(SearchKey) & "%'", con, adOpenDynamic, adLockBatchOptimistic
   Set SearchDataView.DataSource = rst
   On Error GoTo err
   rst.MoveFirst
   If rst.EOF = True Then
      Dim q As String
      'MsgBox "对不起！找不到您要的影片信息！！"
      q = MsgBox("对不起！找不到您要的影片信息！！", vbInformation, "系统提示") = vbOK
      'MsgBox q
      'SearchDataView.Visible = True
      rst.Close
      'MsgBox "cllosed!"
      'Exit Sub
   Else
        'rst.MoveFirst
        'Set SearchDataView.DataSource = rst
        Text1.Text = rst!名称
        Text2.Text = rst!主演
        Text3.Text = rst!导演
        Text4.Text = rst!故事概述
        Text5.Text = rst!租金
        Text6.Text = rst!库存
        Text7.Text = rst!级别
        On Error GoTo picerr
        Image1.Picture = LoadPicture(rst!图片路径)
        rst.Close
        'MsgBox "closed!!!!!!!!!"
        'SearchDataView.Visible = True
        With SearchDataView
            .ColWidth(0) = 1800
            .ColWidth(1) = 500
            .ColWidth(2) = 3650
            .ColWidth(3) = 1900
            .ColWidth(4) = 1000
            .ColWidth(5) = 500
            .ColWidth(6) = 500
            .ColWidth(7) = 500
            .ColWidth(8) = 500
        End With
        'SearchDataView.Col = 1
        'SearchDataView.Row = 1
        
        'Exit Sub
  End If
  'rst.Close
End If
Exit Sub
err:
Select Case err.Number
     Case 3021:
     s = MsgBox("对不起！找不到您要的影片信息！！", vbInformation, "系统提示") = vbOK
     MsgBox s
     rst.Close
     MsgBox "closed!hihihihi!"
     'SearchDataView.Visible = True
End Select
picerr:
Image1.Picture = LoadPicture("h:\pictures\egg.jpg")
End Sub


Private Sub SearchDataView_Click()
rows = SearchDataView.Row
id = VCDAdd.getid(rows - 2)
'Call idTRS
MsgBox id
'On Error GoTo err
'MsgBox SearchCon
'MsgBox SearchCon
'MsgBox SearchKey
rst.Open "select '名称'=cName,'语言'=cLanguage,'主演'=cParts,'导演'=cDirector,'出版日期'=dPublishDate,'租金'=mPrice,'库存'=iStock,'片长'=iLenth,'级别'=cLevel,'故事概述'=cStory,'图片路径'=cPicpath from " & vcdType & " where " & SearchCon & "  like '%" & Trim(SearchKey) & "%'", con, adOpenDynamic, adLockBatchOptimistic
On Error GoTo iderr
rst.Move (id)
'Call idTRS
Call display
rst.Close
Exit Sub
err:
d = MsgBox("数据表为空！没有记录可以显示！", vbInformation, "系统提示") = vbOK
f = MsgBox(err.Description, vbInformation, "系统提示") = vbOK
'rst.Close
iderr:
p = MsgBox("数据表为空！