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

6、用VB开发应用程序如何使用INI文件

为了方便用户使用和使系统具有灵活性，大多数Win-dows应用程序将用户所做的选择以及各种变化的系统信息记录在初始化(INI)文件中。因此，当系统的环境发生变化时，可以直接修改INI文件，而无需修改程序。由此可见，INI文件对系统功能是至关重要的。本文将介绍采用VisualBasicforWindows(下称VB)开发Windows应用程序时如何读写INI文件。

INI文件是文本文件，由若干部分(section)组成，在每个带括号的标题下面，是若干个以单个单词开头的关键词(keyword)和一个等号，每个关键词会控制应用程序某个功能的工作方式，等号右边的值(value)指定关键词的操作方式。其一般形式如下:

[section1]
keyword1=valuel
keyword2=value2
……
[section2]
keyword1=value1
keyword2=value2
……

其中，如果等号右边无任何内容(即value为空)，那就表示Windows应用程序已为该关键词指定了缺省值，如果在整个文件中找不到某个关键词(或整个一部分)，那同样表示为它们指定了缺省值。各个部分所出现的顺序是无关紧要的，在每一个部分里，各个关键词的顺序同样也无关紧要。

读写INI文件通常有两种方式:一是在Windows中用"记事本"(Notepad)对其进行编辑，比较简单，无需赘述;二是由Windows应用程序读写INI文件，通常是应用程序运行时读取INI文件中的信息，退出应用程序时保存用户对运行环境的某些修改。

关键词的值的类型多为字符串或整数型，应分两种情况读写。为了使程序具有可维护性和可移植性，最好把对INI文件的读写封装在一个模块(RWINI.BAS)中，在RWI-NI.BAS中构造GetIniS和GetIniN函数以及SetIniS和Se-tIniN过程，在这些函数和过程中需要使用WindowsAPI的"GetPrivateprofileString"、"GetPrivateProfileInt"和"WritePrivateProfileString"函数。

RWINI.BAS模块的程序代码如下:

在General-Declearation部分中声明使用到的WindowsAPI函数:

Declare Function GetprivateprofileString Lib"Ker-nel"(ByVallpAppName As String，ByVallpKeyName As String，ByVallpDefault As String，ByVal lpRetrm-String As String，ByVal cbReturnString As Integer，ByVal Filename As String)As Integer
Declare FunctionGetPrivatePfileInt Lib "Kernel"(ByVal lpAppName As String，ByVal lpKeyName As String，ByVal lpDefault As Integer，ByVal Filename As String)As Integer
Declare FuncitonWritePrivateprofileString Lib "Kernel"(ByVal lpApplicationName As String，ByVal lpKeyName As String，ByVal lpString As String，ByVal lplFileName As String)As Integer
Function GetIniS(ByVal SectionName As String，ByVal KeyWord As String，ByVal DefString As String)As String
Dim ResultString As String * 144，Temp As Integer
Dims As String，i As Integer
Temp%=GetPrivateProfileString(SectionName，KeyWord，""，ResultString，144，AppProfileName())
‘检索关键词的值
IfTemp%＞0Then‘关键词的值不为空
s=""
Fori=1To144
IfAsc(Mid$(ResultString，I，1))=0Then
ExitFor
Else
s=s&Mid$(ResultString，I，1)
EndIf
Next
Else
Temp%=WritePrivateProfilesString(sectionname，KeyWord，DefString，ppProfileName())
‘将缺省值写入INI文件
s=DefString
EndIf
GetIniS=s
EndFunction
FunctionGetIniN(ByValSectionNameAsString，ByValKeyWordAsString，ByValDefValue
AsIneger)AsInteger
DimdAsLong，sAsString
d=DefValue
GetIniN=GetPrivateProfileInt(SectionName，
KeyWord，DefValue，ppProfileName())
Ifd＜＞DefValueThen
s=""&d
d=WritePrivateProfileString(SectionName，
KeyWord，s，AppProfileName())
EndIf
EndFunction
SubSetIniS(ByValSectionNameAsString，BtVaKeyWordAsString，ByValValStr
AsString)
Dimres%
res%=WritePrivateprofileString(SectionName，KeyWord，ValStr，AppProfileName())
EndSub
SubSetIniN(ByValSectionNameAsString，ByValKeyWordAsString，ByValValInt
AsInteger)
Dimres%，s$
s$=Str$(ValInt)
res%=WriteprivateProfileString(SectionName，KeyWord，s$，AppProfileName())
EndSub

