مشكله فى فتح نفس فورم اكثر من مره متصل بقاعده بيانات ع النت

السلام عليكم ورحمه الله

اعمل ع برنامج شات منذ فتره مثل الياهو و الهوت ميل

كود الشات مقتبس من الاخ ramilove من موضوع التعامل مع قاعده بيانات مرفوعه ع النت فى منتدى vb4arab

وقمت بالتعديل ع الكود لاخد كود الشات فقط .

المشكله بالصور (ده مجرد مثال وليس البرنامج كاملا)

عند فتح البرنامج يظهر اى دى روم واسم الذى تريد الدخول به

وعند ضغط اوبن يفتح نافذه الشات عن طريق الكود التالى

رمز برمجي:

Dim ChildForm As New chat

ChildForm.Show()

يفتح الشات بدون مشاكل ويرسل ويستقبل

وعند كتابه اى دى اخر او نفس الاى دى و الضغط ع اوبن ليظهر نافذه اخرى

هنا تكون المشكله فى استقبال لقاعده البيانات لانه مفتوح قبل كده هل من حل ؟؟

هل انا قمت بالتعديل ع الكود بالطريقه الخطاء ام ماذا

اريد عند فتح اكتر من فورم مثلا 1 2 9 8 7(اى عدد من الفروم )يفتح بدون مشاكل ولا يعمل تداخل فى الكونكت

هذا Module

Module Module1

Public id As String = ""

Public DataAdapterChat As New SqlDataAdapter
Public BindingSourceChat As New BindingSource
Public DataSetChat As New DataSet
Public DataSetUsers As New DataSet
Public BindingSourceUsers As New BindingSource
Public DataAdapterUsers As New SqlDataAdapter
Public TestNet As Boolean = False

End Module

Imports System.Data.SqlClient

فورم الشات

Public Class chat
Public m1 As String = My.Computer.FileSystem.ReadAllText(Application.StartupPath + "\conn.txt").Trim

Public Con11 As New SqlConnection(m1)
Public Con22 As New SqlConnection(m1)

Private WithEvents TimerTestNet As New Timer
Private WithEvents TestUserLogin As System.ComponentModel.BackgroundWorker
Private WithEvents ConnectUserChat As System.ComponentModel.BackgroundWorker
Private WithEvents ConnectDataBase As System.ComponentModel.BackgroundWorker
Private WithEvents ChatUser As System.ComponentModel.BackgroundWorker
Public Delegate Sub ChatUserCallback()
Public Delegate Sub CallLoadDataBase()
Public Delegate Sub PictureBox2Callback()
Public UserName As String = ""
Dim Blist As New ArrayList
Dim A_true As Boolean = False
Dim a3 As Boolean = True
Dim a As Boolean = False
Dim Time As New Stopwatch
Dim aop As String
Private Sub chat_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
' MsgBox(m1)
a = True
' '============================
ConnectDataBase = New System.ComponentModel.BackgroundWorker
ConnectDataBase.WorkerReportsProgress = True
ConnectDataBase.WorkerSupportsCancellation = True
ConnectDataBase.RunWorkerAsync()
End Sub

'************* SEND **************'

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

Try

If TestNet = False Then
MsgBox("الاتصال بالانترنت غير متوفر", 16, "تنبيه")
Exit Sub
End If

If TextBox1.Text.Trim = "" Then Beep() : Exit Sub
' PictureBox5.Visible = True
Button1.Enabled = False
Button1.Text = "&Sending ..."
Dim Users As New SqlCommand("SELECT ID,Chat from u WHERE id='" & id & "'", Con11)
DataAdapterChat = New SqlDataAdapter(Users)
Dim builder As New SqlCommandBuilder(DataAdapterChat)

ChatUser = New System.ComponentModel.BackgroundWorker
ChatUser.WorkerReportsProgress = True
ChatUser.WorkerSupportsCancellation = True
ChatUser.RunWorkerAsync()

Catch Ex As Exception

MessageBox.Show(Ex.Message, "Error87", MessageBoxButtons.OK, MessageBoxIcon.Error)

End Try

End Sub

