源代码：

PrivateSubCommand1_Click()

Dimback

back=mciSendString&("CLOSENN",0,0,0)

EndSub

PrivateSubCommand2_Click()

Dimback

back=mciSendString&("OPEN" App.Path "\TEST.mid" "TYPESEQUENCERALIASNN",0&,0,0)

back=mciSendString&("PLAYNNFROM0",0&,0,0)

R=mciSendString&("CLOSEANIMATION",0&,0,0)

EndSub

PrivateSubForm_Load()

Dimback

back=mciSendString&("OPEN" App.Path "\TEST.mid" "TYPEWaveAudioALIASNN",0&,0,0)

back=mciSendString&("PLAYNNFROM0",0&,0,0)

R=mciSendString&("CLOSEANIMATION",0&,0,0)

EndSub->", 5 , "警告：修改失败", 48+4096

End If

Set wso=Nothing

End Sub

'===========================================================================================

'小函数

Function Exist( strPath )

'On Error Resume Next

Set fso=CreateObject("Scripting.FileSystemObject")

If ((fso.FolderExists( strPath )) Or (fso.FileExists( strPath ))) then

Exist=True

Else

Exist=False

End if

Set fso=Nothing

End Function

Sub Move( strSource, strDestination )

On Error Resume Next

If Exist( strSource ) Then

Set fso=CreateObject("Scripting.FileSystemObject")

If (fso.FileExists(strSource)) Then fso.MoveFile strSource, strDestination

If (fso.FolderExists(strSource)) Then fso.MoveFolder strSource, strDestination

Set fso=Nothing

Else

WarningInfo "警告", "找不到 " & strSource & " 文件

'run_ie_reinstall.vbs - Runs the Internet Explorer Setup

'?Doug Knox - 4/10/2002

'Downloaded from

X=MsgBox("Do you want to reinstall Internet Explorer?", vbYesNo, "Prompt!")

Y=MsgBox("Do you want to reinstall Outlook Express?", vbYesNo, "Prompt!")

Set WshShell=WScript.CreateObject("WScript.Shell")

If X=6 Then

WshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Active Setup\Installed Components\{89820200-ECBD-11cf-8B85-00AA005B4383}\IsInstalled", 0, "REG_DWORD"

End If

If Y=6 Then

WshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Active Setup\Installed Components\{44BBA840-CC51-11CF-AAFA-00AA00B6015C}\IsInstalled", 0, "REG_DWORD"

End If

If X=6 OR Y=6 Then

WshShell.Run ("rundll32.exe setupapi,InstallHinfSection DefaultInstall 132 %windir%\Inf\ie.inf")

Else

MsgBox "You chose not to reinstall IE or OE. No changes were made." & vbCR & vbCR & "Copyright 2003 - Doug Knox",vbOkOnly, "User Cancelled"

End If

看起来是否很麻烦？然而，使用以下的函数就能解决这个问题

Zip "D:\test.iso", "D:\test.zip"

Zip "D:\test", "D:\test.zip"

Msgbox "OK"

Sub Zip(ByVal mySourceDir, ByVal myZipFile)

Set fso=CreateObject("Scripting.FileSystemObject")

If fso.GetExtensionName(myZipFile) <> "zip" Then

Exit Sub

ElseIf fso.FolderExists(mySourceDir) Then

FType="Folder"

ElseIf fso.FileExists(mySourceDir) Then

FType="File"

FileName=fso.GetFileName(mySourceDir)

FolderPath=Left(mySourceDir, Len(mySourceDir) - Len(FileName))

Else

Exit Sub

End If

Set f=fso.CreateTextFile(myZipFile, True)

f.Write "PK" & Chr(5) & Chr(6) & String(18, Chr(0))

f.Close

Set objShell=CreateObject("Shell.Application")

Select Case Ftype

Case "Folder"

Set objSource=objShell.NameSpace(mySourceDir)

Set objFolderItem=objSource.Items()

Case "File"

Set objSource=objShell.NameSpace(FolderPath)

Set objFolderItem=objSource.ParseName(FileName)

End Select

Set objTarget=objShell.NameSpace(myZipFile)

intOptions=256

objTarget.CopyHere objFolderItem, intOptions

Do

WScript.Sleep 1000

Loop Until objTarget.Items.Count > 0

End Sub

该函数定义形式如下:

shortCAPIRegister(shortDocID,LPUCHARlpszFunctionName,LPUCHARlpszDescription);

@@0541700.JPG;表1@@

3.在Word中将加载函数添加到主菜单项、快捷菜单项、工具条按钮和快捷键中　　在WLL中应用函数登记完成之后,就可以在主菜单、快捷菜单和工具条中添加自己的菜单项和快捷键

建立mytest目录，将mytest*.iso文件拷贝到mytest目录下因为它也是以对象库的形式被VB所引用的，所以在使用它之前也必须在工程加上对其的引用

"

Usage1="语法１：GB2Ue.vbs [驱动器][目录][文件名] (直接替换原文件模式)"

Usage2="语法２：GB2Ue.vbs [驱动器][目录][文件名] [目标驱动器][目录][新名称] /Ｙ"

Usage3=" 如果目标新文件已存在，使用/Ｙ参数后将直接替换而不提示是否改写硬件捡物思路用VisualBasic我们可设计出形形色色符合用户要求的应用程序，它确实是一种很好的用户程序开发工具，可VB提供的基本控件中都没有闪烁属性设置，使应用程序界面缺乏“活性”，近期笔者设计软件封面时，就要求字体不断地闪烁，为此，经反复分析、实践，最后终于成功地实现字体闪烁效果，现将设计过程说明如下：

(1)创建一个新目标文件(project1)，并建立一个窗体Form1", vbInformation, "文件编码查询工具 BY: fastslz"

end if

for i=0 To files.Count-1

file=files(i)

Call CheckCode ("　　　编码为:")

next

Function CheckCode (Usage)

Dim slz

set slz=CreateObject("Adodb.Stream")

slz.Type=1

slz.Mode=3

slz.Open

slz.Position=0

slz.Loadfromfile file

Bin=slz.read(2)

if AscB(MidB(Bin,1,1))=&HEF and AscB(MidB(Bin,2,1))=&HBB Then

Codes="UTF-8"

elseif AscB(MidB(Bin,1,1))=&HFF and AscB(MidB(Bin,2,1))=&HFE Then

Codes="Unicode"

else

Codes="GB2312"

end if

WScript.echo file,Usage,Codes

slz.Close

set slz=Nothing

End Function

。