用到了第三方工具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 [email protected]
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>
