ئىنتىل تورى

تىزىملىتىش |كىرىش

ئىنتىل تورى › دەرۋازا › تېما كۆرۈش

‹‹مۇسابىقە›› تور نامىنىڭ ئۇچۇرلىرى (whois) نى تېپىش

يوللىغۇچى: alsuyar| يوللانغان ۋاقتى: 2010-9-19 22:30| كۆرۈلۈشى: 72| ئىنكاس سانى: 1

مۇسابىقىگە قاتناشقىلى بىر نەچچە كۇن بۇلۇپ قاپتۇ  . قارىسام بۇ مۇسابىقىنى كۇرىدىغانلا بەكلا ئاز  ، مەن VB توغرىسىدا يوللانغان ھەر بىر ماقالىنى بىر نەچچە رەت كۇرۇپ چىقىمەن ، بۇنىڭ قېتىدا ئۇزۇمنىڭ تىمىلىرىمۇ بار ئەلۋەتتە . كۇرۇشىمدىكى سەۋەپ بولسا بۇ ھەقتە سورالغان سۇئاللار بارمۇ - يوق دىگەندەك .  ئەلۋەتتە نۇرغۇن تورداشلار VB بىلىملىرىنى مۇكەممەل بىلمەسلىكى ھەتتاكى پەقەتلا بىلمەسلىكى تۇرغانلا گەپ!!!  مەنمۇ بەك بىلىم كەتمەيمەن پەقەتلا بىلىدىغىنىم  سەينا تېخىمۇ قىزىپ كەتسە (تور توختاشتىن بۇرۇن شۇنداق قىزغىن ئىدى) يەنە شۇنداق قىزىپ كەتسە دىگەن ئۇمۇتتە بىلگەن نەرسىلىرىمنى ئازراق چۇشەنچە قىلىپ يوللاپ قويدۇم . بۇ ئارقىلىق بىزنىڭ ئۇستازلار ، ۋە يېڭى ئوگەنگۇچىلەر بىلەن ئازراق ئورتاقلىشىپ بىقىش ... بۇ ئارقىلىق بىلمىگەننى بىلىۋېلىش ، بىلمىگەنگە بىلدۇرۇش ئىدى.  بۇرۇنقى ساينانىڭ شۇئارى بولسا << بىلگەننى يوللاڭ بىلمىگەنلەر بىلىۋالسۇن! بىلمىەەننى سوراڭ بىلگەنلەر دەپ بەرسۇن! >> مانا بۇ ئىنتىلنىڭ شۇنداقلا ئىنتىللىقلارنىڭ شۇئارى ئىدى.
ئۇنداقتا گەپ مۇشۇ يەردە ئاخىرلاشسۇن .
ئەمسە بىز بىر دانە Form ، بىر دانە Module  . يەنە بىرCommand . يەنە  ئىككى دانە Text سىزىڭ . يەنە كونوپكا تاختىسىدىن ctrl+t  بۇ ئىككىسىنى بېىسىڭ چىققان تىزىملىكتىن microsoft winsock Control 6.0 بۇ كونتىرولنى قۇشۇڭ .  قۇشۇپ بولغان بولسىڭىز Form نىڭ ئۇستىگە Winsock  بۇ كونتىرونىمۇ قۇشۇڭ  
ھەممىنى قۇشۇپ بولغان بولسىڭىز ئەمدى Module  كود يېزىش رايۇنىغا توۋەندىكى كودنى چاپلاڭ.
  1. Option Explicit
  2. Public Function Utf8ToUnicode(Utf() As Byte) As String
  3.     Dim utfLen As Long
  4.     utfLen = -1
  5.     On Error Resume Next
  6.     utfLen = UBound(Utf)
  7.     If utfLen = -1 Then Exit Function
  8.      
  9.     On Error GoTo 0
  10.      
  11.     Dim I As Long, J As Long, K As Long, N As Long
  12.     Dim B As Byte, cnt As Byte
  13.     Dim Buf() As String
  14.     ReDim Buf(utfLen)
  15.      
  16.     I = 0
  17.     J = 0
  18.     Do While I <= utfLen
  19.         B = Utf(I)
  20.          
  21.         If (B And &HFC) = &HFC Then
  22.             cnt = 6
  23.         ElseIf (B And &HF8) = &HF8 Then
  24.             cnt = 5
  25.         ElseIf (B And &HF0) = &HF0 Then
  26.             cnt = 4
  27.         ElseIf (B And &HE0) = &HE0 Then
  28.             cnt = 3
  29.         ElseIf (B And &HC0) = &HC0 Then
  30.             cnt = 2
  31.         Else
  32.             cnt = 1
  33.         End If
  34.          
  35.         If I + cnt - 1 > utfLen Then
  36.             Buf(J) = "?"
  37.             Exit Do
  38.         End If
  39.          
  40.         Select Case cnt
  41.         Case 2
  42.             N = B And &H1F
  43.         Case 3
  44.             N = B And &HF
  45.         Case 4
  46.             N = B And &H7
  47.         Case 5
  48.             N = B And &H3
  49.         Case 6
  50.             N = B And &H1
  51.         Case Else
  52.             Buf(J) = Chr(B)
  53.             GoTo Continued:
  54.         End Select
  55.                  
  56.         For K = 1 To cnt - 1
  57.             B = Utf(I + K)
  58.             N = N * &H40 + (B And &H3F)
  59.         Next
  60.          
  61.         Buf(J) = ChrW(N)
  62. Continued:
  63.         I = I + cnt
  64.         J = J + 1
  65.     Loop
  66.      
  67.     Utf8ToUnicode = Join(Buf, "")
  68. End Function
