［上一页］（30）［下一页］

146、如何中断【拨号网路连线】？

要在 VB 程序中中断【拨号网路连线】，可以使用 Remote Access Services Hangup 函数：

'在模组的声明区中加入以下声明及模组：

Public Const RAS_MAXENTRYNAME As Integer = 256
Public Const RAS_MAXDEVICETYPE As Integer = 16
Public Const RAS_MAXDEVICENAME As Integer = 128
Public Const RAS_RASCONNSIZE As Integer = 412
Public Const ERROR_SUCCESS = 0&

Public Type RasEntryName
dwSize As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
End Type

Public Type RasConn
dwSize As Long
hRasConn As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
szDeviceType(RAS_MAXDEVICETYPE) As Byte
szDeviceName(RAS_MAXDEVICENAME) As Byte
End Type

Public Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasConn As Any, lpcb As Long, lpcConnections As Long) As Long

Public Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" (ByVal hRasConn As Long) As Long

Public gstrISPName As String
Public ReturnCode As Long

Public Sub HangUp()
Dim i As Long
Dim lpRasConn(255) As RasConn
Dim lpcb As Long
Dim lpcConnections As Long
Dim hRasConn As Long

lpRasConn(0).dwSize = RAS_RASCONNSIZE
lpcb = RAS_MAXENTRYNAME * lpRasConn(0).dwSize
lpcConnections = 0
ReturnCode = RasEnumConnections(lpRasConn(0), lpcb, lpcConnections)
If ReturnCode = ERROR_SUCCESS Then
For i = 0 To lpcConnections - 1
If Trim(ByteToString(lpRasConn(i).szEntryName)) = Trim(gstrISPName) Then
hRasConn = lpRasConn(i).hRasConn
ReturnCode = RasHangUp(ByVal hRasConn)
End If
Next i
End If
End Sub

Public Function ByteToString(bytString() As Byte) As String
Dim i As Integer
ByteToString = ""
i = 0
While bytString(i) = 0&
ByteToString = ByteToString & Chr(bytString(i))
i = i + 1
Wend
End Function

'在程序中使用实例为

Call HangUp

147、资料库的导出

在很多 VB 的资料库书籍中，都会很完整的提到：如何由其他种类的文件中将资料导入资料库，但是却很少有书提到：如何将资料库中的资料，导出到各种不同的文件类型的文件中，连 VB 的 Help 中也是这样！

或许是大家都认为资料库主题的重点是在资料库本身吧！

但是，在实际的资料库程序运用中，却常常需要将资料库导出到各种不同的文件类型的文件中，这些文件可能是 DBase文件、文字文件 (.Txt)、Excel 文件、Html 文件、Access 文件或其他类型的资料库文件 (ODBC)...等。

在本专题中，考虑到并不是每一个人都有 Oracle 或 SQL Server 的环境，为了让大家都能够实作，我们将以 Access 资料库来作练习，而练习的文件也使用 VB 本身提供的 Biblio.mdb (位于各版本 VB 的目录下)。

预计要练习导出的文件类型有五种：DBase文件、文字文件 (.Txt)、Html 文件、Excel 文件、Access 文件。除了这五种之外，下面的语法可以将资料库之资料导出到任一种 VB 支援的资料库或文件中。

在练习之前，要将导出文件的 SQL 语法先说明一下：

SELECT Table.Fields INTO [dbms type;DATABASE=path].[unqualified filename] FROM [Table or Tables]
SELECT Table.Fields INTO [资料库种类;DATABASE=资料库路径].[资料库文件名称] FROM [Table or Tables]

至于【资料库种类】及【资料库路径】，视资料库或文件类型之不同而异，详见【注一】。
如果上面说的都清楚了，那我们要开始这一个练习了！

在 Form 上放置一个 CommandButton，在【专案】【设定引用项目】中加入 Microsoft DAO 3.51 Object Library，我们将使用 Biblio.mdb 的 authors Table，在 Command1_Click 中加入以下程序码：

Dim db As Database
Set db = Workspaces(0).OpenDatabase(App.Path & "\biblio.mdb")
'db.execute "SELECT Table.Fields INTO [dbms type;DATABASE=path].[unqualified filename] FROM [Table or Tables]"

在以上程序中，db.execute 指令行之指令依资料库或文件的种类说明如下：

一、DBase文件

SQL 语法：SELECT * INTO [dBase III;DATABASE=资料库路径].[dbase文件名称] FROM [authors]
db.Execute "SELECT * INTO [dBase III;DATABASE=C:\test].[authors.DBF] FROM [authors]"
注意事项：
1、authors.DBF 事先不可存在，否则会产生错误！
2、若您没有 Dbase，您可以使用 Access 来连结这个 Table，以便观察结果！

二、文本文件 (.Txt)

SQL 语法：SELECT * INTO [Text;DATABASE=文本文件路径].[文本文件名称] FROM [authors]
db.Execute "SELECT * INTO [Text;DATABASE=C:\test].[authors.TXT] FROM [authors]"
注意事项：
1、authors.TXT 事先不可存在，否则会产生错误！
2、此动作会产生的文件有二个，第一个就是文本文件 authors.TXT，第二个是 Schema.ini。
3、文本文件之格式为 CSV 之文件格式，即各栏位间以逗点分开，实际呈现方式如下：

