帮助修改程序的问题

Question

请教大家,现在有个网络点播程序,由于本人技术有限,水平不够.请求各位高手帮助修改.服务器程序我想把它修改成更细化的分类,比如说在服务器窗体上有:电影,电视剧,音乐三个列表框,还有个选择分类的组合,以及一个命令按钮和一个时钟,一个通用对话框.程序启动后,添加文件时,首先从组合框中选择一个类别,如电影或电视剧等,然后点击命令按钮,可以选择媒体文件,并把文件名填入相应列表中.但现在的问题是:如果这样填加的话,列表框中就太乱了.我想把它修改成选择了组合框中的如电影后,在第二个组合框中可以加入谁的电影,然后进行选择文件,确定后,电影演员的名字填入第一个列表框中,然后选择的电影文件名文件名填入第二个列表框中这样.其它的如电视剧等相同.然后服务器程序启动后,客户端程序也启动并完成与服务器的连接后,服务器程序自动把所有的列表框中的内容发送到客户端上面.这样.
客户端程序是这样的:窗体上有目前有两个组合框,一个选择类别的,如电影,电视剧等.另一个是放节目文件名的.目前是这样的.我想把它修改成:一个组合框放类别,如电影,电视剧等.第二个组合框放如电影类别中的谁演的电影,比如说李连杰系列.然后组合框下面是个列表框,用于显示所有李连杰演的电影的文件名.这样.然后用户选择列表中的节目后,可以在线播放出来.这样.
我目前的情况是,这两个程序我的水平无法修改.一改就错.服务器程序包括一个access数据库表.
请大家帮我修改成我说的那样的更细化分的程序.
下面把两个程序的源码写出我分次写出.服务器源码如下:

Answer 1

Option Explicit
Dim intMax As Long
Dim conn As New ADODB.ConnectionPrivate 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 SubPrivate 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 SubPrivate 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 SubPrivate 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 SubPrivate 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 SubPrivate 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 SubPrivate 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

Answer 2

下面是客户端源码:
Option Explicit
Dim blnCon As BooleanPrivate Sub Combo1_Click()
    If Combo1.Text <> "" Then
        Winsock1.SendData "2" & "$" & Combo1.Text
    Else
        MsgBox "请选择类别！", vbOKOnly, "错误提示"
    End IfEnd SubPrivate Sub Combo2_Click()
    If Combo1.Text <> "" And Combo2.Text <> "" Then
        Winsock1.SendData "3" & "$" & Combo1.Text & ";" & Combo2.Text
    Else
        MsgBox "请选择类别和文件名！", vbOKOnly, "错误提示"
    End IfEnd SubPrivate 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 SubPrivate Sub Form_Unload(Cancel As Integer)
    Winsock1.Close
End SubPrivate 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 SubPrivate 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 SubPrivate 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
请大家帮帮忙吧!我实在无能为力了,自己修改了多次都失败了!请大家帮帮我多谢了!!