globals.bas

来自「Windows CE 应用程序设计随书源码」· BAS 代码 · 共 77 行

Attribute VB_Name = "Globals"
Option Explicit
    '定义复制和RDA变量
    Dim CEMerge As SSCE.Replication
    Dim txtRDAConnectString
    Dim txtRDALocalTable
    Dim txtRDAQuery
    Dim txtRDAErrorTableName
    Dim RDATrackoption
    '定义菜单变量
    Dim mnuItem
    '定义SQL Server登陆信息
    Public gstrGUID As String
    Public gstrSQL As String
    Public gceErr As Object
    Public dbConnStr As String
    '系统路径
    Dim strPath As String
    strPath = App.Path
    If strPath = "\" Then
        strPath = ""
    End If
    Dim gstrRemoteSQLServerName As String
    Dim gstrRemoteSQLServerUID As String
    Dim gstrRemoteSQLServerPsswd As String
    Dim gbSQLAuthentication As Boolean
    '连接数据库
    dbConnStr = "Provider=Microsoft.SQLSERVER.OLEDB.CE.1.0; data source=" & strPath & "\ProjectInfo.sdf"
    gstrRemoteSQLServerName = "davidqin"
    gstrRemoteSQLServerUID = "sa"
    gstrRemoteSQLServerPsswd = "newchinafive008019"
    gbSQLAuthentication = True
 Sub InitReplRDA()
    ' 创建并初始化复制对象
    Set CEMerge = CreateObject("SSCE.Replication.1.0")
    CEMerge.InternetURL = "http://202.204.96.168:8080/sscesa10.dll"
    CEMerge.InternetLogin = ""
    CEMerge.InternetPassword = ""
    CEMerge.Publisher = "davidqin"
    CEMerge.PublisherDatabase = "ProjectInfo"
    CEMerge.Publication = "ProjectInfo"
    CEMerge.PublisherSecurityMode = DB_AUTHENTICATION
    CEMerge.PublisherLogin = "sa"
    CEMerge.PublisherPassword = "newchinafive008019"
    CEMerge.PublisherNetwork = DEFAULT_NETWORK
    CEMerge.Subscriber = "ProjectInfo"
    CEMerge.SubscriberConnectionString = "data source=" & strPath & "\ProjectInfo.sdf"
    CEMerge.DistributorNetwork = DEFAULT_NETWORK
    CEMerge.DistributorSecurityMode = DB_AUTHENTICATION
    CEMerge.DistributorLogin = "sa"
    CEMerge.DistributorPassword = "newchinafive008019"
    CEMerge.ExchangeType = BIDIRECTIONAL
    CEMerge.Validate = NO_VALIDATION
End Sub
'显示错误
Sub ShowErrors(ErrColl As SSCEErrors, strCaption As String)
    Dim ErrRec As Object
    Dim strErr As String
    strErr = ""
    For Each ErrRec In ErrColl
         strErr = strErr & "Source: " & ErrRec.Source & vbCrLf
         strErr = strErr & "Number: " & Hex(ErrRec.Number) & vbCrLf
         strErr = strErr & "NativeError: " & ErrRec.NativeError & vbCrLf
         strErr = strErr & "Description: " & ErrRec.Description & vbCrLf & vbCrLf
    Next ErrRec
    MsgBox strErr, vbOKOnly, strCaption
End Sub

'显示鼠标等待图标
Public Sub ShowWaitCursor()
  Screen.MousePointer = 11
End Sub
'隐藏鼠标等待指针
Public Sub HideWaitCursor()
  Screen.MousePointer = 0
End Sub