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)对其进行编辑比较简单无需赘述; 2是由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 StringByVallpKeyName As StringByVallpDefault As StringByVal lpRetrm-String As StringByVal cbReturnString As IntegerByVal Filename As String)As Integer
Declare FunctionGetPrivatePfileInt Lib "Kernel"(ByVal lpAppName As StringByVal lpKeyName As StringByVal lpDefault As IntegerByVal Filename As String)As Integer
Declare FuncitonWritePrivateprofileString Lib "Kernel"(ByVal lpApplicationName As StringByVal lpKeyName As StringByVal lpString As StringByVal lplFileName As String)As Integer
Function GetIniS(ByVal SectionName As StringByVal KeyWord As StringByVal DefString As String)As String
　　Dim ResultString As String * 144Temp As Integer
　　Dims As Stringi As Integer
　　Temp%=GetPrivateProfileString(SectionNameKeyWord""ResultString144AppProfileName)
‘检索关键词值
　　IfTemp%＞0Then‘关键词值不为空
s=""
Fori=1To144
IfAsc(Mid$(ResultStringI1))=0Then
ExitFor
Else
s=s&Mid$(ResultStringI1)
EndIf
Next
Else
Temp%=WritePrivateProfilesString(sectionnameKeyWordDefStringppProfileName)
‘将缺省值写入INI文件
s=DefString
EndIf
GetIniS=s
EndFunction
FunctionGetIniN(ByValSectionNameAsStringByValKeyWordAsStringByValDefValue
AsIneger)AsInteger
DimdAsLongsAsString
d=DefValue
GetIniN=GetPrivateProfileInt(SectionName
KeyWordDefValueppProfileName)
Ifd＜＞DefValueThen
s=""&d
d=WritePrivateProfileString(SectionName
KeyWordsAppProfileName)
EndIf
EndFunction
SubSetIniS(ByValSectionNameAsStringBtVaKeyWordAsStringByValValStr
AsString)
Dimres%
res%=WritePrivateprofileString(SectionNameKeyWordValStrAppProfileName)
EndSub
SubSetIniN(ByValSectionNameAsStringByValKeyWordAsStringByValValInt
AsInteger)
Dimres%s$
s$=Str$(ValInt)
res%=WriteprivateProfileString(SectionNameKeyWords$AppProfileName)
EndSub　　SectionName为每部分标题KeyWord为关键词GetIniS和GetIniN中DefValue为关键词缺省值SetIniS和SetIniNValStr和ValInt为要写入INI文件关键词值为了能更好地介绍说明如何使用以上和过程下面举两个例子

　　例子1:

　　开发应用通常要使用数据库和其它些文件这些文件目录(包括路径和文件名)不应在中固定而是保存在INI文件中运行时由INI文件中读入读入数据库文件代码如下:

　　DimDatabasenameAsString
Databasename=GetIniS("数据库""职工""")
IfDatabaseName=""ThenDatabaseName=InputBox("请输入数据库职工目录")
App.Title)’也可通过"文件对话框"进行选择
OnErrorResumeNext
Setdb=OpenDatabas(DatabaseName)
IfErr＜＞0Then
MsgBox"打开数据库失败!"MB-
ICONSTOPApp.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、中如何启动默认拨号连接　　随着因特网迅猛发展现在编程常需要在中直接联网来处理些事项如在线注册和在线帮助这就要求我们要在中建立某些连接很多软件Software在不知用户是否联网情况下不管 3 7 2十就启动浏览器查找网址费了 9牛 2虎的力只能查出页来(当然不可能有什么好结果)如果我们在编写时能自动判断用户是否已经联网如已经联网则打开联接如没有则启动默认拨号连接这样是不是让人觉得你软件Software更胜人处呢？判断是否已联网很多地方都有介绍这里我们只介绍如何启动默认拨号连接

　　---- 在介绍的前让我们首先看看如何打开拨号网络由于拨号网络不是个可执行文件所以不能用 “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
　　rame_recv_err As Integer
　　xmit_aborts As Integer
　　xmit_success As Long
　　recv_success As Long
　　rame_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.Pr Err.LastDllError
　　pASTAT = HeapAlloc(GetProcessHeap, HEAP_GENERATE_EXCEPTIONS Or HEAP_ZERO_MEMORY, myNcb.ncb_length)
　　If pASTAT = 0 Then
　　　　Debug.Pr "memory allcoation failed!"
　　　　Exit Sub
　　End If
　　myNcb.ncb_buffer = pASTAT
　　bRet = Netbios(myNcb)
　　Debug.Pr 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 中檢查下【Control控件】【設定引用項目】中 Microsoft Jet and Replication Objects X.X library 如果已经是 2.1 以上版本您就可以不用下载了！

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

　　1、新建個新表单选择功能表中【Control控件】【設定引用項目】

　　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数据库连接动态路径　　我个人经常作些数据库方面对于间如何和数据库进行接口问题的烦是深有体会VB在数据库链接时候般是静态即数据库存放路径是固定如用VBDATAadodc,DataEnvironment 等到作数据库链接时如果存放数据库路径被改变话就会找不到路经真是个特别烦事

　　笔者解决思路方法是利用app.path 来解决这个问题

　　、用dataControl控件进行数据库链接可以这样:

　　在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

　　这几句话意为打开当前运行目录下数据库

　　你只要保证你数据库在你所在目录的下就行了

　　 2、利用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

　　 3、利用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

　　 4、利用ADO(ActiveX Data Objects)进行编程:

　　建立连接:

　　dim conn as adodb.connection

　　dim rs as adodb.record

　　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,adopenkey.adlockpessimistic

　　用完的后关闭数据库:

　　conn.close

　　 conn=nothing