• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Kiểm tra cổng mở hay chưa

Các thủ thuật về hệ thống, thư mục, tập tin và mạng

Moderators: tungcan5diop, QUANITGROBEST

dactung93
Thành viên tâm huyết
Thành viên tâm huyết
Posts: 496
Joined: Tue 04/11/2008 8:43 am
Has thanked: 6 times
Been thanked: 8 times

Kiểm tra cổng mở hay chưa

Postby dactung93 » Fri 11/12/2009 10:50 pm

Thủ thuật: Kiểm tra cổng mở hay chưa
Tác giả: dacting93
Mô tả: Kiểm tra cổng mở hay chưa


Thực ra cách này em dựa vào một trang web để kiểm tra thôi.
Do học lập trình không đến nơi đến chốn + Đam mê đã ra 1 đoạn mã nguồn rất củ chuối. Anh em tham khảo, rồi dạy em cách tách chuỗi nha

Code from 1.
Gồm:
1 button
2 label
1 textbox
  1. Dim src As String
  2. Function Tach(chuoi As String)
  3. Dim a, b As Integer
  4. Dim kq As String
  5. kq = chuoi
  6. ' Tim dau hieu cua su open Port
  7. kq = Replace(kq, "Port " & Text1.Text & " is open and accepting connections.", "`", 1, -1, vbBinaryCompare)
  8. kq = Replace(kq, "Port " & Text1.Text & " is open and accepting connections.", "`", 1, -1, vbBinaryCompare)
  9.  
  10. 'Tach bang For
  11. ' Lan tach thu nhat
  12. For a = 1 To 95
  13.     kq = Replace(kq, Chr(a), "", 1, -1, vbBinaryCompare)
  14. Next a
  15.  
  16. ' Lan tach thu hai
  17. For a = 97 To 128
  18.     kq = Replace(kq, Chr(a), "", 1, -1, vbBinaryCompare)
  19. Next a
  20.  
  21. kq = Replace(kq, "`", "Port " & Text1.Text & " is open and accepting connections.", 1, -1, vbBinaryCompare)
  22. kq = Right(kq, Len(kq) - 34)
  23. b = Len("Port " & Text1.Text & " is open and accepting connections.")
  24. kq = Left(kq, b)
  25. Tach = kq
  26. End Function
  27.  
  28. Private Sub Command1_Click()
  29. Label2.Caption = "Preparing for checking"
  30. src = GetUrlSource("http://www.utorrent.com/testport?port=" & Text1.Text)
  31. Label2.Caption = Tach(src)
  32. If Label2.Caption <> "Port " & Text1.Text & " is open and accepting connections." Then
  33. Label2.Caption = "Port " & Text1.Text & " is not open and accepting connections."
  34. End If
  35. End Sub
  36.  
  37.  
  38.  


Code module
[vb]
Public Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Public Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal sURL As String, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Public Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Public Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer

Public Const IF_FROM_CACHE = &H1000000
Public Const IF_MAKE_PERSISTENT = &H2000000
Public Const IF_NO_CACHE_WRITE = &H4000000

Private Const BUFFER_LEN = 256

Public Function GetUrlSource(sURL As String) As String
Dim sBuffer As String * BUFFER_LEN, iResult As Integer, sData As String
Dim hInternet As Long, hSession As Long, lReturn As Long
hSession = InternetOpen("vb wininet", 1, vbNullString, vbNullString, 0)
If hSession Then hInternet = InternetOpenUrl(hSession, sURL, vbNullString, 0, IF_NO_CACHE_WRITE, 0)
If hInternet Then

iResult = InternetReadFile(hInternet, sBuffer, BUFFER_LEN, lReturn)
sData = sBuffer

Do While lReturn <> 0
iResult = InternetReadFile(hInternet, sBuffer, BUFFER_LEN, lReturn)
sData = sData + Mid(sBuffer, 1, lReturn)
Loop
End If
iResult = InternetCloseHandle(hInternet)
GetUrlSource = sData
End Function


[/vb]

Cứ nhập cổng cần check rồi bấm vô check.
Cái này có thể áp dụng để check nhiểu cổng một lúc. Rất hữu dụng cho những người nào hay download = torrent để kiểm tra cổng. Đôi khi kiểm tra cổng nào đang "bị" mở để đóng vào tránh bị đột nhập

Ý tưởng thì hay nhưng em code kém quá, ai sửa hộ em với
Last edited by NoBi on Thu 17/12/2009 10:11 pm, edited 2 times in total.
Reason: định dạng phù hợp mẫu, sửa Tiêu đề tiếng Việt



User avatar
truongphu
VIP
VIP
Posts: 4766
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 520 times

Re: Check Port is Open or Not ?

Postby truongphu » Sat 12/12/2009 5:52 pm

*- Nếu không bắt buộc, đề bài nên là tiếng Việt

  1. ' Function có giá tri tra vê` là String
  2. Function KetQua(Chuoi As String) As String
  3. ' Tang dactung93 bài hoc tách Chuôi~
  4. Dim A1 As Integer, A2 As Integer
  5. ' Tìm vi trí A1 chu Checking port, chi có 1 chu' nây duy nhât
  6. A1 = InStr(1, Chuoi, "Checking port", vbBinaryCompare)
  7. ' Tìm vi trí A2 chu Port, chi có 1 chu' nây duy nhât sau Checking port
  8. A2 = InStr(A1, Chuoi, "Port", vbBinaryCompare)
  9. ' Tìm vi trí A1 chu </strong> kê't thúc TAG kê't qua mà Url Ðã check. Tri sô' A1 ban Ðâu bo Ði
  10. A1 = InStr(A2 + Len(Text1) + 22, Chuoi, "</strong>", vbBinaryCompare)
  11. ' KetQua là Ðoan giua tu A2 Ðê'n A1
  12. KetQua = Mid(Chuoi, A2, A1 - A2)
  13. ' Loai bo các <Tag>
  14. KetQua = Replace(KetQua, "<strong>", "")
  15. KetQua = Replace(KetQua, "</strong>", "")
  16. End Function
  17.  
  18. Private Sub Command1_Click()
  19. ' Label1 nhân giá tri tra vê` cua hàm KetQua
  20. Label1.Caption = KetQua(GetUrlSource("http://www.utorrent.com/testport?port=" & Text1.Text))
  21. End Sub
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh


Return to “[.NET] Hệ thống - Tập tin - Thư mục và Mạng”

Who is online

Users browsing this forum: No registered users and 2 guests