inputcls.cls

将xml格式的文件导入到 数据库中,将xml格式的文件导入到 数据库中

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "inputcls"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private EAIobj As U8Distribute.iDistribute

Private sxml As New DOMDocument

Private Sub EAIinput(sxml As String, strRet As String)

strRet = EAIobj.Process(sxml)


End Sub

Private Sub init()
If EAIobj Is Nothing Then
    Set EAIobj = New U8Distribute.iDistribute
End If
End Sub


Public Sub UNinit()
Set EAIobj = Nothing
End Sub


Private Sub movefile(sFilename As String, spath As String, dpath As String)
Dim str As String
str = CStr(Date)
str = str & "-" & Replace(Time, ":", "-")
Call FileCopy(spath & "\" & sFilename, dpath & "\" & str & sFilename)
Call Kill(spath & "\" & sFilename)

End Sub


Private Sub writelog(logname As String, logpath As String)
Dim filename As String
Dim A, s, S1 As String
filename = CStr(Date) & ".TXT"
Dim FreeNum As Integer
FreeNum = FreeFile
Open logpath & "\" & filename For Append As FreeNum
'至于将一个新值写进第N行，则可以
'Dim FreeNum As Integer
'FreeNum = FreeFile
''Freenum表示一个空闲的文件号
'Open "D:\date.txt" For Input As #FreeNum
'这步是打开“date.txt”，for input表示以输入方式（即读取文件）打开。如果要写入文件则应该用output或append。
'Do Until EOF(FreeNum) '循环，直到文件结尾。Eof函数用来判断文件是否读完
'Line Input #FreeNum, A
'S1 = S1 + vbNewLine + A 'S用来保存1到n-1行的内容，S1用来表示n行以后的内容
'If A <> "" Then
'S = S1
'S1 = ""
'End If
'Loop
''Close FreeNum
'Open logpath & "" & filename For Output As FreeNum
'Open "D:\date.txt" For Output As FreeNum
'关闭文件之后重新以Output的模式打开?
'Print #FreeNum, CStr(Time) & S
Print #FreeNum, CStr(Time) & "   " & logname
'Print #FreeNum, S1
Close FreeNum





'关闭文件之后重新以Output的模式打开。
'Print #FreeNum, CStr(Time) & logname
'Close FreeNum

End Sub


Public Sub indata(types As String, sFilename As String, spath As String, okpath As String, okpathlog As String, unokpath As String, unokpathlog As String)
Dim aa As New inputcls

Dim dxml As New DOMDocument
Dim logname As String
Dim str As String
init
sxml.Load spath & "\" & sFilename
'保存
EAIinput sxml.xml, str
'保存结果
dxml.loadXML str

    If Not dxml.selectSingleNode("//item").Attributes.getNamedItem("dsc") Is Nothing Then
        If LCase(Trim(dxml.selectSingleNode("//item").Attributes.getNamedItem("dsc").nodeValue)) = LCase("OK") Then

            logname = "保存成功！" & dxml.xml
            Call writelog("[" & sFilename & "]  " & logname, okpathlog)
            Call movefile(sFilename, spath, okpath)
        Else
            logname = "保存失败！" & dxml.xml
            Call writelog("[" & sFilename & "]  " & logname, unokpathlog)
            Call movefile(sFilename, spath, unokpath)
        End If
    Else
            logname = "保存失败！" & dxml.xml
            Call writelog("[" & sFilename & "]   " & logname, unokpathlog)
            Call movefile(sFilename, spath, unokpath)
    End If
 
End Sub
 

Public Sub movedata(SuperGrid As Object)
Dim spath  As String
Dim item As String
Dim i As Integer
With SuperGrid
     For i = 1 To 6
        spath = SuperGrid.TextMatrix(i, 2) & "\"
        item = Dir(spath, vbArchive)
        While Len(item) > 0
            Call indata("1", item, SuperGrid.TextMatrix(i, 2), SuperGrid.TextMatrix(i, 3), SuperGrid.TextMatrix(i, 4), SuperGrid.TextMatrix(i, 5), SuperGrid.TextMatrix(i, 6))
            item = Dir
        Wend
    Next i
   



End With


End Sub