急急急急……无刷新聊天程序的问题?分虽不高,但我也只有这10分了,555555
今天在网上载了一个聊天程序,想弄到我做的一个系统里,但依着做Web服务端时,发布Web服务老是提示出错:HTTP500内部服务器错误
Imports System.Web.Services
Namespace Chat
Public Class ChatWebService
Inherits System.Web.Services.WebService
#Region " Web 服务设计器生成的代码 "
Public Sub New()
MyBase.New()
'该调用是 Web 服务设计器所必需的。
InitializeComponent()
'在 InitializeComponent() 调用之后添加您自己的初始化代码
End Sub
'Web 服务设计器所必需的
Private components As System.ComponentModel.IContainer
'注意: 以下过程是 Web 服务设计器所必需的
'可以使用 Web 服务设计器修改此过程。
'不要使用代码编辑器修改它。
Private Sub InitializeComponent()
components = New System.ComponentModel.Container
End Sub
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
'CODEGEN: 此过程是 Web 服务设计器所必需的
'不要使用代码编辑器修改它。
If disposing Then
If Not (components Is Nothing) Then
components.Dispose()
End If
End If
MyBase.Dispose(disposing)
End Sub
#End Region
<WebMethod()> Public Function Login(ByVal username As String) As String
'"接收用户名作为参数存储到Application对象中
' Ascertain that all the registered chat participants are active
CheckMembersList()
' Synchronization Lock
Application.Lock()
' Get the collection of keys for the Application Variables
Dim Members As String() = Application.AllKeys
' Are there any registered chat members? & the present request is for a unique nick name?
If ((Members.Length > 0) And (Array.IndexOf(Members, username) > -1)) Then
Throw New Exception("该用户已存在!")
'Create a new Member object for this participant
Else
Dim NewMember As Member = New Member(username)
' Add this new member to the collectionof Application Level Variables
Application.Add(username, NewMember)
' Synchronization unlock
Application.UnLock()
'Go and get the list of current chat participants and retrun the list
Return GetMembersList()
End If
End Function
<WebMethod()> Public Function XchangeMsgs(ByVal username As String, ByVal Msg As String) As ChatMessage
'GetMsg方法用用户名和消息为参数返回一个ChatMessage对象,包括要传递的消息和用户列表
' Ascertain that all the registered chat participants are active
CheckMembersList()
' Synchronization Lock
Application.Lock()
'Get the collection of keys for the Application Variables
Dim Members As String() = Application.AllKeys
If ((Members.Length = 0) Or (Array.IndexOf(Members, username) = -1)) Then
' Are there any registered chat members? & the present request is for a unique nick name
Throw New Exception("你当前可能没有登陆或登陆超时,请重新登陆!")
Else
Dim RetMsg As ChatMessage = New ChatMessage
RetMsg.UserList = GetMembersList()
' Loop through all the Chat Participant's serverside Member Objects and
'add the message just received in their waiting message queue
Dim x As Integer
For x = 0 To Members.Length - 1
'建立临时用户
Dim temp As Member = CType(Application(Members(x)), Member)
temp.MsgQueue += ("" + username + " 说:" + Msg)
If (temp.UserName = username) Then RetMsg.Messages = temp.MsgQueue
Next
' Synchronization unlock
Application.UnLock()
Return RetMsg
End If
End Function
<WebMethod()> Public Function GetMsgs(ByVal username As String) As ChatMessage
'GetMsg方法用username为参数返回一个ChatMessage对象,包括要传递的消息和用户列表
Application.Lock()
CheckMembersList()
Application.Lock()
Dim Members As String() = Application.AllKeys
If ((Members.Length = 0) Or (Array.IndexOf(Members, username) = -1)) Then
Throw New Exception("Unknown User. Please Login with a UserName")
Else
Dim RetMsg As ChatMessage = New ChatMessage
RetMsg.UserList = GetMembersList()
Dim temp As Member = CType(Application(username), Member)
RetMsg.Messages = temp.MsgQueue
temp.MsgQueue = ""
temp.LastAccessTime = DateTime.Now
Application.UnLock()
Return RetMsg
End If
End Function
Public Function GetMembersList() As String
Application.Lock()
Dim UserList As String = ""
Dim Members As String() = Application.AllKeys
Application.UnLock()
Dim x As Integer
For x = 0 To Members.Length - 1
Dim temp As Member = CType(Application(Members(x)), Member)
UserList += (temp.UserName + "\n")
Next
Return UserList
End Function
Private Sub CheckMembersList()
Dim Members As String() = Application.AllKeys
Dim RemoveList As ArrayList = New ArrayList
Dim x As Integer
For x = 0 To Members.Length
Dim temp As Member = CType(Application(Members(x)), Member)
Dim test As Integer = (DateTime.Now.Subtract(temp.LastAccessTime)).Minutes
If (test > 2) Then
'踢人
RemoveList.Add(Members(x))
End If
Next
' Users = null;
Dim count As Integer
For count = 0 To RemoveList.Count - 1
Application.Remove(CType(RemoveList(count), String))
Next
Return
End Sub
End Class
End Namespace
高手快来帮忙啊
问题点数:0、回复次数:1Top
1 楼yyy_302(蝶儿飞飞)回复于 2005-06-02 23:36:48 得分 0
哦,另外还有两个类member和ChatMessage忘了说了。
‘ChatMessage.vb:
Namespace chat
Public Class ChatMessage
Public UserList As String
Public Messages As String
'构造函数
Public Sub New()
End Sub
End Class
End Namespace
'Member.vb
Namespace chat
Public Class Member
' 存储消息的队列
Public UserName, MsgQueue As String ' 判断滞留事件以便踢人
Public LastAccessTime As System.DateTime ' The constructor
Public Sub New(ByVal NickName As String)
Me.UserName = NickName
Me.LastAccessTime = DateTime.Now
End Sub
End Class
End Namespace
Top




