Ó£Ö®»¨

1.

Public Sub GetIP()

Dim KaiShi As Integer

Dim GeShu As Integer

Open "d:\ip.txt" For Input As #1

Do While Not EOF(1)

    Line Input #1, LinShi

    Command1.Tag = Command1.Tag + LinShi

    Print Command1.Tag

Loop

Close #1

If Len(Command1.Tag) > 400 Then

    Command1.Tag = Mid(Command1.Tag, 255, 300)

    KaiShi = InStr(Command1.Tag, "IP Address") + Len("IP Address. . . . . . . . . . . . :")

    GeShu = InStr(Command1.Tag, "Subnet Mask") - KaiShi

    Text1 = Mid(Command1.Tag, KaiShi, GeShu)

Else

    MsgBox ("ÄúûÓÐÁ¬½Óµ½ÍøÂçÉÏ£¡£¡")

End If

Kill "d:\ip.txt"

End Sub

Private Sub Command1_Click()

Call GetIP

End Sub

Private Sub Form_Load()

Do Until (Shell("cmd /c" & " " & "ipconfig >d:\ip.txt") > 0)

Loop

Timer1.Interval = 100

Timer1.Enabled = False

Me.Icon = LoadPicture()

Call GetIP

End Sub

Private Sub Timer1_Timer()

Timer1.Enabled = False

End Sub

***********************************************

2.

WebBrowser.text1,text2¿Ø¼þ

Private Sub Form_Load()

WebBrowser.Navigate ("http://www.ip138.com/ip2city.asp") '´ò¿ªIP138ÍøÕ¾

End Sub

Private Sub WebBrowser_DocumentComplete(ByVal pDisp As Object, URL As Variant)

Set webdoc = WebBrowser.Document

y = webdoc.All(0).outerhtml

'--------------------------------------------------»ñÈ¡ÍøÒ³Ô´´úÂë------

Dim sTemp As String

Dim a, b, c, d As Integer

sTemp = y

a = InStrRev(sTemp, "[") + 1

b = InStrRev(sTemp, "]")

Text2.Text = Mid(sTemp, a, b - a)

'--------------------------------------------------È¡IP×Ö¶Î------

c = InStrRev(sTemp, "£º") + 1

d = InStrRev(sTemp, "</CENTER>")

'Text3.Text = Mid(sTemp, c, d - c)

'--------------------------------------------------È¡µØÇø×Ö¶Î------

End Sub

********************************************************************

3.

Option Explicit
Dim objWMIService As Object
Dim colProcesslist As Object
Dim objProcess As Object
Dim strrec$(), aa$, bb$, tmpstr$, i&, colProcesses

Private Sub Command1_Click()
   On Error Resume Next
   '************ ÖÆ×÷Åú´Îµµ²¢ÔËÐÐËü
   aa = "c:\tmpsch.bat"
   bb = "c:\cbmtmp.txt"
   If Dir(bb) <> "" Then Kill bb
   Open aa For Output As #1
   Print #1, "@echo off"
   Print #1, "nslookup >" & bb
   Print #1, "exit"
   Close #1
   Call Shell("cmd /c " & aa, vbHide)
   i = Timer
   'ÑÓʱ5ÃëÄÚÊÇ·ñµÃµ½Îĵµ
   Do
      DoEvents
      If Dir(bb) <> "" Then
         If FileLen(bb) > 0 Then Exit Do
      End If
   Loop Until Timer > i + 5
   If Isrunexe("NSLOOKUP.EXE") Then Call CloseExe("NSLOOKUP.EXE")
   If Isrunexe("cmd.exe") Then Call CloseExe("cmd.exe")
   '******************************************************
   If Dir(bb) <> "" Then
      Open bb For Input As #1
      While Not EOF(1)
         Line Input #1, tmpstr
         If InStr(tmpstr, ":") > 0 And InStr(tmpstr, "Default") > 0 Then Print "·þÎñÆ÷Ãû:" & Trim(Mid(tmpstr, InStr(tmpstr, ":") + 1))
         If InStr(tmpstr, ":") > 0 And InStr(tmpstr, "Address") > 0 Then Print "ÍâÍøIP:" & Trim(Mid(tmpstr, InStr(tmpstr, ":") + 1))
      Wend
      Close #1
   Else
      MsgBox "»ñȡʧ°Ü"
   End If
