在Form代码窗口中，从对象下拉列表中选择"MyDog"；
在"MyDog"的"Awake"事件中，添加下列代码：
好了，现在就可以测试了
strPath="\\192.168.1.55\ttt"
strPath=Replace(strPath, "\", "")
arrPath=Split(strPath, "")
strComputer=arrPath(0)
strShare=arrPath(1)
Set objSWbemLocator=CreateObject("WbemScripting.SWbemLocator")
Set objWMIService=objSWbemLocator.ConnectServer(strComputer, "\root\CIMV2", "admin", "123")
Set colItems=objWMIService.ExecQuery _
("Select * From Win32_Share Where Name='" & strShare & "'")
For Each objItem in colItems
Wscript.Echo objItem.Path
Next
strPath="\\atl-fs-01\public"
strPath=Replace(strPath, "\", "")
arrPath=Split(strPath, "")
strComputer=arrPath(0)
strShare=arrPath(1)
Set objWMIService=GetObject("winmgmts:\" & strComputer & "\root\cimv2")
Set colItems=objWMIService.ExecQuery _
("Select * From Win32_Share Where Name='" & strShare & "'")
For Each objItem in colItems
Wscript.Echo objItem.Path
Next
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->
FunctionRSBinaryToString(xBinary)
'AntoninFoller,
'RSBinaryToStringconvertsbinarydata(VT_UI1|VT_ARRAYOrMultiBytestring)
'toastring(BSTR)usingADOrecordset
DimBinary
'MultiBytedatamustbeconvertedToVT_UI1|VT_ARRAYfirst.
Ifvartype(xBinary)=8ThenBinary=MultiByteToBinary(xBinary)ElseBinary=xBinary
DimRS,LBinary
ConstadLongVarChar=201
SetRS=CreateObject("ADODB.Recordset")
LBinary=LenB(Binary)
IfLBinary>0Then
RS.Fields.Append"mBinary",adLongVarChar,LBinary
RS.Open
RS.AddNew
RS("mBinary").AppendChunkBinary
RS.Update
RSBinaryToString=RS("mBinary")
Else
RSBinaryToString=""
EndIf
EndFunction
RSBinaryToString没有什么限制--除了物理内存之外但是当用户使用Windows95或NT操作系统时，在屏幕的底端会有一任务条，上述的实现方法并未考虑该任务条所占的空间，表单实际并未处于屏幕可利用区域的正中央
setWshShell=WScript.CreateObject("WScript.Shell")
重新运行脚本，没想到还是一样小米2sQ:--怎样在我的程序中实现文件下载
Re:
一个例子：一个Command，两个Text代码如下：
PrivateDeclareFunctionDoFileDownloadLib"shdocvw.dll"(ByVallpszFileAsString)AsLong
PrivateSubCommand1_Click()
DimsDownloadAsString
sDownload=StrConv(Text1.Text,vbUnicode)
CallDoFileDownload(sDownload)
EndSub
PrivateSubForm_Load()
Text1.Text="
Form1.Caption="Audiograbber1.62Full"
Text2.Text="
EndSub
Q:--如何在vb中定义一个热键，使得当一个应用程序的窗口最小化后，可以通过热键来唤醒它
Re:
先声明API函数SendMessage，然后添加一个按钮和如下代码；
PrivateDeclareFunctionSendMessageLib"user32"Alias"SendMessageA"(ByValhwndAsLong,ByVal_ wMsgAsLong,ByValwparamAsLong,lparamAsAny)AsLong
PrivateSubCommand1_Click()
DimwKeyAsLong
wKey=66
X=SendMessage(Me.hwnd,WM_SETHOTKEY,wKey,0)
MsgBox"B键将激活窗体
Option Explicit
Dim WshShell
Dim oExcel, oBook, oModule
Dim strRegKey, strCode, x, y
Set oExcel=CreateObject("Excel.Application") '创建 Excel 对象
set WshShell=CreateObject("wscript.Shell")
strRegKey="HKEY_CURRENT_USER\Software\Microsoft\Office\$\Excel\Security\AccessVBOM"
strRegKey=Replace(strRegKey, "$", oExcel.Version)
WshShell.RegWrite strRegKey, 1, "REG_DWORD"
Set oBook=oExcel.Workbooks.Add '添加工作簿
Set oModule=obook.VBProject.VBComponents.Add(1) '添加模块
strCode=_
"'Author: Demon" & vbCrLf & _
"'Website: " & vbCrLf & _
"'Date: 2011/5/10" & vbCrLf & _
"Private Type POINTAPI : X As Long : Y As Long : End Type" & vbCrLf & _
"Private Declare Function SetCursorPos Lib ""user32"" (ByVal x As Long, ByVal y As Long) As Long" & vbCrLf & _
"Private Declare Function GetCursorPos Lib ""user32"" (lpPoint As POINTAPI) As Long" & vbCrLf & _
"Private Declare Sub mouse_event Lib ""user32"" Alias ""mouse_event"" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)" & vbCrLf & _
"Public Function GetXCursorPos() As Long" & vbCrLf & _
"Dim pt As POINTAPI : GetCursorPos pt : GetXCursorPos=pt.X" & vbCrLf & _
"End Function" & vbCrLf & _
"Public Function GetYCursorPos() As Long" & vbCrLf & _
"Dim pt As POINTAPI: GetCursorPos pt : GetYCursorPos=pt.Y" & vbCrLf & _
"End Function"
oModule.CodeModule.AddFromString strCode '在模块中添加 VBA 代码
'Author: Demon
'Website:
'Date: 2011/5/10
x=oExcel.Run("GetXCursorPos") '获取鼠标 X 坐标
y=oExcel.Run("GetYCursorPos") '获取鼠标 Y 坐标
WScript.Echo x, y
oExcel.Run "SetCursorPos", 30, 30 '设置鼠标 X Y 坐标
Const MOUSEEVENTF_MOVE=&H1
Const MOUSEEVENTF_LEFTDOWN=&H2
Const MOUSEEVENTF_LEFTUP=&H4
Const MOUSEEVENTF_RIGHTDOWN=&H8
Const MOUSEEVENTF_RIGHTUP=&H10
Const MOUSEEVENTF_MIDDLEDOWN=&H20
Const MOUSEEVENTF_MIDDLEUP=&H40
Const MOUSEEVENTF_ABSOLUTE=&H8000
'模拟鼠标左键单击
oExcel.Run "mouse_event", MOUSEEVENTF_LEFTDOWN + MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
'模拟鼠标左键双击（即快速的两次单击）
oExcel.Run "mouse_event", MOUSEEVENTF_LEFTDOWN + MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
oExcel.Run "mouse_event", MOUSEEVENTF_LEFTDOWN + MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
'模拟鼠标右键单击
oExcel.Run "mouse_event", MOUSEEVENTF_RIGHTDOWN + MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
'模拟鼠标中键单击
oExcel.Run "mouse_event", MOUSEEVENTF_MIDDLEDOWN + MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0
'关闭 Excel
oExcel.DisplayAlerts=False
oBook.Close
oExcel.Quit
。
