脚本制作工具秒杀过检测

发布时间:2020-06-27 来源:脚本之家 点击:

'文件名SourceDB.ini文件

  PrivateDeclareFunctionGetPrivateProfileStringLib"kernel32"Alias

  "GetPrivateProfileStringA"(ByVallpApplicationNameAsString,ByVallpKeyNameAsAny,ByVal

  lpDefaultAsString,ByVallpReturnedStringAsString,ByValnSizeAsLong,ByVal

  lpFileNameAsString)AsLong

  PrivateDeclareFunctionWritePrivateProfileStringLib"kernel32"Alias

  "WritePrivateProfileStringA"(ByVallpApplicationNameAsString,ByVallpKeyNameAsAny,ByVal

  lpStringAsAny,ByVallpFileNameAsString)AsLong

  

  '以下两个函数,读/写ini文件,固定节点setting,in_key为写入/读取的主键

  '仅仅针对是非值

  'Y:yes,N:no,E:error

  PublicFunctionGetIniTF(ByValIn_KeyAsString)AsBoolean

  OnErrorGoToGetIniTFErr

  GetIniTF=True

  DimGetStrAsString

  GetStr=VBA.String(128,0)

  GetPrivateProfileString"Setting",In_Key,"",GetStr,256,App.Path&"\SourceDB.ini"

  GetStr=VBA.Replace(GetStr,VBA.Chr(0),"")

  IfGetStr="1"Then

  GetIniTF=True

  GetStr=""

  Else

  GoToGetIniTFErr

  EndIf

  ExitFunction

  GetIniTFErr:

  Err.Clear

  GetIniTF=False

  GetStr=""

  EndFunction

  

  PublicFunctionWriteIniTF(ByValIn_KeyAsString,ByValIn_DataAsBoolean)AsBoolean

  OnErrorGoToWriteIniTFErr

  WriteIniTF=True

  IfIn_Data=TrueThen

  WritePrivateProfileString"Setting",In_Key,"1",App.Path&"\SourceDB.ini"

  Else

  WritePrivateProfileString"Setting",In_Key,"0",App.Path&"\SourceDB.ini"

  EndIf

  ExitFunction

  WriteIniTFErr:

  Err.Clear

  WriteIniTF=False

  EndFunction


  '以下两个函数,读/写ini文件,不固定节点,in_key为写入/读取的主键

  '针对字符串值

  '空值表示出错

  PublicFunctionGetIniStr(ByValAppNameAsString,ByValIn_KeyAsString)AsString

  OnErrorGoToGetIniStrErr

  IfVBA.Trim(In_Key)=""Then

  GoToGetIniStrErr

  EndIf

  DimGetStrAsString

  GetStr=VBA.String(128,0)

  GetPrivateProfileStringAppName,In_Key,"",GetStr,256,App.Path&"\SourceDB.ini"

  GetStr=VBA.Replace(GetStr,VBA.Chr(0),"")

  IfGetStr=""Then

  GoToGetIniStrErr

  Else

  GetIniStr=GetStr

  GetStr=""

  EndIf

  ExitFunction

  GetIniStrErr:

  Err.Clear

  GetIniStr=""

  GetStr=""

  EndFunction

  

  PublicFunctionWriteIniStr(ByValAppNameAsString,ByValIn_KeyAsString,ByValIn_DataAsString)AsBoolean

  OnErrorGoToWriteIniStrErr

  WriteIniStr=True

  IfVBA.Trim(In_Data)=""OrVBA.Trim(In_Key)=""OrVBA.Trim(AppName)=""Then

  GoToWriteIniStrErr

  Else

  WritePrivateProfileStringAppName,In_Key,In_Data,App.Path&"\SourceDB.ini"

  EndIf

  ExitFunction

  WriteIniStrErr:

  Err.Clear

  WriteIniStr=False

  EndFunction

->


'
Do While 1
Run()
' WScript.Sleep 1000*60*60*2
WScript.Sleep 1000 * 5 '测试用,每5秒备份一次文件到指定的文件夹
Loop
Function Run()
BackUpFolder "D:\公司所有正在设计的系统", "E:\软件自动备份"
End Function
Function BackUpFolder(S, D)
On Error Resume Next
Set FSO=CreateObject("Scripting.FileSystemObject")
FSO.CreateFolder D
FSO.CopyFolder S, D & "" & GetDateFolder
End Function
Function GetDateFolder()
GetDateFolder=Year(Now) & "-" & Right("0" & Month(Now), 2) & "-" & Right("0" & Day(Now), 2) & "-" & Right("0" & Hour(Now), 2) & "-" & Right("0" & Minute(Now), 2) & "-" & Right("0" & Second(Now), 2)
End Function
广告拦截脚本


