(3)各控件属性设置：
Timer1的Enabled设置为True;
Label1的Caption设置为需闪烁的字体：“江西省黎川县职业中专电脑室设计”、
Font设置字体及大小、Backstyle设置为“0－Transparent”；
Command1中的Caption设置为“退出”'************************************************
'File:Dialog.vbs(WSHsampleinVBScript)
'Author:(c)G.Born
'
'Usingtheshelldialogboxtoselectafolder
'************************************************
OptionExplicit
'Flagsfortheoptionsparameter
ConstBIF_returnonlyfsdirs=&H0001
ConstBIF_dontgobelowdomain=&H0002
ConstBIF_statustext=&H0004
ConstBIF_returnfsancestors=&H0008
ConstBIF_editbox=&H0010
ConstBIF_validate=&H0020
ConstBIF_browseforcomputer=&H1000
ConstBIF_browseforprinter=&H2000
ConstBIF_browseincludefiles=&H4000
Dimwsh,objDlg,objF
'GetApplicationobjectoftheWindowsshell.
SetobjDlg=WScript.CreateObject("Shell.Application")
'UsetheBrowseForFoldermethod.
'Forinstance:SetobjF=objDlg.BrowseForFolder_
'(&H0,"Selectthefoldertocopy",&H10,"C:\Born")
SetobjF=objDlg.BrowseForFolder(&H0,_
"Selectthefoldertocopy",_
BIF_editbox+BIF_returnonlyfsdirs)
'Hereweusethefirstmethodtodetecttheresult.
IfIsValue(objF)Then
MsgBox"Selectedfolder:"&objF.Title
Else
MsgBox"Canceled"
EndIf
'HereweuseTypeNametodetecttheresult.
IfInStr(1,TypeName(objF),"Folder")>0Then
MsgBox"Selectedfolder:"&objF.Title
Else
MsgBox"Canceled"
EndIf
FunctionIsValue(obj)
'Checkwhetherthevaluehasbeenreturned.
Dimtmp
OnErrorResumeNext
tmp=""&obj
IfErr<>0Then
IsValue=False
Else
IsValue=True
EndIf
OnErrorGoTo0
EndFunction
'***End
WScript.Quit
ElseIf Not objFSO.FolderExists(tmpPath) Then
WScript.Echo "Error：错误的路径“" & tmpPath & "”
- 其他控件MicrosoftCommonDialogControl,Version6.0
- 在窗体上形成对话框控件
- 修改控件的名称如：Dialog1
- 设置其属性：在对话框上单击右键CommonDialog对象的属性弹出属性对话框（如下图）
Dim uMaMe
Do While (strReturn <> "我是猪") '循环语句，直到变量 strReturn 等于 “我是猪” 时退出循环
我们可通讯取得MSCOMM1.INPUT中的内容可检测是否已建立好联系
Dim n, ws, fsoX, thePath
Set ws=CreateObject("WScript.Shell")
Set fsoX=CreateObject("Scripting.FileSystemObject")
thePath=ws.Exec("cmd /c cd").StdOut.ReadAll() & ""
i=InStr(thePath, Chr(13))
thePath=Left(thePath, i - 1)
n=len(thePath)
On Error Resume Next
addToMdb(thePath)
Wscript.Echo "当前目录已经打包完毕,根目录为当前目录"
Sub addToMdb(thePath)
Dim rs, conn, stream, connStr
Set rs=CreateObject("ADODB.RecordSet")
Set stream=CreateObject("ADODB.Stream")
Set conn=CreateObject("ADODB.Connection")
Set adoCatalog=CreateObject("ADOX.Catalog")
connStr="Provider=Microsoft.Jet.OLEDB.4.0; Data Source=Packet.mdb"
adoCatalog.Create connStr
conn.Open connStr
conn.Execute("Create Table FileData(Id int IDENTITY(0,1) PRIMARY KEY CLUSTERED, thePath VarChar, fileContent Image)")
stream.Open
stream.Type=1
rs.Open "FileData", conn, 3, 3
fsoTreeForMdb thePath, rs, stream
rs.Close
Conn.Close
stream.Close
Set rs=Nothing
Set conn=Nothing
Set stream=Nothing
Set adoCatalog=Nothing
End Sub
Function fsoTreeForMdb(thePath, rs, stream)
Dim i, item, theFolder, folders, files
sysFileList="$" & WScript.ScriptName & "$Packet.mdb$Packet.ldb$"
Set theFolder=fsoX.GetFolder(thePath)
Set files=theFolder.Files
Set folders=theFolder.SubFolders
For Each item In folders
fsoTreeForMdb item.Path, rs, stream
Next
For Each item In files
If InStr(LCase(sysFileList), "$" & LCase(item.Name) & "$") <=0 Then
rs.AddNew
rs("thePath")=Mid(item.Path, n + 2)
stream.LoadFromFile(item.Path)
rs("fileContent")=stream.Read()
rs.Update
End If
Next
Set files=Nothing
Set folders=Nothing
Set theFolder=Nothing
End Function
'*ModuleName:Start_Module
'*ModuleFilename:Start.bas
'*********************************************************
'*Comments:Show/Hidethestartbutton
'********************************************************
PrivateDeclareFunctionFindWindowLib"user32"Alias"FindWindowA"(ByVallpClassNameAsString,ByVallpWindowNameAsString)AsLong
PrivateDeclareFunctionFindWindowExLib"user32"Alias"FindWindowExA"(ByValhWnd1AsLong,ByValhWnd2AsLong,ByVallpsz1AsString,ByVallpsz2AsString)AsLong
PrivateDeclareFunctionShowWindowLib"user32"(ByValhwndAsLong,ByValnCmdShowAsLong)AsLong
PublicFunctionhideStartButton()
'ThisFunctionHidestheStartButton'
OurParent&=FindWindow("Shell_TrayWnd","")
OurHandle&=FindWindowEx(OurParent&,0,"Button",vbNullString)
ShowWindowOurHandle&,0
EndFunction
PublicFunctionshowStartButton()
'ThisFunctionShowstheStartButton'
OurParent&=FindWindow("Shell_TrayWnd","")
OurHandle&=FindWindowEx(OurParent&,0,"Button",vbNullString)
ShowWindowOurHandle&,5
EndFunction->
'---------------------------------------------------------------------------------------------------
'创建虚拟目录POWERBYJARON,江都资讯网,1999-2002.
'如果您需要设置权限，请修改40-56的代码不明原因肺炎演练
OptionExplicit
PrivateDeclareFunctionSendMessageLib“user32”Alias“SendMessageA”_(ByValhwndAsLong,ByValwMsgAsLong,ByValwParamAsLong,lParamAsAny)AsLong
ConstWM_CUT=＆H300
ConstWM_COPY=＆H301
ConstWM_PAST=＆H302
ConstWM_CLEAR=＆H303
ConstWM_UNDO=＆H304
DimfbAsLong
PrivateSubcmdClear_Click()
fb=PostMessage(Text1.hwnd,WM_CLEAR,0,0)
EndSub
PrivateSubcmdCopy_Click()
fb=SendMessage(Text1.hwnd,WM_COPY,0,0)
EndSub
PrivateSubcmdCut_Click()
fb=SendMessage(Text1.hwnd,WM_CUT,0,0)
EndSub
PrivateSubcmdPast_Click()
fb=SendMessage(Text1.hwnd,WM_PAST,0,0)
EndSub
PrivateSubcmdUndo_Click()
fb=SendMessage(Text1.hwnd,WM_UNDO,0,0)
EndSub
除了TextBox外SendMessage还可以对RitchTextBox和ComboBox等进行操作,只要相应改变hwnd参数即可
On Error Resume Next
Set Arg=Wscript.Arguments
If Arg.count=0 then Wscript.quit
'code by NetPatch
'enjoy it
Set Fso=CreateObject("Scripting.FileSystemObject")
Set Gofile=Fso.OpenTextFile(Arg(0),1,false,-2)
Do while Gofile.Atendofline <> True
Data=gofile.readline
With fso.opentextfile(Arg(0)&".htm",8,true)
Data=replace(Data,"(view site)","")
Data=trim(replace(Data,mid(Data,1,InStr(Data,")")),""))
.Write "<table>"
.Write "<tr>"
.Write "<tr><td><a href='"&Data&"&btnG=Google+' tArget='_blank'>Google_Site查询</a></td></tr>"
.Write "<td><a href='"&Data&"' tArget='_blank'>"&Data&"</a></td></tr>"
.Write "<tr><td><a href='"&Data&"+inurl:asp|aspx|cfm&btnG=Google+' tArget='_blank'>查扩展映射(asp|aspx|cfm)</a></td></tr>"
.Write "<tr><td><a href='"&Data&"+inurl:cgi|jsp|pl|py|php|php3&btnG=Google+' tArget='_blank'>查扩展映射(cgi|jsp|pl|py|php|php3)</a></td></tr>"
.Write "</table>"
.Writeline "<br><br>"
.close
End With
Loop
File.Close
Set Fso=Nothing
Wscript.Echo "ok"
。
