clsconfigfile.cls

VB数据库设计的代码。需要根据自己的数据库再作调整

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsConfigFile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'***********************************************************************
'* 文件名： clsConfigFile.cls
'* 说  明： 配置信息读写类
'* 版  本： 2005.12.29 颜志军 初版
'***********************************************************************

Option Explicit

'常量定义
Private Const INIFILE = "chainsale.ini"
Private Const OFS_MAXPATHNAME = 128
Private Const OF_EXIST = 16384

'结构定义
Private Type OFSTRUCT
    cBytes As Byte
    fFixedDisk As Byte
    nErrCode As Integer
    Reserved1 As Integer
    Reserved2 As Integer
    szPathName(OFS_MAXPATHNAME) As Byte
End Type

'函数定义
Private Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, _
    lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long

'***********************************************************************
'* 函数名：FileExist
'* 功  能：判断文件是否存在
'* 参  数：String                       文件名
'* 返回值：Boolean                      True 存在
'*       ：                             False 不存在
'* 版  本：2005.12.29 颜志军 初版
'***********************************************************************
Private Function FileExist(ByVal sFilename As String) As Boolean
    Dim typOfStruct As OFSTRUCT
    FileExist = False
    On Error Resume Next
    If Len(sFilename) > 0 Then
        OpenFile sFilename, typOfStruct, OF_EXIST
        FileExist = typOfStruct.nErrCode <> 2
    End If
End Function

'***********************************************************************
'* 函数名：WriteDatabasePara
'* 功  能：写数据库配置参数信息
'* 参  数：String                       服务器
'*       ：String                       用户名
'*       ：String                       密码
'*       ：String                       数据库
'* 版  本：2005.12.29 颜志军 初版
'***********************************************************************
Public Function WriteDatabasePara(ByVal server As String, _
                                    ByVal user As String, _
                                    ByVal pwd As String, _
                                    ByVal dataName As String)
    Dim fileNum As Integer
    Dim fileName As String
    fileNum = FreeFile
    fileName = App.Path & "\" & INIFILE
    Open fileName For Output As fileNum
    Print #fileNum, server
    Print #fileNum, user
    Print #fileNum, pwd
    Print #fileNum, dataName
    Close #fileNum
End Function

'***********************************************************************
'* 函数名：GetDatabasePara
'* 功  能：读数据库配置参数信息
'* 参  数：String                       服务器
'*       ：String                       用户名
'*       ：String                       密码
'*       ：String                       数据库
'* 版  本：2005.12.29 颜志军 初版
'***********************************************************************
Public Function GetDatabasePara(ByRef server As String, _
                                ByRef user As String, _
                                ByRef pwd As String, _
                                ByRef dataName As String)
    Dim fileName As String
    fileName = App.Path & "\" & INIFILE
    If FileExist(fileName) Then
        Dim fileNum As Integer
        fileNum = FreeFile
        On Error Resume Next
        Open fileName For Input As fileNum
        Input #fileNum, server
        Input #fileNum, user
        Input #fileNum, pwd
        Input #fileNum, dataName
        Close #fileNum
    Else
        server = ""
        user = ""
        pwd = ""
        dataName = ""
    End If
End Function