stdrptfunc.bas

来自「本系统是一个报表分析查询系统」· BAS 代码 · 共 83 行

Attribute VB_Name = "StdRptFunc"
Option Explicit

'//初始化数据
Public Function DataInit() As Boolean
 On Error GoTo ErrHandle
 Dim EObj As Object
 Set EObj = CreateObject("ABCCrypto2.Crypto")
 EObj.License = "131-598-271-072"
 EObj.Password = "FxGang_Soft"
 With SysInfo
  With .Base
   .XmlFile = App.Path & "\System.Xml"
   .MsgInfo = "金软提示您"
   Call getXmlValue(.XmlFile, "Rpt/System/Title", .Title)
   Call getXmlValue(.XmlFile, "Rpt/System/LoginID", .LoginID)
  End With
  '/
  With .Data
   Call getXmlValue(SysInfo.Base.XmlFile, "Rpt/Server/Name", .Name)
   Call getXmlValue(SysInfo.Base.XmlFile, "Rpt/Server/Data", .Data)
   Call getXmlValue(SysInfo.Base.XmlFile, "Rpt/Server/User", .User)
   Call getXmlValue(SysInfo.Base.XmlFile, "Rpt/Server/Pass", .Pass)
   ConStr = "Provider=SQLOLEDB.1;Persist Security Info=False;Password=" & EObj.Decrypt(.Pass) & ";User ID=" & EObj.Decrypt(.User) & ";Initial Catalog=" & EObj.Decrypt(.Data) & ";Data Source=" & EObj.Decrypt(.Name)
  End With
 End With
 Set EObj = Nothing
 DataInit = True
 Exit Function
ErrHandle:
 DataInit = False
End Function

'//读取XML文件
Public Function getXmlValue(ByVal XmlFile As String, ByVal AppKey As String, ByRef AppValue As String) As Boolean
 On Error GoTo ErrHandle
 Dim objXml As New DOMDocument
 Dim objNode As IXMLDOMNode
 '//
 Call objXml.Load(XmlFile)
 '//
 Set objNode = objXml.selectSingleNode(AppKey)
 If objNode Is Nothing Then
  AppValue = ""
 Else
  AppValue = objNode.nodeTypedValue
 End If
 '//
 Set objNode = Nothing
 Set objXml = Nothing
 getXmlValue = True
 Exit Function
ErrHandle:
 getXmlValue = False
End Function

'//修改XML文件
Public Function setXmlValue(ByVal XmlFile As String, ByVal AppKey As String, ByVal AppValue As String) As Boolean
 On Error GoTo ErrHandle
 Dim objXml As New DOMDocument
 Dim objNode As IXMLDOMNode
 '//
 Call objXml.Load(XmlFile)
 '//
 Set objNode = objXml.selectSingleNode(AppKey)
 If objNode Is Nothing Then
  Set objNode = Nothing
  Set objXml = Nothing
  setXmlValue = False
  Exit Function
 Else
  objNode.nodeTypedValue = AppValue
  Call objXml.Save(XmlFile)
 End If
 '//
 Set objNode = Nothing
 Set objXml = Nothing
 setXmlValue = True
 Exit Function
ErrHandle:
 setXmlValue = False
End Function