http://www.360doc.com/content/13/1026/11/14285739_324294674.shtml
Private Sub GenerateTaxFileXml(ByRef iTaxYr As Short)
On Error GoTo erhd
Dim sFileName As String
Dim oFileSys As Scripting.FileSystemObject
Dim xmlDoc As MSXML2.DOMDocument
Dim Root As MSXML2.IXMLDOMElement
Dim oTextStream As Scripting.TextStream
Dim oSQL As ClsMySQL
'Dim rsRv As ADODB.Recordset
Dim sBuffer As String
Dim sBufferHeader As String
Dim sEmpyrTaxFIleNo As String
Dim sEmpyrNm As String
Dim sDesgn As String
Dim lRecordCount As Integer
Dim cTotAmt As Decimal
Dim lBtNo As Integer
Dim sSubDte As String
Dim sMsg As String
oSQL = New ClsMySQL
sFileName = GetExportDir() & VB6.Format(iTaxYr, "0000") & sTaxFile
oFileSys = New Scripting.FileSystemObject
'生成一个XML DOMDocument对象
xmlDoc = New MSXML2.DOMDocument
'生成根节点并把它设置为文件的根
Root = xmlDoc.createElement("IR56B")
xmlDoc.documentElement = Root
'在节点上添加多个属性
Call Root.setAttribute("xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance")
Call Root.setAttribute("xmlns", "http://www.kingdee.com/ReK3Inventory")
'-------------------------------------
'Dim XmlWrite As System.Xml.XmlTextWriter = New System.Xml.XmlTextWriter(sFileName, System.Text.Encoding.UTF8)
' XmlWrite.WriteStartDocument() '开始一个文档,写下图第一行
'XmlWrite.WriteStartElement("IR56B") '开始一个元素,根元素
'XmlWrite.WriteAttributeString("xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance") '元素属性
'XmlWrite.WriteAttributeString("xsi:noNamespaceSchemaLocation", "ir56b.xsd") '元素属性
'XmlWrite.WriteStartElement("Section") '开始一个元素book
oTextStream = oFileSys.OpenTextFile(sFileName, Scripting.IOMode.ForWriting, True)
Using gConAPCA As New OleDbConnection(gStrAPCA)
oSQL.ReSet_Renamed()
oSQL.SqlType = ClsMySQL.StatmentType.TYPE_SELECT
oSQL.AddTable("TBL_APCA_FST_PTY_INFO")
oSQL.AddFields("TAX_FL_NO", "NM", "DESGN")
gReader = QueryByReader(gConAPCA, oSQL.SQL)
If gReader.Read Then
sEmpyrTaxFIleNo = Null2Str(gReader("TAX_FL_NO"))
sEmpyrNm = Null2Str(gReader("NM"))
sDesgn = Null2Str(gReader("DESGN"))
End If
gReader.Close()
oSQL.ReSet_Renamed()
oSQL.AddTable("TBL_APCA_TAX_REPORT")
oSQL.AddSimpleFuncField("COUNT", , , "REC_COUNT")
oSQL.AddSimpleFuncField("SUM", "TOT_INCOME", , "TOT")
oSQL.AddFields("BT_NO", "SUB_DTE")
oSQL.AddGroupBy("BT_NO")
oSQL.AddGroupBy("SUB_DTE")
gReader = QueryByReader(gConAPCA, oSQL.SQL)
If gReader.Read Then
lRecordCount = Null2Zero(gReader("REC_COUNT"))
cTotAmt = Null2Zero(gReader("TOT"))
lBtNo = CInt(Null2Str(gReader("BT_NO")))
sSubDte = VB6.Format(gReader("SUB_DTE").ToString, "YYYYMMDD")
End If
gReader.Close()
sBuffer = FillStringWithSpaceRight(VB.Left(sEmpyrTaxFIleNo, 3), 3)
sBuffer = sBuffer & FillStringWithSpaceRight(VB.Right(sEmpyrTaxFIleNo, 8), 8)
sBuffer = sBuffer & FillStringWithSpaceRight(CStr(iTaxYr), 4)
sBuffer = sBuffer & FillStringWithSpaceRight(sSubDte, 8)
sBuffer = sBuffer & FillStringWithZero(CStr(lBtNo), 5)
sBuffer = sBuffer & New String("0", 6)
sBuffer = sBuffer & Space(9)
sBuffer = sBuffer & FillStringWithSpaceRight(sEmpyrNm, 70)
sBuffer = sBuffer & FillStringWithSpaceRight(sDesgn, 25)
sBuffer = sBuffer & FillStringWithZero(CStr(lRecordCount), 5)
sBuffer = sBuffer & FillStringWithZero(CStr(cTotAmt), 11)
sBuffer = sBuffer & Space(1480)
oTextStream.WriteLine(sBuffer)
oSQL.ReSet_Renamed()
oSQL.SqlType = ClsMySQL.StatmentType.TYPE_SELECT
oSQL.AddTable("TBL_APCA_TAX_REPORT")
sBufferHeader = FillStringWithSpaceRight(VB.Left(sEmpyrTaxFIleNo, 3), 3)
sBufferHeader = sBufferHeader & FillStringWithSpaceRight(VB.Right(sEmpyrTaxFIleNo, 8), 8)
sBufferHeader = sBufferHeader & FillStringWithSpaceRight(CStr(iTaxYr), 4)
sBufferHeader = sBufferHeader & FillStringWithSpaceRight(sSubDte, 8)
sBufferHeader = sBufferHeader & FillStringWithZero(CStr(lBtNo), 5)
gReader = QueryByReader(gConAPCA, oSQL.SQL)
Do While gReader.Read
sBuffer = sBufferHeader & FillStringWithZero(CStr(gReader("SHEET_NO").ToString), 6)
sBuffer = sBuffer & FillStringWithSpaceLeft(Null2Str(gReader("HK_ID")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("STUS")), 1)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("S_NM")), 20)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("NM")), 55)
sBuffer = sBuffer & FillChiStringWithSpaceRight(Null2Str(gReader("C_NM")), 50)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("GENDER")), 1)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("M_STUS")), 1)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PASPT_NO")), 20)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PASPT_ISSUE_BY")), 20)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("SPO_NM")), 50)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("SPO_HKID")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("SPO_PASPT_NO")), 20)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("SPO_PASPT_ISSUE_BY")), 20)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("R_ADDR")), 90)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("AR_CDE")), 1)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("CORR_ADDR")), 60)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("CAPCTY")), 40)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRIN_EMPYR")), 30)
sBuffer = sBuffer & VB6.Format(gReader("JOIN_DTE").ToString, "YYYYMMDD")
sBuffer = sBuffer & VB6.Format(gReader("CESS_DTE").ToString, "YYYYMMDD")
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_SLRY")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("SLRY")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_LEV_PAY")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("LEV_PAY")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_DIR_FEE")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("DIR_FEE")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_COMM")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("COMM")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_BNS")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("BNS")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_BACK_PAY")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("BACK_PAY")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_RETR_SCHM_PMNT")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RETR_SCHM_PMNT")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_SLRY_TAX_EMPYR")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("SLRY_TAX_EMPYR")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_EDUC_BNF")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("EDUC_BNF")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_SHR_OPT_GAIN")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("SHR_OPT_GAIN")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("RWD_NATURE1")), 35)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("RWD_PRD1")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RWD_AMT1")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("RWD_NATURE2")), 35)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("RWD_PRD2")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RWD_AMT2")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("RWD_NATURE3")), 35)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("RWD_PRD3")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RWD_AMT3")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_PNSN")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("PNSN")), 9)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("TOT_INCOME")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("R_IND")), 1)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("R_ADDR_1")), 110)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("R_NATURE_1")), 19)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_R_1")), 26)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_EMPYR_1")), 7)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_EMPYE_1")), 7)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_RFND_EMPYE_1")), 7)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_EMPYR_EMPYE_1")), 7)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("R_ADDR_2")), 110)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("R_NATURE_2")), 19)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_R_2")), 26)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_EMPYR_2")), 7)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_EMPYE_2")), 7)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_RFND_EMPYE_2")), 7)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_EMPYR_EMPYE_2")), 7)
If gReader("OSEA_AMT").Equals(DBNull.Value) And gReader("OSEA_ADDR").Equals(DBNull.Value) And gReader("OSEA_NM").Equals(DBNull.Value) Then
sBuffer = sBuffer & "0"
Else
sBuffer = sBuffer & "1"
End If
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("OSEA_AMT")), 20)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("OSEA_NM")), 60)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("OSEA_ADDR")), 60)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("EMPYE_TAX_FL_NO")), 13)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("RMK")), 60)
oTextStream.WriteLine(sBuffer)
'rsRv.MoveNext()
Loop
gReader.Close()
'End of file
oTextStream.Write(Chr(26))
oTextStream.Close()
oSQL.ReSet_Renamed()
oSQL.SqlType = ClsMySQL.StatmentType.TYPE_INSERT
oSQL.AddTable("TBL_APCA_AUD_LOG")
oSQL.AddField("USR")
oSQL.AddValue(sUserID)
oSQL.AddField("ACT")
oSQL.AddValue("S")
oSQL.AddField("LOG_TM")
oSQL.AddValue(VB6.Format(Today, "dd MMM YYYY") & " " & TimeOfDay)
oSQL.AddField("DESC")
sMsg = FormatMsg(My.Resources.str19011, CStr(iTaxYr), oFileSys.GetAbsolutePathName(sFileName))
oSQL.AddValue(sMsg)
'OpenRs(oSQL.SQL)
Call ExeNonQuery(gConAPCA, oSQL.SQL)
ShowInfo(sMsg)
'直接保存成文件即可
'xmlDoc.save(sFileName)
'调用IE浏览器打开xml文件
ShellExecute(Me.Handle.ToInt32, "explore", oFileSys.GetParentFolderName(sFileName) & vbNullChar, "", "", modShell.enuShowWindow.SW_SHOW)
oTextStream = Nothing
oFileSys = Nothing
'rsRv = Nothing
oSQL = Nothing
End Using
Exit Sub
erhd:
oTextStream = Nothing
oFileSys = Nothing
'rsRv = Nothing
oSQL = Nothing
MyErrorRaise(Err.Description)
End Sub
------------------------
Dim oFso As New FileSystemObject
Dim oFile As Object
Dim xmlDoc As MSXML2.DOMDocument
nowDate = CStr(Year(Date)) & CStr(Month(Date)) & CStr(Day(Date))
ePath = expPath.Text + "/" + nowDate
Set xmlDoc = New MSXML2.DOMDocument
xmlDoc.validateOnParse = False
xmlDoc.async = False
Set oFso = CreateObject("scripting.filesystemobject")
If oFso.FileExists(ePath + ".xml") Then
oFso.DeleteFile ePath + ".xml"
End If
Set oFile = oFso.OpenTextFile(ePath + ".xml", 8, True)
Dim str As String
str = "select ajbh from gab_mala where ifexp is null or ifexp=''"
oRs.Open str, oConn, 1, 1
Do While Not oRs.EOF
tempzdaj = "<zdaj:record ajbh='" + oRs("ajbh") + "'><ma><la>"
oFile.WriteLine (tempzdaj)
'基本信息
str = "select xckybh,ladwdm,ladwxc,ajlb1,ajlb2,ajlb3,ajxz1,larq,swrs,ssrs,fxdz,fxdzxz,fxcs,fxbw,zwyw,dnayw,"
str = str + "zjyw,xdhwyw,gj,gjhj,qthjwz,bjwp,zasjsx,zasjxx,fxzarscz,fxzarszz,zagj,qhdx,srcs,qrfs,jcfs,srfs,"
str = str + "wzmj,tlfs,zasdtdms,aqms,zayy,lcfzyj,zazzhzbzcy,lxdh,xsjsfzr,gajgfzr,tbr,tbrq from gab_mala where ajbh='" & oRs("ajbh") & "'"
oRsTemp.Open str, oConn, 1, 1
Do While Not oRsTemp.EOF
Set root = xmlDoc.createNode(1, "jbxx", "")
Set temp = xmlDoc.appendChild(root)
Set onode = xmlDoc.createNode("element", "rec", "")
Set temp = root.appendChild(onode)
For i = 0 To oRsTemp.Fields.Count - 1
Set child = xmlDoc.createNode("element", oRsTemp.Fields(i).Name, "")
If Not IsNull(oRsTemp.Fields(i)) Then
If oRsTemp.Fields(i).Name = UCase("fxcs") Or oRsTemp.Fields(i).Name = UCase("fxbw") Or oRsTemp.Fields(i).Name = UCase("zagj") Or oRsTemp.Fields(i).Name = UCase("qhdx") Or oRsTemp.Fields(i).Name = UCase("srcs") Or oRsTemp.Fields(i).Name = UCase("qrfs") Or oRsTemp.Fields(i).Name = UCase("jcfs") Or oRsTemp.Fields(i).Name = UCase("srfs") Or oRsTemp.Fields(i).Name = UCase("wzmj") Or oRsTemp.Fields(i).Name = UCase("zayy") Then
childext = CL(oRsTemp.Fields(i))
Else.T
child.Text = oRsTemp.Fields(i)
End If
Else
child.Text = ""
End If
Set temp = onode.appendChild(child)
Next
rstoxml = root.xml
oFile.WriteLine (rstoxml)
xmlDoc.removeChild (root)
oRsTemp.MoveNext
Loop
oRsTemp.Close
'人员
str = "select manid from caseman where caseno='" & oRs("ajbh") & "'"
oRs1.Open str, oConn, 1, 1
If oRs1.RecordCount > 0 Then
Set root = xmlDoc.createNode(1, "xyry", "")
Set temp = xmlDoc.appendChild(root)
End If
Do While Not oRs1.EOF
str = "select ztrybh,name as xm,othername as bmhch,sex as xb,birthday as csrqsx,birthday as csrqxx,jzd as hjd,ABODEADDR as hjdxz,STATURE as sgsx,STATURE as sgxx,ACCENT as ky,BODYSHAPE as tmtz,FACESHAPE as tbbj,'' as qttz,SPEC as zc,CARDID as sfzh,'' as qtzjmc,'' as qtzjhm,'' as zp from smaninfo"
str = str + " where manid='" & oRs1("manid") & "'"
oRsTemp.Open str, oConn, 1, 1
Do While Not oRsTemp.EOF
Set onode = xmlDoc.createNode("element", "rec", "")
Set temp = root.appendChild(onode)
For i = 0 To oRsTemp.Fields.Count - 1
Set child = xmlDoc.createNode("element", oRsTemp.Fields(i).Name, "")
If Not IsNull(oRsTemp.Fields(i)) Then
If oRsTemp.Fields(i).Name = UCase("ky") Or oRsTemp.Fields(i).Name = UCase("tmtz") Or oRsTemp.Fields(i).Name = UCase("tbbj") Or oRsTemp.Fields(i).Name = UCase("zc") Then
child.Text = CL(oRsTemp.Fields(i))
Else
If oRsTemp.Fields(i).Name = UCase("csrqsx") Or oRsTemp.Fields(i).Name = UCase("csrqxx") Then
child.Text = CLDate(oRsTemp.Fields(i))
Else
If oRsTemp.Fields(i).Name = UCase("ztrybh") Then
child.Text = "T" + oRsTemp.Fields(i)
Else
child.Text = oRsTemp.Fields(i)
End If
End If
End If
Else
child.Text = ""
End If
Set temp = onode.appendChild(child)
Next
oRsTemp.MoveNext
Loop
oRsTemp.Close
oRs1.MoveNext
Loop
If oRs1.RecordCount > 0 Then
rstoxml = root.xml
oFile.WriteLine (rstoxml)
xmlDoc.removeChild (root)
End If
oRs1.Close
tempzdaj = "</la></ma></zdaj:record>"
oFile.WriteLine (tempzdaj)
oRs.MoveNext
Loop
oRs.Close
set oFso=Nothing
'生成一个XML DOMDocument对象
xmlDoc = New MSXML2.DOMDocument
'生成根节点并把它设置为文件的根
Root = xmlDoc.createElement("employees")
xmlDoc.documentElement = Root
'在节点上添加多个属性
Call Root.setAttribute("xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance")
Call Root.setAttribute("xmlns", "http://www.kingdee.com/ReK3Inventory")
'添加xml文件格式:换行+空格 (1级节点)
Root.appendChild(xmlDoc.createTextNode(vbCrLf & Space(8)))
'添加DataService节点
Dim eleDataService As MSXML2.IXMLDOMElement
eleDataService = xmlDoc.createElement("DataService")
Root.appendChild(eleDataService)
'添加xml文件格式:换行+空格+空格(2级节点)
eleDataService.appendChild(xmlDoc.createTextNode(vbCrLf & Space(16)))
'添加 Name 属性
eleDataService.setAttribute("Name", "zhuyl")
'添加DataService节点的子节点 Ip
Dim eleDataServiceIp As MSXML2.IXMLDOMElement
eleDataServiceIp = xmlDoc.createElement("Ip")
eleDataService.appendChild(eleDataServiceIp)
'添加xml文件格式:换行+空格(1级节点),结束1级节点配置
eleDataService.appendChild(xmlDoc.createTextNode(vbCrLf & Space(8)))
'添加xml文件格式:换行+空格+空格,结束根结点配置
Root.appendChild(xmlDoc.createTextNode(vbCrLf))
--------------------
'2、 读取xml
adapterConfigFilePath = Me.maFileName & "AdapterConfig.xml"
xmlDom = New DOMDocument50
xmlDoc.async = False '是否同步
xmlDoc.load(adapterConfigFilePath)
'如果文件存在,但大小为0字节,则删除该文件
If (fso.FileExists(adapterConfigFilePath) = True) Then
If (fso.GetFile(adapterConfigFilePath).Size = 0) Then
fso.GetFile(adapterConfigFilePath).Delete()
End If
End If
'检查AdapterConfig.xml文件是否存在:若存在,则读取文件的值,并显示在窗体上
If (fso.FileExists(adapterConfigFilePath) = True) Then
element = xmlDoc.selectSingleNode("//AdapterConfig")
Me.txtAdapterName.Text = element.selectSingleNode("AdapterName").Text
Dim strAdapterType As String
strAdapterType = element.selectSingleNode("AdapterType").Text
If (strAdapterType = "DataBase" Or strAdapterType = "") Then
'单选按钮数据库 设置为被选中
Me.optAdapterType1.Item(0).Value = True
Else
If (strAdapterType = "File") Then
Me.optAdapterType1.Item(1).Value = True
ElseIf (strAdapterType = "Api") Then
Me.optAdapterType1.Item(2).Value = True
ElseIf (strAdapterType = "SDE") Then
Me.optAdapterType1.Item(3).Value = True
End If
End If
'应用,为应用列表赋值
elePM = element.selectSingleNode("ApplicationParameter")
If (Not (elePM Is Nothing)) Then
paramList = element.selectNodes("ApplicationParameter")
For i = 0 To paramList.length - 1
eleParam = paramList.Item(i)
Me.lstAppParameter.AddItem(eleParam.getAttribute("Name"))
Next
End If
'3、 修改xml
Dim fso As New FileSystemObject
netConfigPath = frmMain.maFileName & "AdapterNetConfig.xml"
xmlDom = New DOMDocument50
xmlDoc.async = False '是否同步
xmlDoc.load(netConfigPath)
'检查AdapterNetConfig.xml文件是否存在:若不存在,则创建;存在,则显示值到窗体上If (fso.FileExists(netConfigPath) = True) Then
'必填项全部填写,保存修改的内容
Root = xmlDoc.selectSingleNode("AdapterNetConfig")
'为节点赋值
Root.selectSingleNode("DataService/Ip").text = Me.txtAdapterReceiveIp.Text
Root.selectSingleNode("DataService/Port").text = Me.txtAdapterReceivePort.Text
Root.selectSingleNode("DataService/TimeOut").text = Me.txtAdapterReceiveTimeout.Text
Root.selectSingleNode("CommandService/Ip").text = Me.txtCmdReceiveIp.Text
Root.selectSingleNode("CommandService/Port").text = Me.txtCmdReceivePort.Text
Root.selectSingleNode("CommandService/TimeOut").text = Me.txtCmdReceiveTimeout.Text
Root.selectSingleNode("DataExchangeServer/Ip").text = Me.txtSendToServerIp.Text
Root.selectSingleNode("DataExchangeServer/Port").text = Me.txtSendToServerPort.Text
Root.selectSingleNode("DataExchangeServer/TimeOut").text = Me.txtSendToServerTimeout.Text
xmlDoc.save(netConfigPath)
MsgBox("保存成功!")
End If
'4、 xml文件格式化
'获取AdapterConfig.xml所在路径--->maFileName
adapterConfigFilePath = Me.maFileName & "AdapterConfig.xml"
xmlDom = New DOMDocument50
xmlDoc.async = False '是否同步
xmlDoc.load(adapterConfigFilePath)
'如果文件存在,但大小为0字节,则删除该文件
If (fso.FileExists(adapterConfigFilePath) = True) Then
If (fso.GetFile(adapterConfigFilePath).Size = 0) Then
fso.GetFile(adapterConfigFilePath).Delete()
End If
End If
'检查AdapterConfig.xml文件是否存在:若存在,则读取文件的值,并显示在窗体上
If (fso.FileExists(adapterConfigFilePath) = False) Then
'创建文件
If (MsgBox(adapterConfigFilePath & "不存在,现在就创建该文件吗?", vbYesNo, "创建文件提示") = vbYes) Then
Dim root As IXMLDOMElement
root = xmlDoc.createElement("AdapterConfig")
xmlDoc.documentElement = root
root.appendChild(xmlDoc.createTextNode(vbCrLf & Space(8)))
'添加 AdapterName 节点
Dim eleAdpName As IXMLDOMElement
eleAdpName = xmlDoc.createElement("AdapterName")
root.appendChild(eleAdpName)
root.appendChild(xmlDoc.createTextNode(vbCrLf & Space(8)))
'添加 AdapterType 节点
Dim eleAdpType As IXMLDOMElement
eleAdpType = xmlDoc.createElement("AdapterType")
root.appendChild(eleAdpType)
'设置默认值为“DataBase”
Dim txtAdpTypeNew As IXMLDOMText
txtAdpTypeNew = xmlDoc.createTextNode("DataBase")
eleAdpType.appendChild(txtAdpTypeNew)
root.appendChild(xmlDoc.createTextNode(vbCrLf & Space(8)))
'添加 AppParam 节点
Dim eleAppParam As IXMLDOMElement
eleAppParam = xmlDoc.createElement("AppParam")
root.appendChild(eleAppParam)
eleAppParam.appendChild(xmlDoc.createTextNode(vbCrLf & Space(16)))
'添加 PacketSize 节点
Dim elePacketSize As IXMLDOMElement
elePacketSize = xmlDoc.createElement("PacketSize")
eleAppParam.appendChild(elePacketSize)
eleAppParam.appendChild(xmlDoc.createTextNode(vbCrLf & Space(16)))
'添加 HeartBeatTime 节点
Dim eleHeartBeatTime As IXMLDOMElement
eleHeartBeatTime = xmlDoc.createElement("HeartBeatTime")
eleAppParam.appendChild(eleHeartBeatTime)
eleAppParam.appendChild(xmlDoc.createTextNode(vbCrLf & Space(8)))
root.appendChild(xmlDoc.createTextNode(vbCrLf & Space(8)))
'添加 ThreadNumber 节点
Dim eleThreadNum As IXMLDOMElement
eleThreadNum = xmlDoc.createElement("ThreadNumber")
root.appendChild(eleThreadNum)
eleThreadNum.appendChild(xmlDoc.createTextNode(vbCrLf & Space(16)))
'添加 SendToServer 节点
Dim eleThreadSendToServer As IXMLDOMElement
eleThreadSendToServer = xmlDoc.createElement("SendToServer")
eleThreadNum.appendChild(eleThreadSendToServer)
eleThreadNum.appendChild(xmlDoc.createTextNode(vbCrLf & Space(16)))
'添加 ReceiveApplication 节点
Dim eleThreadReceiveApp As IXMLDOMElement
eleThreadReceiveApp = xmlDoc.createElement("ReceiveApplication")
eleThreadNum.appendChild(eleThreadReceiveApp)
eleThreadNum.appendChild(xmlDoc.createTextNode(vbCrLf & Space(8)))
root.appendChild(xmlDoc.createTextNode(vbCrLf & Space(8)))
'添加 NoDataWaitTime 节点
Dim eleNoDataWaitTime As IXMLDOMElement
eleNoDataWaitTime = xmlDoc.createElement("NoDataWaitTime")
root.appendChild(eleNoDataWaitTime)
eleNoDataWaitTime.appendChild(xmlDoc.createTextNode(vbCrLf & Space(16)))
'添加 SendToServer 节点
Dim eleNoDataSendToServer As IXMLDOMElement
eleNoDataSendToServer = xmlDoc.createElement("SendToServer")
eleNoDataWaitTime.appendChild(eleNoDataSendToServer)
eleNoDataWaitTime.appendChild(xmlDoc.createTextNode(vbCrLf & Space(16)))
'添加 ReceiveApplication 节点
Dim eleNoDataReceiveApp As IXMLDOMElement
eleNoDataReceiveApp = xmlDoc.createElement("ReceiveApplication")
eleNoDataWaitTime.appendChild(eleNoDataReceiveApp)
eleNoDataWaitTime.appendChild(xmlDoc.createTextNode(vbCrLf & Space(8)))
root.appendChild(xmlDoc.createTextNode(vbCrLf & Space(8)))
'添加 FailedOperationWaitTime 节点
Dim eleFailedWaitTime As IXMLDOMElement
eleFailedWaitTime = xmlDoc.createElement("FailedOperationWaitTime")
root.appendChild(eleFailedWaitTime)
eleFailedWaitTime.appendChild(xmlDoc.createTextNode(vbCrLf & Space(16)))
'添加 SendToServer 节点
Dim eleFailedSendToServer As IXMLDOMElement
eleFailedSendToServer = xmlDoc.createElement("SendToServer")
eleFailedWaitTime.appendChild(eleFailedSendToServer)
eleFailedWaitTime.appendChild(xmlDoc.createTextNode(vbCrLf & Space(16)))
'添加 ReceiveApplication 节点
Dim eleFailedReceiveApp As IXMLDOMElement
eleFailedReceiveApp = xmlDoc.createElement("ReceiveApplication")
eleFailedWaitTime.appendChild(eleFailedReceiveApp)
eleFailedWaitTime.appendChild(xmlDoc.createTextNode(vbCrLf & Space(8)))
root.appendChild(xmlDoc.createTextNode(vbCrLf))
End If
End If
' //************* 上面的内容都保存在xmlDoc 中,在点击“保存”按钮的时候,暂不保存到文件,新创建一个xmlDocFormat 对象,读取 xmlDoc 对象中的值,填充到 xmlDocFormat 文档中,加上换行和空格,进行格式化操作 ************//
'''''''' 格式化生成的xml文件 '''''''''''''
'如果文件存在,但大小为0字节,则删除该文件,重新创建之
If (fso.FileExists(adapterConfigFilePath) = True) Then
fso.GetFile(adapterConfigFilePath).Delete()
fso.CreateTextFile(adapterConfigFilePath)
End If
Dim xmlDocFormat As DOMDocument50
Dim versionFormat As IXMLDOMProcessingInstruction
xmlDocFormat = New DOMDocument50
xmlDocFormat.async = False
xmlDocFormat.Load(adapterConfigFilePath)
'添加xml文件版本号,编码语言
versionFormat = xmlDocFormat.createProcessingInstruction("xml", "version=" & Chr(34) & "1.0" & Chr(34) & Space(8) & "encoding=" & Chr(34) & "GBK" & Chr(34))
xmlDocFormat.appendChild(versionFormat)
'添加根结点
Dim rootFormat As IXMLDOMElement
rootFormat = xmlDocFormat.createElement("AdapterConfig")
xmlDocFormat.documentElement = rootFormat
'添加xml文件格式:换行+空格 (1级节点)
rootFormat.appendChild(xmlDocFormat.createTextNode(vbCrLf & Space(4)))
'添加 AdapterName 节点
Dim eleAdpNameFormat As IXMLDOMElement
eleAdpNameFormat = xmlDocFormat.createElement("AdapterName")
rootFormat.appendChild(eleAdpNameFormat)
'设置 AdapterName 节点的值
Dim txtAdpNameFormat As IXMLDOMText
txtAdpNameFormat = xmlDocFormat.createTextNode(Root.selectSingleNode("AdapterName").text)
eleAdpNameFormat.appendChild(txtAdpNameFormat)
'添加xml文件格式:换行+空格 (1级节点)
rootFormat.appendChild(xmlDocFormat.createTextNode(vbCrLf & Space(4)))
'添加 AdapterType 节点
Dim eleAdpTypeFormat As IXMLDOMElement
eleAdpTypeFormat = xmlDocFormat.createElement("AdapterType")
rootFormat.appendChild(eleAdpTypeFormat)
'设置 AdapterType 节点的值
Dim txtAdpTypeFormat As IXMLDOMText
txtAdpTypeFormat = xmlDocFormat.createTextNode(Root.selectSingleNode("AdapterType").text)
eleAdpTypeFormat.appendChild(txtAdpTypeFormat)
'添加xml文件格式:换行+空格 (1级节点)
rootFormat.appendChild(xmlDocFormat.createTextNode(vbCrLf & vbCrLf & Space(4)))
'添加 AppParam 节点
Dim eleAppParamFormat As IXMLDOMElement
eleAppParamFormat = xmlDocFormat.createElement("AppParam")
rootFormat.appendChild(eleAppParamFormat)
'添加xml文件格式:换行+空格+空格 (2级节点)
eleAppParamFormat.appendChild(xmlDocFormat.createTextNode(vbCrLf & Space(8)))
'添加 PacketSize 节点
Dim elePacketSizeFormat As IXMLDOMElement
elePacketSizeFormat = xmlDocFormat.createElement("PacketSize")
eleAppParamFormat.appendChild(elePacketSizeFormat)
'设置 PacketSize 节点的值
Dim txtPacketSizeFormat As IXMLDOMText
txtPacketSizeFormat = xmlDocFormat.createTextNode(Root.selectSingleNode("AppParam/PacketSize").text)
elePacketSizeFormat.appendChild(txtPacketSizeFormat)
'添加xml文件格式:换行+空格+空格 (2级节点)
eleAppParamFormat.appendChild(xmlDocFormat.createTextNode(vbCrLf & Space(8)))
'添加 HeartBeatTime 节点
Dim eleHeartBeatTimeFormat As IXMLDOMElement
eleHeartBeatTimeFormat = xmlDocFormat.createElement("HeartBeatTime")
eleAppParamFormat.appendChild(eleHeartBeatTimeFormat)
'设置 HeartBeatTime 节点的值
Dim txtHeartBeatTimeFormat As IXMLDOMText
txtHeartBeatTimeFormat = xmlDocFormat.createTextNode(Root.selectSingleNode("AppParam/HeartBeatTime").text)
eleHeartBeatTimeFormat.appendChild(txtHeartBeatTimeFormat)
'添加xml文件格式:换行+空格格 (1级节点)
eleAppParamFormat.appendChild(xmlDocFormat.createTextNode(vbCrLf & Space(4)))
'添加xml文件格式:换行+空格 (1级节点)
rootFormat.appendChild(xmlDocFormat.createTextNode(vbCrLf))
xmlDocFormat.save(adapterConfigFilePath)
MsgBox("保存成功!")
Dim oFileSys As Scripting.FileSystemObject
Dim oFile As Scripting.TextStream
Dim sFileName As String
Dim xmlDoc As MSXML2.DOMDocument
Dim Root As MSXML2.IXMLDOMElement
Dim Rs As ADODB.Recordset
Dim Conn As ADODB.Connection
Dim tempNode As MSXML2.IXMLDOMNode
Dim emp As MSXML2.IXMLDOMElement
oFileSys = New Scripting.FileSystemObject
sFileName = GetExportDir() & VB6.Format(iTaxYr, "0000") & sTaxFile
'delete old tax file
If oFileSys.FileExists(sFileName) Then
oFileSys.DeleteFile(sFileName)
End If
oFile = oFileSys.OpenTextFile(sFileName, Scripting.IOMode.ForWriting, True)
'生成一个XML DOMDocument对象
xmlDoc = New MSXML2.DOMDocument
xmlDoc.validateOnParse = False
xmlDoc.async = False
'生成根节点并把它设置为文件的根
Root = xmlDoc.createElement("employees")
xmlDoc.documentElement = Root
'在节点上添加多个属性
Call Root.setAttribute("xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance")
Call Root.setAttribute("xmlns", "http://www.kingdee.com/ReK3Inventory")
如何通过VB处理XML
首先要引用一个Microsoft XML 随便选个版本。
在初始化的时候读取XML显示到TXTBOX中,代码如下: '通过2进制流将XML文件读出来,也可以是其它文件格式
Private Function pstrUpdateView(istrXMLPath As String) As String
Dim wlngFreeFile As Long
Dim wbytwbytLoadBytes() As Byte
'获得一个空闲文件号
wlngFreeFile = FreeFile
Open istrXMLPath For Binary As #wlngFreeFile
ReDim wbytLoadBytes(1 To LOF(wlngFreeFile)) As Byte
Get #wlngFreeFile, , wbytLoadBytes
Close wlngFreeFile
pstrUpdateView = StrConv(wbytLoadBytes, vbUnicode)
End Function
装载XML。传进去一个XML地址,如果装载不成功就error,成功则执行下一步 Private Sub fsubLoadXML(istrXMLPath As String)
Set pobjXMLDoc = CreateObject("MSXML2.DOMDocument")
If pobjXMLDoc.Load(istrXMLPath) = False Then
On Error GoTo LoadXMLErr:
End If
On Error GoTo 0
Exit Sub
LoadXMLErr:
Dim myErr
Set myErr = pobjXMLDoc.parseError
MsgBox ("ERROR:" & myErr.reason)
Set myErr = Nothing
End Sub
读属性。DOMDocument对象里有2个读节点的方法:
selectNodes() 如果根节点下有多个子节点就要用这个方法,item定义了第几个子节点
selectSingleNode()如果根节点下只有一个字节点可以用这个方法
Private Function fstrReadAttr(istrNodes As String, istrAttribute As String) As String
On Error GoTo ErrHandle:
Dim wobjXmlAttr As MSXML2.IXMLDOMAttribute
'
' Set wobjXmlAttr = pobjXMLDoc.selectNodes(istrNodes).Item(0).Attributes.getNamedItem(istrAttribute)
'
Set wobjXmlAttr = pobjXMLDoc.selectSingleNode(istrNodes).Attributes.getNamedItem(istrAttribute)
fstrReadAttr = wobjXmlAttr.Text
'destroy object
Set wobjXmlAttr = Nothing
On Error GoTo 0
Exit Function
ErrHandle:
MsgBox Err.Description
Set wobjXmlAttr = Nothing
End Function
读节点。 call fstrReadNode("/test/user") ,参数是test节点下的user子节点 Private Function fstrReadNode(istrNodes As String) As String
Dim xNode As MSXML2.IXMLDOMNode
Set xNode = pobjXMLDoc.selectSingleNode(istrNodes)
fstrReadNode = xNode.Text
Set xNode = Nothing
End Function
写节点。参数1:节点;参数2:需要写入的值 Private Sub fsubWriteNode(istrNodes As String, istrValue As String)
Dim wobjXMLNode As IXMLDOMElement
Set wobjXMLNode = pobjXMLDoc.documentElement.selectNodes(istrNodes).Item(0)
wobjXMLNode.Text = istrValue
Set wobjXMLNode = Nothing
End Sub
a sample :download
--------------------------------------------------------------------------------
转自:http://blog.youkuaiyun.com/kinytx/
MSXML 处理 xml 文档时外部DTD定义的问题(ASP)
项目中碰到这个问题,所以也贴了出来
xmlfile = "http://myserver/catalog.xml"
xslfile = "catalog.xsl"
' 创建相关对象
Set xslDoc = server.CreateObject("MSXML2.FreeThreadedDOMDocument")
Set xmlDoc = server.CreateObject("MSXML2.DOMDocument")
' 读取xsl文件
xsldoc.async = False
xsldoc.resolveExternals = True
xsldoc.load server.MapPath(xslfile)
' 读取xml文件
xmldoc.setProperty "ServerHTTPRequest",True ' 设置ServerHTTPRequest 属性为 True 为了通过http协议载入xml文档
xmldoc.async = False ' 设置 async属性为 False 关闭异步调用
xmldoc.resolveExternals = True ' 设置 resolveExternals 为 True 打开外部DTD分析
xmldoc.validateOnParse = False ' 设置 validateOnParse 为 False 允许文档验证
xmldoc.load xmlfile ' 读取xml文档
Do While (xmldoc.ReadyState < 4) ' 检查ReadyState状态值是否为4 ' 具体数值定义参见msxml sdk document
xmldoc.waitForResponse 10 ' 通过waitForResponse方法等待文档完全读取完毕 ' 如果为读取完成,系统暂停10毫秒
Loop
' 转换xml -> html 并输出文档
xmldoc.transformNodeToObject xsldoc,Response
' 清空对象
Set xslt = Nothing
Set xsldoc = Nothing
Set xmldoc = Nothing
<?xml version="1.0" encoding="UTF-8"?>
<IR56B xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:noNamespaceSchemaLocation="ir56b.xsd">
<Section>6A1</Section>
<ERN>01234561</ERN>
<YrErReturn>2014</YrErReturn>
<SubDate>20140420</SubDate>
<ErName>ABCD COMPANY</ErName>
<Designation>PARTNER</Designation>
<NoRecordBatch>00002</NoRecordBatch>
<TotIncomeBatch>360000</TotIncomeBatch>
<Employee>
<SheetNo>000001</SheetNo>
<HKID>A1144556</HKID>
<TypeOfForm>O</TypeOfForm>
<Surname>AUYEUNG</Surname>
<GivenName>TAI MAN</GivenName>
<NameInChinese>歐陽大文</NameInChinese>
<Sex>M</Sex>
<MaritalStatus>2</MaritalStatus>
<PpNum />
<SpouseName>WONG, MEI MEI</SpouseName>
<SpouseHKID>A456789A</SpouseHKID>
<SpousePpNum />
<ResAddr>Flat A, 8/F, 5 Mei Lai Road </ResAddr>
<AreaCodeResAddr>K</AreaCodeResAddr>
<PosAddr />
<Capacity>CLERK</Capacity>
<PtPrinEmp />
<StartDateOfEmp>20130401</StartDateOfEmp>
<EndDateOfEmp>20140331</EndDateOfEmp>
<PerOfSalary>20130401 - 20140331</PerOfSalary>
<AmtOfSalary>100000</AmtOfSalary>
<PerOfLeavePay />
<AmtOfLeavePay>0</AmtOfLeavePay>
<PerOfDirectorFee />
<AmtOfDirectorFee>0</AmtOfDirectorFee>
<PerOfCommFee />
<AmtOfCommFee>0</AmtOfCommFee>
<PerOfBonus>20130401 - 20140331</PerOfBonus>
<AmtOfBonus>50000</AmtOfBonus>
<PerOfBpEtc />
<AmtOfBpEtc>0</AmtOfBpEtc>
<PerOfPayRetire />
<AmtOfPayRetire>0</AmtOfPayRetire>
<PerOfSalTaxPaid />
<AmtOfSalTaxPaid>0</AmtOfSalTaxPaid>
<PerOfEduBen />
<AmtOfEduBen>0</AmtOfEduBen>
<PerOfGainShareOption />
<AmtOfGainShareOption>0</AmtOfGainShareOption>
<NatureOtherRAP1 />
<PerOfOtherRAP1 />
<AmtOfOtherRAP1>0</AmtOfOtherRAP1>
<NatureOtherRAP2 />
<PerOfOtherRAP2 />
<AmtOfOtherRAP2>0</AmtOfOtherRAP2>
<NatureOtherRAP3 />
<PerOfOtherRAP3 />
<AmtOfOtherRAP3>0</AmtOfOtherRAP3>
<PerOfPension />
<AmtOfPension>0</AmtOfPension>
<TotalIncome>150000</TotalIncome>
<PlaceOfResInd>0</PlaceOfResInd>
<AddrOfPlace1 />
<NatureOfPlace1 />
<PerOfPlace1 />
<RentPaidEr1>0</RentPaidEr1>
<RentPaidEe1>0</RentPaidEe1>
<RentRefund1>0</RentRefund1>
<RentPaidErByEe1>0</RentPaidErByEe1>
<AddrOfPlace2 />
<NatureOfPlace2 />
<PerOfPlace2 />
<RentPaidEr2>0</RentPaidEr2>
<RentPaidEe2>0</RentPaidEe2>
<RentRefund2>0</RentRefund2>
<RentPaidErByEe2>0</RentPaidErByEe2>
<OverseaIncInd>0</OverseaIncInd>
<AmtPaidOverseaCo />
<NameOfOverseaCo />
<AddrOfOverseaCo />
<Remarks />
</Employee>
<Employee>
<SheetNo>000002</SheetNo>
<HKID>K1234560</HKID>
<TypeOfForm>O</TypeOfForm>
<Surname>LEE</Surname>
<GivenName>SIU SUM</GivenName>
<NameInChinese>李小森</NameInChinese>
<Sex>F</Sex>
<MaritalStatus>1</MaritalStatus>
<PpNum />
<SpouseName />
<SpouseHKID />
<SpousePpNum />
<ResAddr>Flat B 2/F Block C Happy Garden 1 Happy Road </ResAddr>
<AreaCodeResAddr>H</AreaCodeResAddr>
<PosAddr />
<Capacity>MANAGER</Capacity>
<PtPrinEmp />
<StartDateOfEmp>20130401</StartDateOfEmp>
<EndDateOfEmp>20140331</EndDateOfEmp>
<PerOfSalary>20130401 - 20140331</PerOfSalary>
<AmtOfSalary>210000</AmtOfSalary>
<PerOfLeavePay />
<AmtOfLeavePay>0</AmtOfLeavePay>
<PerOfDirectorFee />
<AmtOfDirectorFee>0</AmtOfDirectorFee>
<PerOfCommFee />
<AmtOfCommFee>0</AmtOfCommFee>
<PerOfBonus />
<AmtOfBonus>0</AmtOfBonus>
<PerOfBpEtc />
<AmtOfBpEtc>0</AmtOfBpEtc>
<PerOfPayRetire />
<AmtOfPayRetire>0</AmtOfPayRetire>
<PerOfSalTaxPaid />
<AmtOfSalTaxPaid>0</AmtOfSalTaxPaid>
<PerOfEduBen />
<AmtOfEduBen>0</AmtOfEduBen>
<PerOfGainShareOption />
<AmtOfGainShareOption>0</AmtOfGainShareOption>
<NatureOtherRAP1 />
<PerOfOtherRAP1 />
<AmtOfOtherRAP1>0</AmtOfOtherRAP1>
<NatureOtherRAP2 />
<PerOfOtherRAP2 />
<AmtOfOtherRAP2>0</AmtOfOtherRAP2>
<NatureOtherRAP3 />
<PerOfOtherRAP3 />
<AmtOfOtherRAP3>0</AmtOfOtherRAP3>
<PerOfPension />
<AmtOfPension>0</AmtOfPension>
<TotalIncome>210000</TotalIncome>
<PlaceOfResInd>1</PlaceOfResInd>
<AddrOfPlace1>Flat B 21/F Block C Happy Garden 1 Happy Garden 1 Happy Road HK</AddrOfPlace1>
<NatureOfPlace1>Flat</NatureOfPlace1>
<PerOfPlace1>20130401 - 20140331</PerOfPlace1>
<RentPaidEr1>0</RentPaidEr1>
<RentPaidEe1>120000</RentPaidEe1>
<RentRefund1>120000</RentRefund1>
<RentPaidErByEe1>0</RentPaidErByEe1>
<AddrOfPlace2 />
<NatureOfPlace2 />
<PerOfPlace2 />
<RentPaidEr2>0</RentPaidEr2>
<RentPaidEe2>0</RentPaidEe2>
<RentRefund2>0</RentRefund2>
<RentPaidErByEe2>0</RentPaidErByEe2>
<OverseaIncInd>0</OverseaIncInd>
<AmtPaidOverseaCo />
<NameOfOverseaCo />
<AddrOfOverseaCo />
<Remarks />
</Employee>
</IR56B>
Private Sub GenerateTaxFile(ByRef iTaxYr As Short)
On Error GoTo erhd
Dim oFileSys As Scripting.FileSystemObject
Dim oTextStream As Scripting.TextStream
Dim oSQL As ClsMySQL
'Dim rsRv As ADODB.Recordset
Dim sBuffer As String
Dim sBufferHeader As String
Dim sFileName As String
Dim sEmpyrTaxFIleNo As String
Dim sEmpyrNm As String
Dim sDesgn As String
Dim lRecordCount As Integer
Dim cTotAmt As Decimal
Dim lBtNo As Integer
Dim sSubDte As String
Dim sMsg As String
oSQL = New ClsMySQL
oFileSys = New Scripting.FileSystemObject
sFileName = GetExportDir() & VB6.Format(iTaxYr, "0000") & sTaxFile
'delete old tax file
If oFileSys.FileExists(sFileName) Then
oFileSys.DeleteFile(sFileName)
End If
oTextStream = oFileSys.OpenTextFile(sFileName, Scripting.IOMode.ForWriting, True)
Using gConAPCA As New OleDbConnection(gStrAPCA)
oSQL.ReSet_Renamed()
oSQL.SqlType = ClsMySQL.StatmentType.TYPE_SELECT
oSQL.AddTable("TBL_APCA_FST_PTY_INFO")
oSQL.AddFields("TAX_FL_NO", "NM", "DESGN")
gReader = QueryByReader(gConAPCA, oSQL.SQL)
If gReader.Read Then
sEmpyrTaxFIleNo = Null2Str(gReader("TAX_FL_NO"))
sEmpyrNm = Null2Str(gReader("NM"))
sDesgn = Null2Str(gReader("DESGN"))
End If
gReader.Close()
'-------------------------
oSQL.ReSet_Renamed()
oSQL.AddTable("TBL_APCA_TAX_REPORT")
oSQL.AddSimpleFuncField("COUNT", , , "REC_COUNT")
oSQL.AddSimpleFuncField("SUM", "TOT_INCOME", , "TOT")
oSQL.AddFields("BT_NO", "SUB_DTE")
oSQL.AddGroupBy("BT_NO")
oSQL.AddGroupBy("SUB_DTE")
gReader = QueryByReader(gConAPCA, oSQL.SQL)
If gReader.Read Then
lRecordCount = Null2Zero(gReader("REC_COUNT"))
cTotAmt = Null2Zero(gReader("TOT"))
lBtNo = CInt(Null2Str(gReader("BT_NO")))
sSubDte = VB6.Format(gReader("SUB_DTE").ToString, "YYYYMMDD")
End If
gReader.Close()
sBuffer = FillStringWithSpaceRight(VB.Left(sEmpyrTaxFIleNo, 3), 3)
sBuffer = sBuffer & FillStringWithSpaceRight(VB.Right(sEmpyrTaxFIleNo, 8), 8)
sBuffer = sBuffer & FillStringWithSpaceRight(CStr(iTaxYr), 4)
sBuffer = sBuffer & FillStringWithSpaceRight(sSubDte, 8)
sBuffer = sBuffer & FillStringWithZero(CStr(lBtNo), 5)
sBuffer = sBuffer & New String("0", 6)
sBuffer = sBuffer & Space(9)
sBuffer = sBuffer & FillStringWithSpaceRight(sEmpyrNm, 70)
sBuffer = sBuffer & FillStringWithSpaceRight(sDesgn, 25)
sBuffer = sBuffer & FillStringWithZero(CStr(lRecordCount), 5)
sBuffer = sBuffer & FillStringWithZero(CStr(cTotAmt), 11)
sBuffer = sBuffer & Space(1480)
oTextStream.WriteLine(sBuffer)
oSQL.ReSet_Renamed()
oSQL.SqlType = ClsMySQL.StatmentType.TYPE_SELECT
oSQL.AddTable("TBL_APCA_TAX_REPORT")
sBufferHeader = FillStringWithSpaceRight(VB.Left(sEmpyrTaxFIleNo, 3), 3)
sBufferHeader = sBufferHeader & FillStringWithSpaceRight(VB.Right(sEmpyrTaxFIleNo, 8), 8)
sBufferHeader = sBufferHeader & FillStringWithSpaceRight(CStr(iTaxYr), 4)
sBufferHeader = sBufferHeader & FillStringWithSpaceRight(sSubDte, 8)
sBufferHeader = sBufferHeader & FillStringWithZero(CStr(lBtNo), 5)
gReader = QueryByReader(gConAPCA, oSQL.SQL)
Do While gReader.Read
sBuffer = sBufferHeader & FillStringWithZero(CStr(gReader("SHEET_NO").ToString), 6)
sBuffer = sBuffer & FillStringWithSpaceLeft(Null2Str(gReader("HK_ID")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("STUS")), 1)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("S_NM")), 20)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("NM")), 55)
sBuffer = sBuffer & FillChiStringWithSpaceRight(Null2Str(gReader("C_NM")), 50)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("GENDER")), 1)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("M_STUS")), 1)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PASPT_NO")), 20)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PASPT_ISSUE_BY")), 20)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("SPO_NM")), 50)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("SPO_HKID")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("SPO_PASPT_NO")), 20)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("SPO_PASPT_ISSUE_BY")), 20)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("R_ADDR")), 90)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("AR_CDE")), 1)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("CORR_ADDR")), 60)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("CAPCTY")), 40)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRIN_EMPYR")), 30)
sBuffer = sBuffer & VB6.Format(gReader("JOIN_DTE").ToString, "YYYYMMDD")
sBuffer = sBuffer & VB6.Format(gReader("CESS_DTE").ToString, "YYYYMMDD")
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_SLRY")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("SLRY")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_LEV_PAY")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("LEV_PAY")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_DIR_FEE")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("DIR_FEE")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_COMM")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("COMM")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_BNS")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("BNS")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_BACK_PAY")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("BACK_PAY")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_RETR_SCHM_PMNT")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RETR_SCHM_PMNT")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_SLRY_TAX_EMPYR")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("SLRY_TAX_EMPYR")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_EDUC_BNF")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("EDUC_BNF")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_SHR_OPT_GAIN")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("SHR_OPT_GAIN")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("RWD_NATURE1")), 35)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("RWD_PRD1")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RWD_AMT1")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("RWD_NATURE2")), 35)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("RWD_PRD2")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RWD_AMT2")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("RWD_NATURE3")), 35)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("RWD_PRD3")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RWD_AMT3")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_PNSN")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("PNSN")), 9)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("TOT_INCOME")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("R_IND")), 1)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("R_ADDR_1")), 110)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("R_NATURE_1")), 19)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_R_1")), 26)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_EMPYR_1")), 7)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_EMPYE_1")), 7)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_RFND_EMPYE_1")), 7)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_EMPYR_EMPYE_1")), 7)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("R_ADDR_2")), 110)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("R_NATURE_2")), 19)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_R_2")), 26)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_EMPYR_2")), 7)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_EMPYE_2")), 7)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_RFND_EMPYE_2")), 7)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_EMPYR_EMPYE_2")), 7)
If gReader("OSEA_AMT").Equals(DBNull.Value) And gReader("OSEA_ADDR").Equals(DBNull.Value) And gReader("OSEA_NM").Equals(DBNull.Value) Then
sBuffer = sBuffer & "0"
Else
sBuffer = sBuffer & "1"
End If
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("OSEA_AMT")), 20)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("OSEA_NM")), 60)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("OSEA_ADDR")), 60)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("EMPYE_TAX_FL_NO")), 13)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("RMK")), 60)
oTextStream.WriteLine(sBuffer)
'rsRv.MoveNext()
Loop
gReader.Close()
'End of file
oTextStream.Write(Chr(26))
oTextStream.Close()
oSQL.ReSet_Renamed()
oSQL.SqlType = ClsMySQL.StatmentType.TYPE_INSERT
oSQL.AddTable("TBL_APCA_AUD_LOG")
oSQL.AddField("USR")
oSQL.AddValue(sUserID)
oSQL.AddField("ACT")
oSQL.AddValue("S")
oSQL.AddField("LOG_TM")
oSQL.AddValue(VB6.Format(Today, "dd MMM YYYY") & " " & TimeOfDay)
oSQL.AddField("DESC")
sMsg = FormatMsg(My.Resources.str19011, CStr(iTaxYr), oFileSys.GetAbsolutePathName(sFileName))
oSQL.AddValue(sMsg)
'OpenRs(oSQL.SQL)
Call ExeNonQuery(gConAPCA, oSQL.SQL)
ShowInfo(sMsg)
ShellExecute(Me.Handle.ToInt32, "explore", oFileSys.GetParentFolderName(sFileName) & vbNullChar, "", "", modShell.enuShowWindow.SW_SHOW)
oTextStream = Nothing
oFileSys = Nothing
'rsRv = Nothing
oSQL = Nothing
End Using
Exit Sub
erhd:
oTextStream = Nothing
oFileSys = Nothing
'rsRv = Nothing
oSQL = Nothing
MyErrorRaise(Err.Description)
End Sub
Private Sub GenerateTaxFileXml(ByRef iTaxYr As Short)
On Error GoTo erhd
Dim sFileName As String
Dim oFileSys As Scripting.FileSystemObject
Dim xmlDoc As MSXML2.DOMDocument
Dim Root As MSXML2.IXMLDOMElement
Dim oTextStream As Scripting.TextStream
Dim oSQL As ClsMySQL
'Dim rsRv As ADODB.Recordset
Dim sBuffer As String
Dim sBufferHeader As String
Dim sEmpyrTaxFIleNo As String
Dim sEmpyrNm As String
Dim sDesgn As String
Dim lRecordCount As Integer
Dim cTotAmt As Decimal
Dim lBtNo As Integer
Dim sSubDte As String
Dim sMsg As String
oSQL = New ClsMySQL
sFileName = GetExportDir() & VB6.Format(iTaxYr, "0000") & sTaxFile
oFileSys = New Scripting.FileSystemObject
'生成一个XML DOMDocument对象
xmlDoc = New MSXML2.DOMDocument
'生成根节点并把它设置为文件的根
'Root = xmlDoc.createElement("employees")
'xmlDoc.documentElement = Root
'-------------------------------------
oTextStream = oFileSys.OpenTextFile(sFileName, Scripting.IOMode.ForWriting, True)
Using gConAPCA As New OleDbConnection(gStrAPCA)
oSQL.ReSet_Renamed()
oSQL.SqlType = ClsMySQL.StatmentType.TYPE_SELECT
oSQL.AddTable("TBL_APCA_FST_PTY_INFO")
oSQL.AddFields("TAX_FL_NO", "NM", "DESGN")
gReader = QueryByReader(gConAPCA, oSQL.SQL)
If gReader.Read Then
sEmpyrTaxFIleNo = Null2Str(gReader("TAX_FL_NO"))
sEmpyrNm = Null2Str(gReader("NM"))
sDesgn = Null2Str(gReader("DESGN"))
End If
gReader.Close()
oSQL.ReSet_Renamed()
oSQL.AddTable("TBL_APCA_TAX_REPORT")
oSQL.AddSimpleFuncField("COUNT", , , "REC_COUNT")
oSQL.AddSimpleFuncField("SUM", "TOT_INCOME", , "TOT")
oSQL.AddFields("BT_NO", "SUB_DTE")
oSQL.AddGroupBy("BT_NO")
oSQL.AddGroupBy("SUB_DTE")
gReader = QueryByReader(gConAPCA, oSQL.SQL)
If gReader.Read Then
lRecordCount = Null2Zero(gReader("REC_COUNT"))
cTotAmt = Null2Zero(gReader("TOT"))
lBtNo = CInt(Null2Str(gReader("BT_NO")))
sSubDte = VB6.Format(gReader("SUB_DTE").ToString, "YYYYMMDD")
End If
gReader.Close()
sBuffer = FillStringWithSpaceRight(VB.Left(sEmpyrTaxFIleNo, 3), 3)
sBuffer = sBuffer & FillStringWithSpaceRight(VB.Right(sEmpyrTaxFIleNo, 8), 8)
sBuffer = sBuffer & FillStringWithSpaceRight(CStr(iTaxYr), 4)
sBuffer = sBuffer & FillStringWithSpaceRight(sSubDte, 8)
sBuffer = sBuffer & FillStringWithZero(CStr(lBtNo), 5)
sBuffer = sBuffer & New String("0", 6)
sBuffer = sBuffer & Space(9)
sBuffer = sBuffer & FillStringWithSpaceRight(sEmpyrNm, 70)
sBuffer = sBuffer & FillStringWithSpaceRight(sDesgn, 25)
sBuffer = sBuffer & FillStringWithZero(CStr(lRecordCount), 5)
sBuffer = sBuffer & FillStringWithZero(CStr(cTotAmt), 11)
sBuffer = sBuffer & Space(1480)
oTextStream.WriteLine(sBuffer)
oSQL.ReSet_Renamed()
oSQL.SqlType = ClsMySQL.StatmentType.TYPE_SELECT
oSQL.AddTable("TBL_APCA_TAX_REPORT")
sBufferHeader = FillStringWithSpaceRight(VB.Left(sEmpyrTaxFIleNo, 3), 3)
sBufferHeader = sBufferHeader & FillStringWithSpaceRight(VB.Right(sEmpyrTaxFIleNo, 8), 8)
sBufferHeader = sBufferHeader & FillStringWithSpaceRight(CStr(iTaxYr), 4)
sBufferHeader = sBufferHeader & FillStringWithSpaceRight(sSubDte, 8)
sBufferHeader = sBufferHeader & FillStringWithZero(CStr(lBtNo), 5)
gReader = QueryByReader(gConAPCA, oSQL.SQL)
Do While gReader.Read
sBuffer = sBufferHeader & FillStringWithZero(CStr(gReader("SHEET_NO").ToString), 6)
sBuffer = sBuffer & FillStringWithSpaceLeft(Null2Str(gReader("HK_ID")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("STUS")), 1)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("S_NM")), 20)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("NM")), 55)
sBuffer = sBuffer & FillChiStringWithSpaceRight(Null2Str(gReader("C_NM")), 50)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("GENDER")), 1)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("M_STUS")), 1)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PASPT_NO")), 20)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PASPT_ISSUE_BY")), 20)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("SPO_NM")), 50)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("SPO_HKID")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("SPO_PASPT_NO")), 20)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("SPO_PASPT_ISSUE_BY")), 20)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("R_ADDR")), 90)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("AR_CDE")), 1)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("CORR_ADDR")), 60)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("CAPCTY")), 40)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRIN_EMPYR")), 30)
sBuffer = sBuffer & VB6.Format(gReader("JOIN_DTE").ToString, "YYYYMMDD")
sBuffer = sBuffer & VB6.Format(gReader("CESS_DTE").ToString, "YYYYMMDD")
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_SLRY")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("SLRY")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_LEV_PAY")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("LEV_PAY")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_DIR_FEE")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("DIR_FEE")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_COMM")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("COMM")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_BNS")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("BNS")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_BACK_PAY")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("BACK_PAY")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_RETR_SCHM_PMNT")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RETR_SCHM_PMNT")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_SLRY_TAX_EMPYR")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("SLRY_TAX_EMPYR")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_EDUC_BNF")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("EDUC_BNF")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_SHR_OPT_GAIN")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("SHR_OPT_GAIN")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("RWD_NATURE1")), 35)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("RWD_PRD1")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RWD_AMT1")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("RWD_NATURE2")), 35)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("RWD_PRD2")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RWD_AMT2")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("RWD_NATURE3")), 35)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("RWD_PRD3")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RWD_AMT3")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_PNSN")), 19)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("PNSN")), 9)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("TOT_INCOME")), 9)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("R_IND")), 1)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("R_ADDR_1")), 110)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("R_NATURE_1")), 19)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_R_1")), 26)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_EMPYR_1")), 7)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_EMPYE_1")), 7)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_RFND_EMPYE_1")), 7)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_EMPYR_EMPYE_1")), 7)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("R_ADDR_2")), 110)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("R_NATURE_2")), 19)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_R_2")), 26)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_EMPYR_2")), 7)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_EMPYE_2")), 7)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_RFND_EMPYE_2")), 7)
sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_EMPYR_EMPYE_2")), 7)
If gReader("OSEA_AMT").Equals(DBNull.Value) And gReader("OSEA_ADDR").Equals(DBNull.Value) And gReader("OSEA_NM").Equals(DBNull.Value) Then
sBuffer = sBuffer & "0"
Else
sBuffer = sBuffer & "1"
End If
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("OSEA_AMT")), 20)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("OSEA_NM")), 60)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("OSEA_ADDR")), 60)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("EMPYE_TAX_FL_NO")), 13)
sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("RMK")), 60)
oTextStream.WriteLine(sBuffer)
'rsRv.MoveNext()
Loop
gReader.Close()
'End of file
oTextStream.Write(Chr(26))
oTextStream.Close()
oSQL.ReSet_Renamed()
oSQL.SqlType = ClsMySQL.StatmentType.TYPE_INSERT
oSQL.AddTable("TBL_APCA_AUD_LOG")
oSQL.AddField("USR")
oSQL.AddValue(sUserID)
oSQL.AddField("ACT")
oSQL.AddValue("S")
oSQL.AddField("LOG_TM")
oSQL.AddValue(VB6.Format(Today, "dd MMM YYYY") & " " & TimeOfDay)
oSQL.AddField("DESC")
sMsg = FormatMsg(My.Resources.str19011, CStr(iTaxYr), oFileSys.GetAbsolutePathName(sFileName))
oSQL.AddValue(sMsg)
'OpenRs(oSQL.SQL)
Call ExeNonQuery(gConAPCA, oSQL.SQL)
ShowInfo(sMsg)
'直接保存成文件即可
'xmlDoc.save(sFileName)
'调用IE浏览器打开xml文件
ShellExecute(Me.Handle.ToInt32, "explore", oFileSys.GetParentFolderName(sFileName) & vbNullChar, "", "", modShell.enuShowWindow.SW_SHOW)
oTextStream = Nothing
oFileSys = Nothing
'rsRv = Nothing
oSQL = Nothing
End Using
Exit Sub
erhd:
oTextStream = Nothing
oFileSys = Nothing
'rsRv = Nothing
oSQL = Nothing
MyErrorRaise(Err.Description)
End Sub