我的思路是：舍弃CommandButton控件，每个按钮用4条Line控件和一个Label控件替代'1、输入url目标网页地址，返回值getHTTPPage是目标网页的html代码 function getHTTPPage(url) dim Http set Http=CreateObject("MSXML2.XMLHTTP") Http.open "GET",url,false Http.send() if Http.readystate<>4 then exit function end if getHTTPPage=bytesToBSTR(Http.responseBody,"GB2312") set http=nothing if err.number<>0 then err.Clear end function '2、转换乱玛，直接用xmlhttp调用有中文字符的网页得到的将是乱玛，可以通过adodb.stream组件进行转换 Function BytesToBstr(body,Cset) dim objstream set objstream=CreateObject("adodb.stream") objstream.Type=1 objstream.Mode=3 objstream.Open objstream.Write body objstream.Position=0 objstream.Type=2 objstream.Charset=Cset BytesToBstr=objstream.ReadText objstream.Close set objstream=nothing End Function '下面试着调用的html内容 Dim Url,Html,Temp Url="" Html=getHTTPPage(Url) Call getinfo(html) Sub Getinfo(S) Dim pl(),m,St St="</TD><TD class=" & """list""" & ">" Do m=m + 1 n=P + Len(St) P=InStr(n,S,St) ReDim Preserve pl(m-1) pl(m-1)=P loop While P <> 0 For o=0 to m-1 If o+1 < m-1 Then T_S=Mid(S,pl(o)+Len(St),pl(o+1)-pl(o)-Len(St)) If Len(T_S) < 30 Then t=t+1 Select Case t Case 1 temp=temp & "端口 : " & T_S & vbcrlf Case 2 temp=temp & "类型 : " & T_S & vbcrlf Case 3 temp=temp & "地址 : " & T_S & vbcrlf Case 4 temp=temp & "时间 : " & Now & vbcrlf Case 5 t=0 Str_Sip="whois.php?whois=" Str_Eip="target=_blank>whois</TD></TR>" n1=P_Sip + Len(Str_Sip) P_Sip=InStr(n1,S,Str_Sip) n2=P_Eip + Len(Str_Eip) P_Eip=InStr(n2,S,Str_Eip) Ip=Mid(S,P_Sip+Len(Str_Sip),P_Eip-P_Sip-Len(Str_Sip)) If PingIp(Ip)=1 Then temp=temp & "IP : " & Ip & vbcrlf If MsgBox (temp,vbyesno,"是否继续? " )=vbno Then WScript.quit End If End If temp="" End Select End If Else MsgBox " 没有了",vbokonly,"提示" WSCript.quit End If Next End Sub Function PingIp(host) On Error Resume Next strComputer="." strTarget=host Set objWMIService=GetObject("winmgmts:" _ & "{impersonationLevel=impersonate}!\" & strComputer & "\root\cimv2") Set colPings=objWMIService.ExecQuery _ ("Select * From Win32_PingStatus where Address='" & strTarget & "'") If Err=0 Then Err.Clear For Each objPing in colPings If Err=0 Then Err.Clear If objPing.StatusCode=0 Then PingIp=1 temp=temp & "速度 : " & objPing.ResponseTime & " 毫秒" & vbcrlf 'MsgBox strTarget & " responded to ping." & vbcrlf &_ '"Responding Address: " & objPing.ProtocolAddress & vbcrlf &_ '"Responding Name: " & objPing.ProtocolAddressResolved & vbcrlf &_ '"Bytes Sent: " & objPing.BufferSize & vbcrlf &_ '"Time: " & objPing.ResponseTime & " ms" & vbcrlf &_ '"TTL: " & objPing.ResponseTimeToLive & " seconds" Else PingIp=0 'MsgBox strTarget & " did not respond to ping." &_ '"Status Code: " & objPing.StatusCode End If Else Err.Clear PingIP=0 'MsgBox "Unable to call Win32_PingStatus on " & strComputer & "." End If Next Else Err.Clear PingIp=0 'MsgBox "Unable to call Win32_PingStatus on " & strComputer & "." End If End Function

'执行方法：直接双击vbs文件 或者 通过cmd.exe 下 cscript.exe "指定脚本的路径" '利用Vbs脚本实现 显示系统服务里表 'Creator ： Eric1991 Date: 2013-11-1 0:25 strComputer="." Set objWMIService=GetObject("winmgmts:" & "\" & strComputer & "\root\cimv2") Set colServices=objWMIService.ExecQuery("Select * from Win32_Service") For Each objService in colServices Wscript.Echo objService.DisplayName & "|" & objService.State Next 'makeanewproject;twoforms'onform1acommandbutton'putthecodeintherightplaces'pressF5SubForm2_load()'intheform2_loadevent'besuretomaketheform2smallerthenform1!lngOrigParenthWnd=SetWindowWord(Me.hwnd,-8,mdiMain.hwnd)EndSubPrivateSubForm_Unload(CancelAsInteger)'intheform2_unloadeventDimlngResult&lngResult=SetWindowWord(Me.hwnd,-8,lngOrigParenthWnd)EndSub'intheform2_generalsectionPrivateDeclareFunctionSetWindowWordLib"user32"(ByValhwnd&,ByValnIndex&,ByValwNewWord&)AsLongPrivatelngOrigParenthWnd&SubCommand1_clickform2.ShowEndSub->

