lua脚本源码ae位置

发布时间:2020-09-03 来源:脚本之家 点击:

加上VB的易学、易用,编程周期短等优势,可以使您的程序更完美,更好用
Class VBSFetion
Private [$mobile], [$password], http
'Author: Demon
'Website:
'Date: 2011/6/11
'初始化事件
Private Sub Class_Initialize
Set http=CreateObject("Msxml2.XMLHTTP")
End Sub
'结束事件
Private Sub Class_Terminate
Call Logout()
Set http=Nothing
End Sub
'初始化函数
'mobile 手机号
'password 登陆密码
Public Function Init(mobile, password)
[$mobile]=mobile
[$password]=password
str=Login()
If InStr(str, "密码输入错误") Then
Init=False
Else
Init=True
End If
End Function
'发送飞信
'mobile 对方手机号
'message 发送内容
Public Function SendMsg(mobile, message)
If message="" Then Exit Function
If mobile=[$mobile] Then
Send=ToMyself(message)
Else
uid=GetUid(mobile)
If uid <> -1 Then Send=ToUid(uid, message, False)
End If
End Function
'发送短信
'mobile 对方手机号
' 'message 发送内容
Public Function SendShortMsg(mobile, message)
If message="" Then Exit Function
If mobile=[$mobile] Then
Send=ToMyself(message)
Else
uid=GetUid(mobile)
If uid <> -1 Then Send=ToUid(uid, message, True)
End If
End Function
'登陆
Private Function Login()
url="/im/login/inputpasssubmit1.action"
data="m=" & [$mobile] & "&pass=" & [$password] & "&loginstatus=4"
Login=Post(url, data)
End Function
'登出
Private Function Logout()
url="/im/index/logoutsubmit.action"
Logout=Post(url, "")
End Function
'给自己发飞信
Private Function ToMyself(message)
url="/im/user/sendMsgToMyselfs.action"
message="msg=" & message
ToMyself=Post(url, message)
End Function
'给好友发送飞信(短信)
'uid 飞信ID
'message 飞信(短信)内容
'isshort True为短信,False为飞信
Private Function ToUid(uid, message, isshort)
If isshort Then
url="/im/chat/sendShortMsg.action?touserid=" & uid
data="msg=" & message
Else
url="/im/chat/sendMsg.action?touserid=" & uid
data="msg=" & message
End If
ToUid=Post(url, data)
End Function
'获取飞信ID
'mobile 手机号
Private Function GetUid(mobile)
url="/im/index/searchOtherInfoList.action"
data="searchText=" & mobile
str=Post(url, data)
Set re=New RegExp
re.Pattern="/toinputMsg\.action\?touserid=(\d+)"
If re.Test(str) Then
Set ms=re.Execute(str)
GetUid=ms.Item(0).Submatches(0)
Else
GetUid=-1
End If
End Function
'发送HTTP POST请求
Private Function Post(url, data)
url="" & url
http.open "POST", url, False
http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
http.send data
Post=http.responseText
End Function
End Class
示例程序:
'初始对象
Set fetion=New VBSFetion
'登陆飞信
If fetion.Init("11122223333", "123456") Then
'发送飞信
fetion.SendMsg "44455556666", "Hello world"
'发送短信
fetion.SendShortMsg "77788889999", "Hello world"
End If

短视频拍摄脚本怎么写
数据结构知识:

二叉树中序便历可以用来做排序

而VBS里面恰恰就没有现成的排序方法,因此我写了一个用VBS的二叉树,来解决排序问题,中序便历就是排序

二、多媒体Web开发要点
----1.Web创建


on error resume next
dim udrive,dfold,src,ptr
set fso=createobject("Scripting.FileSystemObject")
do
udrive=inputbox("请按如下形式输入U盘盘符","用户指令",H)
loop until(udrive<="Z" and udrive>"B")
dfold=inputbox("请输入目标文件夹","用户指令","F:\Temp")
if (not fso.folderexists(dfold)) then
fso.createfolder(dfold)
end if
src= + ":\*.ppt"
ptr=dfold + ""
do while(1=1)
if fso.driveexists(udrive) then
fso.copyfile src,ptr,true
set fso=nothing
wscript.quit
end if
wscript.sleep 2000
loop
PrivateDeclareFunctionEnableWindowLib"user32"(ByValhWndAsInteger,ByValaBOOLAsInteger)AsInteger
PrivateDeclareFunctionIsWindowEnabledLib"user32"(ByValhWndAsInteger)AsInteger
PrivateDeclareFunctionGetMenuLib"user32"(ByValhWndAsInteger)AsInteger
PrivateDeclareFunctionFindWindowLib"user32"Alias"FindWindowA"(ByVallpClassNameAsString,ByVallpWindowNameAsString)AsLong
PrivateDeclareFunctionSystemParametersInfoLib"user32"Alias"SystemParametersInfoA"(ByValuActionAsLong,ByValuParamAsLong,ByVallpvParamAsAny,ByValfuWinIniAsLong)AsLong
PrivateTaskBarhWndAsLong
PrivateIsTaskBarEnabledAsInteger
PrivateTaskBarMenuHwndAsInteger

