2009-12-11 16:58:47| 分类: Visual Basic | 标签: |举报 |字号大中小 订阅
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
****************************************************
评论