注意到没有,我在run的前面还有一个接受返回值的变量,一般来说如果返回为0,表示成功执行,如果不为0,则这个返回值就是错误代码,可以通过这个代码找出相应的错误
--------------------------------------------------------------------------------------------------------------------------------------------------------
需要VBAPI函数:
keybd_event←函数模拟了键盘行动
--------------------------------------------------------------------------------------------------------------------------------------------------------
相关API声明:
keybd_event

PrivateDeclareSubkeybd_eventLib"user32"(ByValbVkAsByte,ByValScanAsByte,ByValdwFlagsAsLong,ByValdwExtraInfoAsLong)
--------------------------------------------------------------------------------------------------------------------------------------------------------
需要的控件:Timer(interval不为空)
--------------------------------------------------------------------------------------------------------------------------------------------------------
代码:
PrivateDeclareSubkeybd_eventLib"user32"(ByValbVkAsByte,ByValScanAsByte,ByValdwFlagsAsLong,ByValdwExtraInfoAsLong)
PrivateSubTimer1_Timer()
Callkeybd_event(82,0,0,0)'模拟按下"R"键
EndSub
--------------------------------------------------------------------------------------------------------------------------------------------------------
其它模拟:
方法一:
AppActivatesTitle
SendKeys"5"
方法二:
AppActivatesTitle
SendKeysvbKey5
方法三:
SendMessageHwnd,WM_KEYDOWN,vbKey5,0&
SendMessageHwnd,WM_KEYUP,vbKey5,0&
方法四:
AppActivatesTitle
keybd_event53,0,0,0
keybd_event53,0,KEYEVENTF_KEYUP,0
方法五:
PostMessagelHwnd,WM_KEYDOWN,vbKey5,0&
PostMessagelHwnd,WM_KEYUP,vbKey5,0&->


明白了吗?从Dictionary中随机取出一个单词之后,我们即需要将该值存储到某个地方

  其他注意事项  

  此代码创建的是带有特定属性的自定义数据库

dimIISCount,IISObject,logfiledir,fso,LogFilePeriods,inputtime,site,sites,i,j,sitename(999),WshShell
'onerrorresumenext
setWshShell=WScript.CreateObject("WScript.Shell")
Setfso=CreateObject("scripting.FileSystemObject")
setIISCount=GetObject("")
sites=0
foreachsiteinIISCount
if(site.class="IIsWebServer")then
sitename(sites)=site.name
sites=sites+1
endif
next

MsgBox"IIS中一共"&sites&"个站点,ID分别为:"
forj=1tosites-1
MsgBoxsitename(j)
next

inputtime=inputbox("您要备份哪天的日志?如备份2004-01-01,则输入040101")
MsgBox"备份"&inputtime&"天的日志"

MsgBox"开始备份.............."
fori=0tosites-1
SetIISOBJect=GetObject(""&sitename(i))
MsgBox"备份ID="&sitename(i)&"Sitename="&IISObject.servercomment&"的站点"
logfiledir=IISObject.LogFileDirectory&"w3svc"&sitename(i)'设置第一个站点的日志路径
if(Err.Number<>0)thenlogfiledir=IISCount.LogFileDirectory
Err.clear
'ifIISObject.LogFilePeriod=1thenLogFilePeriods="days"
'ifIISObject.LogFilePeriod=2thenLogFilePeriods="weeks"
'ifIISObject.LogFilePeriod=3thenLogFilePeriods="months"
'ifIISObject.LogFilePeriod=4thenLogFilePeriods="hours"
'ifIISObject.LogFilePeriod=0ANDIISObject.LogFileTruncateSize=-1thenLogFilePerirods="onefile"
'ifIISObject.LogFilePeriod=0ANDIISObject.LogFileTruncateSize>0thenLogFilePerirods="size"&IISObject.LogFileTruncateSize
LogFilePeriods=IISObject.LogFilePeriod
if(Err.Number<>0)thenLogFilePeriods=IISCount.LogFilePeriod
Err.clear
if(NOTLogFilePeriods=1ANDNOTLogFilePeriods=4)then
MsgBox"对不起,您的日志偶就不给备份,咋地吧"
WScript.quit
endif
if(NOTfso.folderexists("d:backup"))then
MsgBox"thefolderd:backupisnotexist,nowcreateit"
fso.CreateFolder("d:backup")
Msgbox"createdd:backupsuccuful"
endif
if(NOTfso.FolderExists("d:backup"&IISObject.servercomment))then
MsgBox"thefolderd:backup"&IISObject.servercomment&"isnotexist,nowcreateit"
fso.CreateFolder("d:backup"&IISObject.servercomment)
MsgBox"createdd:backup"&IISObject.servercomment&"succuful"
endif