　　"Au_ID","Author","Year Born"
　　1,"Jacobs, Russell",1950
　　2,"Metzger, Philip W.",1942

4、Schema.ini 若事先不存在会新产生一个，若已存在，则会在原文件后面直接 Append。
5、至于 Schema.ini 的属性为此次导出的相关资讯，格式同一般的 Ini 文件，详细属性如下：

　　[authors.TXT]
　　ColNameHeader=True
　　CharacterSet=OEM
　　Format=CSVDelimited
　　Col1=Au_ID Integer
　　Col2=Author Char Width 50
　　Col3="Year Born" Short

三、Html 文件

SQL 语法：SELECT * INTO [Excel 8.0;DATABASE=Html文件路径].[Html文件名称] FROM [authors]
db.Execute "SELECT * INTO [HTML Export;DATABASE=C:\test].[authors.HTM] FROM [authors]"
注意事项：
1、authors.HTM 事先不可存在，否则会产生错误！
2、此动作会产生的文件有二个，第一个就是文本文件 authors.HTM，第二个是 Schema.ini。
3、Schema.ini 若事先不存在会新产生一个，若已存在，则会在原文件后面直接 Append。
4、至于 Schema.ini 的属性为此次导出的相关资讯，格式同一般的 Ini 文件，详细属性如下：

　　[authors.HTM]
　　ColNameHeader=True
　　CharacterSet=ANSI
　　Format=HTML
　　Col1=Au_ID Integer
　　Col2=Author Char Width 50
　　Col3="Year Born" Short

四、Excel 文件

SQL 语法：SELECT * INTO [Excel 8.0;DATABASE=文件路径+文件名].[工作表名称] FROM [authors]
db.Execute "SELECT * INTO [Excel 8.0;DATABASE=C:\test\authors.XLS].[authors] FROM [authors]"
注意事项：
1、authors.XLS 可事先存在，也可以不存在，会自动产生一个。
2、工作表 authors 事先不可存在，否则会产生错误！

五、Access 文件

SQL 语法：SELECT * INTO [新资料库路径+文件名][新资料表名称] FROM [authors]
'导出到同一资料库 ( 新 Table 为 authors1 )
'新 Table authors1 事先不可存在，否则会产生错误！
db.Execute "SELECT * INTO [authors1] FROM [authors]"
'导出到不同的资料库 ( 新资料库为 db1，新 Table 为 authors )
'新资料库 db1事先必须存在，否则会产生错误！
'但是其中新 Table authors 事先不可存在，否则会产生错误！
db.Execute "SELECT * INTO [C:\test\db1.mdb].[authors] FROM [authors]"

注一：各种可能的资料库种类 Connect 属性设定方式：

148、模拟 Windows 的资源回收站！

您现在将屏幕上所有的视窗全部缩小，找到资源回收站，按鼠标右键，选择【属性】，便会出现【资源回收站】的属性问话框。

其中有几个选项如下：

1、不要将文件移到资源回收站，删除时立即移除文件。
2、显示删除确认对话框？

根据以上之状况，文件之删除有三种情形：

1、删除文件，出现确认对话框，文件移到资源回收站。
2、删除文件，出现确认对话框，文件不移到资源回收站。
3、删除文件，不出现确认对话框，文件也不移到资源回收站。

模拟程序如下：

'在模组的声明区中加入以下声明：

Public Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As Long
End Type

Public Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

Public Const FO_DELETE = &H3
Public Const FOF_ALLOWUNDO = &H40 '可以还原
Public Const FOF_NOCONFIRMATION = &H10 '不出现确认对话框
Public Const FOF_SILENT = &H4

'在程序中之使用方法如下：
'以下之例子会出现确认对话框，文件也会移到资源回收站。

Private Sub Command1_Click()
Dim SHop As SHFILEOPSTRUCT
Dim strFile As String '要删除的文件(含全路径)
strFile = "c:\test.txt"

With SHop
.wFunc = FO_DELETE
.pFrom = strFile
.fFlags = FOF_ALLOWUNDO
End With

SHFileOperation SHop
End Sub

'若要调整，只要更改 fFlags 之值即可，如下：
.fFlags = FOF_SILENT '删除文件，出现确认对话框，文件不移到资源回收站。
.fFlags = FOF_NOCONFIRMATION '删除文件，不出现确认对话框，文件也不移到资源回收站。

149、如何得到文件路径的文件名

Dim sFilePath As String
sFilePath = "C:\Windows\System\sytem.dll"

Dim lGetLen As Long, lNum As Long
Dim sGetFile As String, sTemp As String
lGetLen = Len(sFilePath) '得到文件路径长度
sTemp = lGetLen
For lNum = 1 To lGetLen
If Left(sGetFile, 1) = "\" Then Exit For
sGetFile = Mid(sFilePath, sTemp, lNum)
sTemp = sTemp - 1
Next lNum
sGetFile = Mid(sGetFile, 2) '得到文件名
MsgBox sGetFile

150、如何用VB准确计算年龄

Function CalcAge(datEmpDateOfBirth as Variant) as Integer
CalcAge = Int(DateDiff("y",datEmpDateOfBirth,Date())/365.25)
End Function