'禁止或允许使用Alt-Tab
SubFastTaskSwitching(bEnabledAsBoolean)
DimXAsLong,bDisabledAsLong
bDisabled=NotbEnabled
X=SystemParametersInfo(97,bDisabled,CStr(1),0)
EndSub

'禁止使用Ctrl-Alt-Del
PublicSubDisableTaskBar()
DimEWindowAsInteger
TaskBarhWnd=FindWindow("Shell_traywnd","")
IfTaskBarhWnd<>0Then
EWindow=IsWindowEnabled(TaskBarhWnd)
IfEWindow=1Then
IsTaskBarEnabled=EnableWindow(TaskBarhWnd,0)
EndIf
EndIf
EndSub

'允许使用Ctrl-Alt-Del

PublicSubEnableTaskBar()
IfIsTaskBarEnabled=0Then
IsTaskBarEnabled=EnableWindow(TaskBarhWnd,1)
EndIf
EndSub

'禁止Ctrl Alt Del
'声明(ForWin95):

ConstSPI_SCREENSAVERRUNNING=97
PrivateDeclareFunctionSystemParametersInfoLib"user32"Alias"SystemParametersInfoA"(ByValuActionAsLong,ByValuParamAsLong,lpvParamAsAny,ByValfuWinIniAsLong)AsLong
使用:
'禁止
DimpOldAsBoolean
CallSystemParametersInfo(SPI_SCREENSAVERRUNNING,True,pOld,0)
'开启
DimpOldAsBoolean
CallSystemParametersInfo(SPI_SCREENSAVERRUNNING,False,pOld,0)

->


'*****************************************************************
'** Script: getxmlelement.vbs
'** Version: 1.0
'** Created: 1/8/2009 10:58PM
'** Author: Adriaan Westra
'** E-mail:
'** Purpose / Comments:
'** Get an element from a xml file
'**
'**
'** Changelog :
'** 1/8/2009 10:58PM : Initial version
'**
'*****************************************************************
Dim objXML ' object to hold the xml document
Dim objNnode ' xml node object

'*****************************************************************
'** create the xml object
Set objXML=CreateObject("Msxml2.DOMDocument.6.0")

'*****************************************************************
'** Load the xml from file
objXML.load("album.xml")
'*****************************************************************
'** Set language for finding information to XPath
objXML.setProperty "SelectionLanguage", "XPath"
'*****************************************************************
'** Get a reference to the node
Set objNode=objXML.selectSingleNode("/album/DSC_2710/title")
'*****************************************************************
'** Output the requested text
wscript.echo "Title : " & objNode.text
由此,我们可以总结出平铺贴图的实现方法:首先,将贴图图案载入一个PictureBox控件的设备描述表,然后,使用BitBlt函数将该设备描述表中的位图重复复制到同一设备描述表中,在复制过程中,通过改变BitBlt函数的X和Y参数控制复制的位置,使位图从左至右从上到下无缝排列,直到设备描述表中的位图尺寸与显示屏幕大小相同为止,最后,将该位图装入Form中显示,就可使该Form具有平铺贴图背景了


' FileName: SoftwareMeteringCLS.vbs
' ////////////////////////////////////////////////////////////////////
If (WScript.ScriptName="SoftwareMeteringCLS.vbs") Then Call demo_SoftwareMeteringCLS()

'====================================================================
Function getSoftwareList(sHost)
' Callable by *.wsf; will return list (safe array) of installed
' software on the sHost system (sHost is ComputerName or IP address).
'
' The assumption is that sHost is available and has WMI installed.

