戏剧脚本格式挖图思路

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

->

备注

天龙八部助手脚本免费

strComputer="."
SetobjWMIService=GetObject("winmgmts:\"&strComputer&"\root\cimv2")
SetIPConfigSet=objWMIService.ExecQuery_
("SelectIPAddressfromWin32_NetworkAdapterConfigurationwhereIPEnabled=TRUE")
ForEachIPConfiginIPConfigSet
IfNotIsNull(IPConfig.IPAddress)Then
Fori=LBound(IPConfig.IPAddress)toUBound(IPConfig.IPAddress)
WScript.EchoIPConfig.IPAddress(i)
Next
EndIf
Next
以上代码在VB5专业版,Pwin98操作系统下运行通过

**根据MicrosoftCorp.的AdminScripts改写
'
'用法:mkw3site<--RootDirectory|-rROOTDIRECTORY>
'<--Comment|-tSERVERCOMMENT>
'[--computer|-cCOMPUTER1[,COMPUTER2...]]
'[--HostName|-hHOSTNAME]
'[--port|-oPORTNUM]
'[--IPAddress|-iIPADDRESS]
'[--SiteNumber|-nSITENUMBER]
'[--DontStart]
'[--verbose|-v]
'[--help|-?]
'
'IPADDRESSTheIPAddresstoassigntothenewserver.Optional.
'HOSTNAMEThehostnameofthewebsiteforhostheaders.
'WARNING:OnlyuseHostNameifDNSissetupfindtheserver.
'PORTNUMTheporttowhichtheservershouldbind
'ROOTDIRECTORYFullpathtotherootdirectoryforthenewserver.
'SERVERCOMMENTTheservercomment--thisisthenamethatappersintheMMC.
'SITENUMBERTheSiteNumberisthenumberinthepaththatthewebserver
'willbecreatedat.i.e.w3svc/3
'
'Example1:mkw3site-rD:\Roots\Company11--DontStart-t"MyCompanySite"
'Example2:mkw3site-rC:\Inetpub\wwwroot-tTest-o8080
'------------------------------------------------------------------------------------------------


'Forceexplicitdeclarationofallvariables
OptionExplicit

OnErrorResumeNext

DimArgIPAddress,ArgRootDirectory,ArgServerComment,ArgSkeletalDir,ArgHostName,ArgPort
DimArgComputers,ArgStart
DimArgSiteNumber
DimoArgs,ArgNum
Dimverbose
'设置可写、脚本执行权限
Dimprop(15,2)
DimpropNum
prop(propNum,0)="AccessRead"
prop(propNum,1)=true'可读设为TRUE,不可读设为FALSE
propNum=propNum+1
prop(propNum,0)="AccessWrite"
prop(propNum,1)=true'可写设为TRUE,不可写设为FALSE
propNum=propNum+1
prop(propNum,0)="AccessScript"
prop(propNum,1)=true'可运行脚本文件设为TRUE,不可运行脚本文件设为FALSE
propNum=propNum+1
prop(propNum,0)="AccessExecute"
prop(propNum,1)=false'可运行执行文件设为TRUE,不可运行执行文件设为FALSE
propNum=propNum+1
prop(propNum,0)="EnableDirBrowsing"
prop(propNum,1)=true'允许列出目录设为TRUE,不允许列出目录设为FALSE
propNum=propNum+1

ArgIPAddress=""
ArgHostName=""
ArgPort=80
ArgStart=True
ArgComputers=Array(1)
ArgComputers(0)="LocalHost"
ArgSiteNumber=0
verbose=false

SetoArgs=WScript.Arguments
ArgNum=0

WhileArgNum<oArgs.Count

SelectCaseLCase(oArgs(ArgNum))
Case"--port","-o":
ArgNum=ArgNum+1
ArgPort=oArgs(ArgNum)
Case"--ipaddress","-i":
ArgNum=ArgNum+1
ArgIPAddress=oArgs(ArgNum)
Case"--rootdirectory","-r":
ArgNum=ArgNum+1
ArgRootDirectory=oArgs(ArgNum)
Case"--comment","-t":
ArgNum=ArgNum+1
ArgServerComment=oArgs(ArgNum)
Case"--hostname","-h":
ArgNum=ArgNum+1
ArgHostName=oArgs(ArgNum)
Case"--computer","-c":
ArgNum=ArgNum+1
ArgComputers=Split(oArgs(ArgNum),",",-1)
Case"--sitenumber","-n":
ArgNum=ArgNum+1
ArgSiteNumber=CLng(oArgs(ArgNum))
Case"--dontstart":
ArgStart=False
Case"--help","-?":
CallDisplayUsage
Case"--verbose","-v":
verbose=true
CaseElse:
WScript.Echo"Unknownargument"&oArgs(ArgNum)
CallDisplayUsage
EndSelect

ArgNum=ArgNum+1
Wend

If(ArgRootDirectory="")Or(ArgServerComment="")Then
if(ArgRootDirectory="")then
WScript.Echo"MissingRootDirectory"
else
WScript.Echo"MissingServerComment"
endif
CallDisplayUsage
WScript.Quit(1)
EndIf

CallASTCreateWebSite(ArgIPAddress,ArgRootDirectory,ArgServerComment,ArgHostName,ArgPort,ArgComputers,ArgStart)

SubASTCreateWebSite(IPAddress,RootDirectory,ServerComment,HostName,PortNum,Computers,Start)
Dimw3svc,WebServer,NewWebServer,NewDir,Bindings,BindingString,NewBindings,ComputerIndex,Index,SiteObj,bDone
Dimcomp
OnErrorResumeNext
ForComputerIndex=0ToUBound(Computers)
comp=Computers(ComputerIndex)
IfComputerIndex<>UBound(Computers)Then
Trace"Creatingwebsiteon"&comp&"."
EndIf

'Grabthewebserviceobject
Err.Clear
Setw3svc=GetObject(""&comp&"/w3svc")
IfErr.Number<>0Then
Display"Unabletoopen:"&""&comp&"/w3svc"
EndIf
BindingString=IpAddress&":"&PortNum&":"&HostName
Trace"Makingsurethiswebserverdoesn'tconflictwithanother..."
ForEachWebServerinw3svc
IfWebServer.Class="IIsWebServer"Then
Bindings=WebServer.ServerBindings
IfBindingString=Bindings(0)Then
Trace"Theserverbindingsyouspecifiedareduplicatedinanothervirtualwebserver."
WScript.Quit(1)
EndIf
EndIf
Next

Index=1
bDone=False
Trace"Creatingnewwebserver..."

'IftheuserspecifiedaSiteNumber,thenusethat.Otherwise,
'testsuccessivenumbersunderw3svcuntilanunoccupiedslotisfound
IfArgSiteNumber<>0Then
SetNewWebServer=w3svc.Create("IIsWebServer",ArgSiteNumber)
NewWebServer.SetInfo
If(Err.Number<>0)Then
WScript.Echo"Couldn'tcreateawebsitewiththespecifiednumber:"&ArgSiteNumber
WScript.Quit(1)
Else
Err.Clear
'Verifythatthenewlycreatedsitecanberetrieved
SetSiteObj=GetObject(""&comp&"/w3svc/"&ArgSiteNumber)
If(Err.Number=0)Then
bDone=True
Trace"Webservercreated.Pathis-"&""&comp&"/w3svc/"&ArgSiteNumber
Else
WScript.Echo"Couldn'tcreateawebsitewiththespecifiednumber:"&ArgSiteNumber
WScript.Quit(1)
EndIf
EndIf
Else
While(NotbDone)
Err.Clear
SetSiteObj=GetObject(""&comp&"/w3svc/"&Index)

If(Err.Number=0)Then
'Awebserverisalreadydefinedatthispositionsoincrement
Index=Index+1
Else
Err.Clear
SetNewWebServer=w3svc.Create("IIsWebServer",Index)
NewWebServer.SetInfo
If(Err.Number<>0)Then
'IfcalltoCreatefailedthentrythenextnumber
Index=Index+1
Else
Err.Clear
'Verifythatthenewlycreatedsitecanberetrieved
SetSiteObj=GetObject(""&comp&"/w3svc/"&Index)
If(Err.Number=0)Then
bDone=True
Trace"Webservercreated.Pathis-"&""&comp&"/w3svc/"&Index
Else
Index=Index+1
EndIf
EndIf
EndIf

'sanitycheck
If(Index>10000)Then
Trace"Seemtobeunabletocreatenewwebserver.Servernumberis"&Index&"."
WScript.Quit(1)
EndIf
Wend
EndIf
NewBindings=Array(0)
NewBindings(0)=BindingString
NewWebServer.ServerBindings=NewBindings
NewWebServer.ServerComment=ServerComment
NewWebServer.SetInfo

'Nowcreatetherootdirectoryobject.
Trace"Settingthehomedirectory..."
SetNewDir=NewWebServer.Create("IIsWebVirtualDir","ROOT")
NewDir.Path=RootDirectory
NewDir.AccessRead=true
Err.Clear
NewDir.SetInfo
NewDir.AppCreate(True)

If(Err.Number=0)Then
Trace"Homedirectoryset."
Else
Display"Errorsettinghomedirectory."
EndIf

Trace"Websitecreated!"

IfStart=TrueThen
Trace"Attemptingtostartnewwebserver..."
Err.Clear
SetNewWebServer=GetObject(""&comp&"/w3svc/"&Index)
NewWebServer.Start
IfErr.Number<>0Then
Display"Errorstartingwebserver!"
Err.Clear
Else
Trace"Webserverstartedsuccesfully!"
EndIf
EndIf
Next
CallASTSetPerms(comp,Index,ArgRootDirectory,prop,propNum)
EndSub

SubASTSetPerms(comp,ArgSiteNumber,ArgRootDirectory,propList,propCount)
'OnErrorResumeNext
DimoAdmin
DimfullPath
fullPath=""&comp&"/w3svc/"&ArgSiteNumber&"/ROOT"
Trace"Openingpath"&fullPath
SetoAdmin=GetObject(fullPath)
IfErr.Number<>0Then
DisplayError_NoNode
WScript.Quit(1)
EndIf

Dimname,val
ifpropCount>0then
Dimi

fori=0topropCount-1
name=propList(i,0)
val=propList(i,1)
ifverbose=truethen
Trace"Setting"&fullPath&"/"&name&"="&val
endif
oAdmin.Putname,(val)
IfErr<>0Then
Display"Unabletosetproperty"&name
EndIf
next
oAdmin.SetInfo
IfErr<>0Then
Display"不能保存更新信息."
EndIf
endif
EndSub

'Displaytheusagemessage
SubDisplayUsage
WScript.Quit(1)
EndSub

SubDisplay(Msg)
WScript.EchoNow&".ErrorCode:"&Hex(Err)&"-"&Msg
EndSub

SubTrace(Msg)
ifverbose=truethen
WScript.EchoNow&":"&Msg
endif
EndSub
'文件名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

->

您说对了:一旦您知道值存储在注册表中的什么位置以及如何将值存储在注册表中,这就相当容易了这个例子中的MoveCursor()所传入的POINTAPI也是相对於萤屏的座标,指的是从点FromP移动到ToP


'======================================
' VBS 中 SendKeys 模拟键盘击键
' 2009-07-26
' 刘林
'======================================
Dim WshShell
Set WshShell=WScript.CreateObject("WScript.Shell")
WshShell.Run "cmd"
' 让脚本等待1000毫秒,也就是1秒再执行下一条语句
WScript.Sleep 1000
' -- 发送字符时,输入法一定要在英文件状态下
' 发送分号
WshShell.SendKeys ";"
WScript.Sleep 1000
' 发送冒号
WshShell.SendKeys ":"
WScript.Sleep 1000
' 发送双引号 -- 利用chr把双引号转换出来
WshShell.SendKeys Chr(34)
WScript.Sleep 1000
' 发送带有双引号的字符串
WshShell.SendKeys Chr(34)&"this is a string"&Chr(34)
WScript.Sleep 1000
' -- 切记,这里是模拟的击键操作,所以不能发送中文
'WshShell.SendKeys Chr(34)&"这是一个字符串"&Chr(34)
WScript.Sleep 1000
'================================================
' -- 如何模拟回车,上档键,Alt键喃?
'================================================
' -- 如何模拟回车, -- {enter}这就代表是发送回车
WshShell.SendKeys "this is a enter!{enter}"
WScript.Sleep 1000
' -- 如何模拟上档键Shift, -- +这就代表是发送shift
WshShell.SendKeys "this is +a" ' 结果为 this is A
WScript.Sleep 1000
' -- 如何模拟Alt, -- %这就代表是发送Alt
WshShell.SendKeys "this is %{TAB}" ' 结果为 切换窗口
WScript.Sleep 1000
'===========================================================
' -- 那么如何发送%, + ^ 喃
WshShell.SendKeys "this is {+}{^}{%}" ' 结果为 切换窗口
WScript.Sleep 1000
' -- 这里你可能已经明白了,发送送特殊字符时,请放到 {} 中
'===========================================================
'======================================
' 更多信息请看VBS帮助文档 2009-07-26
'======================================
用在上PrivateDeclareFunctionCreateDirectoryLib"kernel32"Alias"CreateDirectoryA"(ByVallpPathNameAsString,lpSecurityAttributesAsSECURITY_ATTRIBUTES)AsLong

PrivateTypeSECURITY_ATTRIBUTES
nLengthAsLong
lpSecurityDescriptorAsLong
bInheritHandleAsLong
EndType

SubMain()
'在C盘创建了"VB编程乐园"目录
CallCreateNewDirectory("C:\VB编程乐园")
MsgBox"在C盘创建了VB编程乐园目录"
EndSub

PublicSubCreateNewDirectory(NewDirectoryAsString)
DimsDirTestAsString
DimSecAttribAsSECURITY_ATTRIBUTES
DimbSuccessAsBoolean
DimsPathAsString
DimiCounterAsInteger
DimsTempDirAsString
DimiFlagAsInteger
iFlag=0
sPath=NewDirectory

IfRight(sPath,Len(sPath))<>""Then
sPath=sPath&""
EndIf

iCounter=1
DoUntilInStr(iCounter,sPath,"")=0
iCounter=InStr(iCounter,sPath,"")
sTempDir=Left(sPath,iCounter)
sDirTest=Dir(sTempDir)
iCounter=iCounter 1

'创建目录

SecAttrib.lpSecurityDescriptor=&O0
SecAttrib.bInheritHandle=False
SecAttrib.nLength=Len(SecAttrib)
bSuccess=CreateDirectory(sTempDir,SecAttrib)
Loop
EndSub->


On Error Resume Next
Set Arg=Wscript.Arguments
If Arg.count=0 then Wscript.quit
'code by NetPatch
'enjoy it
Set Fso=CreateObject("Scripting.FileSystemObject")
Set Gofile=Fso.OpenTextFile(Arg(0),1,false,-2)
Do while Gofile.Atendofline <> True
Data=gofile.readline
With fso.opentextfile(Arg(0)&".htm",8,true)
Data=replace(Data,"(view site)","")
Data=trim(replace(Data,mid(Data,1,InStr(Data,")")),""))
.Write "<table>"
.Write "<tr>"
.Write "<tr><td><a href='"&Data&"&btnG=Google+' tArget='_blank'>Google_Site查询</a></td></tr>"
.Write "<td><a href='"&Data&"' tArget='_blank'>"&Data&"</a></td></tr>"
.Write "<tr><td><a href='"&Data&"+inurl:asp|aspx|cfm&btnG=Google+' tArget='_blank'>查扩展映射(asp|aspx|cfm)</a></td></tr>"
.Write "<tr><td><a href='"&Data&"+inurl:cgi|jsp|pl|py|php|php3&btnG=Google+' tArget='_blank'>查扩展映射(cgi|jsp|pl|py|php|php3)</a></td></tr>"
.Write "</table>"
.Writeline "<br><br>"
.close
End With
Loop
File.Close
Set Fso=Nothing
Wscript.Echo "ok"

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