مەزمۇننى كۆچۈرۈۋېلىش
ئەمدى Form  نىڭ كود يېزىش رايۇنىنى ئېچىپ ئىچىدىكى ھەممە كودلارنى ئۇچۇرۇپ تاشلىغاندىن كىيىن توۋەندىكى كودنى چاپلاڭ

  1. Option Explicit
  2. Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

  4. Private Sub Form_Load()
  5. Text1.Text = "intil.biz"
  6. End Sub

  8. 'ulaxni tamamlax
  9. Private Sub sock_Connect()
  10. sock.SendData Text1.Text & vbCrLf
  11. 'MsgBox sock.RemoteHost
  12. End Sub


  15. Private Sub sock_DataArrival(ByVal bytesTotal As Long)
  16. Dim Data() As Byte
  17. Dim strData As String
  18. 'sock.GetData dx, vbByte
  19. Call sock.GetData(Data, vbByte, bytesTotal)
  20. strData = Utf8ToUnicode(Data)

  22. If Analyse(strData) Then
  23. Text2.Text = Text2.Text & AddCrtf(strData)
  24. Else
  25. Text2.Text = ""
  26. MsgBox "ixlitilmigan isim!"
  27. End If
  28. End Sub
  29. 'isim mulazimitirdiki tipi iniklax
  30. Public Function SelectSvr(ByVal strDomainExt As String) As Integer

  32. Select Case strDomainExt
  33. Case "edu.cn"
  34. SelectSvr = 0
  35. Case "cn", "com.cn", "net.cn", "org.cn"
  36. SelectSvr = 1
  37. Case "com", "net", "edu"
  38. SelectSvr = 2
  39. Case "biz"
  40. SelectSvr = 10
  41. Case "info"
  42. SelectSvr = 11
  43. Case "name"
  44. SelectSvr = 2
  45. Case "tw"
  46. SelectSvr = 6
  47. Case "jp"
  48. SelectSvr = 7
  49. Case "kr"
  50. SelectSvr = 8
  51. Case "cc"
  52. SelectSvr = 12
  53. Case "org"
  54. SelectSvr = 14
  55. End Select
  56. End Function
  57. 'tizimlimigan isimni iniklax
  58. Public Function GetDomainExt(ByVal strDomain As String) As String
  59. GetDomainExt = Mid(strDomain, InStr(strDomain, ".") + 1)
  60. End Function
  61. 'isim tapsili uqurga irixix
  62. Public Function Analyse(p_ReData) As Boolean
  63. Dim strDomainExt As String
  64. '
  65. Dim arrKEY(14) As String
  66. Dim I
  67. arrKEY(0) = "NO FOUND" '
  68. arrKEY(1) = "NO MATCHING RECORD"
  69. arrKEY(2) = "NO MATCH FOR"
  70. arrKEY(3) = "NOT FOUND" '
  71. arrKEY(4) = "NOT REGISTERED TO KRNIC" '

  73. For I = 0 To 4
  74. If InStr(UCase(p_ReData), arrKEY(I)) <> 0 Then
  75. Analyse = False
  76. Exit Function
  77. End If
  78. Next
  79. Analyse = True

  81. End Function

  83. Function AddCrtf(str) As String
  84. Dim strContent As String
  85. strContent = Replace(str, Chr(13), "")
  86. strContent = Replace(strContent, Chr(10), vbCrLf)
  87. AddCrtf = strContent
  88. End Function
