登录  
 加关注
查看详情
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

面包会有的

... ...

 
 
 

日志

 
 

VB使用大全 - 6  

2007-09-08 14:32:35|  分类: 默认分类 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |

104、如何用 VB 启动其他程序或开启各类文件?

要在 VB 中启动其他程序或开启各类文件,最简单的方法就是使用 Shell 函数,例如:要开启 C:\Test.txt 这个文字文件,则要启动记事本来开启这个文件案,程序如下:

Dim RetVal As Long

RetVal = Shell("C:\Windows\Notepad.exe C:\Test.txt", 3) '3代表视窗会最大化,并具有驻点,细节请查 Help

以上的语法虽然很简单,但有一个风险,若是我们不知道开启文件的执行文件位置,则程序便会有错误产生,尤其一般软件在安装的时候都可以让使用者自行选择安装目录,所以执行文件的路径不能写死在程序中,要解决这个问题,就是在注册文件中找到该副文件名之启动程序位置,再放入 Shell 中。

但是以上的作法必须熟悉注册文件,而且必须使用 Windows API 来 Call (注册文件的存取以后会有专文来说明),如果您对注册文件的存取及 API 的使用都很纯熟的话,当然没问题,但是有些人对于注册文件会有畏惧,这时候,您可以使用下面的方法:

Shell("Start C:\Test.txt")

您完全不用知道这份文件的启动程序是什么?它放在什么地方?参数 Start 便会自动依照附文件名到注册文件中找到启动程序来开启该份文件案! 不赖吧!

注一:在 Windows 95/98/NT 平台中, 什么副文件名之文件案, 该由什么执行文件来启动, 都设在关联中,

代码为 HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Extensions

例如: 名称为 ".DOC" 之资料为 "C:\Progra~1\Micros~2\Office\WINWORD.EXE ^.DOC"

名称为 ".TXT" 之资料为 "notepad.exe ^.txt"

注二:使用 Start 之唯一缺点为 "会比直接指定执行文件稍为慢 0.5-1 秒钟."

注三:有一个例外就是屏幕保护程序,请看下面。

105、由程序中启动屏幕保护程序!(一)

如果您曾在民营企业的资讯中心待过,不知您是否曾遇过一种情形,某一个高阶主管 (或他的秘书) 要您帮他改一支报表,当他将有问题的报表交给您时,还千交待万交待,不可以让别人看到这份报表!这时您是不是觉得很好笑,其实在资讯中心,那里还有什么秘密可言?

话是如此说,但是如果您能够将程序写得让他们觉得很安全,您也会获得比较多的礼遇,而从程序中启动屏幕保护程序就是技巧之一,为什么呢?因为当他在作业中途要离开位置时,他可以不用结束作业中的程序,而直接启动屏幕保护程序,而在屏幕保护程序中他可以设定密码,这样就不会不小心给人看到资料了!

要启动屏幕保护程序可以直接使用 Shell 函数,但是上一个专题《问题 84》中我们讨论到的 Shell 二种作法对于屏幕保护程序却有不同的意义,分别说明如下:

错误的作法 ==> x = Shell("c:\windows\Sheep.scr") '这种作法只能开启屏幕保护程序的设定画面而已!

正确的作法 ==> Shell ("start c:\windows\sheep.scr") '这种作法才能正确启动屏幕保护程序

106、如何让您的电脑进入待命状态 (Win98) 或启动屏幕保护程序 (Win95)?

您的程序使用者会不会开启程序后不结束应用程序,结果就离开座位,久久不回座位?使用以下的方法,您可以做到:

1、在 Windows98 中,您可以在程序中让他的电脑进入待命状态! (屏幕黑黑一片)

2、在 Windows95 中,您可以启动他电脑中预设的屏幕保护程序!

而要让电脑进入待命状态或启动屏幕保护程序,只要送一个讯息给桌面 (DeskTop Window) 就可以了!

'在声明区中加入以下声明:

Const WM_SYSCOMMAND = &H112&

Const SC_SCREENSAVE = &HF140&

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Function GetDesktopWindow Lib "user32" () As Long

Function gf_StartScreenSaver() As Boolean

Dim hWnd&

On Error Resume Next

hWnd& = GetDesktopWindow()

Call SendMessage(hWnd&, WM_SYSCOMMAND, SC_SCREENSAVE, 0&)

