注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

樱之花

叶散的时候,你明白欢聚;花谢的时候,你明白青春.

 
 
 

日志

 
 
关于我

分类中“我的实验室”是我在日常工作中的一些知识总结,有些写的比较匆忙,可能大家在阅读时会产生困扰,后期有时间我会重新整理编辑,谢谢大家的到访,您们的支持是我前进的动力!

网易考拉推荐

获取外网IP的几种办法   

2009-12-11 16:58:47|  分类: Visual Basic |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |

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

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

  评论这张
 
阅读(3749)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017