مشكلة في توظيف الكود - anes - 05-06-17
السلام عليكم ورحمة الله
رمضان كريم
الى انني لما حاولت تطبيقه
المشكلة انه عند تشغيل البرنامج يصبح لا يجيب اي وكانه هناك خطء
يصبح البرنامج جامد اذ لا استطيح حتى اقفاله
اريد وضع زر لتشغيل الكود والاخر لاقفال
ارجو انني قد وضحت السؤال
وشكرا جزيلا
كود :
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/
نجد ان الكود شغال لكن البرنامج لا يجيب
RE: مشكلة في توظيف الكود - alma2 - 05-06-17
كود :
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
RE: مشكلة في توظيف الكود - anes - 05-06-17
(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
شكرا لك اخي نجحت معي
الله يتقبل صيامك وقيامك
RE: مشكلة في توظيف الكود - anes - 07-06-17
لو سمحتم اضافة صغيرة منفظلكم وهي اريد عرض معلومات الصفحة في التكست بوكس بنفس الكود
مثال
RE: مشكلة في توظيف الكود - anes - 08-06-17
هل يمكن عرض معلومات الصفحة المفوحة بالكود نفسه
|