End Sub

Public Function Isrunexe(ExeNm As String) As Boolean
   tmpstr = "."
   Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & tmpstr & "\root\cimv2")
   Set colProcesslist = objWMIService.ExecQuery("Select * from Win32_Process Where Name = '" & ExeNm & "'")
   Isrunexe = IIf(colProcesslist.Count > 0, True, False)
   Set objWMIService = Nothing
   Set colProcesslist = Nothing
End Function

Public Sub CloseExe(ExeNm As String, Optional Qty As Long)
   tmpstr = "."
   Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & tmpstr & "\root\cimv2")
   Set colProcesslist = objWMIService.ExecQuery("Select * from Win32_Process Where Name = '" & ExeNm & "'")
   If colProcesslist.Count > 0 Then
      For Each objProcess In colProcesslist
         If InStr(UCase(objProcess.ExecutablePath), UCase(ExeNm)) > 0 Then objProcess.Terminate
         If Qty = 1 Then Exit For
      Next
   End If
   Set objWMIService = Nothing
   Set colProcesslist = Nothing
End Sub

Private Sub Form_Load()

End Sub
**************************************************************************

4.

Option Explicit

 Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
  Public Declare Function GetIpAddrTable Lib "IPHlpApi" (pIPAdrTable As Byte, pdwSize As Long, ByVal Sort As Long) As Long
    
  Const Max_IP = 5
    
  Type IPINFO
      dwAddr   As Long
      dwIndex   As Long
      dwMask   As Long
      dwBCastAddr   As Long
      dwReasmSize     As Long
      UnUsed1   As Integer
      UnUsed2   As Integer
  End Type
    
  Type MIB_IPADDRTABLE
      dEntrys   As Long
      mIPInfo(Max_IP)   As IPINFO
  End Type
    
  Type IP_Array
      mBuffer   As MIB_IPADDRTABLE
      BufferLen   As Long
  End Type
    
  Sub Main()
      Start
  End Sub
    
  Public Function ConvertAddressToString(longAddr As Long) As String
      Dim MyByte(3)     As Byte
      Dim Cnt     As Long
      CopyMemory MyByte(0), longAddr, 4
      For Cnt = 0 To 3
          ConvertAddressToString = ConvertAddressToString + CStr(MyByte(Cnt)) + "."
      Next Cnt
      ConvertAddressToString = Left$(ConvertAddressToString, Len(ConvertAddressToString) - 1)
  End Function
    
  Public Sub Start()
      Dim Ret     As Long, Tel       As Long
      Dim bBytes()     As Byte
      Dim Listing     As MIB_IPADDRTABLE
      On Error GoTo End1
      GetIpAddrTable ByVal 0&, Ret, True
      If Ret <= 0 Then Exit Sub
      ReDim bBytes(0 To Ret - 1) As Byte
      GetIpAddrTable bBytes(0), Ret, False
      CopyMemory Listing.dEntrys, bBytes(0), 4
      MsgBox "ÕÒµ½   " & Listing.dEntrys & "   ¸öIPµØÖ·!", 0, "Ìáʾ"
      For Tel = 0 To Listing.dEntrys - 1
          CopyMemory Listing.mIPInfo(Tel), bBytes(4 + (Tel * Len(Listing.mIPInfo(0)))), Len(Listing.mIPInfo(Tel))                         '¿½±´Õû¸ö½á¹¹µ½Listing
          MsgBox "IPµØÖ·:" & ConvertAddressToString(Listing.mIPInfo(Tel).dwAddr), 0, "Ìáʾ"
      Next
      End
End1:
      MsgBox "³ö´í£¡", 0, "Ìáʾ"
      End
  End Sub

****************************************************