SectionName为每一部分的标题，KeyWord为关键词，GetIniS和GetIniN中的DefValue为关键词的缺省值，SetIniS和SetIniN的ValStr和ValInt为要写入INI文件的关键词的值。为了能更好地说明如何使用以上函数和过程，下面举两个实例。

实例1:

开发应用程序通常要使用数据库和其它一些文件，这些文件的目录(包括路径和文件名)不应在程序中固定，而是保存在INI文件中，程序运行时由INI文件中读入。读入数据库文件的代码如下:
DimDatabasenameAsString
Databasename=GetIniS("数据库"，"职工"，"")
IfDatabaseName=""ThenDatabaseName=InputBox("请输入数据库《职工》的目录")，
App.Title)’也可通过"文件对话框"进行选择
OnErrorResumeNext
Setdb=OpenDatabas(DatabaseName)
IfErr＜＞0Then
MsgBox"打开数据库失败!"，MB-
ICONSTOP，App.Title:GotoErrorProcessing
Else
SetIniS"数据库"，"职工"，DatabaseName
EndIf
OnErrorGoTo0
……
实例2:

为了方便用户操作，有时需要保存用户界面的某些信息，例如窗口的高度和宽度等。装载窗体时，从INI文件中读入窗体高度和宽度，卸载窗体时将窗体当前高度和宽度存入INI文件，代码如下:
Sub Form1_Load()
……
Forml.Height=GetIniN("窗体1"，"高度"，6000)
Form1.Width=GetIniN("窗体1"，"高度"，4500)
EndSub
……
Sub Form1_Unload()
……
SetIniN"窗体1"，"高度"，Me.Height
SetIniN"窗体1，"宽度"，Me.Width
……
End Sub

7、程序中如何启动默认的拨号连接

---- 在介绍之前让我们首先看看如何打开拨号网络。由于拨号网络不是一个可执行文件，所以不能用 “Shell 可执行文件”的方式来打开。要启动拨号网络，需借助 Explorer ，方法如下：

Shell "Explorer ::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\" & "::{992CFFA0-F557-101A-88EC-00DD010CCC48}", vbNormalFocus

---- 但若是要启动拨号网络中的某一个连接，则需借助rundll.exe 及 rnaui.dll来启动，方法如下（假定连接名称为163）：

Shell "rundll rnaui.dll,RnaDial 163", vbNormalFocus

---- 说明：在以上叙述中，“,RnaDial 163”这部分不要插入额外的空格，大小写也不要任意更改。

---- 上面仅仅假定了连接名称，但实际编程中我们是不知道其名称的，如何取得默认的连接名称并启动它呢？这里我们可利用注册表来达到目的。完整程序如下：

---- 在窗体上放置一个命令按钮（名称为 cmdCallConnect)，下面为代码部份：

Option Explicit
     
'有关注册的API声明
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long

Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal szData As String, ByRef lpcbData As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
'常数
Const HKEY_CURRENT_USER = &H80000001
Const ERROR_SUCCESS = 0&
     
Private Sub cmdCallConnect_Click()
'启动默认拨号连接
Shell "rundll rnaui.dll,RnaDial " + GetConnect, vbNormalFocus
End Sub
     
Public Function GetConnect() As String
Dim hKey As Long
Dim SubKey As String
hKey = HKEY_CURRENT_USER  '主键
SubKey = "RemoteAccess"   '子键
'取得默认连接名
GetConnect = GetRegValue(hKey, SubKey, "Default")
End Function

Public Function GetRegValue(hKey As Long, lpszSubKey As String, szKey As String) As Variant
On Error GoTo ErrorRoutineErr:
Dim phkResult As Long
Dim lResult As Long
Dim szBuffer As String
Dim lBuffSize As Long

'创建缓冲区
szBuffer = Space(255)
lBuffSize = Len(szBuffer)

'打开注册键
RegOpenKeyEx hKey, lpszSubKey, 0, 1, phkResult

'查询结果
lResult = RegQueryValueEx(phkResult,szKey, 0, 0, szBuffer,lBuffSize)

'关闭注册键
RegCloseKey phkResult

'返回结果
If lResult = ERROR_SUCCESS Then
GetRegValue = Left(szBuffer, lBuffSize - 1)
Else
GetRegValue = ""
End If
Exit Function

ErrorRoutineErr:
GetRegValue = ""
End Function
以上程序在 WIN98,VB6.0 下调试通过。

8、如何通过VB获取网卡地址

