منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب

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

رمضان كريم

لقد تعبة كثيرا في البحث على هذا الكود الموجود في هذا الرابـــــــط

الى انني لما حاولت تطبيقه

المشكلة انه عند تشغيل البرنامج يصبح لا يجيب اي وكانه هناك خطء

يصبح البرنامج جامد اذ لا استطيح حتى اقفاله

اريد وضع زر لتشغيل الكود والاخر لاقفال

ارجو انني قد وضحت السؤال

وشكرا جزيلا Shy

كود :

Imports System.Net

Imports System.Net.Sockets

Imports System.Text

كود :

Dim soc As New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)

Try

soc.Bind(New IPEndPoint(IPAddress.Parse("127.0.0.1"), 4040))

soc.Listen(10)

Me.Text = "Web Server Started ..."

While True

Dim client As Socket = soc.Accept

Dim sb As New System.Text.StringBuilder

Dim html As String = "<html><head><title>Web Server Test</title></head><body><h1>Web Server Hello wolrd!</h1></body></html>"

Dim htmlHeader As String = _

"HTTP/1.0 200 OK" & ControlChars.CrLf & _

"Server: WebServer 1.0" & ControlChars.CrLf & _

"Content-Length: " & html.Length & ControlChars.CrLf & _

"Content-Type: text/html" & _

ControlChars.CrLf & ControlChars.CrLf

Dim headerByte() As Byte = Encoding.ASCII.GetBytes(htmlHeader)

client.Send(headerByte, headerByte.Length, SocketFlags.None)

Dim htmlByte() As Byte = Encoding.ASCII.GetBytes(html)

client.Send(htmlByte, 0, htmlByte.Length, SocketFlags.None)

End While

Catch ex As Exception

MsgBox(ex.Message)

End Try

عندما نشغل البرنامج يصبح لا يجيب لكن الكود يعمل صحيح وللتجريب
نفتح المتصفح ونحط http://127.0.0.1:4040/
نجد ان الكود شغال لكن البرنامج لا يجيب

كود :

Imports System.Net

Imports System.Net.Sockets

Imports System.Text

Public Class Form1

    Dim soc As Socket

    Dim thr As Threading.Thread

    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load

        Control.CheckForIllegalCrossThreadCalls = False

        Button1.Text = "Start"

    End Sub

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

        If thr Is Nothing Then

            Button1.Text = "Stop"

            thr = New Threading.Thread(AddressOf runWebServer)

            thr.IsBackground = True

            thr.Start()

            Process.Start("http://127.0.0.1:4040/") 'هذا السطر للإختبار يمكن حذفه

        Else

            soc.Close()

            thr.Abort()

            thr = Nothing

            Me.Text = "Web Server Stopped ..."

            Button1.Text = "Start"

        End If

    End Sub

    Sub runWebServer()

        Try

            soc = New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)

            soc.Bind(New IPEndPoint(IPAddress.Parse("127.0.0.1"), 4040))

            soc.Listen(10)

            Me.Text = "Web Server Started ..."

            While True

                Dim client As Socket = soc.Accept

                Dim sb As New System.Text.StringBuilder

                Dim html As String =

                    "<html dir='rtl'> " & _

                    "<head> " & _

                    "   <title>Web Server Test</title> " & _

                    "   <meta http-equiv='Content-Type' content='text/html; charset=UTF-8' /> " & _

                    "</head> " & _

                    "<body> " & _

                    "   <h1>مرحباً بكم في الويب سيرفر</h1> " & _

                    "</body> " & _

                    "</html>"

                Dim htmlHeader As String = _

                    "HTTP/1.0 200 OK" & ControlChars.CrLf & _

                    "Server: WebServer 1.0" & ControlChars.CrLf & _

                    "Content-Length: " & html.Length & ControlChars.CrLf & _

                    "Content-Type: text/html" & ControlChars.CrLf & _

                    ControlChars.CrLf

                Dim headerByte() As Byte = Encoding.UTF8.GetBytes(htmlHeader)

                client.Send(headerByte, headerByte.Length, SocketFlags.None)

                Dim htmlByte() As Byte = Encoding.UTF8.GetBytes(html)

                client.Send(htmlByte, 0, htmlByte.Length, SocketFlags.None)

            End While

        Catch ex As Exception

            'MsgBox(ex.Message)

        End Try

    End Sub

End Class

(05-06-17, 09:27 PM)alma2 كتب : [ -> ]

كود :

Imports System.Net Imports System.Net.Sockets Imports System.Text Public Class Form1 Dim soc As Socket Dim thr As Threading.Thread Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load Control.CheckForIllegalCrossThreadCalls = False Button1.Text = "Start" End Sub Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click If thr Is Nothing Then Button1.Text = "Stop" thr = New Threading.Thread(AddressOf runWebServer) thr.IsBackground = True thr.Start() Process.Start("http://127.0.0.1:4040/") 'هذا السطر للإختبار يمكن حذفه Else soc.Close() thr.Abort() thr = Nothing Me.Text = "Web Server Stopped ..." Button1.Text = "Start" End If End Sub Sub runWebServer() Try soc = New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp) soc.Bind(New IPEndPoint(IPAddress.Parse("127.0.0.1"), 4040)) soc.Listen(10) Me.Text = "Web Server Started ..." While True Dim client As Socket = soc.Accept Dim sb As New System.Text.StringBuilder Dim html As String = "<html dir='rtl'> " & _ "<head> " & _ " <title>Web Server Test</title> " & _ " <meta http-equiv='Content-Type' content='text/html; charset=UTF-8' /> " & _ "</head> " & _ "<body> " & _ " <h1>مرحباً بكم في الويب سيرفر</h1> " & _ "</body> " & _ "</html>" Dim htmlHeader As String = _ "HTTP/1.0 200 OK" & ControlChars.CrLf & _ "Server: WebServer 1.0" & ControlChars.CrLf & _ "Content-Length: " & html.Length & ControlChars.CrLf & _ "Content-Type: text/html" & ControlChars.CrLf & _ ControlChars.CrLf Dim headerByte() As Byte = Encoding.UTF8.GetBytes(htmlHeader) client.Send(headerByte, headerByte.Length, SocketFlags.None) Dim htmlByte() As Byte = Encoding.UTF8.GetBytes(html) client.Send(htmlByte, 0, htmlByte.Length, SocketFlags.None) End While Catch ex As Exception 'MsgBox(ex.Message) End Try End Sub End Class

شكرا لك اخي نجحت معي
الله يتقبل صيامك وقيامك Smile

لو سمحتم اضافة صغيرة منفظلكم وهي اريد عرض معلومات الصفحة في التكست بوكس بنفس الكود

مثال

هل يمكن عرض معلومات الصفحة المفوحة بالكود نفسه

منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب

anes

alma2

anes

anes

anes