帮助修改程序的问题
请教大家,现在有个网络点播程序,由于本人技术有限,水平不够.请求各位高手帮助修改.服务器程序我想把它修改成更细化的分类,比如说在服务器窗体上有:电影,电视剧,音乐三个列表框,还有个选择分类的组合,以及一个命令按钮和一个时钟,一个通用对话框.程序启动后,添加文件时,首先从组合框中选择一个类别,如电影或电视剧等,然后点击命令按钮,可以选择媒体文件,并把文件名填入相应列表中.但现在的问题是:如果这样填加的话,列表框中就太乱了.我想把它修改成选择了组合框中的如电影后,在第二个组合框中可以加入谁的电影,然后进行选择文件,确定后,电影演员的名字填入第一个列表框中,然后选择的电影文件名文件名填入第二个列表框中这样.其它的如电视剧等相同.然后服务器程序启动后,客户端程序也启动并完成与服务器的连接后,服务器程序自动把所有的列表框中的内容发送到客户端上面.这样.
客户端程序是这样的:窗体上有目前有两个组合框,一个选择类别的,如电影,电视剧等.另一个是放节目文件名的.目前是这样的.我想把它修改成:一个组合框放类别,如电影,电视剧等.第二个组合框放如电影类别中的谁演的电影,比如说李连杰系列.然后组合框下面是个列表框,用于显示所有李连杰演的电影的文件名.这样.然后用户选择列表中的节目后,可以在线播放出来.这样.
我目前的情况是,这两个程序我的水平无法修改.一改就错.服务器程序包括一个access数据库表.
请大家帮我修改成我说的那样的更细化分的程序.
下面把两个程序的源码写出我分次写出.服务器源码如下:
[解决办法]
Option Explicit
Dim intMax As Long
Dim conn As New ADODB.Connection
Private Sub cmdAdd_Click()
Dim strType As String, strFile() As String
Dim dbName As String, strConn As String, strsql As String
Dim rs As New ADODB.Recordset
If Combo1.Text <> "" Then
strType = Combo1.Text
CommonDialog1.ShowOpen
CommonDialog1.CancelError = False
If CommonDialog1.FileName <> "" Then
' MsgBox CommonDialog1.FileName
strFile = Split(CommonDialog1.FileName, "")
dbName = App.Path & "\data.mdb"
strConn = "PROVIDER=microsoft.jet.oledb.4.0;data source=" & dbName
conn.Open strConn
strsql = "select * from file"
Set rs = New ADODB.Recordset
rs.Open strsql, conn, 1, 3
If rs.RecordCount > 0 Then
rs.MoveLast
End If
rs.AddNew
rs("文件名") = strFile(UBound(strFile))
rs("文件路径") = CommonDialog1.FileName
rs("类别") = strType
rs.Update
rs.Close
conn.Close
Call addlist
End If
Else
MsgBox "请选择类别！", vbOKOnly, "错误提示"
End If
End Sub
Private Sub Form_Load()
Dim i As Integer
intMax = 0
Winsock1(0).Protocol = sckTCPProtocol
Winsock1(0).LocalPort = 1010
Winsock1(0).Listen
Call addlist
Combo1.Clear
Combo1.AddItem "电影"
Combo1.AddItem "电视剧"
Combo1.AddItem "音乐"
End Sub
Private Sub addlist()
Dim dbName As String, strConn As String, strsql As String
Dim rs As New ADODB.Recordset
dbName = App.Path & "\data.mdb"
strConn = "PROVIDER=microsoft.jet.oledb.4.0;data source=" & dbName
conn.Open strConn
'更新list1
strsql = "select * from file where 类别='电影'"
rs.Open strsql, conn, 1
List1.Clear
If rs.RecordCount > 0 Then
rs.MoveFirst
Do While Not rs.EOF
If rs.Fields("文件名").Value & "" <> "" Then
List1.AddItem rs.Fields("文件名").Value & ""
End If
rs.MoveNext
Loop
End If
rs.Close
'更新list2
strsql = "select * from file where 类别='电视剧'"
rs.Open strsql, conn, 1
List2.Clear
If rs.RecordCount > 0 Then
rs.MoveFirst
Do While Not rs.EOF
If rs.Fields("文件名").Value & "" <> "" Then
List2.AddItem rs.Fields("文件名").Value & ""
End If
rs.MoveNext
Loop
End If
rs.Close
'更新list3
strsql = "select * from file where 类别='音乐'"
rs.Open strsql, conn, 1
List3.Clear
If rs.RecordCount > 0 Then
rs.MoveFirst
Do While Not rs.EOF
If rs.Fields("文件名").Value & "" <> "" Then
List3.AddItem rs.Fields("文件名").Value & ""
End If
rs.MoveNext
Loop
End If
rs.Close
conn.Close
List1.Refresh
List2.Refresh
List3.Refresh
End Sub
Private Sub List1_DblClick()
Dim dbName As String, strConn As String, strsql As String
Dim rs As New ADODB.Recordset
If List1.ListIndex < 0 Then
MsgBox "请选中一条数据！", vbOKOnly, "信息提示"
Else
If MsgBox("您确定要删除此数据吗?", vbInformation + vbOKCancel) = vbOK Then
dbName = App.Path & "\data.mdb"
strConn = "PROVIDER=microsoft.jet.oledb.4.0;data source=" & dbName
conn.Open strConn
strsql = "select * from file where 类别='电影' and 文件名='" & List1.Text & "'"
Set rs = New ADODB.Recordset
rs.Open strsql, conn, 1, 3
rs.Delete
rs.Update
rs.Close
conn.Close
Call addlist
End If
End If
End Sub
Private Sub List2_DblClick()
Dim dbName As String, strConn As String, strsql As String
Dim rs As New ADODB.Recordset
If List2.ListIndex < 0 Then
MsgBox "请选中一条数据！", vbOKOnly, "信息提示"
Else
If MsgBox("您确定要删除此数据吗?", vbInformation + vbOKCancel) = vbOK Then
dbName = App.Path & "\data.mdb"
strConn = "PROVIDER=microsoft.jet.oledb.4.0;data source=" & dbName
conn.Open strConn
strsql = "select * from file where 类别='电视剧' and 文件名='" & List2.Text & "'"
Set rs = New ADODB.Recordset
rs.Open strsql, conn, 1, 3
rs.Delete
rs.Update
rs.Close
conn.Close
Call addlist
End If
End If
End Sub
Private Sub List3_DblClick()
Dim dbName As String, strConn As String, strsql As String
Dim rs As New ADODB.Recordset
If List3.ListIndex < 0 Then
MsgBox "请选中一条数据！", vbOKOnly, "信息提示"
Else
If MsgBox("您确定要删除此数据吗?", vbInformation + vbOKCancel) = vbOK Then
dbName = App.Path & "\data.mdb"
strConn = "PROVIDER=microsoft.jet.oledb.4.0;data source=" & dbName
conn.Open strConn
strsql = "select * from file where 类别='音乐' and 文件名='" & List3.Text & "'"
Set rs = New ADODB.Recordset
rs.Open strsql, conn, 1, 3
rs.Delete
rs.Update
rs.Close
conn.Close
Call addlist
End If
End If
End Sub
Private Sub Winsock1_ConnectionRequest(index As Integer, ByVal requestID As Long)
Dim i As Long
For i = 1 To intMax
If Winsock1(i).State = 0 Then
Exit For
End If
Next i
If i > intMax Then
intMax = intMax + 1
Load Winsock1(intMax)
End If
Winsock1(i).Accept requestID
End Sub
Private Sub Winsock1_DataArrival(index As Integer, ByVal bytesTotal As Long)
Dim strData As String, strSendData As String
Dim a() As String, b() As String
Dim dbName As String, strConn As String, strsql As String
Dim rs As New ADODB.Recordset
Winsock1(index).GetData strData
a = Split(strData, "$")
Select Case a(0)
Case 1:
strSendData = "1" & "$" & "电影;电视剧;音乐"
Case 2:
strSendData = "2" & "$"
dbName = App.Path & "\data.mdb"
strConn = "PROVIDER=microsoft.jet.oledb.4.0;data source=" & dbName
conn.Open strConn
strsql = "select 文件名 from file where 类别='" & a(1) & "'"
rs.Open strsql, conn, 1
If rs.RecordCount > 0 Then
rs.MoveFirst
Do While Not rs.EOF
If rs.Fields("文件名").Value & "" <> "" Then
strSendData = strSendData & rs.Fields("文件名").Value & ";"
End If
rs.MoveNext
Loop
End If
rs.Close
conn.Close
Case 3:
strSendData = "3" & "$"
b = Split(a(1), ";")
dbName = App.Path & "\data.mdb"
strConn = "PROVIDER=microsoft.jet.oledb.4.0;data source=" & dbName
conn.Open strConn
strsql = "select 文件路径 from file where 类别='" & b(0) & "' and 文件名='" & b(1) & "'"
rs.Open strsql, conn, 1
If rs.RecordCount > 0 Then
rs.MoveFirst
If rs.Fields("文件路径").Value & "" <> "" Then
strSendData = strSendData & rs.Fields("文件路径").Value & ""
End If
End If
rs.Close
conn.Close
End Select
Winsock1(index).SendData strSendData
End Sub
[解决办法]
Option Explicit
Dim blnCon As Boolean
Private Sub Combo1_Click()
If Combo1.Text <> "" Then
Winsock1.SendData "2" & "$" & Combo1.Text
Else
MsgBox "请选择类别！", vbOKOnly, "错误提示"
End If
End Sub
Private Sub Combo2_Click()
If Combo1.Text <> "" And Combo2.Text <> "" Then
Winsock1.SendData "3" & "$" & Combo1.Text & ";" & Combo2.Text
Else
MsgBox "请选择类别和文件名！", vbOKOnly, "错误提示"
End If
End Sub
Private Sub Form_Load()
Dim sfile As String, temp As String, a As Variant
If App.PrevInstance Then
MsgBox "程序已经运行，不能打开相同的程序！", vbInformation, "错误提示"
Unload Me
Exit Sub
End If
blnCon = False
Winsock1.Protocol = sckTCPProtocol
Winsock1.RemoteHost = "192.168.1.250"
Winsock1.RemotePort = 1010
Combo1.Clear
Combo2.Clear
Combo1.Enabled = False
Combo2.Enabled = False
Me.WindowsMediaPlayer1.Enabled = False
' Winsock1.RemoteHost = "192.168.1.250"
End Sub
Private Sub Form_Unload(Cancel As Integer)
Winsock1.Close
End Sub
Private Sub Timer1_Timer()
If blnCon = False Then
If Winsock1.State = 0 Then
Winsock1.Connect
ElseIf Winsock1.State = 7 Then
Winsock1.SendData "1" & "$"
Combo1.Enabled = True
Combo2.Enabled = True
Me.WindowsMediaPlayer1.Enabled = True
blnCon = True
Else
Winsock1.Close
End If
End If
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim strData As String, i As Integer
Dim a() As String, b() As String
Winsock1.GetData strData, vbString
'数据结构为: 命令$数据,命令=1时填充combo1，命令=2时填充combo2，命令=3时获取文件路径
a = Split(strData, "$")
Select Case a(0)
Case 1:
b = Split(a(1), ";")
Combo1.Clear
For i = LBound(b) To UBound(b)
Combo1.AddItem b(i)
Next i
Case 2:
b = Split(a(1), ";")
Combo2.Clear
For i = LBound(b) To UBound(b)
Combo2.AddItem b(i)
Next i
Case 3:
If a(1) <> "" Then
Me.WindowsMediaPlayer1.URL = a(1)
End If
End Select
End Sub
Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
If MsgBox(Description & vbCrLf & "是否重新连接?", vbInformation + vbOKCancel) = vbOK Then
Winsock1.Close
blnCon = False
End If
End Sub
请大家帮帮忙吧!我实在无能为力了,自己修改了多次都失败了!请大家帮帮我多谢了!!
[解决办法]
。。。。。太长了，帮顶~