[功能描述] IPX和NETBIOS接口需要网络地址。该文通过详细的步骤演示了如何通过VB获取网卡地址。
步骤：

1)在Visual Basic生成标准的EXE文件。缺省创建 Form1。
2)在Form1中添加一命令按钮，缺省名为Command1。
3)把下列代码放到Form1中说明部分。

Option Explicit
Private Const NCBASTAT = &H33
Private Const NCBNAMSZ = 16
Private Const HEAP_ZERO_MEMORY = &H8
Private Const HEAP_GENERATE_EXCEPTIONS = &H4
Private Const NCBRESET = &H32

Private Type NCB
　　ncb_command As Byte 'Integer
　　ncb_retcode As Byte 'Integer
　　ncb_lsn As Byte 'Integer
　　ncb_num As Byte ' Integer
　　ncb_buffer As Long 'String
　　ncb_length As Integer
　　ncb_callname As String * NCBNAMSZ
　　ncb_name As String * NCBNAMSZ
　　ncb_rto As Byte 'Integer
　　ncb_sto As Byte ' Integer
　　ncb_post As Long
　　ncb_lana_num As Byte 'Integer
　　ncb_cmd_cplt As Byte 'Integer
　　ncb_reserve(9) As Byte ' Reserved, must be 0
　　ncb_event As Long
End Type

Private Type ADAPTER_STATUS
　　adapter_address(5) As Byte 'As String * 6
　　rev_major As Byte 'Integer
　　reserved0 As Byte 'Integer
　　adapter_type As Byte 'Integer
　　rev_minor As Byte 'Integer
　　duration As Integer
　　frmr_recv As Integer
　　frmr_xmit As Integer
　　iframe_recv_err As Integer
　　xmit_aborts As Integer
　　xmit_success As Long
　　recv_success As Long
　　iframe_xmit_err As Integer
　　recv_buff_unavail As Integer
　　t1_timeouts As Integer
　　ti_timeouts As Integer
　　Reserved1 As Long
　　free_ncbs As Integer
　　max_cfg_ncbs As Integer
　　max_ncbs As Integer
　　xmit_buf_unavail As Integer
　　max_dgram_size As Integer
　　pending_sess As Integer
　　max_cfg_sess As Integer
　　max_sess As Integer
　　max_sess_pkt_size As Integer
　　name_count As Integer
End Type

Private Type NAME_BUFFER
　　name As String * NCBNAMSZ
　　name_num As Integer
　　name_flags As Integer
End Type

Private Type ASTAT
　　adapt As ADAPTER_STATUS
　　NameBuff(30) As NAME_BUFFER
End Type

Private Declare Function Netbios Lib "netapi32.dll" (pncb As NCB) As Byte
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Declare Function GetProcessHeap Lib "kernel32" () As Long
Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long,ByVal dwFlags As Long, lpMem As Any) As Long

把下面的代码放入Command1_Click的事件中：

Private Sub Command1_Click()
　　Dim myNcb As NCB
　　Dim bRet As Byte
　　myNcb.ncb_command = NCBRESET
　　bRet = Netbios(myNcb)
　　myNcb.ncb_command = NCBASTAT
　　myNcb.ncb_lana_num = 0
　　myNcb.ncb_callname = "*　　　　　　 "
　　Dim myASTAT As ASTAT, tempASTAT As ASTAT
　　Dim pASTAT As Long
　　myNcb.ncb_length = Len(myASTAT)
　　Debug.Print Err.LastDllError
　　pASTAT = HeapAlloc(GetProcessHeap(), HEAP_GENERATE_EXCEPTIONS Or HEAP_ZERO_MEMORY, myNcb.ncb_length)
　　If pASTAT = 0 Then
　　　　Debug.Print "memory allcoation failed!"
　　　　Exit Sub
　　End If
　　myNcb.ncb_buffer = pASTAT
　　bRet = Netbios(myNcb)
　　Debug.Print Err.LastDllError
　　CopyMemory myASTAT, myNcb.ncb_buffer, Len(myASTAT)
　　MsgBox Hex(myASTAT.adapt.adapter_address(0)) & " " & Hex(myASTAT.adapt.adapter_address(1)) _
　　　　& " " & Hex(myASTAT.adapt.adapter_address(2)) & " " _
　　　　& Hex(myASTAT.adapt.adapter_address(3)) _
　　　　& " " & Hex(myASTAT.adapt.adapter_address(4)) & " " _
　　　　& Hex(myASTAT.adapt.adapter_address(5))
　　HeapFree GetProcessHeap(), 0, pASTAT
End Sub

