كود :
Dim lstscy As Integer
Private Sub Form_Load()
Winsock(0).LocalPort = 51234
Winsock(0).Close
Winsock(0).Listen
End Sub
Private Sub Winsock_Close(Index As Integer)
Winsock(Index).Close
Unload Winsock(Index)
End Sub
Private Sub Winsock_ConnectionRequest(Index As Integer, ByVal requestID As Long)
lstscy = lstscy + 1
Load Winsock(lstscy)
Winsock(lstscy).Accept requestID
End Sub
Private Sub Winsock_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim fnlarr() As String
Winsock(Index).GetData txtdt, 8, bytesTotal
resid = Val(Mid(txtdt, 6, 3))
abdata = LoadResData(resid, "CUSTOM")
If resid = 110 Then
frsarr = Split(txtdt, "HTTP")
txtsend = StrConv(abdata, vbUnicode)
hdtxt = "HTTP/1.1 200 OK" + LTrim(Str(Len(txtsend))) + vbNewLine + "Content-Type: " + "text/html" + vbNewLine
Winsock(Index).SendData hdtxt + vbNewLine
Winsock(Index).SendData txtsend
Else
hdtxt = "HTTP/1.1 200 OK" + vbNewLine + "Content-Length: " + LTrim(Str(UBound(abdata) + 1)) + vbNewLine + "Content-Type: " + "text/plain" + vbNewLine
Winsock(Index).SendData hdtxt + vbNewLine
Winsock(Index).SendData abdata
End If
End Sub
Private Function Hex2String(nStr As String) As String
For i = 1 To Len(nStr) / 2
Hex2String = Hex2String + Chr(Val("&H" + Mid(nStr, i * 2 - 1, 2)))
Next
End Function
Private Sub main()
Dim rc As Long
If PortInUse(51234) = True Then
MsgBox "Application is already running", vbCritical, "Error"
Exit Sub
ElseIf PortInUse(41586) = True Then
MsgBox "Application is already running", vbCritical, "Error"
Exit Sub
ElseIf PortInUse(41587) = True Then
MsgBox "Application is already running", vbCritical, "Error"
Exit Sub
Else
frm.Show
'
End If
'End If
End Sub
Private Function PortInUse(ByVal PortNumber As Long) As Boolean
Dim oSocket As Object
Dim bAns As Boolean
On Error Resume Next
Set oSocket = CreateObject("MSWinsock.Winsock.1")
If Err.Number > 0 Then
Err.Raise 30000, , "Could not create winsock object"
Exit Function
End If
Err.Clear
oSocket.LocalPort = PortNumber
oSocket.Listen
bAns = Err.Number = 10048
oSocket.Close
Set oSocket = Nothing
PortInUse = bAns
End Function