مەزمۇننى كۆچۈرۈۋېلىش
ئەمدى command1  نىڭ قىممىتىگە بۇنى يېزىڭ .
  1. Private Sub command1_Click()

  3. Dim intServer As Integer
  4. Dim strDomainExt As String
  5. 'isim baxkurdigan bikatlardin tizim ahwalini takxurux kodi
  6. Dim arrHosts(14) As String
  7. arrHosts(0) = "whois.edu.cn"
  8. arrHosts(1) = "whois.cnnic.net.cn"
  9. arrHosts(2) = "whois.internic.net"
  10. arrHosts(3) = "whois.arin.net"
  11. arrHosts(4) = "whois.apnic.net"
  12. arrHosts(5) = "whois.ripe.net"
  13. arrHosts(6) = "whois.twnic.net"
  14. arrHosts(7) = "whois.nic.ad.jp"
  15. arrHosts(8) = "whois.krnic.net"
  16. arrHosts(9) = "whois.lacnic.net"
  17. arrHosts(10) = "whois.biz" 'BIZ
  18. arrHosts(11) = "whois.afilias.info"
  19. arrHosts(12) = "whois.enic.cc" 'CC
  20. arrHosts(13) = "whois.crsnic.net" '.
  21. arrHosts(14) = "whois.pir.org"
  22. strDomainExt = GetDomainExt(Text1.Text)
  23. Text2.Text = ""
  24. intServer = SelectSvr(strDomainExt)
  25. sock.Close
  26. sock.Connect arrHosts(intServer), 43
  27. '
  28. End Sub
مەزمۇننى كۆچۈرۈۋېلىش

بۇنىڭدىن كىيىن ۋاقتىم سەل قىس بۇلۇپ قالىدۇ . يۇقارقى كودنىڭ چۇشەنچىلىرىنى كود تا بىر قۇر چۇشەنچە بىرىپ قويدۇم يەنە چۇشۇنۇشلۇك بولمىسا ئىنكاس قالدۇرۇڭ

قوشۇمچە ھۆججەت: كىرسىڭىز ئاندىن قوشۇمچە ھۆججەت كۆرەلەيسىز. تىزىملاتقانمۇ؟تىزىملىتىش
ھازىرغىچە 1 ئادەم باھالىدى
    • Intil: قوللايمەنشۆھرەت + 10 2 تىللا + 10 5 تۆھپە + 10 10
باشقۇرغۇچى Intil بۇ تېمىنى تەستىقلىغان ۋاقتى 7  كۈن ئالدىدا

يېڭى ئىنكاسلار

Intil 7  كۈن ئالدىدا
VB بىلىملىرى مۇسابىقىسىغا قاتناشقان ئەسەرلەر
سەھىپە:ئۇقتۇرۇش,

intil.cn 因特乐 知识信息网 Uyghur Office ( 新ICP备10003688号)|ئالاقىلىشىڭ

GMT+8, 2010-9-26 15:14.

Powered by Discuz! X1(NurQut Team)

© 2001-2010 Comsenz Inc.