4)按F5，运行该程序。
5)点击Command1。注意，网卡地址将在一信息框中显示出来。

9、如何使用 ADO 來压缩或修复 Microsoft Access 文件

以前使用 DAO 時，Microsoft 有提供 CompactDatabase Method 來压缩 Microsoft Access 文件，RepairDatabase Method 來修复损坏的 Microsoft Access 文件，。可是自从 ADO 出來之后，好像忘了提供相对的压缩及修复 Microsoft Access 文件的功能。

現在 Microsoft 发现了这个问题了，也提供了解決方法，不过有版本上的限制！限制說明如下：

ActiveX Data Objects (ADO), version 2.1
Microsoft OLE DB Provider for Jet, version 4.0

這是 Microsoft 提出的 ADO 的延伸功能：Microsoft Jet OLE DB Provider and Replication Objects (JRO)

这个功能在 JET OLE DB Provider version 4.0 (Msjetoledb40.dll) 及 JRO version 2.1 (Msjro.dll) 中第一次被提出！
這些必要的 DLL 文件在您安裝了 MDAC 2.1 之后就有了，您可以在以下的网页中下载 MDAC 的最新版本！

Universal Data Access Web Site

在下载之前先到 VB6 中檢查一下，【控件】【設定引用項目】中的 Microsoft Jet and Replication Objects X.X library 如果已经是 2.1 以上的版本，您就可以不用下载了！

在您安裝了 MDAC 2.1 或以上的版本之后，您就可以使用 ADO 來压缩或修复 Microsoft Access 文件，下面的步骤告訴您如何使用 CompactDatabase Method 來压缩 Microsoft Access 文件：

1、新建一個新表单，选择功能表中的【控件】【設定引用項目】。
2、加入 Microsoft Jet and Replication Objects X.X library，其中 ( X.X 大于或等于 2.1 )。
3、在适当的地方加入以下的程序代码，記得要修改 data source 的內容及目地文件的路径：

Dim jro As jro.JetEngine
Set jro = New jro.JetEngine
jro.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=d:\\nwind2.mdb", _ '來源文件
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=d:\\abbc2.mdb;Jet OLEDB:Engine Type=4" '目的文件

在 DAO 3.60 之后，RepairDatabase Method 已经无法使用了，以上的程序代码显示了 ADO CompactDatabase Method 的用法，而它也取代了 DAO 3.5 時的 RepairDatabase method！

10、如何设置对VB数据库连接的动态路径

一、用data控件进行数据库链接，可以这样：
在form_load()过程中放入：
private form_load()
Dim str As String '定义
str = App.Path
If Right(str, 1) <> "\" Then
str = str + "\"
End If
data1.databasename=str & "\数据库名"
data1.recordsource="数据表名"
data1.refresh
sub end
这几句话的意为，打开当前程序运行的目录下的数据库。
你只要保证你的数据库在你程序所在的目录之下就行了。

二、利用adodc（ADO Data Control)进行数据库链接：
private form_load ()
Dim str As String '定义
str = App.Path
If Right(str, 1) <> "\" Then
str = str + "\"
End If
str = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=" & str & "\tsl.mdb"
Adodc1.ConnectionString = str
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = "select * from table3"
Adodc1.Refresh
end sub

三、利用DataEnvironment进行数据库链接
可在过程中放入：
On Error Resume Next
If DataEnvironment1.rsCommand1.State <> adStateClosed Then
DataEnvironment1.rsCommand1.Close '如果打开，则关闭
End If
'i = InputBox("请输入友人编号:", "输入")
'If i = "" Then Exit Sub
DataEnvironment1.Connection1.Open App.Path & "\userdatabase\tsl.mdb"
DataEnvironment1.rsCommand1.Open "select * from table3 where 编号='" & i & "'"
'Set DataReport2.DataSource = DataEnvironment1
'DataReport2.DataMember = "command1"
'DataReport2.show
end sub

四、利用ADO(ActiveX Data Objects)进行编程：
建立连接：
dim conn as new adodb.connection
dim rs as new adodb.recordset
dim str
str = App.Path
If Right(str, 1) <> "\" Then
str = str + "\"
End If
str = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=" & str & "\tsl.mdb"
conn.open str
rs.cursorlocation=aduseclient
rs.open "数据表名",conn,adopenkeyset.adlockpessimistic
用完之后关闭数据库：
conn.close
set conn=nothing

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