mdlset_init.bas

vb 调用ＩＢＭ ｄｏｍｉｎｏ ｓｅｒｖｅｒ数据库的例子

Attribute VB_Name = "MdlSet_Init"
Public Gcon_main As New ADODB.Connection
Public Session As New Domino.NotesSession
Public ConfigTable As String
Public gsDataBase As String
Public Str_Connection As String
Public GStr_Connection As String
Public Const ini = "oa.ini"
Public WinDir As String
Public confwRs As New ADODB.Recordset


Public txtCount As String
Public txtwsdaDominoServer As String
Public txtwsdaDominoDatabase As String
Public txtwsdaview As String
Public txtwsdaZD As String
Public txtwsdaTable As String
Public txtwsdaAdvice As String
Public txtwsdaAdviceZD As String
Public txtwsdaYW As String
Public txtwsdaYWPath As String
Public txtwsdaYWHttpPath As String
Dim txtpass As String
Public strfwgzzd As String
Public strswgzzd As String
Public strbmfwgzzd As String
Public strxxgzzd As String
Public strqbgzzd As String

Public conswRs As New ADODB.Recordset
Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Sub Main()
    On Error GoTo err_main
    
  
  
   '''''''''''''''''连接oracle
   WinDir = P_GetWinDir()
   WinDir = App.path & "\"
'''''''''   gsDataBase = "ORACLE Driver"
'''''''''   If gsDataBase = "SQLSERVER" Then
'''''''''        Str_Connection = "DRIVER=SQL Server;SERVER=" & _
'''''''''        GetSetting("PDE", "DATASET", "SERVER") & _
'''''''''        ";DATABASE=" & GetSetting("PDE", "DATASET", "DATASOURCE") & _
'''''''''        ";User Id= " & GetSetting("PDE", "DATASET", "USERID") & _
'''''''''        ";password=" & GetSetting("PDE", "DATASET", "PASSWORD") & ";Timeout=300;"
'''''''''    ElseIf gsDataBase = "ORACLE Driver" Then
'''''''''        Str_Connection = "Provider=OraOLEDB.Oracle.1;User ID=" & _
'''''''''        GetSetting("PDE", "DATASET", "USERID") & _
'''''''''        ";password=" & GetSetting("PDE", "DATASET", "PASSWORD") & _
'''''''''        ";Data Source=" & GetSetting("PDE", "DATASET", "DATASOURCE") & _
'''''''''        ";Persist Security Info=False;"
'''''''''        'Str_Connection = "DATASOURCE=Provider=MSDAORA.1;User ID=" & _
'''''''''
'''''''''    ElseIf gsDataBase = "ORACLE Driver1" Then
'''''''''        'Str_Connection = "Provider=OraOLEDB.Oracle.1;User ID=dyp;password=123;Data Source=dyp;Persist Security Info=False;" '需要修改
'''''''''        Str_Connection = "Provider=MSDAORA.1;User ID=" & _
'''''''''        GetSetting("PDE", "DATASET", "USERID") & _
'''''''''        ";password=" & GetSetting("PDE", "DATASET", "PASSWORD") & _
'''''''''        ";Data Source=" & GetSetting("PDE", "DATASET", "DATASOURCE") & _
'''''''''        ";Persist Security Info=true;"
'''''''''        'Str_Connection = P_GetProFile("SYSTEM", "DataSource", ini)
'''''''''
'''''''''    Else
'''''''''        GoTo err_main
'''''''''    End If
'''''''''    MsgBox Str_Connection
'''''''''    'Oraoledb.oracle.1   MSDAORA.1
'''''''''    With Gcon_main
'''''''''        .CursorLocation = adUseClient
'''''''''        If gsDataBase = "SQLSERVER" Then
'''''''''            .Provider = "MSDASQL"
'''''''''        End If
'''''''''        If gsDataBase = "ORACLE" Then
'''''''''            '.Provider = "MSDAORA.1"
'''''''''            .Provider = "OraOLEDB.Oracle.1"
'''''''''        End If
'''''''''         If gsDataBase = "ORACLE Driver" Then
'''''''''          .Provider = "OraOLEDB.Oracle.1"
'''''''''        End If
'''''''''
'''''''''       .CursorLocation = adUseClient
'''''''''       .ConnectionString = Str_Connection
'''''''''       .Open
'''''''''    End With

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Str_Connection = "Provider = OraOLEDB.Oracle.1;UserID=archive_fz;password=123456;DataSource=portal_134.224.52.105;Persist Security Info=True;"
'Gcon_main.CursorLocation = adUseClient
'Gcon_main.Provider = "OraOLEDB.Oracle.1"
'Gcon_main.CursorLocation = adUseClient
'Gcon_main.ConnectionString = Str_Connection
Str_Connection = "Provider=MSDAORA.1;User ID=" & _
        GetSetting("PDE", "DATASET", "USERID") & _
        ";password=" & GetSetting("PDE", "DATASET", "PASSWORD") & _
        ";Data Source=" & GetSetting("PDE", "DATASET", "DATASOURCE") & _
        ";Persist Security Info=false;"
 Gcon_main.Provider = "MSDAORA.1"
        Gcon_main.ConnectionString = Str_Connection
        MsgBox Str_Connection
Gcon_main.Open

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    Dim struid As String
    Dim struiddes As String
    struid = GetSetting("PDE", "DATASET", "USERID")
    If struid = "archive_gz" Then struiddes = "赣州市分公司"
    If struid = "archive_nc" Then struiddes = "南昌市分公司"
    If struid = "archive_sr" Then struiddes = "上饶市分公司"
    If struid = "archive_jj" Then struiddes = "九江市分公司"
    If struid = "archive_fz" Then struiddes = "抚州市分公司"
    If struid = "archive_yc" Then struiddes = "宜春市分公司"
    If struid = "archive_ja" Then struiddes = "吉安市分公司"
    If struid = "archive_jdz" Then struiddes = "景德镇市分公司"
    If struid = "archive_px" Then struiddes = "萍乡市分公司"
    If struid = "archive_xy" Then struiddes = "新余市分公司"
    If struid = "archive_yt" Then struiddes = "鹰潭市分公司"
    If struid = "archive_ywclzx" Then struiddes = "业务处理中心"
    If struid = "archive_wgzx" Then struiddes = "网络管理中心"
    If struid = "archive_csj" Then struiddes = "电信传输局"
    If struid = "archive" Then struiddes = "江西省电信有限公司"
    If struid = "archive_zczx" Then struiddes = "技术支撑中心"
    
    If MsgBox("已经连接到    --[" & struiddes & "]," & Chr(13) & "你想继续[" & struiddes & "]OA 文书档案数据操作吗？" & Chr(13), vbQuestion + vbOKCancel, "信息") = vbCancel Then Exit Sub
      
    
'''''''''''''''''''''''''''
    '''连接到Domino数据库
Set Session = CreateObject("Lotus.NotesSession")
txtpass = P_GetProFile("SYSTEM", "DominoPass", ini)
Call Session.Initialize(txtpass) '需要修改


'''''''''''''取出配置文档中省公司文档管理的信息
txtwsdaDominoServer = P_GetProFile("SYSTEM", "DominoServer", ini)
txtwsdaDominoDatabase = P_GetProFile("SYSTEM", "DominowsdaDataBase", ini)
txtwsdaview = P_GetProFile("SYSTEM", "wsdaView", ini)
txtwsdaZD = P_GetProFile("SYSTEM", "wsdazd1", ini) + "," + P_GetProFile("SYSTEM", "wsdazd2", ini)
txtwsdaTable = P_GetProFile("SYSTEM", "MainTable", ini)
txtwsdaYW = P_GetProFile("SYSTEM", "YWTable", ini)
txtwsdaYWPath = P_GetProFile("SYSTEM", "YWPath", ini)
txtwsdaYWHttpPath = P_GetProFile("SYSTEM", "XNPath", ini)

'''''''''''''''''''''
txtCount = P_GetProFile("SYSTEM", "count", ini)
''''''''''''意见字段列表
strfwgzzd = P_GetProFile("SYSTEM", "fwgzzd", ini)
strswgzzd = P_GetProFile("SYSTEM", "swgzzd", ini)
strbmfwgzzd = P_GetProFile("SYSTEM", "bmfwgzzd", ini)
strxxgzzd = P_GetProFile("SYSTEM", "xxgzzd", ini)
strqbgzzd = P_GetProFile("SYSTEM", "qbgzzd", ini)

'''''''''''''''''''''''''''''''
firform.Show
    Exit Sub
err_main:
    MsgBox "发生异常，请检查oa.ini 文件设置!" & Err.Description
    Exit Sub
End Sub
Public Function P_GetWinDir() As String
    Dim X As String * 50, v As Long
    Dim CompName As String
    Dim i As Integer
    v = GetWindowsDirectory(X, Len(X))
    i = InStr(1, X, Chr(0))
    
    CompName = Left(X, i - 1)
    P_GetWinDir = CompName
End Function
Public Function P_GetProFile(contents As String, texthead As String, Filename As String) As String
    Dim str1 As String * 255
    Dim u As Long
    u = GetPrivateProfileString(contents, texthead, "", str1, Len(str1), Trim(WinDir) & Filename)
    If u = 0 Then
        Beep
    Else
        P_GetProFile = Left(str1, InStrRev(str1, ";") - 1)
    End If
End Function