gf_StartScreenSaver = (Err.Number = 0)

End Function

'要使用时直接呼叫 gf_StartScreenSaver 即可!例如:

Private Sub Command1_Click()

gf_StartScreenSaver

End Sub

107、如何在程序中模拟按了 Windows95/98 屏幕左下方之【开始键】?

或许有人会问:这有什么意义?当然有,随便举个例子,有的程序在执行时会盖住开始任务栏,就算滑鼠移到屏幕下方,任务栏也不会出现,目前这个方法就可以强迫任务栏出现!当然也可以让使用者选择执行【开始工能表】中各群组之程序。

如果您看过了前一个问题 (86-如何让您的电脑进入待命状态 (Win98) 或启动屏幕保护程序 (Win95)?),您一定会发现这个问题的答案和上一个范例好像!没错!要让程序模拟按了 Windows95/98 屏幕左下方之【开始键】,也只要送一个讯息给桌面 (DeskTop Window) 就可以了!差别只在传入的参数不同而已:

'在声明区中加入以下声明:

Const WM_SYSCOMMAND = &H112&

Const SC_TASKLIST = &HF130 '-------->只有这里不同而已

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Function GetDesktopWindow Lib "user32" () As Long

Function gf_StartButton() As Boolean

Dim hWnd&

On Error Resume Next

hWnd& = GetDesktopWindow()

Call SendMessage(hWnd&, WM_SYSCOMMAND, SC_TASKLIST, 0&)

gf_StartButton = (Err.Number = 0)

End Function

'要使用时直接呼叫 gf_StartButton 即可!例如:

Private Sub Command1_Click()

gf_StartButton

End Sub

108、如何让表单的标题列变成走马灯?

说穿了,这个功能就是标准的做苦工的程序!不过效果还算不错!

Dim C As String '存放现行视窗的标题列

Dim CO As Integer '存放标题的长度

Dim FS As Long '存放现行视窗的宽度

Private Sub Form_Load()

Timer1.Interval = 100

Me.Caption = "会移动的标题列"

C = Me.Caption

CO = Len(C) + 1

Me.Caption = ""

If Me.BorderStyle <> 2 Then

FS = Me.ScaleWidth + 250

Else

FS = Me.ScaleWidth + 500

End If

End Sub

Private Sub Form_Resize()

If Me.WindowState = 1 Then

FS = 3500

Else

FS = Me.ScaleWidth

End If

End Sub

Private Sub Timer1_Timer()

On Error GoTo ATH

Static C01 As Integer ' 第一个 Counter

Static CO2 As Integer ' 第二个 Counter

Static A As String ' to move caption

Dim R As String ' restore caption

Dim T As String ' restore caption

XX:

If CO > 0 Then

C01 = CO

T = Mid(C, C01, 1)

CO = CO - 1

R = " "

Mid(R, 1) = T

Me.Caption = R & Me.Caption

Else

A = A & " "

R = " "

Mid(R, 1) = A

Me.Caption = R & Me.Caption

End If

If CO2 >= FS Then

CO2 = 0

CO = Len(C)

Me.Caption = ""

GoTo XX

Else

CO2 = CO2 + 50

End If

Exit Sub

ATH:

End Sub

109、如何求出硬盘大小及剩余空间大小

在我们安装软体的时候,在安装选项的画面,常常会出现如下的一些叙述:

选择安装项目大小..............................................10,000,000 Bytes

C 硬盘总空间大小..........................................1,847,328,768 Bytes

C 硬盘剩余空间大小...........................................51,707,904 Bytes

后面的二项是我们硬盘的资讯,我们只要使用一个 API,就可以同时抓到这二个资讯!

请在声明区中放入以下声明:

Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long

'第一个参数是硬盘代号,其他参数如范例中说明

'在程序中呼叫范例如下:

Private Sub Command1_Click()

Dim SectorsPerCluster As Long '参数二:每个 Cluster 的 Sector 数

Dim BytesPerSector As Long '参数三:每个 Sector 的 Byte 数

Dim NumberOfFreeClusters As Long '参数四:剩余的 Cluster 数

Dim TotalNumberOfClusters As Long '参数五:Cluster 总数

Dim FreeBytes As Long '剩余的 Byte 数

Dim TotalBytes As Long '总 Byte 数

