2018年1月5日 星期五

VB.NET 利用登錄檔,紀錄程式使用次數

參考資料1:[VB6][VBA][C#][JAVA] 製作簡易 時間/次數 測試版 試用版
參考資料2:讀取和寫入登錄 (Visual Basic)
或者搜尋Computer.Registry

Step 1. 畫面上建立三個Button,分別是Button1、Button2、Button3,Button1屬性Name為「點我 增加使用次數」、Button2屬性Name為「刪除使用次數」、Button3屬性Name為「完整刪除」,建議先看一下參考資料2

Code 如下

Public Class Form1

    '點我 增加使用次數
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        '開啟TEST_Company1\TestAPP01
        Dim regVersion = My.Computer.Registry.CurrentUser.OpenSubKey("TEST_Company1\TestAPP01", True)

        If regVersion Is Nothing Then
            '假如不存在,就在HKEY_CURRENT_USER底下,建立TEST_Company1\TestAPP01
            '這裡TEST_Company1\TestAPP01,有點像是電腦中的資料夾路徑的概念,程式會幫我們儲存在登錄檔的HKEY_CURRENT_USER底下,並建立TEST_Company1\TestAPP01
            regVersion = My.Computer.Registry.CurrentUser.CreateSubKey(
                         "TEST_Company1\TestAPP01") ' Key doesn't exist; create it.
        End If

        Dim int_usage_count As Integer = 0
        If regVersion IsNot Nothing Then
            int_usage_count = regVersion.GetValue("usage_count", 0)
            int_usage_count = int_usage_count + 1
            regVersion.SetValue("usage_count", int_usage_count)
            regVersion.Close()

            MsgBox("使用次數" & int_usage_count)
        End If

    End Sub

    '刪除使用次數
    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        '開啟TEST_Company1\TestAPP01
        Dim regVersion = My.Computer.Registry.CurrentUser.OpenSubKey("TEST_Company1\TestAPP01", True)

        If Not regVersion Is Nothing Then
            '假如存在
            If regVersion IsNot Nothing Then
                regVersion.DeleteValue("usage_count")
                regVersion.Close()
                MsgBox("刪除完成")
            End If
        End If

    End Sub

    '完整刪除
    Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
        '開啟TEST_Company1
        Dim regVersion = My.Computer.Registry.CurrentUser.OpenSubKey("TEST_Company1", True)

        If Not regVersion Is Nothing Then
            '假如存在,就整個刪除
            My.Computer.Registry.CurrentUser.DeleteSubKeyTree("TEST_Company1")

            '假如只要刪除TestAPP01底下的資料,可以使用以下程式碼刪除
            'My.Computer.Registry.CurrentUser.DeleteSubKey("TEST_Company1\TestAPP01")

            regVersion.Close()
            MsgBox("全部刪除完成")
        End If
    End Sub
End Class

Step 2.執行程式完後,可以開啟「登入編輯程式」(開始>搜尋程式及檔案>輸入regedit)


2017年12月29日 星期五

VB.NET 檔案是否被鎖定

  在和朋友聊到他寫的程式,有些使用者反應程式沒有正常執行(好像停擺了),和朋友討論著有哪些原因會造成程式無法正常執行,其中討論到會不會是檔案還在建立中還沒有完成,結果程式去搬移了檔案或複製檔案發生例外錯誤,導致程式無法正常運作。
  我和朋友把這個原因,納入是程式無法正常執行的原因,開始上網搜尋資料,找到以下幾篇參考資料,自己先作個陽春版的程式,實作先檢查檔案是否存在,再檢查檔案是否可以正常讀取檔案,如果不能讀取就表示檔案已被鎖定(Lock)。


參考資料1:[C#]如何偵測特定檔案是否為Lock狀態
參考資料2:can't check in file : file is open by another application
參考資料3:VB.NET Checking if a File is Open before proceeding with a Read/Write?

說明

首先拉個陽春的畫面,畫面上放上2個TextBox、1個Button,TextBox1的作用是自己填上完整的檔案路徑、TextBox2顯示執行過程訊息(其屬性設定為ScrollBars=Vertical、Multiline=True),Button1為執行按鈕。

P.S 因為是陽春測試的小程式,所以沒有防呆,在測試時路徑要填寫完整(例如:D:\test.mp4),不要填錯了。

程式碼

Imports System.IO
Imports System.Runtime.InteropServices

Public Class Form1

    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        Dim str_thispath As String = String.Empty '完整檔案路徑
        str_thispath = TextBox1.Text
        TextBox2.Text = ""
        If File.Exists(str_thispath) Then
            IsFileOpen(str_thispath)
        Else
            TextBox2.Text = "檔案不存在:" & Date.Now.ToString("yyyy/MM/dd HH:mm:ss.fffffff") & " 結束執行。" & vbNewLine & TextBox2.Text
        End If
        TextBox2.Text = "系統於 " & Date.Now.ToString("yyyy/MM/dd HH:mm:ss.fffffff") & " 結束執行。" & vbNewLine & TextBox2.Text
    End Sub

    Function IsFileOpen(ByVal str_thispath As String) As Boolean
        Dim stream As FileStream = Nothing
        Try
            stream = File.Open(str_thispath, FileMode.Open, FileAccess.ReadWrite, FileShare.None)
            stream.Close()
            TextBox2.Text = "檔案可開啟:" & Date.Now.ToString("yyyy/MM/dd HH:mm:ss.fffffff") & " " & vbNewLine & TextBox2.Text
        Catch ex As Exception

            If TypeOf ex Is IOException AndAlso IsFileLocked(ex) Then
                TextBox2.Text = "發生例外錯誤:原因可能檔案正在使用中已上鎖..." & Date.Now.ToString("yyyy/MM/dd HH:mm:ss.fffffff") & " " & vbNewLine & TextBox2.Text
                Return True
            End If
        End Try
        Return False
    End Function

    Function IsFileLocked(exception As Exception) As Boolean
        Dim ERROR_SHARING_VIOLATION As Integer = 32, ERROR_LOCK_VIOLATION As Integer = 33
        Dim errorCode As Integer = Marshal.GetHRForException(exception) And ((1 << 16) - 1)
        Return errorCode = ERROR_SHARING_VIOLATION OrElse errorCode = ERROR_LOCK_VIOLATION
    End Function

End Class

2017年11月11日 星期六

ASP.NET[VB語法] 初次使用NLog

初次使用NLog,來記錄專案的Log檔,方便追中問題的結果。

圖片太小看不到,請自己另存圖片。


程式碼:
Imports NLog

Partial Class Default_TEST_Nlog
    Inherits System.Web.UI.Page

    Private Sub Default_TEST_Nlog_Load(sender As Object, e As EventArgs) Handles Me.Load
        If Not Page.IsPostBack Then
            Dim logger As Logger = Nothing
            logger = NLog.LogManager.GetCurrentClassLogger()
            logger.Debug("這裡是Page_Load")
        End If
    End Sub

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Dim logger As Logger = Nothing
        logger = NLog.LogManager.GetCurrentClassLogger()
        logger.Info("Button1_Click")
        logger.Trace("我是Trace")
        logger.Debug("我是Debug")
        logger.Info("我是Info")
        logger.Warn("我是Warn")
        logger.Error("我是Error")
        logger.Fatal("我是Fatal")
    End Sub

End Class

補充:
2017/11/14
如果想要以每個月來記錄Log檔,你可以修改NLog.config這個檔案。先找到這一行,如下:
 <target xsi:type="File" name="f" fileName="${basedir}/logs/${shortdate}.log" layout="${longdate} ${uppercase:${level}} ${message}" />
將 fileName 的${shortdate}.log 改為 ${date:format=yyyy-MM}.log,這樣就會把每一天的log記錄在當月份的log檔。
改完如下:
<target xsi:type="File" name="f" fileName="${basedir}/logs/${date:format=yyyy-MM}.log" layout="${longdate} ${uppercase:${level}} ${message}" />

2017年9月17日 星期日

ASP.NET FileUpload.PostedFile.InputStream + MemoryStream儲存檔案

參考資料1:How to Save the MemoryStream as a file in c# and VB.Net

Web.config
<?xml version="1.0"?>
<configuration>
    <!--這裡自己加入appSettings標籤以及FileUpload_path1-->
    <appSettings>
      <add key="FileUpload_path1" value="~/FileUpload/File1/" />
    </appSettings>
    ....
</configuration>

Default.aspx
<%@ Page Language="VB" AutoEventWireup="false" CodeFile="Default.aspx.vb" Inherits="_Default" %>

<!DOCTYPE html>

<html xmlns="http://www.w3.org/1999/xhtml">
<head runat="server">
    <title></title>
</head>
<body>
    <form id="form1" runat="server">
    <div>
        使用FileUpload.PostedFile.InputStream + MemoryStream儲存檔案<br/>
        <asp:FileUpload ID="FileUpload2" runat="server" />
        <asp:Button ID="Button2" runat="server" Text="Start Upload2" />
        <br/>
        <asp:Label ID="Label2" runat="server"></asp:Label>
    </div>
    </form>
</body>
</html>

Default.aspx.vb
Imports System.IO
Imports System.Web.Configuration

Partial Class _Default
    Inherits System.Web.UI.Page

    Function EnMD5(ByVal EnString As String, Optional ByVal substring_startIndex As Integer = 8, Optional ByVal select_length As Integer = 16) As String
        Dim str_En As String = Nothing
        If select_length = 16 Then
            str_En = System.Web.Security.FormsAuthentication.HashPasswordForStoringInConfigFile(EnString, "MD5").ToLower().Substring(substring_startIndex, select_length)
        ElseIf select_length = 32 Then
            str_En = System.Web.Security.FormsAuthentication.HashPasswordForStoringInConfigFile(EnString, "MD5").ToLower()
        Else
            str_En = "0"
        End If
        Return str_En
    End Function

    Protected Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        If Not FileUpload2.PostedFile Is Nothing Then
            Try
                If FileUpload2.HasFile And FileUpload2.PostedFile.ContentLength > 0 Then
                    Dim filetype As String = Nothing
                    Dim bool_by As Boolean = True
                    Dim str_DirPath As String = String.Empty
                    If (Not WebConfigurationManager.AppSettings("FileUpload_path1") Is Nothing) Then

                        str_DirPath = Server.MapPath(WebConfigurationManager.AppSettings("FileUpload_path1").ToString())
                        If Directory.Exists(str_DirPath) = False Then '檢查目錄存不存在
                            '不存在就建立資料夾
                            Directory.CreateDirectory(str_DirPath)
                        End If
                        '====================================
                        Dim s As Stream = FileUpload2.PostedFile.InputStream
                        Dim file_bytes(s.Length - 1) As Byte
                        s.Read(file_bytes, 0, s.Length)

                        Dim header As String = Hex(file_bytes(0)) & Hex(file_bytes(1)) & Hex(file_bytes(2)) & Hex(file_bytes(3))
                        '檢查檔案格式
                        Select Case header
                            Case "FFD8FFE0" '*.jfif *.jpe *.jpeg *.jpg
                                '假如是用小畫家製作的圖或另存的圖檔,header值會是FFD8FFE0,但如果是其他方式產生的jpg圖檔最後一碼會變動
                                filetype = "jpg"
                            Case "25504446"
                                filetype = "pdf"
                            Case "D0CF11E0"
                                filetype = "doc"
                            Case "504B34"
                                filetype = "docx"
                            Case Else
                                bool_by = False
                        End Select
                        '=====================================
                        If bool_by = True Then
                            '====================================
                            Dim myFileName As String
                            myFileName = FileUpload2.PostedFile.FileName
                            Dim c As String = String.Empty  '取得檔案及副檔名System.IO.Path.GetFileName(myFileName)
                            filetype = myFileName.Substring(myFileName.LastIndexOf(".") + 1)

                            '=========================================
                            Dim str_temp_fn As String = String.Empty
                            '用MD5來作檔案名稱
                            str_temp_fn = EnMD5("FU_PATH1_" & Date.Now.ToString("yyyyMMddHHmmssffff"), select_length:=32)
                            Dim Uploadfile As String = String.Empty
                            '重新命名
                            c = str_temp_fn & "." & filetype 'MD5命名
                            Uploadfile = str_DirPath & c
                            Dim myfilecount As Integer = 1
                            '檢查檔名是否有重複
                            While (System.IO.File.Exists(Uploadfile))
                                '有重複的檔案從2開始
                                myfilecount = myfilecount + 1
                                c = str_temp_fn & myfilecount & "." & filetype  'MD5命名 + 第幾個檔案
                                Uploadfile = str_DirPath & c '重新命名並加上副檔名
                            End While
                            '==========================================
                            Dim ms As New MemoryStream(file_bytes)
                            Dim fs2 As New FileStream(Uploadfile, FileMode.Create, FileAccess.Write)
                            ms.WriteTo(fs2)
                            fs2.Close()
                            ms.Close()
                            '==========================================
                            Label2.Text = Uploadfile
                        Else
                            Label2.Text = "檔案格式不符"
                        End If
                        s.Close()
                        s.Dispose() '釋放所有資源要在最後執行,否則即使存檔也無效

                    End If
                Else
                    Label2.Text = "請選擇檔案"
                End If
            Catch ex As Exception
                Label2.Text = ex.ToString
            End Try
        Else
            Label2.Text = "請選擇檔案"
        End If
    End Sub
End Class

2017年7月29日 星期六

ASP.NET 多檔上傳,加上移除檔案按鈕

參考資料:JAVASCRIPT - W3C DOM簡介

繼上一篇「ASP.NET 利用JavaScript達到多檔上傳」,這次我想在每個檔案上傳的地方個別再加上移除檔案的按鈕,除了第一個檔案上傳之外,當我不要這個檔案的時候,我就可以移除我不要的檔案。

執行結果

Step 1.請在另外建立一個aspx檔案,檔名為test_multi-file_fileupload2.aspx,程式碼如下:

紅色的字是我而外加上去的,橘色的底是我有修改過的地方,請先看前一篇的作法。

<%@ Page Language="VB" AutoEventWireup="false" CodeFile="test_multi-file_fileupload2.aspx.vb" Inherits="test_multi_file_fileupload2" %>

<!DOCTYPE html>

<html xmlns="http://www.w3.org/1999/xhtml">
<head runat="server">
    <title></title>
    <script type="text/javascript">

        function addFileUploadBox() {
            if (!document.getElementById || !document.createElement) {
                return false;
            };
            //取得id叫作upload-area元素
            var uploadArea = document.getElementById('upload-area');
            if (!uploadArea) {
                return false;
            };
            //建立br元素(在Html中叫作換行)
            var newLine = document.createElement('br');
            //在upload-area中加入換行
            uploadArea.appendChild(newLine);
            //建立input元素
            var newUploadBox = document.createElement('input');
            newUploadBox.type = 'file'; //input的類型為file檔案類型
            newUploadBox.size = '40';
            if (!addFileUploadBox.lastAssignedId) {
                addFileUploadBox.lastAssignedId = 1;
            };
            //設定input的id、name
            newUploadBox.setAttribute('id', 'FileF' + addFileUploadBox.lastAssignedId);
            newUploadBox.setAttribute('name', 'FileF:' + addFileUploadBox.lastAssignedId);
            uploadArea.appendChild(newUploadBox);
            //=======================
            //建立input元素-移除檔案 按鈕
            var newBRF = document.createElement('input');
            newBRF.setAttribute('type', 'button');
            newBRF.setAttribute('value', '移除檔案');
            newBRF.setAttribute('onclick', 'RemoveFile(' + addFileUploadBox.lastAssignedId + ');');
            //設定input按鈕的id、name
            newBRF.setAttribute('id', 'BRF' + addFileUploadBox.lastAssignedId);
            newBRF.setAttribute('name', 'BRF:' + addFileUploadBox.lastAssignedId);
            uploadArea.appendChild(newBRF);
            //=======================
            addFileUploadBox.lastAssignedId++;
        };
        function RemoveFile(tempid) {
            var uploadArea = document.getElementById('upload-area');
            if (!uploadArea) {
                return false;
            };
            //利用id取得file元素
            var UploadBox = document.getElementById('FileF' + tempid); 
            var preItem = prevSib(UploadBox); //尋找type=File的上一個節點,也就是br元素
            if (preItem != null) {
                //有找到就不等於null,代表有找到br
                uploadArea.removeChild(preItem);
            };
            //利用id取得button元素
            var BRF = document.getElementById('BRF' + tempid); 
            uploadArea.removeChild(UploadBox); //移除file
            uploadArea.removeChild(BRF); //移除button
        };
        //此處參考http://blog.kkbruce.net/2012/02/javascript-w3c-dom.html#.WXViWISGOUm
        function prevSib(node) {
            var tempFirst = node.parentNode.firstChild; //取得node的第一個節點
            if (node == tempFirst) { //是否為第一個節點
                return null;
            }
            var tempObj = node.previousSibling; //非第一個,可往上找上一個Node
            while (tempObj.nodeType != 1 && tempObj.previousSibling != null) //nodeType不是元素節點且不是第一個,即找到元素節點為止
                tempObj = tempObj.previousSibling; //往上找上一個
            return (tempObj.nodeType == 1) ? tempObj : null; //如果是元素節點,傳回節點本身,否則傳回null
        };
    </script>
</head>
<body>
    <form id="form1" runat="server">
    <div>
        <h1>測試多檔上傳,加上移除檔案按鈕</h1>
        附加檔案:<br/>
        <p id="upload-area">
            <input id="FileField" type="File" runat="server" size="40" />
        </p>
        <input id="ButtonAdd" type="button" value="繼續附加" onclick="addFileUploadBox();" />&nbsp;&nbsp;
        <asp:Button ID="Button1" runat="server" Text="開始上傳" /><span style=" color:red;">檔案附加不可超過10MB</span><br/>
        <asp:Label ID="Send_msg" runat="server"></asp:Label>
    </div>
    </form>
</body>
</html>

Step 2.後置程式碼一樣沒有變,請自行參考前一篇。

2017年7月22日 星期六

ASP.NET 利用JavaScript達到多檔上傳

這是大學時期的畢業專題,曾經寫過的一個「多檔上傳」的功能,參考國外的文章,至於那篇文章,我也沒特別留下來,今天特別找出來記錄,以防哪一天需要用的時候就可以使用,這也是大學時期對一個剛學程式的學生來講,特別有成就感的一個功能;在這裡還是要提一下檔案上傳可能會影響的資安問題(ASP.NET FileUpload上傳檔案,讀取Byte檢查副檔名,以圖片為例)。

執行結果

Step 1.先設定Web.config
<configuration>
    <system.web>
      <compilation debug="true" strict="false" explicit="true" targetFramework="4.0" />
      <!-- 可修改maxRequestLength的值來改變上傳限制,單位為K,4096=4MB,15360=15MB -->
      <httpRuntime maxRequestLength="15360"/>
    </system.web>
</configuration>

Step 2.test_multi-file_fileupload.aspx
<%@ Page Language="VB" AutoEventWireup="false" CodeFile="test_multi-file_fileupload.aspx.vb" Inherits="test_multi_file_fileupload" %>
<!DOCTYPE html>
<html xmlns="http://www.w3.org/1999/xhtml">
<head runat="server">
    <title></title>
    <script type="text/javascript">
        function addFileUploadBox() {
            if (!document.getElementById || !document.createElement) {
                return false;
            };
            //取得id叫作upload-area元素
            var uploadArea = document.getElementById('upload-area');
            if (!uploadArea) {
                return false;
            };
            //建立br元素(在Html中叫作換行)
            var newLine = document.createElement('br');
            //在upload-area中加入換行
            uploadArea.appendChild(newLine);
            //建立input元素
            var newUploadBox = document.createElement('input');
            newUploadBox.type = 'file'; //input的類型為file檔案類型
            newUploadBox.size = '40';
            if (!addFileUploadBox.lastAssignedId) {
                addFileUploadBox.lastAssignedId = 100;
            };
            //設定input的id、name
            newUploadBox.setAttribute('id', 'FileF' + addFileUploadBox.lastAssignedId);
            newUploadBox.setAttribute('name', 'FileF:' + addFileUploadBox.lastAssignedId);
            uploadArea.appendChild(newUploadBox);
            addFileUploadBox.lastAssignedId++;
        };
    </script>
</head>
<body>
    <form id="form1" runat="server">
    <div>
        <h1>測試多檔上傳</h1>
        附加檔案:<br/>
        <p id="upload-area">
            <input id="FileField" type="File" runat="server" size="40" />
        </p>
        <input id="ButtonAdd" type="button" value="繼續附加" onclick="addFileUploadBox();" />&nbsp;&nbsp;
        <asp:Button ID="Button1" runat="server" Text="開始上傳" /><span style=" color:red;">檔案附加不可超過10MB</span><br/>
        <asp:Label ID="Send_msg" runat="server"></asp:Label>
    </div>
    </form>
</body>
</html>

Step 3.test_multi-file_fileupload.aspx.vb
Imports System.IO
Partial Class test_multi_file_fileupload
    Inherits System.Web.UI.Page

    Protected Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        '======================
        Dim uploads As HttpFileCollection = Nothing
        uploads = HttpContext.Current.Request.Files
        Dim FileToUpload As HttpPostedFile = Nothing
        '======================
        '計算全部附加檔案的大小
        Dim x_KB As Integer = 0, x_Byte As Integer = 0
        Dim x_MB As Double
        For i As Integer = 0 To (uploads.Count - 1)
            FileToUpload = uploads(i)
            x_Byte = x_Byte + FileToUpload.ContentLength
        Next
        x_KB = x_Byte / 1024 'Byte / 1024=KB
        x_MB = x_KB / 1024 'KB / 1024=MB
        '信件傳送不能超過或等於10MB
        If Int(x_MB) >= 10 Then '取整數
            '否則>=10MB
            '所有的附加檔案不能超過或等於10MB
            Send_msg.Text = "注意:所有的附加檔案加起來不能超過或等於10MB"
            Send_msg.ForeColor = Drawing.Color.Red
            Exit Sub
        End If
        '======================
        Dim us_f As UShort = 0 '檔案是否重複,重複為1,不重複0
        Dim str_FolderName As String = "File"
        Dim GEM_MSG As New StringBuilder
        Dim FilePath() As String = Nothing '存放檔案路徑
        Dim AYN As Integer = -1
        For i As Integer = 0 To (uploads.Count - 1)
            FileToUpload = uploads(i)
            ReDim Preserve FilePath(i)
            If FileToUpload.FileName <> "" Then
                AYN = AYN + 1
                '建立檔案路徑
                '第三個參數:指定看由哪一個網頁呼叫此程序,就必須在那個目錄下建立資料夾
                FilePath(i) = ServerFilePath(FileToUpload, System.IO.Path.GetFileName(FileToUpload.FileName), str_FolderName) '串聯路徑
                '===============================
                Dim FileName As String = Nothing

                If (FileToUpload.ContentLength <> 0) Then
                    'System.IO.Path.GetFileNameWithoutExtension(FileToUpload.FileName) '取檔案名稱,不包含副檔名
                    'System.IO.Path.GetExtension(FileToUpload.FileName) '取副檔名
                    '判斷檔案名稱是否有重複
                    If File.Exists(FilePath(i)) = True Then
                        Dim Uploadfile As String
                        Uploadfile = HttpContext.Current.Server.MapPath(str_FolderName) '會指定看由哪一個網頁呼叫此程序,就必須在那個目錄下建立資料夾
                        Dim Repeat_Number As Integer = 0
                        While (File.Exists(FilePath(i)))
                            Repeat_Number = Repeat_Number + 1
                            '如果存在就更改檔名
                            FileName = System.IO.Path.GetFileNameWithoutExtension(FileToUpload.FileName) & "(" & Repeat_Number & ")" &
                            System.IO.Path.GetExtension(FileToUpload.FileName)
                            FilePath(i) = Uploadfile + "\" + FileName
                        End While
                        GEM_MSG.Append("<span style=" & Chr(34) & "color:red;" & Chr(34) & ">附加檔案名稱以重複,檔案名稱修改為" & FileName)
                    Else
                        GEM_MSG.Append("<span style=" & Chr(34) & "color:blue;" & Chr(34) & ">" & System.IO.Path.GetFileName(FileToUpload.FileName))
                    End If
                End If
                Try
                    FileToUpload.SaveAs(FilePath(i))
                    GEM_MSG.Append(",附加成功</span><br />")
                Catch ex As Exception
                    GEM_MSG.Append(",附加失敗</span><br />")
                    'GEM_MSG.Append(",附加失敗" & ex.ToString & "</span><br />")
                End Try
                '===============================
            Else
                FilePath(i) = ""
            End If
            If i = uploads.Count - 1 And AYN <> -1 Then
                GEM_MSG.Append("<hr size=" & Chr(34) & "1" & Chr(34) & " />")
            End If
        Next
        Send_msg.Text = GEM_MSG.ToString
        Send_msg.ForeColor = Drawing.Color.Black

    End Sub

    '建立檔案路徑,
    Function ServerFilePath(ByVal FileToUpload As HttpPostedFile, ByVal FileName As String, ByVal Folder_name As String) As String

        Dim Uploadfile As String
        Uploadfile = HttpContext.Current.Server.MapPath(Folder_name) '會指定看由哪一個網頁呼叫此程序,就必須在那個目錄下建立資料夾
        If Directory.Exists(Uploadfile) = False Then '檢查目錄存不存在
            '不存在就建立資料夾
            Directory.CreateDirectory(Uploadfile)
        End If
        If (FileToUpload.ContentLength <> 0) Then
            Uploadfile = Uploadfile + "\" + FileName '建立檔案路徑
        Else
            Uploadfile = ""
        End If
        Return Uploadfile
    End Function
End Class



2017年7月15日 星期六

ASP.NET Word套表產生的docx檔,多檔合併


參考資料:
[Updated] How To: Merge Multiple Microsoft Word Documents | Keith Rull
主要是參考這篇資料,有範例檔

繼上一篇「ASP.NET 使用TemplateEngine.Docx套件,Word套表產生docx檔」後,假如使用者在使用的過程中,產生出很多docx檔時,總不能讓使用者一個一個套表下載吧!  因此須製作一個功能,可以讓使用者可以一次將多個docx檔合併到同一個docx檔。

Step 1.首先要將 Microsoft Word 12.0 Object Library 加入參考到自己的專案中,這個步驟應該要看自己的電腦安裝哪一種Office,有的可能找不到12.0 Object Library,那就用其他版本試試看或者是使用Microsoft.Office.Interop.Word.dll檔加入參考。

Step 2.請在自己的專案中建立3個資料夾,分別是news_merge_word、temp_word、Template_Word,說明如下:
news_merge_word資料夾主要是存放已經合併完成的docx檔。
temp_word資料夾存放程式套好表的docx檔。
Template_Word資料夾只存放一個空到Word檔,你可以想像這個Word檔是將多的docx檔存放到同一個docx檔,這個空的word檔檔名為 normal.docx,你可以先設定好normal.docx上下左右的邊界,當多個docx檔合併到normal.docx時,會依照normal.docx的邊界下去合併。

Step 3.建立一個aspx網頁,畫面上只需要一個Button1按鈕,並在這個按鈕上建立Click事件。
以下為程式碼,程式碼的部分我是參考上方的參考資料
Imports System
Imports Word = Microsoft.Office.Interop.Word

Partial Class test_word_multi_file_merge
    Inherits System.Web.UI.Page

    Protected Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Dim str_path As String = String.Empty
        '假設陣列中,是已經透過程式word套表,產生出的docx檔
        Dim str_arrfile() As String = {Server.MapPath("~/temp_word/word1.docx"), Server.MapPath("~/temp_word/word2.docx"), Server.MapPath("~/temp_word/word3.docx")}

        '第二個參數是將合併後的word檔,給予新的檔案名稱、第三個參數是否要有分頁符號
        Merge(str_arrfile, Server.MapPath("~/news_merge_word/new_merge_word_" & Date.Now.ToString("yyyyMMddHHmmss") & ".docx"), True, Page)
    End Sub

    Sub Merge(ByVal filesToMerge As String(), ByVal outputFilename As String, ByVal insertPageBreaks As Boolean, ByVal this_page As Page)
        'normal.docx檔(可以針對normal.docx先設定好邊界)是空白的word檔,可以把它想像成,把多個word檔合併到normal.docx;
        Merge(filesToMerge, outputFilename, insertPageBreaks, Server.MapPath("~/Template_Word/normal.docx"))
    End Sub


    Sub Merge(ByVal filesToMerge As String(), ByVal outputFilename As String, ByVal insertPageBreaks As Boolean, ByVal documentTemplate As String)
        Dim defaultTemplate As Object = documentTemplate
        Dim pageBreak As Object = Word.WdBreakType.wdPageBreak
        Dim outputFile As Object = outputFilename

        ' Create a new Word application
        Dim wordApplication As Word._Application = New Word.Application()

        Try
            ' Create a new file based on our template
            Dim wordDocument As Word._Document = wordApplication.Documents.Add(defaultTemplate)

            ' Make a Word selection object.
            Dim selection As Word.Selection = wordApplication.Selection

            'Count the number of documents to insert;
            Dim documentCount As Integer = filesToMerge.Length

            'A counter that signals that we shoudn't insert a page break at the end of document.
            Dim breakStop As Integer = 0

            ' Loop thru each of the Word documents
            For Each file As String In filesToMerge
                breakStop += 1
                ' Insert the files to our template
                selection.InsertFile(file)

                'Do we want page breaks added after each documents?
                If insertPageBreaks AndAlso breakStop <> documentCount Then
                    selection.InsertBreak(pageBreak) '插入分頁
                End If
            Next

            ' Save the document to it's output file.
            wordDocument.SaveAs(outputFile)

            ' Clean up!
            wordDocument = Nothing
        Catch ex As Exception
            'I didn't include a default error handler so i'm just throwing the error
            Throw ex
        Finally
            ' Finally, Close our Word application
            wordApplication.Quit()
        End Try
    End Sub

End Class