• 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

Điều hành viên: tungcan5diop, QUANITGROBEST

dactung93
Thành viên tâm huyết
Thành viên tâm huyết
Bài viết: 496
Ngày tham gia: T.Ba 04/11/2008 8:43 am
Has thanked: 6 time
Been thanked: 8 time

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

Gửi bàigửi bởi dactung93 » T.Sáu 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
  1. 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
  2. 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
  3. Public Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
  4. Public Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
  5.  
  6. Public Const IF_FROM_CACHE = &H1000000
  7. Public Const IF_MAKE_PERSISTENT = &H2000000
  8. Public Const IF_NO_CACHE_WRITE = &H4000000
  9.  
  10. Private Const BUFFER_LEN = 256
  11.  
  12. Public Function GetUrlSource(sURL As String) As String
  13.     Dim sBuffer As String * BUFFER_LEN, iResult As Integer, sData As String
  14.     Dim hInternet As Long, hSession As Long, lReturn As Long
  15.     hSession = InternetOpen("vb wininet", 1, vbNullString, vbNullString, 0)
  16.     If hSession Then hInternet = InternetOpenUrl(hSession, sURL, vbNullString, 0, IF_NO_CACHE_WRITE, 0)
  17.     If hInternet Then
  18.  
  19.         iResult = InternetReadFile(hInternet, sBuffer, BUFFER_LEN, lReturn)
  20.         sData = sBuffer
  21.  
  22.         Do While lReturn <> 0
  23.             iResult = InternetReadFile(hInternet, sBuffer, BUFFER_LEN, lReturn)
  24.             sData = sData + Mid(sBuffer, 1, lReturn)
  25.         Loop
  26.     End If
  27.     iResult = InternetCloseHandle(hInternet)
  28.     GetUrlSource = sData
  29. End Function
  30.  
  31.  
  32.  


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
Sửa lần cuối bởi NoBi vào ngày T.Năm 17/12/2009 10:11 pm với 2 lần sửa.
Lý do: định dạng phù hợp mẫu, sửa Tiêu đề tiếng Việt



Hình đại diện của người dùng
truongphu
VIP
VIP
Bài viết: 4756
Ngày tham gia: CN 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 time
Been thanked: 509 time

Re: Check Port is Open or Not ?

Gửi bàigửi bởi truongphu » T.Bảy 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


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

Đang trực tuyến

Đang xem chuyên mục này: Không có thành viên nào trực tuyến.1 khách