Dim dummy As Long '传回值

dummy = GetDiskFreeSpace("c:\", SectorsPerCluster, BytesPerSector, NumberOfFreeClusters, TotalNumberOfClusters)

FreeBytes = NumberOfFreeClusters * SectorsPerCluster * BytesPerSector

TotalBytes = TotalNumberOfClusters * SectorsPerCluster * BytesPerSector

剩余空间大小 = FreeBytes

硬盘大小 = TotalBytes

End Sub

注:在 VB6 以前的各版本 VB,只能使用这种方法来做,但是到了 VB6 已经有了更简单、不 要使用 API 的新作法,就是使用新物件 FileSystemObject,我们将在 《问题 99》再来探讨。

110、如何新增、移除【文件功能表】的内容?

在 Windows95/98 环境中,当您开启一份文件后,Windows 便会将这份文件记录在最近开启的文件记录中 (其实是将它放在 Windows/Recent 目录下)。

下一次您要开启同一份文件时,有三种以上的方法:

1、选择【开始】【文件】,就可以看到【文件功能表】的文件清单,再选择文件名称即可!

2、在文件总管文件所在目录下,直接开启该份文件。

3、在文件总管 Windows/Recent 目录下选择该份文件。

若是您想清除这份文件清单,有二个方法:

1、在文件总管中,将 Windows/Recent 目录下的文件通通删除即可。

2、在任务栏上按滑鼠右键,选择【内容】,出现【任务栏 内容】选单,选择【开始功能表程序集】,在【文件功能表】框中按【清除】按钮即可。

以上是人工的方法及 Windows 内部之作业流程,若是我们的 VB 程序中,要做到这样的功能,也是很简单的,但是它有什么作用呢?有的,举个例子:

今天 User 在操作我们的程序中,产生了几份文件,可能有文字档、Word 文件、Excel 文件...等,当然您可以事先和 User 约定好,产生的文件固定放在某一个目录下, User 再自行到该目录下去作处理,但是,如果您将产生的文件清单,直接放入【文件功能表】的文件清单中,User 根本不 知道文件放在那里,他只要在【文件功能表】中选择即可,是不是很方便!

'请在声明区中加入以下声明:

Private Declare Sub SHAddToRecentDocs Lib "shell32.dll" (ByVal uFlags As Long, ByVal pv As String)

'新增 (一次增加一笔)

Private Sub Command1_Click()

Dim NewFile As String

NewFile = "c:\doc\880730订购清单.doc" '<----- 要放到【文件功能表】文件清单的文件

Call SHAddToRecentDocs(2, NewFile)

End Sub

'清除 (一次全部清除)

Private Sub Command2_Click()

Call SHAddToRecentDocs(2, vbNullString)

End Sub

111、您认识 VB 的扩展名吗?

我不知道您已经使用 VB 多久时间了,但是今天当您面对一堆乱七八糟的文件时,您能由扩展名来判断那一个文件是属於 VB 的文件吗?恐怕不是每一个人都可以?

您知道以下这些扩展名都是 VB 指定给【设计阶段文件】的扩展名吗?

扩展名

用於

VB6

VB5

VB4-32

VB4-16

VB3

.bas

Basic 模组

*

*

*

*

*

.cls

物件类别模组

*

*

*

*

 

.ctl

使用者控制项文件

*

*

 

 

 

.ctx

使用者控制项二进位文件

*

*

 

 

 

.dca

现用设计师快取文件

*

*

 

 

 

.dep

安装精灵附属文件

*

*

 

 

 

.dob

使用者文件表单

*

*

 

 

 

.dox

使用者文件二进位表单文件

*

*

 

 

 

.dsr

现用设计师文件

*

*

 

 

 

.dsx

现用设计师二进位文件

*

*

 

 

 

.frm

表单文件

*

*

*

*

*

.frx

二进位表单文件

*

*

*

*

*

.log

载入错误的记录档

*

*

*

*

*

.oca

控制项 Typelib 文件

*

*

*

*

 

.pag

属性页文件

*

*

 

 

 

.pgx

二进位属性页文件

*

*

 

 

 

.res

资源档

*

*

*

*

 

.swt

Visual Basic 安装精灵范本文件

*

*

 

 

 

.tlb

Remote Automation Typelib 文件

*

*

 

 

 

.vbg

Visual Basic 群组专案

*

*

 

 

 

.vbl

使用者控制项授权文件

*

*

 

 

 

.vbp

Visual Basic 专案

*

*

*

*

 

.vbr

Remote Automation 注册文件

*

*

*

*

 

.vbw

Visual Basic 专案工作区

*

*

 

 

 

.vbz

精灵启动文件

*

*

*

*

*

.wct

Webclass 范本文件

*

 

 

 

 

.ocx

控制项文件

*

*

*

*

 

.vbx

控制项文件

 

 

 

*

*

.mak

Visual Basic 专案

*

*

*

*

*

112、完全模拟【开始】中的【运行...】功能

请您现在按下【开始】中的【运行...】,看看【运行...】问话框中的说明,是不是如下:

请输入程序、资料夹、文件或 Internet 资源的名称,Windows 会自动开启。

如果说您我也可以做到这种功能,只要是可开启的、可执行的,通通可以做到,您相信吗?不要怀疑!不但可以做到,而且更让您惊讶的,是程序竟然这么短,只要一行就可以了!

您一定认为要用 API,喔!不是!先别乱猜,这次不用声明 API!直接来看一个例子:

在 Form 中放一个 TextBox,名称为 Text1

Private Sub Command1_Click()

Call Shell("rundll32.exe url.dll,FileProtocolHandler " & Text1, 1)

End Sub

而其中的 Text1 可以输入程序、资料夹、文件或 Internet 资源的名称,也可以输入快捷方式 (shortcut file),都可以正确执行!

113、模拟【网路上的芳邻】及【我的电脑】中的【连线 / 中断网路磁盘】

在【网路上的芳邻】及【我的电脑】中都有提供【连线网路磁盘】及【中断网路磁盘】的功能,在 VB 的程序中我们一样可以轻易做到。

'请在声明区中加入以下声明及模组:

Declare Function WNetAddConnection Lib "mpr.dll" Alias "WNetAddConnectionA" (ByVal lpszNetPath As String, ByVal lpszPassword As String, ByVal lpszLocalName As String) As Long

Declare Function WNetCancelConnection Lib "mpr.dll" Alias "WNetCancelConnectionA" _

(ByVal lpszName As String, ByVal bForce As Long) As Long

Function AddConnection(MyShareName As String, MyPWD As String, UseLetter As String) As Integer

On Local Error GoTo AddConnection1_Err

AddConnection = WNetAddConnection(MyShareName, MyPWD, UseLetter)

AddConnection_End:

Exit Function

AddConnection1_Err:

AddConnection = Err

MsgBox Error$

Resume AddConnection_End

End Function

Function CancelConnection(DriveLetter As String, Force As Integer) As Integer

On Local Error GoTo CancelConnection_Err

CancelConnection = WNetCancelConnection(DriveLetter, Force)

CancelConnection_End:

Exit Function

CancelConnection_Err:

CancelConnection = Err

MsgBox Error$

Resume CancelConnection_End

End Function

呼叫的方法如下:

连线网路磁盘:传回值 = AddConnection(<共享的路径>, <密码>, <磁盘代号>)

中断网路磁盘:传回值 = CancelConnection(<磁盘代号>, <强迫中断?>)

呼叫实例:

连线网路磁盘:X = AddConnection("\\IO\io_c", "", "H:")

中断网路磁盘:X = CancelConnection("H:", True)

注:这个范例实际执行,连线时,NT 及 Novell 之速度相若,但是,在中断时,Novell 之速度明显较慢!

注:以上的方式乃是由程序中直接指定,另外的一个方法是显示问话框由使用者自行设定,这个方法我们在以后将再说明!

114、自制 Round 函数 (取小数点几位)

这一个问题,有网友反应在某些情形下,会造成误差 ( 连 VB6.0 提供的 Round 函数都会造成误差 ),我针对多种情形实际测试,结果很令人惊讶,让人怀疑如何做才会百分之百完全正确,根据测试结果,我原本想拿掉这个单元,但後来我重新写了一个比较笨,但是在有限小数位数内仍然会正确的式子,可是这个功能只支援小数点,不再支援整数以上的 Round 功能,如下:

'传入的参数和之前相同,第一个是要判断的数字,第二个是要取小数几位。

Public Function round(num As Double, pos As Integer) As Double

'整数以上不处理

If pos <= 0 Then

round = Format(num, "#")

Exit Function

End If

Dim i As Integer

Dim formatstr As String

'拼凑 Format 的格式

formatstr = "#."

For i = 1 To pos

formatstr = formatstr & "0"

Next

round = Format(num, formatstr)

End Function

115、如何找出 Windows 目录的正确路径?

有时候我们在程序中必须用到 Windows 的目录,以存取 Windows 目录下的文件,照理说,这应该是最简单的功能,前提是每个人在 Setup Windows 必须采用 Windows 的预设目录名称,也就是 C:\Windows,但是常常不是这样,有时候由於要使新旧版本共存,或者其他原因,有人会将 Windows 目录改成 c:\win95、c:\win98、Windows95 或 Windows98......

若是程序中必须用到 Windows 目录,要找到正确的路径,做法如下:

'在声明区中加入以下声明:

Const MAX_PATH = 260

Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Public Function GetWinPath()

Dim strFolder As String

Dim lngResult As Long

strFolder = String(MAX_PATH, 0)

lngResult = GetWindowsDirectory(strFolder, MAX_PATH)

If lngResult <> 0 Then

GetWinPath = Left(strFolder, InStr(strFolder, Chr(0)) - 1)

Else

GetWinPath = ""

End If

End Function

'在程序中使用方法如下:

Private Sub Command1_Click()

Call MsgBox("您电脑中 Windows 目录的正确路径是: " & GetWinPath, vbInformation)

End Sub

116、让您的音乐 CD 动起来!

之前,我们讨论过,但是只会开启及关闭,用处还不太大,今天,我们来看看要怎么让您的音乐 CD 动起来!

'请在声明区中加入以下声明: ( 和 "开启及关闭CD-Rom的门" 相同的声明)

Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

'在 Form 中加入二个 CommandButton,分别命名为 cmdPlay 及 cmdStop 并加入以下程序码:

Sub cmdPlay_Click()

Dim lRet As Long

Dim nCurrentTrack As Integer

'开启装置

lRet = mciSendString("open cdaudio alias cd wait", 0&, 0, 0)

'设定时间格式为 Tracks ( 预设值是 milliseconds )

lRet = mciSendString("set cd time format tmsf", 0&, 0, 0)

'从头开始播放

lRet = mciSendString("play cd", 0&, 0, 0)

'您也可以指定要从第几首歌 (Track) 开始播放,例如以下指定从第 3 首歌开始播放

'nCurrentTrack = 3

lRet = mciSendString("play cd from" & Str(nCurrentTrack), 0&, 0, 0)

End Sub

' 记得在播放完毕时要关闭装置

Sub cmdStop_Click()

Dim lRet As Long

'停止播放

lRet = mciSendString("stop cd wait", 0&, 0, 0)

DoEvents '给 Windows一点时间去处理其他事件

'关闭装置

lRet = mciSendString("close cd", 0&, 0, 0)

End Sub

注:如果您想指定从第几首歌开始播放,只要将上面绿色那行程序之 Mark 拿掉,改掉数字即可!

注:原作者原来的声明是在 mmsystem.dll,现在要使用 winmm.dll 才可以!

117、如何求出磁盘大小及剩余空间大小 (更简单的 VB6 新功能)

在《问题 91》时,我们使用了 API 来求出磁盘大小及剩余空间大小,也就是下方资讯之后二项:

《在我们安装软体的时候,在安装选项的画面,常常会出现如下的一些叙述:》

选择安装项目大小..............................................10,000,000 Bytes

C 磁碟总空间大小..........................................1,847,328,768 Bytes

C 磁碟剩余空间大小...........................................51,707,904 Bytes

在 VB6 以前我们只能如此做,对于不熟悉 API 的人来说,很难,但是在 VB6 就变得很简单,因为在 VB6 中提供了一个新物件:FileSystemObject

让我们实№来自看例子:

Private Sub Command1_Click()

Dim fso As New FileSystemObject, drv As Drive

Set drv = fso.GetDrive(fso.GetDriveName("c:"))

剩余空间大小 = drv.FreeSpace

磁盘大小 = drv.TotalSize

End Sub

使用上面的方法算出的结果和使用 GetDiskFreeSpace API 算出的结果是完全一样的!

  评论这张
 
阅读(757)| 评论(0)

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2018