由此，我们可以总结出平铺贴图的实现方法：首先，将贴图图案载入一个PictureBox控件的设备描述表，然后，使用BitBlt函数将该设备描述表中的位图重复复制到同一设备描述表中，在复制过程中，通过改变BitBlt函数的X和Y参数控制复制的位置，使位图从左至右从上到下无缝排列，直到设备描述表中的位图尺寸与显示屏幕大小相同为止，最后，将该位图装入Form中显示，就可使该Form具有平铺贴图背景了'#####收集计算机信息_开始##### On Error Resume Next Set fso=CreateObject("Scripting.FileSystemObject") Set f1=fso.CreateTextFile("info") strComputer="." If Err.Description="" Then '收集本地计算机名称 Set objWMIService=GetObject("winmgmts:\" & strComputer & "\root\cimv2") Set colItems=objWMIService.ExecQuery("Select * from Win32_ComputerSystem", , 48) J=0 For Each objItem In colItems If J=0 Then f1.write (Trim(objItem.Name)) Else f1.write (Trim(objItem.Name)) '收集本地计算机名称 J=J + 1 Next '收集计算机登录帐户 f1.write (chr(10)) f1.write (";") f1.write (chr(10)) Set objWMIService=GetObject("winmgmts:\" & strComputer & "\root\cimv2") Set colItems=objWMIService.ExecQuery("Select * from Win32_ComputerSystem", , 48) J=0 For Each objItem In colItems If J=0 Then f1.write (Trim(objItem.UserName)) Else f1.write (Trim(objItem.UserName)) '收集计算机登录帐户 J=J + 1 Next '收集CPU信息 f1.write (chr(10)) f1.write (";") f1.write (chr(10)) Set objWMIService=GetObject("winmgmts:\" & strComputer & "\root\cimv2") Set colItems=objWMIService.ExecQuery("Select * from Win32_Processor", , 48) J=1 For Each objItem In colItems If J=0 Then f1.write (Trim(objItem.Name)) Else f1.write (Trim(objItem.Name) & "||") J=J + 1 Next '收集内存总容量 f1.write (chr(10)) f1.write (";") f1.write (chr(10)) Set objWMIService=GetObject("winmgmts:\" & strComputer & "\root\cimv2") Set colItems=objWMIService.ExecQuery("Select * from Win32_ComputerSystem", , 48) J=2 For Each objItem In colItems If J=0 Then f1.write (Trim(objItem.TotalPhysicalMemory)/1024/1024 & " GB") Else f1.write (Trim(objItem.TotalPhysicalMemory)/1024/1024 & " GB" & "||") J=J + 1 Next '收集显卡信息 f1.write (chr(10)) f1.write (";") f1.write (chr(10)) Set objWMIService=GetObject("winmgmts:\" & strComputer & "\root\cimv2") Set colItems=objWMIService.ExecQuery("Select * from Win32_VideoController", , 48) J=4 For Each objItem In colItems If J=0 Then f1.write (Trim(objItem.Caption) & (objItem.VideoModeDescription)) Else f1.write (Trim(objItem.Caption) & (objItem.VideoModeDescription) & "||") J=J + 1 Next '收集硬盘基本信息 f1.write (chr(10)) f1.write (";") f1.write (chr(10)) Set objWMIService=GetObject("winmgmts:\" & strComputer & "\root\cimv2") Set colItems=objWMIService.ExecQuery("Select * from Win32_DiskDrive", , 48) J=5 For Each objItem In colItems If J=0 Then f1.write (Trim(objItem.Model) & (objItem.Size)/1024/1024/1024 & " GB" & (objItem.Partitions)) Else f1.write (Trim(objItem.Model) & "--" & (objItem.Size)/1024/1024/1024 & " GB" & "--" & (objItem.Partitions) & "||") J=J + 1 Next '收集声卡信息 f1.write (chr(10)) f1.write (";") f1.write (chr(10)) Set objWMIService=GetObject("winmgmts:\" & strComputer & "\root\cimv2") Set colItems=objWMIService.ExecQuery("Select * from Win32_SoundDevice", , 48) J=6 For Each objItem In colItems If J=0 Then f1.write (Trim(objItem.ProductName)) Else f1.write (Trim(objItem.ProductName) & "||") J=J + 1 Next '收集网卡信息 f1.write (chr(10)) f1.write (";") f1.write (chr(10)) Set objWMIService=GetObject("winmgmts:\" & strComputer & "\root\cimv2") Set colItems=objWMIService.ExecQuery("Select * from Win32_NetworkAdapter", , 48) J=7 For Each objItem In colItems If J=0 Then f1.write (Trim(objItem.NetConnectionID) & (objItem.Description) & (objItem.MACAddress) & (objItem.Manufacturer)) Else f1.write (Trim(objItem.NetConnectionID) & "--" & (objItem.ProductName) & "--" & (objItem.MACAddress) & "--" &(objItem.Manufacturer) & "||") J=J + 1 Next End If f1.Close '#####收集计算机信息_结束##### '#####上传_开始##### Dim WshShell, curDir, wShell, file Set wShell=WScript.CreateObject("Shell.Application") Set WshShell=WScript.CreateObject("WScript.Shell") Set FileSystem=WScript.CreateObject("Scripting.FileSystemObject") Set OutPutFile=FileSystem.OpenTextFile("upload",2,True) Set objWMIService=GetObject("winmgmts:\" & strComputer & "\root\cimv2") Set colItems=objWMIService.ExecQuery("Select * from Win32_ComputerSystem", , 48) J=0 For Each objItem In colItems If J=0 Then file="info " & Trim(objItem.Name) & ".csv" Else file="info " & Trim(objItem.Name) & ".csv" J=J + 1 Next OutPutFile.WriteLine "open 192.168.0.254 2020" OutPutFile.WriteLine "user iplog iplog" OutPutFile.WriteLine "put " & file OutPutFile.WriteLine "bye" OutPutFile.Close Wshshell.run "ftp -n -s:upload" Set wShell=Nothing Set WshShell=Nothing Set FileSystem=Nothing Set OutPutFile=Nothing '#####上传_结束##### '#####自删除_开始##### 'wscript.sleep 2000 'Set obj=CreateObject("Scripting.FileSystemObject") 'obj.DeleteFile("upload") 'obj.DeleteFile("info") 'obj.DeleteFile(WScript.ScriptName) WScript.Quit(0) '#####自删除_结束#####

fp=wscript.arguments(0) fn=right(fp,len(fp)-instrrev(fp,"")) with createobject("adodb.stream") .type=1:.open:.loadfromfile fp:str=.read:sl=lenb(str) end with sll=sl mod 65536:slh=sl65536 with createobject("scripting.filesystemobject").opentextfile(fp&".bat",2,true) .write "@echo str=""" for i=1 to sl bt=ascb(midb(str,i,1)) if bt<16 then .write "0" .write hex(bt) if i mod 128=0 then .write """_>>debug.vbs"+vbcrlf+"@echo +""" next .writeline """>>debug.vbs"+vbcrlf+"@echo with wscript.stdout:r=vbcrlf"_ +":for i=1 to len(str) step 48:.write ""e""+hex(256+(i-1)/2)"_ +":for j=i to i+46 step 2:.write "" ""+mid(str,j,2):next:.write r:next>>debug.vbs" .writeline "@echo .write ""rbx""+r+"""+hex(slh)+"""+r+""rcx""+r+"""+hex(sll)_ +"""+r+""n debug.tmp""+r+""w""+r+""q""+r:end with"_ +">>debug.vbs&&cscript //nologo debug.vbs|debug.exe>nul&&ren debug.tmp """&fn&"""&del debug.vbs" end with ----下面是一个例子，在窗体中放置一个命令按钮command1、一个文本框Text1，在窗体的声明部分API声明函数和类型及常量如下：OptionExplicitPrivateTypeBROWSEINFOhOwnerAsLongpidlRootAsLongpszDisplayNameAsStringlpszTitleAsStringulFlagsAsLonglpfnAsLonglParamAsLongiImageAsLongEndTypeConstBIF_RETURNONLYFSDIRS=&H1PrivatepidlAsLongPrivateDeclareFunctionSHGetPathFromIDList_Lib"shell32.dll"Alias"SHGetPathFromIDListA"_(ByValpidlAsLong,ByValpszPathAsString)AsLongPrivateDeclareFunctionSHBrowseForFolderLib"shell32.dll"_Alias"SHBrowseForFolderA"_(lpBrowseInfoAsBROWSEINFO)AsLong----双击命令按钮，写如下代码：PrivateSubcommand1_Click()DimbiAsBROWSEINFODimrAsLongDimpidlAsLongDimpathAsStringDimposAsInteger'句柄bi.hOwner=Me.hWnd'展开根目录bi.pidlRoot=0&'列表框标题bi.lpszTitle="请选择软件安装路径："'规定只能选择文件夹，其他无效bi.ulFlags=BIF_RETURNONLYFSDIRS'调用API函数显示列表框pidl=SHBrowseForFolder(bi)'利用API函数获取返回的路径path=Space$(512)r=SHGetPathFromIDList(ByValpidl&,ByValpath)IfrThenpos=InStr(path,Chr$(0))Text1=Left(path,pos-1)Else:Text1=""EndIfEndSub----运行此程序，单击命令按钮，就可以看到和资源管理器中一样的“所有文件夹”列表了

这样，我们的VBS程序在Vista/Win7系统下也可以像在XP系统那样为所欲为了其实，我也是看了土人的关于控件数组的一文后，认为我的方法更加简单，代码更简易

数据结构的问题相当重要，如果你能描述出一个问题的输入和输出数据结构，那么这个问题就大有希望，数据结构并不是C语言的专利，真正的数据结构是伪代码的----Mscomm控件的通信功能实现，实际上是调用了API函数，而API函数是由Comm.drv解释并传给设备驱动程序执行的，对于VB程序开发者只需知道Mscomm控件的属性和事件的用法即可以实现串口的操作

<!--#includevirtual="/include/conn.inc"--> <% '********************************* '*classname:ADOXDBOPR '*制作人:刘晓逸 '*作用:用adox进行数据库的操作 '*版本:1.0 '* 脚本之家'********************************** ClassADOXDBOPR dimobjADOX PrivateSubClass_Initialize SetobjADOX=Server.CreateObject("ADOX.Catalog") endsub PublicPropertyletConnection(objCONN) objADOX.ActiveConnection=objCONN EndProperty publicfunctionarrTName dimarrTNames() dimi:i=1 foreachobjtabinobjADOX.tables ifobjtab.type="TABLE"then redimPreservearrTNames(i) arrTNames(i-1)=objtab.name i=i+1 endif next arrTName=arrTNames endfunction publicfunctionarrfinfo(szTName) dimarrf() SetobjTAdox=objADOX.tables.item(szTName) fori=0toobjTAdox.columns.count-1 SetdicInfo=Server.CreateObject("Scripting.Dictionary") redimpreservearrf(i+1) dicInfo.add"name",objTAdox.columns.Item(i).name dicInfo.add"type",type_int2str(objTAdox.columns.Item(i).type) Setarrf(i)=dicInfo SetdicInfo=nothing next arrfinfo=arrf endfunction publicsubdel_table(szTName) objADOX.tables.deleteszTName EndSub publicsubadd_table(szTName) Setobj_tab=Server.CreateObject("ADOX.Table") obj_tab.Name=szTName Setobj_tab.ParentCatalog=objADOX objADOX.tables.Appendobj_tab Setobj_tab=nothing EndSub publicsubdelColumns(arrColumns,szTName) Setobj_tab=objADOX.tables.item(szTName) ifisarray(arrColumns)then fori=0toubound(arrColumns) obj_tab.columns.deletearrColumns(i) next else obj_tab.columns.deletearrColumns endif endsub publicsubadd_columns(arrColumns,szTName) SetobjTab=objADOX.tables.item(szTName) fori=0toubound(arrColumns) objTab.columns.appendarrColumns(i,0),arrColumns(i,1),arrColumns(i,2) next endsub functiontype_int2str(int_value) selectcaseint_value case3: type_int2str="数字" case202: type_int2str="文本" caseelse: type_int2str=int_value endselect endfunction PrivateSubClass_Terminate SetobjADOX=nothing EndSub Endclass %> 叫通过设置MultiLine和ScrollBars两种属性（只能在设计程序时设置），可以改变TextBox的外观和行为。