السلام عليكم
قمت بكتابة كود من اليوتيوب من خلال الفيديو مباشرة
الى ان سطران في حافة الفيدية تحذر رئيتهم
ارجو المساعدة من الاساتذة الكرام
هذا الكود منقوص من نصف السطرين
كود :
Imports System.IO
Imports System.Net
Imports System.Net.Sockets
Imports System.Text
Public Class Form1
Dim WithEvents Svr As TcpListener
Dim threadListen As Threading.Thread
Dim thrC As New List(Of Threading.Thread)
Dim enc As New System.Text.UTF8Encoding
Private Sub StartListen()
While True
Try
Dim tc As TcpClient = Svr.AcceptTcpClient
Dim thr As New Threading.Thread(AddressOf requestHandler)
thr.Start(New Object() {tc, thrC.Count})
thrC.Add(thr)
Catch ex As Exception
Exit While
End Try
End While
End Sub
Private Sub requestHandler(ByVal param As Object())
Dim cln As TcpClient = param(0)
Dim id As Integer = param(1)
Dim recv As Integer = 0
Try
Do
Dim b(cln.SendBufferSize) As Byte
recv = cln.GetStream.Read(b, 0, b.Length)
Dim cek As String = enc.GetString(b)
If cek.Contains("GET /") = True Then
cek = cek.Replace("GET /", "")
cek = cek.Substring(0, cek.IndexOf(" "))
Try
While True
If cek.Contains("%") = True Then
Dim code As String = cek.Substring(cek.IndexOf("%") + 1, 2)
Dim code_rebuild As String = ChrW(Convert.ToByte(code, 16))
cek = cek.Replace("%" & code, code_rebuild)
Else
Exit While
End If
End While
Catch ex As Exception
End Try
TextBox1.Text = cek
If cek = "" Then
cek = "index.html"
End If
cek = Application.StartupPath & "\HomePage\" & cek
Dim ofile = New System.IO.FileInfo(cek)
Dim file_Type As String = ""
If LCase(cek).Contains(".") = True Then
Dim extension As String = cek.Substring(cek.IndexOf("."))
file_Type = getcontentType(extension) & "Content-length:" & ofile.Length & vbCrLf
End If
Dim response_200() As Byte = enc.GetBytes("HTTP/1.1 200 OK" & vbCrLf & file_Type & "server:MRI-server=" & My.Application, )
cln.GetStream.Write(response_200, 0, response_200.Length)
Dim fstream As New FileStream(ofile.FullName, FileMode.Open, FileAccess.Read)
Dim br As New BinaryReader(fstream)
Dim data() As Byte = br.readbytes(fstream.Length)
cln.GetStream.Write(data, 0, data.Length)
Else
Dim Response_404() As Byte = enc.GetBytes("HTTP/1.1 404 NOT Found" & vbCrLf & "Refresh: s; url=/" & vbCrLf & vbCr)
cln.GetStream.Write(Response_404, 0, Response_404.Length)
End If
Loop Until cln.Connected
Catch ex As Exception
If cln.Connected Then cln.Close()
End Try
Try
If cln.Connected Then cln.Close()
If Not thrC(id) Is Nothing Then
If thrC(id).IsAlive Then thrC(id).Abort()
End If
Catch ex As Exception
End Try
End Sub
Private Shared Function getcontentType(ByVal extension As String) As String
Dim CT As String = ""
Try
Select Case extension
Case ".css"
CT = "text/css"
Case ".php"
CT = "text/php"
Case ".htm", ".html"
CT = "text/html"
Case ".js"
CT = "application/x-javascript"
Case ""
Case ""
Case ""
Case ""
Case ""
End Select
Catch ex As Exception
End Try
If CT <> " " Then
CT = "Content-Type:" & CT & vbCrLf
End If
Return CT
End Function
Private Sub Form1_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
End
End Sub
Dim strHostName As String = System.Net.Dns.GetHostName
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Try
Me.TextBox2.Text = "127.0.0.1"
'Me.TextBox2.Text = Dns.GetHostByName(strHostName).AddressList(0).ToString
Catch ex As Exception
Me.TextBox2.Text = "127.0.0.1"
End Try
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
If Button1.Text = "Start" Then
Button1.Text = "Stop"
Dim ip = New System.Net.IPEndPoint(System.Net.IPAddress.Parse(Me.TextBox2.Text), 80)
Svr = New TcpListener(ip)
Try
Svr.Start()
threadListen = New Threading.Thread(AddressOf StartListen)
threadListen.Start()
Catch ex As Exception
MsgBox("Error: " & ex.Message)
End Try
Else
Button1.Text = "Start"
Try
Svr.Stop()
Catch ex As Exception
End Try
For Each t As Threading.Thread In thrC
Try
If t.IsAlive Then t.Abort()
Catch ex As Exception
End Try
Next
End If
End Sub
End Classو ايضا وجدت هذا الكود في هذاالرابط فهل يمكن تطبيقه بنفس الفكرة
كود :
Imports System.IO
Imports System.Net
Imports System.Net.Sockets
Imports System.Text
Imports System.Threading
Imports System.Xml
Public Class WebServer
#Region "Declarations"
Private Shared singleWebserver As WebServer
Private Shared blnFlag As Boolean
Private LocalTCPListener As TcpListener
Private LocalPort As Integer = 80
Private LocalAddress As IPAddress = GetIPAddress()
Private DefaultDoc As String = "index.html"
Private WebThread As Thread
Private LocalImageDir As String
Private LocalVirtualRoot As String
#End Region
#Region "Properties"
Public Property ListenWebPort() As Integer
Get
Return LocalPort
End Get
Set(ByVal Value As Integer)
LocalPort = Value
End Set
End Property
Public ReadOnly Property ListenIPAddress() As IPAddress
Get
Return LocalAddress
End Get
End Property
Public Property DefaultDocument() As String
Get
Return DefaultDoc
End Get
Set(ByVal Value As String)
DefaultDoc = Value
End Set
End Property
Public Property ImageDirectory() As String
Get
Return LocalImageDir
End Get
Set(ByVal Value As String)
LocalImageDir = Value
End Set
End Property
Public Property VirtualRoot() As String
Get
Return LocalVirtualRoot
End Get
Set(ByVal Value As String)
LocalVirtualRoot = Value
End Set
End Property
#End Region
#Region "Methods"
Private Function GetIPAddress() As IPAddress
Dim oAddr As System.Net.IPAddress
Dim sAddr As String
With System.Net.Dns.GetHostByName(System.Net.Dns.GetHostName())
If .AddressList.Length > 0 Then
oAddr = New IPAddress(.AddressList.GetLowerBound(0))
End If
End With
GetIPAddress = oAddr
End Function
Friend Shared Function getWebServer() As WebServer
If Not blnFlag Then
singleWebserver = New WebServer
blnFlag = True
Return singleWebserver
Else
Return singleWebserver
End If
End Function
Public Sub StartWebServer()
Try
LocalTCPListener = New TcpListener(LocalAddress, LocalPort)
LocalTCPListener.Start()
WebThread = New Thread(AddressOf StartListen)
WebThread.Start()
Catch ex As Exception
Console.WriteLine(ex.Message)
End Try
End Sub
'Here is where we check our XML file and see what MIME types are defined and handle the accordingly.
Public Function GetMimeType(ByVal sRequestFile As String) As String
Dim sr As StreamReader
Dim sLine As String = ""
Dim sMimeType As String = ""
Dim sFileExt As String = ""
Dim sMimeExt As String = ""
sRequestFile = sRequestFile.ToLower
Dim iStartPos As Integer = sRequestFile.IndexOf(".") + 1
sFileExt = sRequestFile.Substring(iStartPos)
'now go through the mime definitions and apply to the request.
Dim dom As New XmlDocument
dom.Load(Application.StartupPath & "\Settings.xml")
Dim objCurrentNode As XmlNode
objCurrentNode = dom.SelectSingleNode("//mimetypes")
'now go through all child nodes.
If objCurrentNode.HasChildNodes Then
'loop
Dim xmlMimeType As XmlNode
For Each xmlMimeType In objCurrentNode
sMimeExt = xmlMimeType.Name
sMimeType = xmlMimeType.InnerText
If (sMimeExt = sFileExt) Then
Exit For
End If
Next
End If
If sMimeExt = sFileExt Then
Return sMimeType
Else
Return ""
End If
End Function
Public Function GetTheDefaultFileName(ByVal sLocalDirectory As String) As String
Return "index.html"
End Function
Public Function GetLocalPath(ByVal sWebServerRoot As String, ByVal sDirName As String) As String
'Dim sr As StreamReader
'Dim sLine As String = ""
Dim sVirtualDir As String = ""
Dim sRealDir As String = ""
Dim iStartPos As Integer = 0
sDirName.Trim()
sWebServerRoot = sWebServerRoot.ToLower
sDirName = sDirName.ToLower
Select Case sDirName
Case "/"
sRealDir = LocalVirtualRoot
Case Else
If Mid$(sDirName, 1, 1) = "/" Then
sDirName = Mid$(sDirName, 2, Len(sDirName))
End If
sRealDir = LocalVirtualRoot & sDirName.Replace("/", "\")
End Select
Return sRealDir
End Function
Public Sub SendHeader(ByVal sHttpVersion As String, ByVal sMimeHeader As String, _
ByVal iTotalBytes As Integer, ByVal sStatusCode As String, ByRef thisSocket As Socket)
Dim sBuffer As String = ""
If Len(sMimeHeader) = 0 Then
sMimeHeader = "text/html"
End If
sBuffer = sHttpVersion & sStatusCode & vbCrLf & _
"Server: X10CamControl" & vbCrLf & _
"Content-Type: " & sMimeHeader & vbCrLf & _
"Accept-Ranges: bytes" & vbCrLf & _
"Content-Length: " & iTotalBytes & vbCrLf & vbCrLf
Dim bSendData As [Byte]() = Encoding.ASCII.GetBytes(sBuffer)
SendToBrowser(bSendData, thisSocket)
End Sub
Public Overloads Sub SendToBrowser(ByVal sData As String, ByRef thisSocket As Socket)
SendToBrowser(Encoding.ASCII.GetBytes(sData), thisSocket)
End Sub
Public Overloads Sub SendToBrowser(ByVal bSendData As [Byte](), ByRef thisSocket As Socket)
Dim iNumBytes As Integer = 0
If thisSocket.Connected Then
If (iNumBytes = thisSocket.Send(bSendData, bSendData.Length, 0)) = -1 Then
'socket error can't send packet
Else
'number of bytes sent.
End If
Else
'connection dropped.
End If
End Sub
Private Sub New()
'create a singleton
End Sub
Private Sub StartListen()
Dim iStartPos As Integer
Dim sRequest As String
Dim sDirName As String
Dim sRequestedFile As String
Dim sErrorMessage As String
Dim sLocalDir As String
Dim sWebserverRoot = LocalVirtualRoot
Dim sQueryString As String
Dim sPhysicalFilePath As String = ""
Dim sFormattedMessage As String = ""
Do While True
'accept new socket connection
Dim mySocket As Socket = LocalTCPListener.AcceptSocket
If mySocket.Connected Then
Dim bReceive() As Byte = New [Byte](1024) {}
Dim i As Integer = mySocket.Receive(bReceive, bReceive.Length, 0)
Dim sBuffer As String = Encoding.ASCII.GetString(bReceive)
'find the GET request.
If (sBuffer.Substring(0, 3) <> "GET") Then
mySocket.Close()
Return
End If
iStartPos = sBuffer.IndexOf("HTTP", 1)
Dim sHttpVersion = sBuffer.Substring(iStartPos, 8)
sRequest = sBuffer.Substring(0, iStartPos - 1)
sRequest.Replace("\\", "/")
If (sRequest.IndexOf(".") < 1) And (Not (sRequest.EndsWith("/"))) Then
sRequest = sRequest & "/"
End If
'get the file name
iStartPos = sRequest.LastIndexOf("/") + 1
sRequestedFile = sRequest.Substring(iStartPos)
If InStr(sRequest, "?") <> 0 Then
iStartPos = sRequest.IndexOf("?") + 1
sQueryString = sRequest.Substring(iStartPos)
sRequestedFile = Replace(sRequestedFile, "?" & sQueryString, "")
End If
'get the directory
sDirName = sRequest.Substring(sRequest.IndexOf("/"), sRequest.LastIndexOf("/") - 3)
'identify the physical directory.
If (sDirName = "/") Then
sLocalDir = sWebserverRoot
Else
sLocalDir = GetLocalPath(sWebserverRoot, sDirName)
End If
'if the directory isn't there then display error.
If sLocalDir.Length = 0 Then
sErrorMessage = "Error!! Requested Directory does not exists"
SendHeader(sHttpVersion, "", sErrorMessage.Length, " 404 Not Found", mySocket)
SendToBrowser(sErrorMessage, mySocket)
mySocket.Close()
End If
If sRequestedFile.Length = 0 Then
sRequestedFile = GetTheDefaultFileName(sLocalDir)
If sRequestedFile = "" Then
sErrorMessage = "Error!! No Default File Name Specified"
SendHeader(sHttpVersion, "", sErrorMessage.Length, " 404 Not Found", mySocket)
SendToBrowser(sErrorMessage, mySocket)
mySocket.Close()
Return
End If
End If
Dim sMimeType As String = GetMimeType(sRequestedFile)
sPhysicalFilePath = sLocalDir & sRequestedFile
If Not File.Exists(sPhysicalFilePath) Then
sErrorMessage = "404 Error! File Does Not Exists..."
SendHeader(sHttpVersion, "", sErrorMessage.Length, " 404 Not Found", mySocket)
SendToBrowser(sErrorMessage, mySocket)
Else
Try
Dim iTotBytes As Integer = 0
Dim sResponse As String = ""
Dim fs As New FileStream(sPhysicalFilePath, FileMode.Open, FileAccess.Read, FileShare.Read)
Dim reader As New BinaryReader(fs)
Dim bytes() As Byte = New Byte(fs.Length) {}
While reader.BaseStream.Position < reader.BaseStream.Length
reader.Read(bytes, 0, bytes.Length)
sResponse = sResponse & Encoding.ASCII.GetString(bytes, 0, reader.BaseStream.Length)
iTotBytes = reader.BaseStream.Length
End While
reader.Close()
fs.Close()
SendHeader(sHttpVersion, sMimeType, iTotBytes, " 200 OK", mySocket)
SendToBrowser(bytes, mySocket)
Catch ex As Exception
sErrorMessage = "404 Error! File Does Not Exists..."
SendHeader(sHttpVersion, "", sErrorMessage.Length, " 404 Not Found", mySocket)
SendToBrowser(sErrorMessage, mySocket)
End Try
End If
mySocket.Close()
End If
Loop
End Sub
Public Sub StopWebServer()
Try
LocalTCPListener.Stop()
WebThread.Abort()
Catch ex As Exception
Console.WriteLine(ex.Message)
End Try
End Sub
#End Region
End Class
