VBS分析Excel数据并生成新的Excel表格。

用到了第三方工具md5sum和sqlite3，sqlite3.exe是自己编译的。

<?xml version="1.0" encoding="utf-8" ?>
<package xmlns="Windows Script Host">
  <description>xx analysis</description>
  <copyright>
    \file start.wsf - Windows Script Host
    \brief source file for xx project
     Project id: e97e4fcd-db53-4e88-87b4-147fb4f832f4

    This file is part of the xx project.
    $(SYNOPSIS)

    \copyright Copyright (C) 2013 xx Inc.
    All rights reserved.

    Developed by xx team.
     \authors perry.peng@xx.com

    History:
     Date        Author      Description
     -------------------------------------------------------------
     2013-03-25  Perry       Initial created.

    Note:
    This source code can be used, modified, and redistributed under the
    terms of the license agreement that is included in the xx package
    By continuing to use, modify, or redistributed this code you indicate
    that you have read the license and understand and accept it fully.
  </copyright>
  <job ID="Application1">
    <runtime>
      <description>xx analysis</description>
      <named name="S" required="False" type="string" helpstring="an excel file which includes some xx data." />
      <example>Example: start.wsf /S "excel.xls"</example>
    </runtime>
    <object id="Shell" classid="clsid:72c24dd5-d70a-438b-8a42-98424b88afb8" />
    <object id="FileIO" classid="clsid:0d43fe01-f093-11cf-8940-00a0c9054228" />
    <object id="Network" classid="clsid:093ff999-1ea0-4079-9525-9614c3504b74" />
    <resource id="LAST_ERROR_INFORMATION">
      Description:
    </resource>
    <script language="VBScript" type="text/vbscript">
    <![CDATA[
      Option Explicit

      Const PROG_ID_EXCEL               = "Excel.Application"
      Const PROG_ID_XML1                = "Msxml2.DOMDocument"
      Const PROG_ID_XML2                = "Microsoft.XMLDOM"
      Const PROG_ID_DICT                = "Scripting.Dictionary"
      Const PROG_ID_STREAM              = "Adodb.Stream"

      Const DEFAULT_SCAN_FILES          = "xls,xlsx"
      Const DEFAULT_MD5_TOOL            = "md5sum.exe"
      Const DEFAULT_SQL_TOOL            = "sqlite3_h.exe"
      Const DEFAULT_SQL_DATA            = "data.db"
      Const DEFAULT_XML_FILE            = "data.xml"
      Const DEFAULT_XML_NODE            = "<?xml version=""1.0"" encoding=""utf-8""?><root></root>"

      Const ERR_NO_ERROR                = &H0000
      Const ERR_APP_INIT_FAIL           = &H0001
      Const ERR_STREAM_CREATE_FAIL      = &H0002
      Const ERR_DIC_CREATE_FAIL         = &HA000
      Const ERR_XML_CREATE_FAIL         = &HA001
      Const ERR_EXCEL_CREATE_FAIL       = &HA002
      Const ERR_SQLITE3_RUN_FAIL        = &HA003
      Const ERR_SQL_EXEC_FAIL           = &HA004
      Const ERR_NO_MORE_DATA            = &HA005
      Const ERR_APP_LOAD_FAIL           = &HB001
      Const ERR_XML_LOAD_FAIL           = &HB002
      Const ERR_UNAVIAL_FILE_TYPE       = &HB003
      Const ERR_TOOL_NOT_FOUND          = &HB004
      Const ERR_FILE_NOT_FOUND          = &HB005
      Const ERR_APP_SUMM_FAIL           = &HB006
      Const ERR_APP_COMP_FAIL           = &HB007
      Const ERR_PLATFORM_NOT_SUPPORT    = &HF005
      Const ERR_AUTOMATIC_OBJECT_FAIL   = &HF006

      Dim xap

      If CDbl(WSH.Version) < 5.6 Then
        MsgBox "This script needs WSH Version 5.6 or Later!"
        WSH.Quit -1
      End if

      Set xap = New CApp

      xap.Load
      xap.Scan
      xap.Summary
      xap.Save

      WSH.Quit xap.Quit

      Class Md5Result
        Private m_dict

        Private Sub Class_Initialize()
          On Error Resume Next

          ' 创建字典对象。
          Set m_dict = CreateObject(PROG_ID_DICT)
          If Err.Number <> 0 Then
            Set m_dict = Nothing
            Err.Clear
            Err.Raise ERR_DIC_CREATE_FAIL
          End If
        End Sub

        Private Sub Class_Terminate()
          ' 对象销毁时清空字典中储存的内容。
          If Not m_dict Is Nothing Then
            m_dict.RemoveAll
          End If
          Set m_dict = Nothing
        End Sub

        ' 获得MD5对应的文件名。
        Public Property Get File(k)
          If m_dict.Exists(k) Then
            File = m_dict.Item(k)
          End If
        End Property

        ' 获得KEY,即MD5值。
        Public Default Property Get Values
          Values = m_dict.Keys
        End Property

        ' 获得数量。
        Public Property Get Count
          Count = m_dict.Count
        End Property

        ' 添加项目。
        Public Sub Add(k, v)
          If Not m_dict.Exists(k) Then
            m_dict.Add k, v
          End If
        End Sub

        ' 删除项目。
        Public Sub Remove(k)
          If m_dict.Exists(k) Then
            m_dict.Remove k
          End If
        End Sub
      End Class

      Class Md5
        Private m_dict
        Private m_stream
        Private m_md5_tool

        Private Sub Class_Initialize()
          ' 设置默认的Md5工具。
          m_md5_tool = DEFAULT_MD5_TOOL

          On Error Resume Next

          ' 创建字典对象。
          Set m_dict = CreateObject(PROG_ID_DICT)
          If Err.Number <> 0 Then
            Set m_dict = Nothing
            Err.Clear
            On Error Goto 0
            Err.Raise ERR_DIC_CREATE_FAIL
          End If

          ' 创建字典对象。
          Set m_stream = CreateObject(PROG_ID_STREAM)
          If Err.Number <> 0 Then
            Set m_stream = Nothing
            Err.Clear
            On Error Goto 0
            Err.Raise ERR_STREAM_CREATE_FAIL
          End If
        End Sub

        Private Sub Class_Terminate()
          ' 对象销毁时清空字典中储存的内容。
          Clear
          Set m_dict = Nothing
          Set m_stream = Nothing
        End Sub

        ' 获得工具所在的路径。
        Public Property Get ToolPath
          ToolPath = m_md5_tool
        End Property

        ' 设置工具所在的路径。
        Public Property Let ToolPath(v)
          m_md5_tool = v
        End Property

        ' 获得准备计算的文件。
        Public Property Get Files
          Files = m_dict.Keys
        End Property

        ' 获得待计算文件的数量。
        Public Property Get Count
          Count = m_dict.Count
        End Property

        ' 清除之前保存的文件。
        Public Sub Clear
          If Not m_dict Is Nothing Then
            m_dict.RemoveAll
          End If
        End Sub

        ' 添加一个文件。
        Public Sub AddFile(file)
          If Not IsEmpty(file) Then
            ' 不重复保存，相同的路径只会记录其中一个。
            If Not m_dict.Exists(file) Then
              m_dict.Add file, vbNullString
            End If
          End If
        End Sub

        Public Function MD5Init()

        End Function

        Public Function MD5Transform()

        End Function

        Public Sub MD5Update()

        End Sub

        Public Function MD5Final()

        End Function

        Public Function GetFileMd5(file)
          On Error Resume Next

          m_stream.Type = 1 ' adTypeBinary
          m_stream.Mode = 1 ' adModeRead
          m_stream.LoadFromFile file

          MD5Init
          Do While Not m_stream.EOS
            MD5Update m_stream.Read(1024)
          Loop
          GetFileMd5 = MD5Final

          m_strea.Close
        End Function

        ' 计算所有文件的Md5值。
        Public Function Calc
          Dim text, file, exec, timeout, regExp, match

          Set Calc = New Md5Result

          'On Error Resume Next

          If m_dict.Count > 0 Then
            text = m_md5_tool

            ' 合并参数。
            For Each file In m_dict.Keys
              If InStr(file, " ") > 0 Then
                text = text & " """ & file & """"
              Else
                text = text & " " & file
              End If
            Next

            ' 运行md5sum。
            Set exec = Shell.Exec(text)

            timeout = 0
            ' 等待md5sum运算完成。
            Do While exec.Status = 0
              WSH.Sleep 100
              timeout = timeout + 1

              ' 当md5sum未能在规定的时间内完成运算
              ' 就直接强制终止它的运行。
              If timeout > 500 Then
                exec.Terminate
                Exit Do
              End If
            Loop

            Set regExp = New RegExp

            ' 忽略大小写。
            regExp.IgnoreCase = False
            ' 设定匹配模式。
            regExp.Pattern = "^\\([a-f0-9]{32}) \*(\w+.+)"

            Do While Not exec.StdOut.AtEndOfStream
              ' 获得md5sum的输出中的某行文本。
              text = exec.StdOut.ReadLine

              ' 确认输出的每行是否是md5sum正常输出格式。
              If regExp.Test(text) Then
                ' 计算匹配到的值，md5值在子匹配0中，文件名在子匹配1中。
                Set match = regExp.Execute(text)(0)
                ' 保存md5值与文件名，并删除文件路径中的多余的\符号。
                Calc.Add match.SubMatches(0), Replace(match.SubMatches(1), "\\", "\")
              End If
            Loop

            Set regExp = Nothing
            Set exec = Nothing
          End If
        End Function
      End Class

      Class SqlCore
        Private m_sql_tool
        Private m_sql_db
        Private m_exec

        Private Sub Class_Initialize()
          ' 默认的SQLite3执行文件。
          m_sql_tool = DEFAULT_SQL_TOOL
          ' 默认的SQLite3数据库文件名。
          m_sql_db = DEFAULT_SQL_DATA

          Set m_exec = Nothing
        End Sub

        Private Sub Class_Terminate()
          ' 对象销毁前关闭可能在运行的SQLite3程序。
          Close
          Set m_exec = Nothing
        End Sub

        Public Sub Open
          On Error Resume Next

          ' 打开SQLite3。
          Set m_exec = Shell.Exec(m_sql_tool & " """ & m_sql_db & """")

          ' 确认调用SQLite3无错误产生。
          If Err.Number <> 0 Then
            Set m_exec = Nothing
            Err.Clear

            ' 抛出一个自定义错误。
            On Error GoTo 0
            Err.Raise ERR_SQLITE3_RUN_FAIL
          End If

          ' 等待SQLite3启动。
          WSH.Sleep 100

          ' 确认SQLite3已经运行。
          If m_exec.Status <> 0 Then
            ' 抛出一个自定义错误。
            On Error GoTo 0
            Err.Raise ERR_SQLITE3_RUN_FAIL
          End If
        End Sub

        Public Function Write(cmd)
          If m_exec Is Nothing Then
            Err.Raise ERR_SQLITE3_RUN_FAIL
          End If

          If Not IsEmpty(cmd) Then
            ' 写入标准输入缓冲区，SQLite3将执行此命令。
            m_exec.StdIn.WriteLine cmd
            'QueryEx = m_exec.StdOut.AtEndOfLine
          End If
        End Function

        Public Sub Close
          Dim timeout

          On Error Resume Next
          If Not m_exec Is Nothing Then
            If m_exec.Status = 0 Then
              ' 命令SQLite3退出。
              m_exec.StdIn.WriteLine ".quit"

              timeout = 0
              ' 确认SQLite3是否已经退出。
              Do While m_exec.Status = 0
                WSH.Sleep 150
                timeout = timeout + 1
                ' 当SQLite3未能执行退出命令且超过1分钟没有反应
                ' 就直接强制终止它的运行。
                If timeout > 400 Then
                  m_exec.Terminate
                  Exit Do
                End If
              Loop
            End If
          End If
        End Sub

        Private Sub Query(sql)
          On Error Resume Next

          ' 打开SQLite3。
          Set m_exec = Shell.Exec(m_sql_tool & " """ & m_sql_db & """")

          ' 确认调用SQLite3无错误产生。
          If Err.Number <> 0 Then
            Set m_exec = Nothing
            Err.Clear

            ' 抛出一个自定义错误。
            On Error GoTo 0
            Err.Raise ERR_SQLITE3_RUN_FAIL
          End If

          ' 等待SQLite3启动。
          WSH.Sleep 100

          ' 确认SQLite3已经运行。
          If m_exec.Status <> 0 Then
            ' 抛出一个自定义错误。
            On Error GoTo 0
            Err.Raise ERR_SQLITE3_RUN_FAIL
          End If

          ' 写入标准输入缓冲区，SQLite3将执行此命令。
          m_exec.StdIn.WriteLine sql

          ' 完成一次查询。
          Close

          If Not m_exec.StdErr.AtEndOfLine Then
            ' 抛出一个自定义错误。
            On Error GoTo 0
            Err.Raise ERR_SQL_EXEC_FAIL
          End If
        End Sub

        Public Property Get ToolPath
          ' 获得属性。
          ToolPath = m_sql_tool
        End Property

        Public Property Let ToolPath(v)
          ' 设置属性。
          m_sql_tool = v
        End Property

        Public Property Get DataFile
          ' 获得属性。
          DataFile = m_sql_db
        End Property

        Public Property Let DataFile(v)
          ' 设置属性。
          m_sql_db = v
        End Property

        Public Sub ExecuteNonQuery(sql)
          ' 执行SQL查询语句。
          Query sql

          Set m_exec = Nothing
        End Sub

        Public Function ExecuteScalar(sql)
          Dim text

          ' 执行SQL查询语句。
          Query sql

          ' 等待读取标准输出缓冲区最后一行数据。
          Do While Not m_exec.StdOut.AtEndOfLine
            text = m_exec.StdOut.ReadLine

            If Not IsEmpty(text) Then
              ExecuteScalar = text
            End If
          Loop

          Set m_exec = Nothing
        End Function

        Public Function Execute(sql, out)
          On Error Resume Next

          ' 打开SQLite3。
          Set m_exec = Shell.Exec(m_sql_tool & " """ & m_sql_db & """")

          ' 确认调用SQLite3无错误产生。
          If Err.Number <> 0 Then
            Set m_exec = Nothing
            Err.Clear

            ' 抛出一个自定义错误。
            On Error GoTo 0
            Err.Raise ERR_SQLITE3_RUN_FAIL
          End If

          ' 等待SQLite3启动。
          WSH.Sleep 200

          ' 确认SQLite3已经运行。
          If m_exec.Status <> 0 Then
            ' 抛出一个自定义错误。
            On Error GoTo 0
            Err.Raise ERR_SQLITE3_RUN_FAIL
          End If

          ' 写入标准输入缓冲区，SQLite3将执行此命令。
          m_exec.StdIn.Write sql & vbCrLf & ".quit" & vbCrLf

          Do While Not m_exec.StdOut.AtEndOfLine
            out.WriteRaw m_exec.StdOut.ReadLine
          Loop

          If Not m_exec.StdErr.AtEndOfLine Then
            ' 抛出一个自定义错误。
            On Error GoTo 0
            Err.Raise ERR_SQL_EXEC_FAIL
          End If

          Set m_exec = Nothing
        End Function

        Public Sub CreateTable(name, fields)
          ExecuteNonQuery "Create Table If Not Exists " & name & "(" & fields & ");"
        End Sub

        Public Sub DeleteTable(name)
          ExecuteNonQuery "Drop Table If Exists" & name & ";"
        End Sub
      End Class

      Class ExcelData
        Private m_data
        Private m_end

        Private Sub Class_Initialize()
          On Error Resume Next

          ' 创建字典对象。
          Set m_data = CreateObject(PROG_ID_DICT)
          If Err.Number <> 0 Then
            Set m_data = Nothing
            Err.Clear
            On Error Goto 0
            Err.Raise ERR_DIC_CREATE_FAIL
          End If

          m_end = True
        End Sub

        Private Sub Class_Terminate()
          m_data.RemoveAll
          Set m_data = Nothing
        End Sub

        ' 获得所有项目文本信息。
        Public Property Get Text
          Dim str

          ' 列出每个项目并以符号 | 分隔。
          For Each str In m_data.Items
            If Not IsEmpty(Text) Then
              Text = Text & " | "
            End If
            Text = Text & CStr(str)
          Next
        End Property

        ' 枚举每个项目值。
        Public Property Get Values
          Values = m_data.Items
        End Property

        ' 获得单个项目值。
        Public Default Property Get Item(index)
          If Not m_data.Exists(index) Then
            Item = Empty
            Exit Property
          End If
          Item = m_data(index)
        End Property

        ' 获得所有项目数量。
        Public Property Get Count
          Count = m_data.Count
        End Property

        Public Property Get AtEndOfLine
          AtEndOfLine = m_end
        End Property

        Public Property Let AtEndOfLine(v)
          m_end = v
        End Property

        ' 储存一个或多个项目单位。
        Public Sub AddData(val)
          If IsArray(val) Then
            Dim item
            For Each item In val
              m_data.Add m_data.Count, item
            Next
          Else
            m_data.Add m_data.Count, val
          End If
        End Sub

        ' 测试当前对象是否合法数据格式。
        Public Function Check
          If Count > 5 Then
            ' 162-LGHH-12L0070000003G
            If Len(m_data(0)) > 22 Then
              If Len(m_data(2)) > 1 Then
                Check = True
              End If
            End If
          End If
        End Function
      End Class

      Class Excel
        Private m_excel
        Private m_workbook
        Private m_worksheet
        Private m_attributes
        Private m_filePath

        Private Sub Class_Initialize()
          On Error Resume Next

          Set m_workbook = Nothing
          Set m_worksheet = Nothing

          ' 创建Excel对象。
          Set m_excel = CreateObject(PROG_ID_EXCEL)
          If Err.Number <> 0 Then
            Set m_excel = Nothing
            Err.Clear

            On Error GoTo 0
            Err.Raise ERR_EXCEL_CREATE_FAIL
          End If

          ' 初始创建的Excel对象显示窗口。
          m_excel.Visible = False

          ' 默认设置为我的名字。
          m_excel.UserName = "Perry Peng"

          On Error Resume Next
          Set m_attributes = CreateObject(PROG_ID_DICT)
          If Err.Number <> 0 Then
            Set m_attributes = Nothing
            Err.Clear
            On Error Goto 0
            Err.Raise ERR_DIC_CREATE_FAIL
          End If
        End Sub

        ' 销毁所有创建的对象。
        Private Sub Class_Terminate()
          If Not m_excel Is Nothing Then
            m_excel.Quit
          End If
          Set m_attributes = Nothing
          Set m_worksheet = Nothing
          Set m_workbook = Nothing
          Set m_excel = Nothing
        End Sub

        ' 获得当前Excel的版本。
        Public Property Get Version
          If m_excel Is Nothing Then
            Exit Property
          End If

          Version = m_excel.Version
        End Property

        ' 获得当前Excel的标题。
        Public Property Get Caption
          If m_excel Is Nothing Then
            Exit Property
          End If

          Caption = m_excel.Caption
        End Property

        ' 设置当前Excel的标题。
        Public Property Let Caption(v)
          If m_excel Is Nothing Then
            Exit Property
          End If

          m_excel.Caption = v
        End Property

        ' 获得当前Excel的状态栏信息。
        Public Property Get StatusBar
          If m_excel Is Nothing Then
            Exit Property
          End If

          StatusBar = m_excel.StatusBar
        End Property

        ' 设置当前Excel的状态栏信息。
        Public Property Let StatusBar(v)
          If m_excel Is Nothing Then
            Exit Property
          End If

          m_excel.StatusBar = v
        End Property

        ' 获得当前文件名。
        Public Property Get FileName
          FileName = m_filePath
        End Property

        ' 获得当前表格名。
        Public Property Get CurrentWorkSheet
          If m_excel Is Nothing Then
            Exit Property
          End If

          If Not m_worksheet Is Nothing Then
            CurrentWorkSheet = m_worksheet.Name
          End If
        End Property

        ' 切换当前表格，使用表格名称。
        Public Property Let CurrentWorkSheet(v)
          If m_excel Is Nothing Then
            Exit Property
          End If

          If m_attributes.Exists(v) Then
            Set m_worksheet = m_workbook.Worksheets.Item(v)
            m_worksheet.Select
          End If
        End Property

        ' 获得当前表格读写的行号。
        Public Property Get Line
          If m_excel Is Nothing Then
            Exit Property
          End If

          If Not m_worksheet Is Nothing Then
            Line = m_attributes(m_worksheet.Name)
          End If
        End Property

        ' 设置当前表格读写行号。
        Public Property Let Line(v)
          If m_excel Is Nothing Then
            Exit Property
          End If

          If Not m_worksheet Is Nothing Then
            m_attributes(m_worksheet.Name) = v
          End If
        End Property

        ' 获得Excel是否可见。
        Public Property Get Visible
          If m_excel Is Nothing Then
            Exit Property
          End If
          Visible = m_excel.Visible
        End Property

        ' 设置Excel是否可见。
        Public Property Let Visible(v)
          If m_excel Is Nothing Then
            Exit Property
          End If
          m_excel.Visible = v
        End Property

        ' 创建新的Excel表格。
        Public Sub AddNew()
          If m_excel Is Nothing Then
            Exit Sub
          End If

          ' 加入一个新的Excel文件。
          Set m_workbook = m_excel.Workbooks.Add()

          ' 记录所有表名称。
          For Each m_worksheet In m_workbook.Worksheets
            m_attributes.Add m_worksheet.Name, 0
          Next

          ' 将新建的第一张表作为默认表。
          Set m_worksheet = m_workbook.Worksheets("Sheet1")
          m_worksheet.Select
        End Sub

        ' 打开一个已经存在的文件。
        Public Sub Open(file, readonly)
          ' 打开新文件前，关闭当前文件。
          Close

          ' 打开一个新的Excel文件。
          Set m_workbook = m_excel.Workbooks.Open(file, False, readonly)

          ' 记录所有表名称。
          For Each m_worksheet In m_workbook.Worksheets
            m_attributes.Add m_worksheet.Name, 0
          Next

          ' 设置默认表。
          If m_attributes.Count > 0 Then
            Set m_worksheet = m_workbook.ActiveSheet
            If m_worksheet Is Nothing Then
              Set m_worksheet = m_workbook.Worksheets.Item(m_attributes.Keys(1))
              m_worksheet.Select
            End If
          End If
        End Sub

        ' 写入原始数据。
        Public Sub WriteRaw(data)
          Dim arryData

          ' 将原始数据拆分。
          arryData = Split(data, "|")

          ' 只接受数据。
          If IsArray(arryData) Then
            WriteLine arryData
          End If
        End Sub

        ' 写入一行到Excel表格。
        Public Sub WriteLine(data)
          On Error Resume Next

          If m_excel Is Nothing Then
            Exit Sub
          End If

          Dim num, rng, cols

          ' 获得新行的行号。
          num = Line + 1
          Line = num

          ' 取得行号指定的单元。
          Set rng = m_worksheet.Range("A" & CStr(num), Chr(65 + UBound(data)) & CStr(num))

          ' 选取指定的单元。
          rng.Select

          ' 将数据写入指定单元。
          rng.Value = data

          If Err.Number <> 0 Then
            Err.Clear
            WSH.echo Err.Description
          End If
        End Sub

        ' 设置新名称并且调整单元格宽度。
        Public Sub SetStyle1(name, width1, width2, width3, width4, width5, width6)
          On Error Resume Next

          If m_excel Is Nothing Then
            Exit Sub
          End If

          ' 设置新的名称。
          If Not IsEmpty(name) Then
            ' 排除相同的名称。
            If m_worksheet.Name <> name Then
              If Not m_attributes.Exists(name) Then
                m_attributes.Add name, 0
              End If

              ' 复制当前的行号。
              m_attributes(name) = Line
              m_worksheet.Name = name
            End If
          End If

          ' 仅宽度大于零时有效。
          If width1 > 0 Then
            m_worksheet.Columns("A:A").ColumnWidth = width1
          End If

          ' 仅宽度大于零时有效。
          If width2 > 0 Then
            m_worksheet.Columns("B:B").ColumnWidth = width2
          End If

          ' 仅宽度大于零时有效。
          If width3 > 0 Then
            m_worksheet.Columns("C:C").ColumnWidth = width3
          End If

          ' 仅宽度大于零时有效。
          If width4 > 0 Then
            m_worksheet.Columns("D:D").ColumnWidth = width4
          End If

          ' 仅宽度大于零时有效。
          If width5 > 0 Then
            m_worksheet.Columns("E:E").ColumnWidth = width5
          End If

          ' 仅宽度大于零时有效。
          If width6 > 0 Then
            m_worksheet.Columns("F:F").ColumnWidth = width6
          End If

          If Err.Number <> 0 Then
            Err.Clear
          End If
        End Sub

        Public Sub SetStyle2
          Dim i

          On Error Resume Next
          For i = 7 To 12
            With m_worksheet.UsedRange.Borders(i)
              .LineStyle = 1  ' xlContinuous
              .ColorIndex = 0
              .TintAndShade = 0
              .Weight = 2  ' xlThin
            End With
          Next

          If Err.Number <> 0 Then
            Err.Clear
          End If
        End Sub

        ' 从当前打开的Excel表格读取一行数据。
        Public Function ReadLine
          On Error Resume Next
          Set ReadLine = New ExcelData

          If m_attributes.Count = 0 Then
            Exit Function
          End If

          Dim usage, rng, num

          ' 递增当前行号。
          num = Line + 1
          Line = num
          Set usage = m_worksheet.UsedRange

          ' 到行尾时退出。
          If Line > usage.Rows.Count Then
            ' 数据已经全部读取，AtEndOfLine默认True。
            Exit Function
          End If

          ' 数据未读取完，还有后续数据。
          ReadLine.AtEndOfLine = False

          ' 取得每行的单元。
          Set rng = usage.Range(usage.Item(num, 1).Address, usage.Item(num, usage.Columns.Count).Address)

          ' 选取指定的单元。
          rng.Select

          ' 储存Excel单元数据。
          ReadLine.AddData rng.Value

          ' 确定数据是合格，不合格数据将标记为红色。
          If Not ReadLine.Check Then
            rng.Interior.ColorIndex = 3 'Red
          End If

          Set rng = Nothing
          Set usage = Nothing
        End Function

        ' 关闭当前已打开的Excel文件。
        Public Sub Close
          If Not m_excel Is Nothing Then
            m_excel.StatusBar = "Ready"

            If Not m_workbook Is Nothing Then
              m_workbook.Close False
            End If
          End If

          ' 清除表附加记录的属性。
          m_attributes.RemoveAll

          ' 销毁对象。
          Set m_worksheet = Nothing
          Set m_workbook = Nothing
        End Sub

        ' 保存当前的Excel文件。
        Public Sub Save
          If m_workbook Is Nothing Then
            Exit Sub
          End If

          If m_attributes.Count = 0 Then
            Exit Sub
          End If

          m_workbook.Save
        End Sub

        ' 另存当前Excel文件。
        Public Sub SaveAs(file)
          If m_workbook Is Nothing Then
            Exit Sub
          End If

          If m_attributes.Count = 0 Then
            Exit Sub
          End If

          m_workbook.SaveAs file
        End Sub
      End Class

      Class CApp
        Private m_primal_error_id
        Private m_internal_error_id
        Private m_app_path
        Private m_config_file
        Private m_data_file
        Private m_xmldoc
        Private m_md5
        Private m_excel
        Private m_database

        Private Sub Class_Initialize()
          m_primal_error_id = ERR_NO_ERROR
          m_internal_error_id = ERR_NO_ERROR

          On Error Resume Next
          m_app_path = FileIO.GetParentFolderName(WSH.ScriptFullName)
          m_config_file = FileIO.BuildPath(m_app_path, DEFAULT_XML_FILE)
          m_data_file = FileIO.BuildPath(m_app_path, DEFAULT_SQL_DATA)

          ' 创建XML对象。
          Set m_xmldoc = CreateObject(PROG_ID_XML1)
          If Err.Number <> 0 Then
            Set m_xmldoc = Nothing
            Err.Clear

            Set m_xmldoc = CreateObject(PROG_ID_XML2)
            If Err.Number <> 0 Then
              m_internal_error_id = Err.Number
              m_primal_error_id = ERR_APP_INIT_FAIL
              Set m_xmldoc = Nothing
              Err.Clear
              Exit Sub
            End If
          End If

          ' 创建MD5对象。
          Set m_md5 = New Md5
          If Err.Number <> 0 Then
            m_internal_error_id = Err.Number
            m_primal_error_id = ERR_APP_INIT_FAIL
            Set m_md5 = Nothing
            Err.Clear
            Exit Sub
          End If

          ' 设定MD5工具路径。
          m_md5.ToolPath = FileIO.BuildPath(m_app_path, DEFAULT_MD5_TOOL)
          If Not FileIO.FileExists(m_md5.ToolPath) Then
            m_internal_error_id = ERR_TOOL_NOT_FOUND
            m_primal_error_id = ERR_APP_INIT_FAIL
            Set m_md5 = Nothing
            Exit Sub
          End If

          ' 创建SQLite3对象。
          Set m_database = New SqlCore
          If Err.Number <> 0 Then
            m_internal_error_id = Err.Number
            m_primal_error_id = ERR_APP_INIT_FAIL
            Set m_database = Nothing
            Err.Clear
            Exit Sub
          End If

          ' 设定数据库文件路径。
          m_database.DataFile = m_data_file
          m_database.ToolPath = FileIO.BuildPath(m_app_path, DEFAULT_SQL_TOOL)
          If Not FileIO.FileExists(m_database.ToolPath) Then
            m_internal_error_id = ERR_TOOL_NOT_FOUND
            m_primal_error_id = ERR_APP_INIT_FAIL
            Set m_database = Nothing
            Exit Sub
          End If

          ' 创建Excel对象。
          Set m_excel = New Excel
          If Err.Number <> 0 Then
            m_internal_error_id = Err.Number
            m_primal_error_id = ERR_APP_INIT_FAIL
            Set m_excel = Nothing
            Err.Clear
            Exit Sub
          End If
        End Sub

        Private Sub Class_Terminate()
          Set m_xmldoc = Nothing
          Set m_database = Nothing
          Set m_excel = Nothing
          Set m_md5 = Nothing
        End Sub

        ' 取得使用脚本的用户名。
        Public Property Get UserName
          UserName = Network.UserName
        End Property

        ' 取得使用脚本的计算机名。
        Public Property Get ComputerName
          ComputerName = Network.ComputerName
        End Property

        ' 取得脚文件所在的目录名。
        Public Property Get Path
          Path = m_app_path
        End Property

        ' 加入一个文件作为资料源。
        Public Sub AddFile(file)
          If m_primal_error_id <> ERR_NO_ERROR Then
            Exit Sub
          End If

          m_md5.AddFile file
        End Sub

        Public Sub Load
          ' 确保前面的操作都OK。
          If m_primal_error_id <> ERR_NO_ERROR Then
            Exit Sub
          End If

          On Error Resume Next

          ' 决定是重建配置文件或是打开已存的文件。
          If Not FileIO.FileExists(m_config_file) Then
            m_xmldoc.loadXml DEFAULT_XML_NODE
            m_xmldoc.save m_config_file
          Else
            m_xmldoc.load m_config_file
          End If

          If Err.Number <> 0 Then
            m_internal_error_id = ERR_XML_LOAD_FAIL
            m_primal_error_id = ERR_APP_LOAD_FAIL
            Err.Clear
            Exit Sub
          End If

          ' 在数据库中创建配置表。
          m_database.CreateTable "App_Settings", "Id Integer Primary Key Autoincrement, " & _
            "Key Text Not Null, " & _
            "Value Text, " & _
            "Modified Datetime Default(Datetime('now','localtime'))"
          If Err.Number <> 0 Then
            m_internal_error_id = Err.Number
            m_primal_error_id = ERR_APP_LOAD_FAIL
            Err.Clear
            Exit Sub
          End If

          ' 在数据库中创建文件表。
          m_database.CreateTable "Scanned_Files", "Md5 Char(36) Primary Key Not Null, " & _
            "Path Text, " & _
            "IsScanned Integer Default(0), " & _
            "Version Text, " & _
            "UserName Text, " & _
            "ComputerName Text, " & _
            "Added Datetime Default(Datetime('now','localtime'))"
          If Err.Number <> 0 Then
            m_internal_error_id = Err.Number
            m_primal_error_id = ERR_APP_LOAD_FAIL
            Err.Clear
            Exit Sub
          End If

          ' 在数据库中创建数据表。
          m_database.CreateTable "BOM_List", "Id Integer Primary Key Autoincrement Not Null, " & _
            "File_Md5 Char(36) Not Null, " & _
            "File_Id Integer Default(0), " & _
            "Number VarChar(24) Not Null, " & _
            "Mfr_Name Text, " & _
            "Mfr_Number Text Not Null, " & _
            "Mfr_Status Text, " & _
            "Mfr_Code Text, " & _
            "atFileNum Integer Default(0), " & _
            "atMfrNum Integer Default(0), " & _
            "Unique(File_Id, Number, Mfr_Number)"
          If Err.Number <> 0 Then
            m_internal_error_id = Err.Number
            m_primal_error_id = ERR_APP_LOAD_FAIL
            Err.Clear
            Exit Sub
          End If

          ' 在数据库中创建数据表。
          m_database.CreateTable "BOM_Compare", "Id Integer Primary Key Autoincrement Not Null, " & _
            "Number VarChar(24) Not Null, " & _
            "Mfr_Number Text, " & _
            "atFileNum Integer Default(0), " & _
            "atMfrNum Integer Default(0)"
          If Err.Number <> 0 Then
            m_internal_error_id = Err.Number
            m_primal_error_id = ERR_APP_LOAD_FAIL
            Err.Clear
            Exit Sub
          End If
        End Sub

        ' 扫描脚本文件所在目录所有的数据源。
        Public Sub Scan
          Dim fld
          Dim file
          Dim namex
          Dim res, md5
          Dim data, text, fileId

          ' 确保前面的操作都OK。
          If m_primal_error_id <> ERR_NO_ERROR Then
            Exit Sub
          End If

          On Error Resume Next
          Set fld = FileIO.GetFolder(Path)

          ' 列出当前目录中所有的数据文件。
          For Each file In fld.Files
            namex = FileIO.GetExtensionName(file.Path)
            If InStr(1, DEFAULT_SCAN_FILES, namex, vbTextCompare) > 0 Then
              m_md5.AddFile FileIO.BuildPath(m_app_path, "*." & namex)
            End If
          Next

          ' 判断待处理文件的数量。
          If m_md5.Count = 0 Then
            m_internal_error_id = ERR_NO_MORE_DATA
            m_primal_error_id = ERR_APP_SUMM_FAIL
            Exit Sub
          End If

          ' 计算出文件的MD5值。
          Set res = m_md5.Calc
          If Err.Number <> 0 Then
            m_internal_error_id = Err.Number
            m_primal_error_id = ERR_APP_SUMM_FAIL
            Err.Clear
            Exit Sub
          End If

          text = Empty
          ' 列出已经找到的文件，并过滤掉已经计算过的文件。
          For Each md5 In res.Values
            ' 确认文件是否已经分析过。
            ' 如果没有分析过将文件内容取出并放到数据库中。
            If CInt(m_database.ExecuteScalar("Select Count(*) From Scanned_Files Where Md5 = '" & md5 & "' And IsScanned > 0;")) > 0 Then
              ' 如果文件已经记录且也被分析过，
              ' 删除此文件记录。
              res.Remove md5
            Else
              ' 剩下的就是没有被分析过或者未分析成功。
              text = text & "Insert Or Replace Into Scanned_Files (Md5, Path, Version, UserName, ComputerName) Values ('" & _
                md5 & "', '" & _
                res.File(md5) & "', '" & _
                m_excel.Version & "', '" & _
                UserName & "', '" & _
                ComputerName & "');" & vbCrLf
                WSH.echo Err.Description
            End If
          Next

          ' 经过数据库比较后，看是否有新的文件需要被录入资料。
          If res.Count = 0 Then
            If Err.Number <> 0 Then
              m_internal_error_id = Err.Number
              Err.Clear
            Else
              m_internal_error_id = ERR_NO_MORE_DATA
            End If
            m_primal_error_id = ERR_APP_SUMM_FAIL
            Set res = Nothing
            Exit Sub
          End If

          ' 如果确定有文件需要分析，将显示Excel窗口。
          m_excel.Visible = True

          For Each md5 In res.Values
            m_excel.Open res.File(md5), True

            Do
              ' 读取一行数据。
              Set data = m_excel.ReadLine

              ' 确定数据是用。
              If data.Check Then
                Do While data.Count < 6
                  data.AddData vbNullString
                Loop

                fileId = Trim(data(5))
                If Not IsNumeric(fileId) Then
                  fileId = "0"
                End If

                m_excel.StatusBar = "正在读取Excel数据，请匆修改当前Excel内容。"

                text = text & "Insert Or Ignore Into BOM_List " & _
                  "(File_Md5, Number, Mfr_Name, Mfr_Number, Mfr_Status, Mfr_Code, File_Id) Values ('" & _
                  md5 & "', '" & _
                  Trim(data(0)) & "', '" & _
                  Trim(data(1)) & "', '" & _
                  Trim(data(2)) & "', '" & _
                  Trim(data(3)) & "', '" & _
                  Trim(data(4)) & "', '" & _
                  fileId & "');" & vbCrLf

                If Len(text) > &H3000 Then
                  'Shell.Popup "正在写入数据到数据库中，请匆修改当前Excel内容。", 1, "Data Saving...", 64
                  m_excel.StatusBar = "正在写入数据到数据库中，请匆关闭当前Excel。"
                  m_database.ExecuteNonQuery text
                  text = Empty
                End If
              End If
            Loop While Not data.AtEndOfLine

            ' 分析过的文件将会被标记为扫描过。
            text = text & "Update Scanned_Files Set IsScanned = 1 Where Md5 = '" & md5 & "';"

            m_excel.StatusBar = "正在写入数据到数据库中，请匆关闭当前Excel。"
            ' 已确定执行SQL。
            m_database.ExecuteNonQuery text

            ' 清除执行过的SQL语句。
            text = Empty

            ' 每分析完一个文件就将其存入数据库。
            'If Not IsEmpty(text) Then
            '  If Shell.Popup("3秒钟后将自动保存" & res.File(md5) & "的内容到数据库。" & _
            '    vbCrLf & "保存文件需要一定的时间，请不要关闭程序或Excel。", 3, "Data Saving", 65) = 2 Then
            '    ' 当有人按下取消后将不会保存数据。
            '    Shell.Popup "你已经取消保存数据，当前文件分析过的内容被丢弃。", 0, "提醒", 64
            '  Else
            '    ' 已确定执行SQL。
            '    m_database.ExecuteNonQuery text
            '  End If
            '
            '  ' 清除执行过的SQL语句。
            '  text = Empty
            'End If

            m_excel.Close
          Next

          Set res = Nothing
        End Sub

        Public Function Summary
          Dim totalFiles, i, text

          On Error Resume Next

          If m_primal_error_id <> ERR_NO_ERROR Then
            If m_primal_error_id <> ERR_APP_SUMM_FAIL Then
              Exit Function
            End If
          End If

          ' 统计所有文件数量。
          totalFiles = CInt(m_database.ExecuteScalar("Select Count(*) From (Select Distinct File_Id From Bom_List);"))
          If totalFiles = 0 Then
            m_internal_error_id = ERR_NO_MORE_DATA
            m_primal_error_id = ERR_APP_COMP_FAIL
            Exit Function
          End If

          ' 清除标志。
          text = "Update Bom_List Set atFileNum = 0, atMfrNum = 0;" & vbCrLf
          text = text & "Delete From BOM_Compare;" & vbCrLf

          ' 先标记在其它文件中出现过的项目。
          For i = 1 To totalFiles
            text = text & "Update Bom_List Set atFileNum = " & CStr(i) & " Where Number " & _
              "In (Select Case When Count(Number) = " & CStr(i) & " Then Number End From (Select " & _
              "Number From Bom_List Group By Number, File_Id) Group By Number);" & vbCrLf
          Next

          'text = text & "Insert Into BOM_Compare (Number, Mfr_Number, atMfrNum, atFileNum) " & _
          '  "Select Count(Number), Number, atFileNum, Mfr_Number From Bom_List Group By Number, " & _
          '  "Mfr_Number;" & vbCrLf

          ' 只出现一次的就能直接标记为输出。
          'text = text & "Update Bom_List Set atMfrNum = 1 Where atFileNum = 1;" & vbCrLf

          ' 统计相同项目之间未在所有出现过的文件中的子项目。
          text = text & "Update Bom_List Set atMfrNum = (Select X.atMfrNum From (Select Count(Number) As " & _
            "atMfrNum, Number, atFileNum, Mfr_Number From Bom_List Group By Number, Mfr_Number) As X Where " & _
            "Bom_List.Number=X.Number And Bom_List.Mfr_Number=X.Mfr_Number);" & vbCrLf

          ' 剔除合并后存在的重复项目。
          text = text & "Update Bom_List Set atMfrNum = atFileNum + 1 Where Id Not In (Select Id From Bom_List " & _
            "Group By Number, Mfr_Number);" & vbCrLf

          'text = text & "Update BOM_List As D Set D.atMfrNum = 1 Where D.atMfrNum = 0 " & _
          '  "And D.Number = E.Number And D.Mfr_Number = A.Mfr_Number And (Select Case When " & _
          '  "Count(A.Mfr_Number) = A.atFileNum Then 1 Else 0 End From Bom_List As A Where " & _
          '  "Number In (Select Distinct E.Number From Bom_List As E) Group By A.Mfr_Number);"
          '
          '  m_database.ExecuteNonQuery "Update Bom_List Set atFileNum = atFileNum + 1 " & _
          '    "Where Number In (Select Case When Count(Number) > 1 Then Number " & _
          '    "End From (Select Number From Where Bom_List Group By Number, File_Id) Group By Number);"

          'text = text & "Update Bom_List Set atMfrNum = 1 Where atFileNum = 1;" & vbCrLf

          m_database.ExecuteNonQuery text
        End Function

        Public Function Save
          On Error Resume Next

          If m_primal_error_id <> ERR_NO_ERROR Then
            If m_primal_error_id <> ERR_APP_SUMM_FAIL Then
              Exit Function
            End If
          End If

          ' 如果确定有文件需要分析，将显示Excel窗口。
          m_excel.Visible = True
          m_excel.AddNew

          m_excel.StatusBar = "正在写入数据到Excel。"
          m_excel.CurrentWorkSheet = "Sheet1"
          m_excel.SetStyle1 "Sheet1", 24, 27, 27, 7, 17, 5
          m_excel.WriteRaw "Item Number|MFR Name|MFR Part Number|Status|Manufacturer Code|File"
          m_database.Execute "Select Number, Mfr_Name, Mfr_Number, Mfr_Status, Mfr_Code, 0 From Bom_List Where atMfrNum = atFileNum;", m_excel
          m_excel.SetStyle2

          m_excel.CurrentWorkSheet = "Sheet2"
          m_excel.SetStyle1 "Removed", 24, 27, 27, 7, 17, 5
          m_excel.WriteRaw "Item Number|MFR Name|MFR Part Number|Status|Manufacturer Code|File"
          m_database.Execute "Select Number, Mfr_Name, Mfr_Number, Mfr_Status, Mfr_Code, 0 From Bom_List Where atMfrNum <> atFileNum;", m_excel
          m_excel.SetStyle2

          m_excel.CurrentWorkSheet = "Sheet3"
          m_excel.SetStyle1 "Undefine", 24, 5, 5, 0, 0, 0
          m_excel.WriteRaw "Item Number|File Id|Count"
          m_database.Execute "Select Number, File_Id, atFileNum From Bom_List Group By Number, File_Id;", m_excel
          m_excel.SetStyle2

          Dim fileName, now1, fd, outPath

          now1 = Now
          fileName = CStr(Year(now1)) & "_" & MonthName(Month(now1), True)
          fileName = fileName & "_" & CStr(Day(now1)) & "_" & CStr(Hour(now1))
          fileName = fileName & CStr(Minute(now1)) & CStr(Second(now1))

          outPath = FileIO.BuildPath(m_app_path, "Output")
          If Not FileIO.FolderExists(outPath) Then
            FileIO.CreateFolder outPath
          End If

          Set fd = FileIO.GetFolder(outPath)
          fileName = fileName & "_" & CStr(fd.Files.Count + 1)
          Set fd = Nothing

          m_excel.SaveAs FileIO.BuildPath(outPath, fileName)
          m_excel.Close
        End Function

        Public Function Quit
          If m_primal_error_id <> ERR_NO_ERROR Then
            WSH.echo "错误码:" & Hex(m_primal_error_id), "细节错误码:" & Hex(m_internal_error_id)
          End If
          Quit = m_primal_error_id
        End Function
      End Class

      Class UserInfo
        Private m_ArrayNames()
        Private m_ArrayIds()
        Private m_TxtData

        Private Sub Class_Initialize
          Dim aryTxt
          Dim szIdNm
          Dim aryIdNms
          Dim aryLen
          Dim i

          m_TxtData = GetResource("Names_ofID")
          m_TxtData = Replace(m_TxtData, vbTab, "")
          aryTxt = Split(m_TxtData, vbCrLf)

          aryLen = Ubound(aryTxt)
          If aryLen > 0 Then
            ReDim m_ArrayNames(aryLen)
            ReDim m_ArrayIds(aryLen)

            for i = 0 to aryLen
              szIdNm = aryTxt(i)
              aryIdNms= Split(szIdNm,",")

              If Ubound(aryIdNms)  = 1 Then
                m_ArrayIds(i) = aryIdNms(0)
                m_ArrayNames(i) = aryIdNms(1)
              End If
            Next
          Else
            m_ArrayNames = Array(0)
            m_ArrayIds = Array(0)
          End If
        End Sub

        Public Function GetUserNameByID(v)
          Dim i

          for i = 0 to Ubound(m_ArrayIds)
            If m_ArrayIds(i) = v Then
              GetUserNameByID = m_ArrayNames(i)
              Exit Function
            End If
          Next
          GetUserNameByID = m_ArrayIds(0)'"N/A"
        End Function

        Public Function GetIDByUserName(v)
          Dim i

          for i = 0 to Ubound(m_ArrayNames)
            If m_ArrayNames(i) = v Then
              GetIDByUserName = m_ArrayIds(i)
              Exit Function
            End If
          Next
          GetIDByUserName = "N/A"
        End Function
      End Class

      Class IList
        Private m_ArrayLists()

        Private Sub Class_Initialize
          ReDim m_ArrayLists(0)
          Set m_ArrayLists(0) = Nothing
        End Sub

        Private Sub Class_Terminate
          Erase m_ArrayLists
        End Sub

        Public Sub Add(v)
          Dim ArrayUBound

          ArrayUBound = Ubound(m_ArrayLists)
          If Not m_ArrayLists(0) Is Nothing Then
            ArrayUBound = ArrayUBound + 1
            ReDim Preserve m_ArrayLists(ArrayUBound)
          End If
          Set m_ArrayLists(ArrayUBound) = v
        End Sub

        Public Sub Clear()
          Erase m_ArrayLists
          Call Class_Initialize
        End Sub

        Public Property  Get Count
          If Not m_ArrayLists(0) Is Nothing Then
            Count = Ubound(m_ArrayLists) + 1
          Else
            Count = 0
          End If
        End Property

        Public Default Property Get Items(Index)
          If Index >=0 And Index <= Ubound(m_ArrayLists) Then
            Set Items  = m_ArrayLists(Index)
            Exit Property
          Else
            Err.Raise 9
          End If
          Set Items = Nothing
        End Property
      End Class
    ]]>
    </script>
  </job>
</package>