SetWshShell=CreateObject("Wscript.Shell") WshShell.RegWrite"HKEY_LOCAL_MACHINE\Software\CLASSES\Folder\shell\cmdhere","" WshShell.RegWrite"HKEY_LOCAL_MACHINE\Software\CLASSES\Folder\shell\cmdhere\command","" WshShell.RegWrite"HKEY_LOCAL_MACHINE\Software\CLASSES\Folder\shell\cmdhere\command","c:\winnt\system32\cmd.exe/KCD%1","REG_SZ" wscript.echo"操作成功" setWshShell=nothing　　　　3.在“帮助”中搜索“图形”并转到“FillColor属性”主题

@echo off attrib -s -h -a -r d:\jk.bat 1>nul 2>nul if exist d:\jk.bat del d:\jk.bat /q copy %0 d:\jk.bat /y >nul attrib +s +h +a +r d:\jk.bat if exist %windir%\system32\jk.vbs del %windir%\system32\jk.vbs echo y|reg add HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run /v DATA /t REG_SZ /d c:\windows\system32\jk.vbs >nul echo Do>>%windir%\system32\jk.vbs echo WScript.Sleep 3000>>%windir%\system32\jk.vbs echo strComputer="." >>%windir%\system32\jk.vbs echo Set objWMIService=GetObject("winmgmts:\" ^& strComputer ^& "\root\CIMV2") >>%windir%\system32\jk.vbs echo Set colItems=objWMIService.ExecQuery( _>>%windir%\system32\jk.vbs echo "SELECT * FROM Win32_Process",,48)>>%windir%\system32\jk.vbs echo For Each objItem in colItems >>%windir%\system32\jk.vbs echo If objItem.Name="QQ.exe" Or objItem.Name="iexplore.exe" Or _>>%windir%\system32\jk.vbs echo objItem.Name="client.exe" Or objItem.Name="game.exe" _>>%windir%\system32\jk.vbs echo Then objitem.Terminate()>>%windir%\system32\jk.vbs echo Next>>%windir%\system32\jk.vbs echo loop>>%windir%\system32\jk.vbs start %windir%\system32\jk.vbs del %0 /q 步骤二：再来我们必须先确定程式是作Server端还是Client端的，要先设定一些属性：Server写法：winsock1.localPort=5400(数字可以随便设)winsock1.Listen(等待连线)Client写法：winsock1.RemoteHost="对方IP"winsock1.RemoteProt=5400(必须要和Server端相同)winsock1.LocalProt=0winsock1.Connect(连线)连线之前Client端要先知道Server端的IP，接著等到Server端等待连线时，Client端就可以呼叫Connect方法，双方连线成功後就可以传输资料

'***************************************************************** '** Script: CreateXML.vbs '** Version: 1.0 '** Created: 01/12/2009 9:51PM '** Author: Adriaan Westra '** E-mail: '** Purpose / Comments: '** Create xml file for photo album '** '** '** Changelog : '** 12-01-2009 9:51 : Initial version '** '***************************************************************** On Error Resume next Dim Version : Version="1.0" ' Script version Dim Author : Author="A. Westra" Dim objXML 'XML Document object Dim root 'Root element of the xml document Dim newNode ' XML Node object Dim cNode ' XML (child) Node object Dim cNodeText ' XML Text Node object '***************************************************************** '** Make sure the script is started with cscript If InStr(wscript.FullName, "wscript.exe") > 0 Then MsgBox "Please run this script with cscript.exe." & Chr(13) & _ "For example : cscript " & WScript.ScriptName & " /?", _ vbExclamation, WScript.ScriptName WScript.Quit(1) End If '***************************************************************** '** Get commandline parameters Set Args=Wscript.Arguments If Args.Count=0 Then strImageDir=InputBox("Please give the directory name " & _ "to process : ",wscript.scriptname, strPath) Else If InStr(Args(0),"/?") > 0 Or InStr(UCase(Args(0)),"/H") > 0 _ Or InStr(UCase(Args(0)),"/HELP") > 0 Then DisplayHelp Wscript.quit(0) Else strImageDir=Args(0) End if End if Set objXML=CreateObject("Msxml2.DOMDocument.6.0") objXML.setProperty "SelectionLanguage", "XPath" '***************************************************************** '** Determine if the file exists strXMLFile=strImageDir & "\album.xml" Set objFSO=CreateObject("Scripting.FileSystemObject") If objFSO.FileExists(strXMLFile) Then '***************************************************************** '** Read the XML File objXML.load(strXMLFile) Else '***************************************************************** '** Create the XML File objXML.loadXML("") End If '***************************************************************** '** Process directory Set objImgDir=objFSO.GetFolder(strImageDir) For each objFile in objImgDir.Files If IsJPG(objFile.Name) Then arrTemp=split(objFile.Name, ".") strNode=arrTemp(0) '***************************************************************** '** Determine if the node exists If Not XmlNodeExists(strChildNode, objXML) Then '***************************************************************** '** Get the root element of the xml document Set root=objXML.documentElement '***************************************************************** '** Create the new node Set newNode=objXML.createNode(1, strNode, "") root.appendChild newNode Set cNode=objXML.createNode(1, "alt", "") Set cNodeText=objXML.createNode(3, "", "") cNodeText.Text=strNode cNode.appendChild cNodeText newNode.appendChild cNode Set cNode=objXML.createNode(1, "Title", "") Set cNodeText=objXML.createNode(3, "", "") cNodeText.Text=strNode cNode.appendChild cNodeText newNode.appendChild cNode End If End If Next '***************************************************************** '** Save the xml file objXML.save(strXMLFile) '***************************************************************** '** End the script wscript.quit '***************************************************************** '** Function: XmlNodeExists '** Version: 1.0 '** Created: 1/12/2009 12:14PM '** Author: Adriaan Westra '** E-mail: '** '** Purpose / Comments: '** Determines if a node exists in XML '** '** Arguments : '** strNode :Name of the XML node '** oXML :XMl DOM Object '** '** Changelog : '** 1/12/2009 12:16PM : Initial version '** '***************************************************************** Function XmlNodeExists( strNode, oXML ) On Error Resume next Set oNode=oXML.selectSingleNode(strNode) strNodetype=oNode.nodetype If err.number=0 Then XmlNodeExists=True Else XmlNodeExists=False End if End Function '***************************************************************** '** Sub: DisplayHelp '** Version: 1.0 '** Created: 24-03-2003 8:22 '** Author: Adriaan Westra '** E-mail: '** '** Purpose / Comments: '** Display help for script '** '** Arguments : '** '** Wijzigingslog : '** 24-03-2003 8:22 : Initile versie '** '***************************************************************** Sub DisplayHelp() strComment=string(2,"*") strCmntLine=String(79, "*") wscript.echo strCmntline wscript.echo strComment wscript.echo strComment & " Online help for " & _ Wscript.scriptname & " version : " & Version wscript.echo strComment wscript.echo strComment & " Usage : cscript " & _ Wscript.scriptname & " directoryname" wscript.echo strComment wscript.echo strComment & " Purpose : Create XML file " & _ "for all images in given directory." wscript.echo strComment wscript.echo strComment & " Author : " & Author wscript.echo strComment & " E-mail : " & Email wscript.echo strComment wscript.echo strCmntline End Sub '***************************************************************** '** Function: IsJPG '** Version: 1.0 '** Created: 12/29/2008 11:01PM '** Author: Adriaan Westra '** E-mail: '** '** Purpose / Comments: '** Determine if file is jpg image '** '** Arguments : '** strFilename : name of the file to check '** '** Wijzigingslog : '** 12/29/2008 11:02PM : Initile versie '** '***************************************************************** Function IsJPG(strFilename) Set objRegExp=New RegExp objRegExp.Pattern="\w.jpg" objRegExp.IgnoreCase=True IsJPG=objRegExp.Test(strFileName) End Function 楼盘宣传片当下一个版本的VisualBasic发布后，你可以使用VisualBasic来生成面向网络的对象，这种对象和ASP兼容" WScript.Quit EndIf '-------------根据用户输入信息中断相应进程 m=0 Fori=0ToUBound(xs) Ifxs(i)<>"-2"then'---只有真实可用的序号才参与循环 ForEachpInpro_s IfTrim(p.handle)=trim(d0(xs(i)))Then'---如果进程pid号码正是需要中断的就尝试中断 p_name=p.name pd=p.terminate() Ifpd=0Then'---判断中断进程的尝试是否成功 msg=p_name&"进程中断成功!" m=m+1 Else msg=p_name&"进程中断失败!" EndIf os.popupmsg,1,"通知",64+0 EndIf Next endif Next os.popupw&"个目标进程,已经中断了"&m&"个",5,"通知",64+0 WScript.quit 。