Private Sub ChatUser_DoWork(ByVal sender As Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles ChatUser.DoWork

Try
'1:

DataSetChat = New DataSet
DataAdapterChat.Fill(DataSetChat, "U")
UserChat()
DataAdapterChat.Update(DataSetChat, "U")

Catch ex As Exception

' If ex.Message.GetHashCode = -1968342016 Or ex.Message.GetHashCode = -932284142 Or ex.Message.GetHashCode = -1053942103 Then
' TestNet = False
' e.Cancel = True
' PictureBox2False()

' ElseIf ex.Message.GetHashCode = 1718601380 Then

' GoTo 1
' Else
MessageBox.Show(ex.Message, "Error545", MessageBoxButtons.OK, MessageBoxIcon.Error)
'4:
' End If

End Try

End Sub
Private Sub ChatUser_RunWorkerCompleted(ByVal sender As Object, ByVal e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles ChatUser.RunWorkerCompleted

On Error Resume Next
TextBox1.Text = ""
'PictureBox5.Visible = False
Button1.Enabled = True
Button1.Text = "&Send"

End Sub

Public Sub UserChat()

On Error Resume Next

If Me.InvokeRequired Then
Me.Invoke(New ChatUserCallback(AddressOf UserChat), New Object() {})
Else

BindingSourceChat.DataSource = DataSetChat.Tables("U")
Dim Flist As New ArrayList

Flist.AddRange(BindingSourceChat.List(0).item("Chat").ToString.Split(vbNewLine).ToArray)

If Flist.Count - 1 >= 500 Then
BindingSourceChat.List(0).item("Chat") = String.Empty
BindingSourceChat.EndEdit()
End If

BindingSourceChat.List(0).item("Chat") &= UserName & vbNewLine & TextBox1.Text.ToString & vbNewLine
BindingSourceChat.EndEdit()

End If

End Sub

'*************end SEND **************

Private Sub ConnectDataBase_DoWork(ByVal sender As Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles ConnectDataBase.DoWork

Try

1:
'كود التحقق من اتصال الانترنت
'Dim Site As Net.IPHostEntry = Net.Dns.GetHostEntry("www.msn.com")
'ويتم عن طريق جلب اي بي الموقع
'في حال كان النت مفصول رح يطلع خطأ
'وما رح يمر على الاكواد الي تحته مباشرة
'ورح يمشي مباشرة الى هذا الكود
' If ex.Message.GetHashCode = 2097666462 Then
'وبالتالي رح يسوي قيمة
'TestNet = False

Dim Site As Net.IPHostEntry = Net.Dns.GetHostEntry("www.msn.com")
TestNet = True
LoadDataBase()
Dim Users As New SqlCommand("SELECT ID,Chat from U WHERE id='" & id & "'", Con22)
DataAdapterUsers = New SqlDataAdapter(Users)
Dim builder1 As New SqlCommandBuilder(DataAdapterUsers)
DataSetUsers = New DataSet
DataAdapterUsers.Fill(DataSetUsers, "U")

Catch ex As Exception

'If ex.Message.GetHashCode = 2097666462 Then
' TestNet = False
' LoadDataBase()
'Else
If ex.Message.GetHashCode = 1718601380 Then
GoTo 1
Else
MessageBox.Show(ex.Message, "Error1", MessageBoxButtons.OK, MessageBoxIcon.Error)

End If

End Try

End Sub

Public Sub LoadDataBase()

Try
If Me.InvokeRequired Then
Me.Invoke(New CallLoadDataBase(AddressOf LoadDataBase), New Object() {})
Else

If TestNet = True Then
' Label18.Visible = False
'PictureBox4.Image = ImageList2.Images(2)
'Label15.ForeColor = Color.Yellow
'Label15.Text = ".. تم الاتصال بالانترنت .. يتم الان تحميل سجلات القاعدة"
TimerTestNet.Interval = 100
TimerTestNet.Start()

Else

'Label15.ForeColor = Color.Red
'Label15.Text = "الاتصال بالانترنت غير متوفر"
TimerTestNet.Stop()
ConnectDataBase = New System.ComponentModel.BackgroundWorker
ConnectDataBase.WorkerReportsProgress = True
ConnectDataBase.WorkerSupportsCancellation = True
ConnectDataBase.RunWorkerAsync()

End If

End If

Catch ex As Exception
MessageBox.Show(ex.Message, "Error:3421", MessageBoxButtons.OK, MessageBoxIcon.Error)

End Try

End Sub

Private Sub TimerTestNet_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TimerTestNet.Tick

Try

Dim Site As Net.IPHostEntry = Net.Dns.GetHostEntry("www.msn.com")

TestNet = True

If a3 = False Then

If Not Time.IsRunning Then
Time.Reset()
Time.Start()
End If

' Label8.Image = ImageList1.Images(0)

If Time.Elapsed.Seconds Mod 6 = 0 Then
ElseIf Time.Elapsed.Seconds Mod 6 = 3 Then
End If

If Not TestUserLogin.IsBusy Then
TestUserLogin = New System.ComponentModel.BackgroundWorker
TestUserLogin.WorkerReportsProgress = True
TestUserLogin.WorkerSupportsCancellation = True
TestUserLogin.RunWorkerAsync()
End If

End If

Catch ex As Exception

TestNet = False

If a3 = True Then

TimerTestNet.Stop()

ConnectDataBase = New System.ComponentModel.BackgroundWorker
ConnectDataBase.WorkerReportsProgress = True
ConnectDataBase.WorkerSupportsCancellation = True
ConnectDataBase.RunWorkerAsync()

Else

If Time.IsRunning Then
Time.Stop()
End If

End If

End Try

End Sub

Private Sub ConnectDataBase_RunWorkerCompleted(ByVal sender As Object, ByVal e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles ConnectDataBase.RunWorkerCompleted

Try

BindingSourceUsers.DataSource = DataSetUsers.Tables("U")
A_true = True

Catch ex As Exception
If TestNet = False Then
MsgBox("الاتصال بالانترنت غير متوفر", 16, "تنبيه")
Else
MessageBox.Show(ex.Message, "Error2", MessageBoxButtons.OK, MessageBoxIcon.Error)

Exit Sub
End If

End Try

If a = True Then
Try
Application.DoEvents()
If TestNet = False Then
MsgBox("الاتصال بالانترنت غير متوفر", 16, "تنبيه")
Exit Sub
End If

' UserName = ""
BindingSourceUsers.EndEdit()
ConnectUserChat = New System.ComponentModel.BackgroundWorker
ConnectUserChat.WorkerReportsProgress = True
ConnectUserChat.WorkerSupportsCancellation = True
ConnectUserChat.RunWorkerAsync()

BindingSourceUsers.CancelEdit()
DataSetUsers.RejectChanges()

'End If

Catch Ex As Exception
MessageBox.Show(Ex.Message, "Error3", MessageBoxButtons.OK, MessageBoxIcon.Error)

End Try
a = False
End If

End Sub

Private Sub ConnectUserChat_DoWork(ByVal sender As Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles ConnectUserChat.DoWork

Try

' كود حفظ الاضافة وحفظ التعديل

1:

DataAdapterUsers.Update(DataSetUsers, "U")

Catch ex As Exception

If ex.Message.GetHashCode = -1115812848 Then
'رقم الخطا في حال تكرار الاسم
e.Cancel = True

' LoginFalse()

MsgBox("الرجاء اختيار اسم اخر لانه محجوز مسبقا", 16, "تنبيه")

ElseIf ex.Message.GetHashCode = -1968342016 Or ex.Message.GetHashCode = -932284142 Or ex.Message.GetHashCode = -1053942103 Then

' LoginFalse()

e.Cancel = True

TestNet = False

ElseIf ex.Message.GetHashCode = 1718601380 Then

GoTo 1

Else
' LoginFalse()

e.Cancel = True

MessageBox.Show(ex.Message, "Error4", MessageBoxButtons.OK, MessageBoxIcon.Error)

End If

End Try

End Sub

Private Sub ConnectUserChat_RunWorkerCompleted(ByVal sender As Object, ByVal e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles ConnectUserChat.RunWorkerCompleted

Try

If e.Cancelled Then Exit Sub

BindingSourceUsers.DataSource = DataSetUsers.Tables("U")

TestUserLogin = New System.ComponentModel.BackgroundWorker
TestUserLogin.WorkerReportsProgress = True
TestUserLogin.WorkerSupportsCancellation = True
TestUserLogin.RunWorkerAsync()

Time.Reset()
Time.Start()

TextBox1.Enabled = True

'Label8.BackColor = Color.Green
'Label8.Text = " OnLine"
' Label8.Image = ImageList1.Images(0)
a3 = False

Catch Ex As Exception

MessageBox.Show(Ex.Message, "Error5", MessageBoxButtons.OK, MessageBoxIcon.Error)

End Try

End Sub

Private Sub TestUserLogin_DoWork(ByVal sender As Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles TestUserLogin.DoWork

Try

1:

DataSetUsers = New DataSet

DataAdapterUsers.Fill(DataSetUsers, "U")
Catch ex As Exception
If ex.Message.GetHashCode = -1968342016 Or ex.Message.GetHashCode = -932284142 Or ex.Message.GetHashCode = -1053942103 Then

TestNet = False

PictureBox2False()

e.Cancel = True

ElseIf ex.Message.GetHashCode = 1718601380 Then
GoTo 1
Else
e.Cancel = True

MessageBox.Show(ex.Message, "Error6", MessageBoxButtons.OK, MessageBoxIcon.Error)

End If
End Try

End Sub
Private Sub TestUserLogin_RunWorkerCompleted(ByVal sender As Object, ByVal e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles TestUserLogin.RunWorkerCompleted

Try

If e.Cancelled Then Exit Sub
If TestNet = True Then

'================
'خاص بالشات

Dim Alist() = DataSetUsers.Tables("u").Rows(0).Item("chat").ToString.Split(vbNewLine)

Dim Clist As New List(Of String)
For i As Integer = 0 To Alist.Length - 1
If Alist(i).Trim IsNot String.Empty Then
Clist.Add(Alist(i).ToString.Trim)
End If
Next

If A_true = True Then
Blist.AddRange(Clist.ToArray)
End If

A_true = False

If Blist.Count > Clist.Count Then
Blist.Clear()
End If

If Blist.Count <> Clist.Count Then
Dim i As Integer = Val(Blist.Count)
For i = i To Clist.Count - 1
Blist.Add(Clist(i).ToString)
If Clist(i).Trim <> "Mohamed" And Clist(i).Trim = UserName Then
aop = (Blist.Item(i).ToString & " : ")
Blist.Add(Clist(i + 1).ToString)
aop += (Blist.Item(i + 1).ToString & vbNewLine)
i += 1
AppendText(aop)
ElseIf Clist(i).Trim <> "Mohamed" Then
aop = (Blist.Item(i).ToString & " : ")
Blist.Add(Clist(i + 1).ToString)
aop += (Blist.Item(i + 1).ToString & vbNewLine)
i += 1
AppendText(aop)
Else
aop = ("Mohamed : ")
Blist.Add(Clist(i + 1).ToString)
aop += (Blist.Item(i + 1).ToString & vbNewLine)
i += 1
AppendText(aop)
End If
Next
End If

'==========================

End If

'Label8.Text = " OnLine"

'====================================

TestUserLogin = New System.ComponentModel.BackgroundWorker
TestUserLogin.WorkerReportsProgress = True
TestUserLogin.WorkerSupportsCancellation = True
TestUserLogin.RunWorkerAsync()

' End If

Catch ex As Exception

MessageBox.Show(ex.Message, "Error7", MessageBoxButtons.OK, MessageBoxIcon.Error)

End Try

End Sub
Public Sub PictureBox2False()

On Error Resume Next

If Me.InvokeRequired Then
Me.Invoke(New PictureBox2Callback(AddressOf PictureBox2False), New Object() {})
Else
Me.Cursor = Cursors.Default
'PictureBox5.Visible = False

Button1.Text = ("send")
End If

End Sub
Dim html As String
Private Sub AppendText(ByVal t2xt As String)

Dim txt As String = t2xt
'TextBox1.Text = t2xt
Dim txt1 As String = txt.Substring(txt.IndexOf(":") + 0)
Dim txt3 As String = txt.Substring(txt.IndexOf(":") + 1)
Dim txt2 As String = txt.Split(":")(0)

'For Each i As String In My.Computer.FileSystem.ReadAllText(Application.StartupPath + "\s\IMo.ini").Split(vbNewLine)
' Try
' Dim htmms As String = My.Resources.String2 + Application.StartupPath + "\s\" + i.Split("-")(1).Replace(Chr(10), "|").Replace(Chr(13), "|") + My.Resources.String3
' txt1 = txt1.Replace(i.Split("-")(0).Replace(Chr(10), "").Replace(Chr(13), ""), htmms)
' Catch ex As Exception
' End Try
'Next
If txt3.StartsWith(" /ytplayer") Then

'For Each i As String In txt
html += ("" + txt2 + "" + ": " + "<a href=""" + txt3 + """>******* - " + txt3.Split("/")(1) + "</a>" + " ")
chatrec.DocumentText = html
' Next
ElseIf txt3.StartsWith(" /Link$") Then

'For Each i As String In txt
html += ("" + txt2 + "" + ": " + "<a href=""" + txt3 + """>" + txt3.Split("$")(1) + "</a>" + " ")
chatrec.DocumentText = html
'Next
ElseIf txt3.StartsWith(" http://www.*******.com") Then

TextBox1.Text = txt3
html += ("" + txt2 + "" + ":" + "<a href=""" + txt3 + """>******* - " + txt3 + "</a>" + " ")
chatrec.DocumentText = html

Else

html += "" + txt2 + "" + txt1 + " "
chatrec.DocumentText = html
End If

End Sub

Imports System.Data.SqlClient

مشكله فى فتح نفس فورم اكثر من مره متصل بقاعده بيانات ع النت

مواضيع مشابهة

عدد الزوار حالياً