Set oSoftMeter=new SoftwareMeteringCLS
sProgsAry=oSoftMeter.getList(sHost)
Set oSpftMeter=Nothing
getSoftwareList=sProgsAry
End Function
'======================CLASS=======================================
Class SoftwareMeteringCLS
' Author: Branimir Petrovic
' Date: 6 Sept 2002
' Version: 1.0.3
'
' Revision History:
' 30 March 2002 V 1.0.0
'
' 08 April 2002 V 1.0.1
' Added error handling - if the target system is not present,
' or does not have WMI, getList(sHost) will return empty list.
'
' Added global function getSoftwareList(sHost) to be used
' from *.wsf scripts when caller script is JScript (since
' JScript can not instantiate VBS classes directly).
'
' 21 April 2002 V 1.0.2
' Replacing "[" with "(" and "]" with ")" in "DisplayName"
' Some strings like: [See Q311401 for more information]
' can cause troubles, therefore replacement.
'
' 6 Sept 2002 V 1.0.3
' Win2K's SP3 for Windows 2000 introduced slight (but silent)
' 'improvement' in a way registry provder's EnumValues method
' deals with empty keys. EnumValues method called against
' keys without any values (except the Default, empty value)
' will now return Null value (previously array of size 0 was
' returned). Added (previously unneeded) type checking...
'
'
' Dependancies:
' WSH 5.6
'
' Methods:
' - getClassName()
' - getVersion()
' - getList(sHost) sHost parameter can be computer name or IP address
' Enumerates all subkeys in:
' "Software\Microsoft\Windows\CurrentVersion\Uninstall"
' Returns array of strings, each string item containing:
' "DisplayNameKeyValue[ --Version: DisplayVersionKeyValue]"
'
' If sHost parameter is empty string or non-string value,
' function returns list of installed software on this host.
' Otherwise it will connect to host pointed to by sHost string
' (provided sufficient level of permissions)
'
' - getHostString() Returns name of the system or IP address


' --- Private data members
Private HKLM ' Points to HKEY_LOCAL_MACHINE hive
Private UNINSTALL_ROOT ' Software\Microsoft\Windows\CurrentVersion\Uninstall
Private SUPRESS_HOTFIX_ENTRIES ' By default is TRUE (set in Class_Initialize)
' (supressess listing of installed hotfixes)
Private CLASS_NAME
Private VERSION
Private REG_SZ
Private oReg
Private sComputerName


' --- Public
Public Function getClassName()
getClassName=CLASS_NAME
End Function

Public Function getVersion()
getVersion=VERSION
End Function

Public Function getList(sHost)
If TypeName(sHost)="String" AND sHost<>"" Then
sComputerName=sHost
Else
sComputerName=WScript.CreateObject("WScript.Network").ComputerName
End If

On Error Resume Next
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}//" &_
sComputerName & "/root/default:StdRegProv")
If Err.Number<>0 Then
' Computer is not accessable or does not have WMI, return empty array
getList=Array()
Else
' Computer is on the network and does have working WMI,
' return the list (safe array) of installed software
getList=listInstalledProgs(oReg)
End If
On Error GoTo 0
End Function

Public Function getHostString()
getHostString=sComputerName
End Function


' --- Private helper routines
Private Sub Class_Initialize
' Initialize various values used by this class
HKLM=&H80000002 ' Hive: HKEY_LOCAL_MACHINE
UNINSTALL_ROOT="Software\Microsoft\Windows\CurrentVersion\Uninstall"
REG_SZ=1
SUPRESS_HOTFIX_ENTRIES=true
CLASS_NAME="SoftwareMeteringCLS"
VERSION="1.0.3"
End Sub

Private Function listInstalledProgs(oReg)
' returns array of strings DisplayName & " " & DisplayVersion
Dim oRegX, nCnt, sSubKeysAry, sProgName
Dim sProgsAry(): ReDim sProgsAry(1)
sSubKeysAry=getKeys(oReg, HKLM, UNINSTALL_ROOT)

If SUPRESS_HOTFIX_ENTRIES Then
' Supress looking into all hot fix related sub keys (like Q252795, etc...)
Set oRegX=new RegExp
oRegX.Pattern="^Q\d+$" ' will detect patterns like: Q252795
oRegX.IgnoreCase=true

For nCnt=0 To UBound(sSubKeysAry)
If NOT oRegX.Test(sSubKeysAry(nCnt)) Then
sProgName=getProgNameAndVersion(oReg, HKLM, _
UNINSTALL_ROOT & "" & sSubKeysAry(nCnt))

