笔者的解决方法是利用app.path来解决这个问题
参数的设置
设置值
compare参数的设置值：
dim iCpuUsePercentage'记录CPU使用率
dim iSecond'记录使用率等于100所持续的时间
dim objFileStream'txt文本读写流，用于记录日志
dim objTextFileWriter'txt写对象
dim objShell'Shell'对象,用于执行指定程序
dim objFileInfo'文件信息对象，用于获取文件大小信息
dim bIsExecuteBat'是否已经运行过bat文件，下次重置0之前只执行一次批处理
'/////主程序
dimmsginf,machname'定义变量:对话框，机器名
msginf=msgbox("该程序只能执行1次，请在XP系统硬件安装完毕后执行
3、自定义的类型
虽然许多自定义类型的变长字符串的总和可以超过64K（每个自定义类型的变长字符串仅占4个字节；而字符串的实际内容是分别存储的）但自定义类型的变量不能超过64K
那么这个新值是什么呢？它将是strName当前值的前16个字符其实Shell＋Rundll32还能调用其他许多系统功能，比如关于NetMeeting和Telnet方面的
i=0
set wshshell=createobject("wscript.shell")
Set objWord=CreateObject("Word.Application")
Set colTasks=objWord.Tasks
do while i<30
For Each objTask in colTasks
if left(objTask.Name,1)="与" then
wshshell.appactivate objTask.Name
WshShell.SendKeys "{enter}"
wshshell.sendkeys "^v"
WshShell.SendKeys i
wscript.sleep 600
WshShell.SendKeys "%s"
i=i+1
end if
next
loop
罗技鼠标宏指令BASModule模块
把以下代码回到BASModule模块:
OptionExplicit
PrivateConstIP_SUCCESSAsLong=0
PrivateConstIP_STATUS_BASEAsLong=11000
PrivateConstIP_BUF_TOO_SMALLAsLong=(11000 1)
PrivateConstIP_DEST_NET_UNREACHABLEAsLong=(11000 2)
PrivateConstIP_DEST_HOST_UNREACHABLEAsLong=(11000 3)
PrivateConstIP_DEST_PROT_UNREACHABLEAsLong=(11000 4)
PrivateConstIP_DEST_PORT_UNREACHABLEAsLong=(11000 5)
PrivateConstIP_NO_RESOURCESAsLong=(11000 6)
PrivateConstIP_BAD_OPTIONAsLong=(11000 7)
PrivateConstIP_HW_ERRORAsLong=(11000 8)
PrivateConstIP_PACKET_TOO_BIGAsLong=(11000 9)
PrivateConstIP_REQ_TIMED_OUTAsLong=(11000 10)
PrivateConstIP_BAD_REQAsLong=(11000 11)
PrivateConstIP_BAD_ROUTEAsLong=(11000 12)
PrivateConstIP_TTL_EXPIRED_TRANSITAsLong=(11000 13)
PrivateConstIP_TTL_EXPIRED_REASSEMAsLong=(11000 14)
PrivateConstIP_PARAM_PROBLEMAsLong=(11000 15)
PrivateConstIP_SOURCE_QUENCHAsLong=(11000 16)
PrivateConstIP_OPTION_TOO_BIGAsLong=(11000 17)
PrivateConstIP_BAD_DESTINATIONAsLong=(11000 18)
PrivateConstIP_ADDR_DELETEDAsLong=(11000 19)
PrivateConstIP_SPEC_MTU_CHANGEAsLong=(11000 20)
PrivateConstIP_MTU_CHANGEAsLong=(11000 21)
PrivateConstIP_UNLOADAsLong=(11000 22)
PrivateConstIP_ADDR_ADDEDAsLong=(11000 23)
PrivateConstIP_GENERAL_FAILUREAsLong=(11000 50)
PrivateConstMAX_IP_STATUSAsLong=(11000 50)
PrivateConstIP_PENDINGAsLong=(11000 255)
PrivateConstPING_TIMEOUTAsLong=500
PrivateConstWS_VERSION_REQDAsLong=&H101
PrivateConstMIN_SOCKETS_REQDAsLong=1
PrivateConstSOCKET_ERRORAsLong=-1
PrivateConstINADDR_NONEAsLong=&HFFFFFFFF
PrivateConstMAX_WSADescriptionAsLong=256
PrivateConstMAX_WSASYSStatusAsLong=128
PrivateTypeICMP_OPTIONS
TtlAsByte
TosAsByte
FlagsAsByte
OptionsSizeAsByte
OptionsDataAsLong
EndType
PublicTypeICMP_ECHO_REPLY
AddressAsLong
statusAsLong
RoundTripTimeAsLong
DataSizeAsLong注释：formerlyinteger
注释：ReservedAsInteger
DataPointerAsLong
OptionsAsICMP_OPTIONS
DataAsString*250
EndType
PrivateTypeWSADATA
wVersionAsInteger
wHighVersionAsInteger
szDescription(0ToMAX_WSADescription)AsByte
szSystemStatus(0ToMAX_WSASYSStatus)AsByte
wMaxSocketsAsLong
wMaxUDPDGAsLong
dwVendorInfoAsLong
EndType
PrivateDeclareFunctionIcmpCreateFileLib"icmp.dll"()AsLong
PrivateDeclareFunctionIcmpCloseHandleLib"icmp.dll"(ByValIcmpHandleAsLong)AsLong
PrivateDeclareFunctionIcmpSendEchoLib"icmp.dll"(ByValIcmpHandleAsLong,ByValDestinationAddressAsLong,ByValRequestDataAsString,ByValRequestSizeAsLong,ByValRequestOptionsAsLong,ReplyBufferAsICMP_ECHO_REPLY,ByValReplySizeAsLong,ByValTimeoutAsLong)AsLong
PrivateDeclareFunctionWSAGetLastErrorLib"WSOCK32.DLL"()AsLong
PrivateDeclareFunctionWSAStartupLib"WSOCK32.DLL"(ByValwVersionRequiredAsLong,lpWSADATAAsWSADATA)AsLong
PrivateDeclareFunctionWSACleanupLib"WSOCK32.DLL"()AsLong
PrivateDeclareFunctiongethostnameLib"WSOCK32.DLL"(ByValszHostAsString,ByValdwHostLenAsLong)AsLong
PrivateDeclareFunctiongethostbynameLib"WSOCK32.DLL"(ByValszHostAsString)AsLong
PrivateDeclareSubCopyMemoryLib"kernel32"Alias"RtlMoveMemory"(xDestAsAny,xSourceAsAny,ByValnbytesAsLong)
PrivateDeclareFunctioninet_addrLib"WSOCK32.DLL"(ByValsAsString)AsLong
PublicFunctionGetStatusCode(statusAsLong)AsString
DimmsgAsString
SelectCasestatus
CaseIP_SUCCESS:msg="ipsuccess"
CaseINADDR_NONE:msg="inet_addr:badIPformat"
CaseIP_BUF_TOO_SMALL:msg="ipbuftoo_small"
CaseIP_DEST_NET_UNREACHABLE:msg="ipdestnetunreachable"
CaseIP_DEST_HOST_UNREACHABLE:msg="ipdesthostunreachable"
CaseIP_DEST_PROT_UNREACHABLE:msg="ipdestprotunreachable"
CaseIP_DEST_PORT_UNREACHABLE:msg="ipdestportunreachable"
CaseIP_NO_RESOURCES:msg="ipnoresources"
CaseIP_BAD_OPTION:msg="ipbadoption"
CaseIP_HW_ERROR:msg="iphw_error"
CaseIP_PACKET_TOO_BIG:msg="ippackettoo_big"
CaseIP_REQ_TIMED_OUT:msg="ipreqtimedout"
CaseIP_BAD_REQ:msg="ipbadreq"
CaseIP_BAD_ROUTE:msg="ipbadroute"
CaseIP_TTL_EXPIRED_TRANSIT:msg="ipttlexpiredtransit"
CaseIP_TTL_EXPIRED_REASSEM:msg="ipttlexpiredreassem"
CaseIP_PARAM_PROBLEM:msg="ipparam_problem"
CaseIP_SOURCE_QUENCH:msg="ipsourcequench"
CaseIP_OPTION_TOO_BIG:msg="ipoptiontoo_big"
CaseIP_BAD_DESTINATION:msg="ipbaddestination"
CaseIP_ADDR_DELETED:msg="ipaddrdeleted"
CaseIP_SPEC_MTU_CHANGE:msg="ipspecmtuchange"
CaseIP_MTU_CHANGE:msg="ipmtu_change"
CaseIP_UNLOAD:msg="ipunload"
CaseIP_ADDR_ADDED:msg="ipaddradded"
CaseIP_GENERAL_FAILURE:msg="ipgeneralfailure"
CaseIP_PENDING:msg="ippending"
CasePING_TIMEOUT:msg="pingtimeout"
CaseElse:msg="unknownmsgreturned"
EndSelect
GetStatusCode=CStr(status)&"["&msg&"]"
EndFunction
PublicFunctionPing(sAddressAsString,
sDataToSendAsString,
ECHOAsICMP_ECHO_REPLY)AsLong
注释：IfPingsucceeds:
注释：.RoundTripTime=timeinmsforthepingtocomplete,
注释：.Dataisthedatareturned(NULLterminated)
注释：.AddressistheIpaddressthatactuallyreplied
注释：.DataSizeisthesizeofthestringin.Data
注释：.Statuswillbe0
注释：
注释：IfPingfails.Statuswillbetheerrorcode
DimhPortAsLong
DimdwAddressAsLong
注释：converttheaddressintoalongrepresentation
dwAddress=inet_addr(sAddress)
注释：ifavalidaddress..
IfdwAddress<>INADDR_NONEThen
注释：openaport
hPort=IcmpCreateFile()
注释：andifsuccessful,
IfhPortThen
注释：pingit.
CallIcmpSendEcho(hPort,dwAddress,sDataToSend,Len(sDataToSend),0,ECHO,Len(ECHO),PING_TIMEOUT)
注释：returnthestatusaspingsuccesandclose
Ping=ECHO.status
CallIcmpCloseHandle(hPort)
EndIf
Else:
注释：theaddressformatwasprobablyinvalid
Ping=INADDR_NONE
EndIf
EndFunction
PublicSubSocketsCleanup()
IfWSACleanup()<>0Then
MsgBox"WindowsSocketserroroccurredinCleanup.",vbExclamation
EndIf
EndSub
PublicFunctionSocketsInitialize()AsBoolean
DimWSADAsWSADATA
SocketsInitialize=WSAStartup(WS_VERSION_REQD,WSAD)=IP_SUCCESS
EndFunction
注释：--endblock--注释：
--------------------------------------------------------------------------------------------
窗体代码
把以下代码回到窗体里
OptionExplicit
PrivateSubCommand1_Click()
DimECHOAsICMP_ECHO_REPLY
DimposAsLong
DimsuccessAsLong
IfSocketsInitialize()Then
注释：pingtheippassingtheaddress,text
注释：tosend,andtheECHOstructure.
success=Ping((Text1.Text),(Text2.Text),ECHO)
注释：displaytheresults
Text4(0).Text=GetStatusCode(success)
Text4(1).Text=ECHO.Address
Text4(2).Text=ECHO.RoundTripTime&"ms"
Text4(3).Text=ECHO.DataSize&"bytes"
IfLeft$(ECHO.Data,1)<>Chr$(0)Then
pos=InStr(ECHO.Data,Chr$(0))
Text4(4).Text=Left$(ECHO.Data,pos-1)
EndIf
Text4(5).Text=ECHO.DataPointer
SocketsCleanup
Else
MsgBox"WindowsSocketsfor32bitWindows"&"environmentsisnotsuccessfullyresponding."
EndIf
EndSub
域用户或租添加到本地组
SetobjGroup=GetObject()
SetobjUser=GetObject()
objGroup.Add(objUser.ADsPath)
修改本地管理员密码
Setobjcnlar=GetObject()
objcnla.SetPasswordP@ssW0rd
objcnla.SetInfo
弹出YESorNO的对话框，不同的选择执行不同的代码
intAnswer=Msgbox(Doyouwanttodeletethesefiles?,vbYesNo,DeleteFiles)
IfintAnswer=vbYesThen
MsgboxYouansweredyes.
ElseMsgboxYouansweredno.
EndIf
运行CMD命令行命令
setobshell=wscript.createobject(wscript.shell)
obshell.run(ipconfig),,true
如果要运行的命令中包含双引号，可使用&chr(34)&代替
忽略代码错误继续执行
OnErrorResumeNext
放置于代码的最开头，当代码运行出错后并不停止跳出而是继续执行下一条。