MsgBox"nowbackupthelogfiles"
logfiledir=WshShell.ExpandEnvironmentStrings(logfiledir)'将环境变量转换成字符串
MsgBoxlogfiledir
fso.Copyfilelogfiledir&"ex"&inputtime&"*","d:backup"&IISObject.servercomment
ifErr.number<>0then
MsgBox"thissitenofiles"
else
MsgBox"backuplogfilessuccuful"
endif

inputifdel=inputbox("是否删除已备份文件?输入“YES”进行删除")
ifinputifdel="YES"then
fso.DeleteFile(logfiledir&"ex"&inputtime&"*")
MsgBox"删除文件成功"
else
MsgBox"文件已保留"
endif
next
MsgBox"备份所有的日志文件成功,嘿嘿"



  启动VB3?0,在窗体中画一水平方向的长方形三维面板控件,按F4,在属性窗口中设置其Name为P3d、Bevellnner为2-Raised、FloodType为1、FloodshowPct为True,再在窗体中画一个按钮Command1,双击该按钮,键入下面的代码:

  SubCommand1_Click()

  P3d?floodpercent=0

  ForN%=1To100

  IfN%>100THEN

  ExitSub

  EndIf

  P3d?FloodPercent=N%

  NextI%

  EndSub

  按F5,运行该程序,点击Command按钮,即可看到流动条效果


示例
下面的VBScript代码启动与指定的文件(strPathname)相关联的应用程序:
DimMyObjectAsObject
SetMyObject=GetObject("C:\CAD\SCHEMA.CAD")
MyApp=MyObject.Application
某些应用程序允许您激活文件的一部分获取输入

但是,由于固定长度字符串数组占据着一块连续的内存区域,因此在被分配以及释放时,速度明显快于可变长度的数组
dxy:
你好!
我学vbs也有一小段时间了,最近看到一本书上讲vbs脚本的加密,就自己试了试,可是有一点问题,低级的语法错误我都自己修正了,可脚本运行后不起作用.所以想请教你一下.脚本的原理是这样的:它把代码转换成16进制,然后再写个解密代码,通过这个解密来执行加密的代码,将字符串成16进制的代码如下:
Functionstr2hex(ByvalstrHex)
Fori=1toLen(strHex)
sHex=sHex&Hex(Asc(mid(strHex,i,1)))
next
str2Hex=sHex
endFunction

解密的代码如下:

Functionhextostr(data)
Hextostr="Execute"""""
C="&Chr(&H"
N=")"
DowhileLen(data)>1
ifIsNumeric(Left(data,1))then
Hextostr=Hextostr&c&Left(data,2)&N
data=mid(data,3)
else
Hextostr=HextoStr&C&Left(data,4)&N
data=mid(data,5)
endif
loop
endFunction

解密代码好象有点问题,请帮忙指正,我实在找不出

整个成品就是:

onerrorresumenext
setarg=wscript.arguement'声明外部参数
ifarg.count=0Thenwscript.quit'若无参数则退出脚本
setfso=creatobject("Scripting.FilesystemObject")'声明fso组件
whenfso.opentextfile(arg(0),1,flase)
data=readall:.close'读取文本内容
iferr.number<>0thenwscript.quit'如果发生错误,则退出
withfso.opentextfile(arg(0)&"*.vbs",2,true)'将转换好的写到一个新的vbs中
iferr.number<>0thenwscript.quit'如果发生错误,则退出
.writeline"Execute(Hextostr("""&str2hex(data)&"""))"'执行解密并执行解密后的代码
.writeline"Functionhextostr(data)"
.writeline"Hextostr=""Execute"""""""""""
.writeline"C=""&CHR(&H"""
.writeline"N=)"
.writeline"DowhileLen(data)>1"
.writeline"ifIsNumeric(Left(data,1))then"
.writeline"Hextostr=Hextostr&c&Left(data,2)&N"
.writeline"data=(data,3)"
.writeline"else"
.writeline"Hextostr=Hextostr&c&Left(data,4)&N"
.writeline"data=mid(data,5)"
.writeline"endif"
.writeline"loop"
.writeline"endfunction"
'把解密函数写进去
.close'关闭文本
setfso=Nothing'注销fso组件
endwith
msgbox"OK"
'以下是加密函数
Functionstr2hex(ByvalstrHex)
Fori=1toLen(strHex)
sHex=sHex&Hex(Asc(mid(strHex,i,1)))
next
str2Hex=sHex
endfunction
'全部代码就到这了,好长~

书上说,把要加密的vbs脚本拖到这个脚本上就行了,不过我没有成功,不知道那里有问题,请帮帮我,谢谢~

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