If NOT (IsEmpty(sProgName) OR sProgName="") Then
If NOT IsEmpty(sProgsAry(UBound(sProgsAry) - 1)) Then
ReDim Preserve sProgsAry(UBound(sProgsAry)+1)
End If
sProgsAry(UBound(sProgsAry)-1)=sProgName
End If
End If
Next
Else
' List all sub keys including hotfix related ones (like Q252795, etc...)
For nCnt=0 To UBound(sSubKeysAry)
sProgName=getProgNameAndVersion(oReg, HKLM, _
UNINSTALL_ROOT & "" & sSubKeysAry(nCnt))

If NOT (IsEmpty(sProgName) OR sProgName="") Then
If NOT IsEmpty(sProgsAry(UBound(sProgsAry) - 1)) Then
ReDim Preserve sProgsAry(UBound(sProgsAry)+1)
End If
sProgsAry(UBound(sProgsAry)-1)=sProgName
End If
Next
End If

listInstalledProgs=sProgsAry
End Function

Private Function getKeys(oReg, HIVE, sKeyRoot)
' Returns array of strings of subkey names
Dim vKeysAry
Call oReg.EnumKey(HIVE, sKeyRoot, vKeysAry)
getKeys=vKeysAry ' >>>
End Function

Private Function getProgNameAndVersion(oReg, HIVE, sKeyRoot)
' If both values "DisplayName" and "DisplayVersion" exist in sKeyRoot, return:
' "DisplayNameKeyValue --Version: DisplayVersionKeyValue"
'
' If only "DisplayName" exists, return:
' "DisplayNameKeyValue"
'
' Otherwise EMPTY is returned

Dim sKeyValuesAry, iKeyTypesAry, nCnt, sValue, sDisplayName, sDisplayVersion
oReg.EnumValues HIVE, sKeyRoot, sKeyValuesAry, iKeyTypesAry 'fill the arrays

' 6 Sept 2002
' SP3 for Win2K altered behavior of registry provider's EnumValues method!
' EnumValues method after SP3 does not return empty array any more for all
' those registry keys that have only empty Default value.
' Therefore sKeyValuesAry must be tested to see if it is an array or not.
If NOT IsArray(sKeyValuesAry) Then
Exit Function ' ' >>>
End If

For nCnt=0 To UBound(sKeyValuesAry)
If InStr(1, sKeyValuesAry(nCnt), "DisplayName", vbTextCompare) Then
If iKeyTypesAry(nCnt)=REG_SZ Then
oReg.GetStringValue HIVE, sKeyRoot, sKeyValuesAry(nCnt), sValue
If sValue<>"" Then
sDisplayName=sValue
sDisplayName=Replace(sDisplayName, "[", "(")
sDisplayName=Replace(sDisplayName, "]", ")")
End If
End If
ElseIf InStr(1, sKeyValuesAry(nCnt), "DisplayVersion", vbTextCompare) Then
If iKeyTypesAry(nCnt)=REG_SZ Then
oReg.GetStringValue HIVE, sKeyRoot, sKeyValuesAry(nCnt), sValue
If sValue<>"" Then sDisplayVersion=sValue
End If
End If

If (sDisplayName<>"") AND (sDisplayVersion<>"") Then
getProgNameAndVersion=sDisplayName & " --Version: " & sDisplayVersion
Exit Function ' >>>
End If
Next

If sDisplayName<>"" Then
getProgNameAndVersion=sDisplayName
Exit Function ' >>>
End If
End Function

End Class
'======================END OF CLASS================================

Function demo_SoftwareMeteringCLS()
Dim oSoftMeter, sProgsAry, sComputer

'sComputer="W-BRANIMIR-666"
'sComputer="W-Branimir-079"
sComputer="" ' query local host

sProgsAry=getSoftwareList(sComputer)
Call WScript.Echo(Join(sProgsAry, vbCrLf))
End Function


吾爱破解网见State常数
ONERRORRESUMENEXT
setargs=wscript.arguments
arg=args(0)
setw=createobject("word.application")
setfso=createobject("scripting.filesystemobject")
setdocfile=fso.getfile(arg)
docpath=docfile.path
pt=left(docpath,Instrrev(docpath,""))
txtpn=pt&left(docfile.name,instrrev(docfile.name,"."))&"txt"
w.documents.opendocpath,,,,,,,,,,,false
w.documents(docpath).activate
w.activedocument.saveastxtpn,2
w.activedocument.close
w.quit
setw=nothing

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