私人公開筆記本: 2015

2015年12月29日星期二

ASP.NET 加上 MS SQL IF判斷式、update指令

Protected Sub Button1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button1.Click

Dim int_sql As Integer = -1
Dim str_sql As String = String.Empty
str_sql = "if exists (select tid,cname from test_table1 where tid=@tid) " & _
" BEGIN " & _
" update test_table1 set cname=@cname where tid=@tid " & _
" END"
Using conn As New SqlConnection("Server=.;uid=test;pwd=test;Database=school")
conn.Open()
Using command As SqlCommand = New SqlCommand(str_sql, conn)
command.Parameters.AddWithValue("@tid", "2")
command.Parameters.AddWithValue("@cname", "李四")
int_sql = command.ExecuteNonQuery() '回傳影響的筆數 -1
End Using
conn.Close()
End Using
Response.Write(int_sql)
End Sub

2015年12月25日星期五

ASP.NET TextBox 加上 jquery autocomplete(自動完成)

參考資料：AutoComplete using JQuery Ajax and Asp.Net WCF Service–C# and Vb.Net

本篇參考以上資料，並作部分修改。

結果：

A.aspx

<html xmlns="http://www.w3.org/1999/xhtml">
<head runat="server">
    <title>jquery autocomplete</title>
    <link rel="stylesheet" href="themes/base/jquery.ui.all.css">
    <script type="text/javascript" src="Scripts/jquery-1.8.2.min.js"></script>
    <script type="text/javascript" src="ui/jquery.ui.core.js"></script>
 <script type="text/javascript" src="ui/jquery.ui.widget.js"></script>
 <script type="text/javascript" src="ui/jquery.ui.position.js"></script>
 <script type="text/javascript" src="ui/jquery.ui.menu.js"></script>
 <script type="text/javascript" src="ui/jquery.ui.autocomplete.js"></script>
    <script type="text/javascript">
         $(function () {
             $("#TextBox1").autocomplete({
                 source: function (request, response) {
                     var val = request.term;
                     $.ajax({
                         url: 'loadData.aspx', method: 'post', dataType: 'json',
                         data: { sd: 'txtaut', p1: val },
                         error: function (XMLHttpRequest, textStatus, errorThrown) {
                             if ((XMLHttpRequest.status == 0) || (textStatus == 'error')) {
                                 alert('執行時發生錯誤\n請重新執行'); 
                             } else {
                                 alert('發生例外錯誤'); 
                                };
                         },
                         success: function (data) {
                             if (data != null) {
                                 var total = data.length;
                                 if (total > 0) {
                                     response($.map(data, function (item) {
                                         return { value: item.text };
                                     }));
                                 } else if (total == 0) {
                                     //查無資料
                                 };
                             };
                         }
                     });
                 },
                 minLength: 1    // MINIMUM 1 CHARACTER TO START WITH.
             });
         });
 </script>
</head>
<body>
    <form id="form1" runat="server">
    <div>
    jquery autocomplete TextBox自動完成<br/>
        <asp:TextBox ID="TextBox1" runat="server"></asp:TextBox>
        <asp:Button ID="Button1" runat="server" Text="送出" />
    </div>
    </form>
</body>
</html>

loadData.aspx

<%@ Page Language="vb" AutoEventWireup="false" CodeBehind="loadData.aspx.vb" Inherits="WebApplication1.loadData" %>

loadData.aspx.vb

Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
 If Not Page.IsPostBack Then
  If (Not Request("sd") Is Nothing) Then
   Dim sd() As String = Request("sd").ToString.Split(";")
   Dim str_data As StringBuilder = Nothing

   If sd(0).Equals("txtaut") = True Then
    If Not Request("p1") Is Nothing Then
     str_data = New StringBuilder()
     Dim str_sql As String = String.Empty
     str_sql = "select rtrim(cname) as text from test_staff where cname like @cname+'%'"
     Dim ds As New DataSet()
     Using conn As New SqlConnection("Server=.;uid=test;pwd=test;Database=temp_db")
      Using command As SqlCommand = New SqlCommand(str_sql, conn)
       '避免 SQL Injection（資料隱碼）攻擊
       If command.Parameters.Contains("@cname") Then
        command.Parameters("@cname").Value = Request("p1").ToString
       Else
        command.Parameters.AddWithValue("@cname", Request("p1").ToString) '讓ADO.NET自行判斷型別轉換
       End If
       
       Using da As New SqlDataAdapter()
        da.SelectCommand = command
        da.Fill(ds)
       End Using
      End Using
     End Using
     str_data.Append(JsonConvert.SerializeObject(ds.Tables(0), Formatting.Indented))
     Response.Write(str_data.ToString)
    Else
     Response.Write("[]")
    End If
   Else
    Response.Write("[]")
   End If

  Else
   Response.Write("[]")
  End If
 End If
End Sub

ASP.NET DropDownList 加上 jquery chosen，送出後保留原本的值

aspx

<html xmlns="http://www.w3.org/1999/xhtml">
<head runat="server">
    <title></title>
    <link rel="stylesheet" href="css/chosen.css">
    <!--JQuery使用v1.8.2-->
    <script type="text/javascript" src="Scripts/jquery.js"></script>
    <script type="text/javascript" src="Scripts/chosen.jquery.js"></script>
    <script type="text/javascript" src="docsupport/prism.js" charset="utf-8"></script>
    <script type="text/javascript">
        $(document).ready(function () {
            var config = {
                '.chosen-select': {},
                '.chosen-select-deselect': { allow_single_deselect: true },
                '.chosen-select-no-single': { disable_search_threshold: 10 },
                '.chosen-select-no-results': { no_results_text: 'Oops, nothing found!' },
                '.chosen-select-width': { width: "95%" }
            };
            for (var selector in config) {
                $(selector).chosen(config[selector]);
            };
            //$('.chosen-select').chosen().change(function (event) {
            $('#<%=DropDownList1.ClientID %>[class="chosen-select"]').chosen().change(function (event) {
                var strval = $(this).val();
                if (strval == null) { $('#<%=HF_DDL1.ClientID %>').val(''); } else { $('#HF_DDL1').val(strval); };
            });
        });
    </script>
</head>
<body>
    <form id="form1" runat="server">
    <div>
    以下為範例<br/>
          <select data-placeholder="Your Favorite Types of Bear" multiple class="chosen-select" style="width:350px;" tabindex="18" id="multiple-label-example">
            <option value=""></option>
            <option>American Black Bear</option>
            <option>Asiatic Black Bear</option>
            <option selected>Brown Bear</option>
            <option>Giant Panda</option>
            <option>Sloth Bear</option>
            <option>Sun Bear</option>
            <option>Polar Bear</option>
            <option>Spectacled Bear</option>
          </select>
          <br/>
          <br/>
        <asp:DropDownList ID="DropDownList1" runat="server" Width="80%"
              CssClass="chosen-select" >
        </asp:DropDownList>
        <asp:HiddenField ID="HF_DDL1" runat="server" />
        <asp:Button ID="Button1" runat="server" Text="送出" />
    </div>
    </form>
</body>
</html>

aspx.vb

    Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        If Not Page.IsPostBack Then
            Dim str_sql As String = String.Empty
            str_sql = "select id_no+'-'+rtrim(cname) as html_text,id_no as val from test_staff"
            Dim ds As New DataSet()
            Using conn As New SqlConnection("Server=.;uid=test;pwd=test;Database=temp_db")
                Using command As SqlCommand = New SqlCommand(str_sql, conn)
                    Using da As New SqlDataAdapter()
                        da.SelectCommand = command
                        da.Fill(ds)
                    End Using
                End Using
            End Using

            DropDownList1.DataTextField = "html_text"
            DropDownList1.DataValueField = "val"
            DropDownList1.DataSource = ds.Tables(0)
            DropDownList1.DataBind()

            DropDownList1.Attributes.Add("data-placeholder", "請選擇學生")
            DropDownList1.Attributes.Add("multiple", "")
        End If
    End Sub

    Protected Sub Button1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button1.Click
        Dim str_js As StringBuilder = New StringBuilder()
        str_js.Append("$(document).ready(function () {")
        str_js.Append("var HF_val=$('#" & HF_DDL1.ClientID & "').val();")
        str_js.Append("if (HF_val!=''){")
        str_js.Append("$.each(HF_val.split(','),function (index,value) {")
        str_js.Append("$('#" & DropDownList1.ClientID & " option[value=" & Chr(34) & "' + value + '" & Chr(34) & "]').prop('selected', true);")
        str_js.Append("});")
        str_js.Append("$('#" & DropDownList1.ClientID & "[class=" & Chr(34) & "chosen-select" & Chr(34) & "]').trigger('" & "chosen:updated" & "');")
        str_js.Append("};")
        str_js.Append("});")
        WJS2(str_js.ToString, Page, "js1")
    End Sub

    Public Sub WJS2(ByVal str_js As String, ByVal Pa As System.Web.UI.Page, ByVal str_js_name As String)
        If ScriptManager.GetCurrent(Pa) Is Nothing Then
            '未啟用asp.net ajax功能
            '有些情況下會需要以動態的方式加入用戶端指令碼。 若要動態加入指令碼，請使用 RegisterClientScriptBlock 方法、RegisterClientScriptInclude 方法、RegisterStartupScript 方法或 RegisterOnSubmitStatement 方法，視您要加入指令碼的時間和方式而定。
            '最後面插入JS程式碼
            Pa.ClientScript.RegisterStartupScript(Me.GetType(), str_js_name, str_js.ToString, True)
        Else
            '啟用asp.net ajax功能
            ScriptManager.RegisterStartupScript(Pa, Me.GetType(), str_js_name, str_js.ToString, True)
        End If
    End Sub

2015年10月27日星期二

VB.NET 建立自己的錯誤紀錄檔

Imports System.IO
Public Class TEST1

    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        Dim plog As String = Application.StartupPath & "\sqlexe_error\"
        Dim fileName As String = plog & "err" & DateTime.Now.ToString("yyyy-MM-dd_HHmmssff") & ".txt"

        '判斷是否有記錄檔資料夾
        If Directory.Exists(plog) = False Then
            Directory.CreateDirectory(plog)
        End If

        Try
            '紀錄瀏覽選擇的路徑
            Dim sw As StreamWriter = New StreamWriter(fileName)
            sw.WriteLine("錯誤測試")
            sw.Write("建檔日期：")
            sw.WriteLine(DateTime.Now)
            sw.Close()
            sw.Dispose()
        Catch ex As Exception
            MsgBox("發生錯誤")
        End Try

    End Sub

End Class

2015年7月28日星期二

ASP.NET 由於該物件目前的狀態，導致作業無效。

參考資料：ASP.NET 發現重大資安弱點影響範圍涵蓋 ASP.NET 1.1 ~ 4.0

我碰到這個問題是在GridView顯示大量資料時，當我點擊GridView中的按鈕，就會發生(由於該物件目前的狀態，導致作業無效)這個錯誤。要解決這個問題，可以在web.config檔中，在<appSettings>...</appSettings>之間加上aspnet:MaxHttpCollectionKeys就可以解決這個問題，如下：

<appSettings> 
  <add key="aspnet:MaxHttpCollectionKeys" value="2000" /> 
</appSettings>

但是這樣還是會有問題(我想)，就是當使用者因為查詢條件的關係，查詢出來的資料有可能又超過MaxHttpCollectionKeys的設定值，又會發生這個錯誤。所以另外一個解決的辦法，就是透過分頁再加上SQL指令的配合，就可以解決這個問題，但是方法比較麻煩ㄧ些。

以下為分頁+SQL指令範例
test_paging.aspx

<%@ Page Language="vb" AutoEventWireup="false" CodeBehind="test_paging.aspx.vb" Inherits="testdb_mssql.test_paging" %>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head runat="server">
    <title></title>
</head>
<body>
    <form id="form1" runat="server">
    <div>
        <asp:GridView ID="GridView1" runat="server">
        </asp:GridView>
        <div id="gv_p1" runat="server" style=" width:500px;">
        分頁顯示在此處
        </div>
    </div>
    </form>
</body>
</html>

test_paging.aspx.vb

Imports System.Data.SqlClient

Public Class test_paging
    Inherits System.Web.UI.Page
    Dim prows As Integer = 100 '每一頁多少筆數(此處100筆分成一頁)
    Dim this_page As Integer = 1 '目前在第幾頁
    Dim maxpage As Integer = 10 '最多顯示頁數(不變動)
    Dim showpage As Integer = 10 '最多顯示頁數
    Dim str_sql As String = String.Empty
    Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        If Not Page.IsPostBack Then
            If (Not Request("p") Is Nothing) Then
                If Regex.IsMatch(Request("p").ToString, "^\d+$") = False Then '數字會回傳true
                    '不是數字,設定回1
                    this_page = 1
                Else
                    this_page = CInt(Request("p").ToString)
                End If
            Else
                this_page = 1
            End If
            Dim dt1 As DataTable = Nothing, tot_dt As DataTable = Nothing
            Dim rows_count As Integer = 0 '資料的總筆數
            str_sql = "select TOP " & prows & " * from (" & _
            "select ROW_NUMBER() OVER(Order by t1.stud_id) as sec,t1.stud_id,t1.stud_name from Student as t1 where t1.stud_id like '401%'" & _
            ") as ta1 where ta1.sec>" & (CInt(this_page) - 1) * prows
            dt1 = queryDataTable(str_sql)
            GridView1.DataSource = dt1
            GridView1.DataBind()

            str_sql = "select count(t1.stud_id) as tot from Student as t1 where t1.stud_id like '401%'"
            tot_dt = queryDataTable(str_sql)
            If Not tot_dt Is Nothing Then
                If tot_dt.Rows.Count = 1 Then
                    rows_count = tot_dt.Rows(0).Item("tot").ToString() '資料的總筆數
                End If
                tot_dt.Clear()
                tot_dt.Dispose()
            End If
            If rows_count > 0 Then
                Dim str_temp1 As String = String.Empty
                's1開始頁數;tot_x1 全部的頁數
                Dim s1 As Integer = 1, tot_x1 As Integer = 0
                tot_x1 = Fix(rows_count / prows) '總筆數/每一頁多少筆數
                '總筆數 求餘數,餘數>0就加1頁
                If (CInt(rows_count) Mod prows) > 0 Then
                    tot_x1 = tot_x1 + 1
                End If
                '==========================
                '頁數變動
                If this_page >= 7 Then
                    If ((tot_x1 + 1) - ((this_page - 6) + 1)) >= maxpage Then
                        s1 = (this_page - 6) + 1
                        showpage = maxpage + (this_page - 6)
                    Else
                        s1 = ((this_page - 6) + 1) + (((tot_x1 + 1) - ((this_page - 6) + 1)) - maxpage)
                        showpage = tot_x1
                    End If
                Else
                    '預設
                    s1 = 1 '第一頁開始
                    showpage = maxpage '顯示的頁數
                End If
                '==========================
                Dim str_ago As String = String.Empty, str_back As String = String.Empty, str_num As String = String.Empty
                For i As Integer = s1 To tot_x1
                    str_num = CStr(i)
                    If str_num.Length = 1 Then
                        str_num = "0" & str_num
                    End If
                    If i = this_page Then
                        str_temp1 = str_temp1 & "<a style=" & Chr(34) & "text-decoration:none" & Chr(34) & ">" & str_num & "</a>&nbsp;"
                        If i > 1 Then
                            str_ago = "<a href=" & Chr(34) & "test_paging.aspx?p=" & (i - 1) & Chr(34) & " style=" & Chr(34) & "text-decoration:none" & Chr(34) & ">&lt;</a>&nbsp;"
                        End If
                        If i < tot_x1 Then
                            str_back = "<a href=" & Chr(34) & "test_paging.aspx?p=" & (i + 1) & Chr(34) & " style=" & Chr(34) & "text-decoration:none" & Chr(34) & ">&gt;</a>&nbsp;"
                        End If
                    Else
                        str_temp1 = str_temp1 & "<a href=" & Chr(34) & "test_paging.aspx?p=" & i & Chr(34) & ">" & str_num & "</a>&nbsp;"
                    End If
                    If i = showpage Then
                        Exit For
                    End If
                Next
                Me.gv_p1.InnerHtml = str_ago & str_temp1 & str_back
            Else
                Me.gv_p1.InnerHtml = ""
            End If
        End If
    End Sub

    Function queryDataTable(ByVal sql_str As String) As DataTable
        Dim ds As New DataSet()
        Using conn As New SqlConnection("Server=127.0.0.1;Database=test1;uid=test;pwd=test")
            Dim command As SqlCommand = New SqlCommand(sql_str, conn)

            Dim da As New SqlDataAdapter()
            da.SelectCommand = command

            da.Fill(ds)
        End Using
        If ds.Tables.Count > 0 Then
            Return ds.Tables(0)
        Else
            Return New DataTable()
        End If
    End Function
End Class

P.S SQL指令中的stud_id為學號，sec是自行自訂編號

ASP.NET 手寫分頁

test_paging.aspx

<%@ Page Language="vb" AutoEventWireup="false" CodeBehind="test_paging.aspx.vb" Inherits="testdb_mssql.test_paging" %>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head runat="server">
    <title></title>
</head>
<body>
    <form id="form1" runat="server">
    <div>
        <div id="gv_p1" runat="server" style=" width:500px;">
        分頁顯示在此處
        </div>
    </div>
    </form>
</body>
</html>

test_paging.aspx.vb

Public Class test_paging
    Inherits System.Web.UI.Page
    Dim this_page As Integer = 1 '目前在第幾頁
    Dim maxpage As Integer = 10 '最多顯示頁數(不變動)
    Dim showpage As Integer = 10 '最多顯示頁數

    Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        If Not Page.IsPostBack Then
            If (Not Request("p") Is Nothing) Then
                If Regex.IsMatch(Request("p").ToString, "^\d+$") = False Then '數字會回傳true
                    '不是數字,設定回1
                    this_page = 1
                Else
                    this_page = CInt(Request("p").ToString)
                End If
            Else
                this_page = 1
            End If
            Dim rows_count As Integer = 2701 '假設此變數是資料的總筆數
            Dim str_temp1 As String = String.Empty
            's1開始頁數;tot_x1 全部的頁數
            Dim s1 As Integer = 1, tot_x1 As Integer = 0
            tot_x1 = Fix(rows_count / 100) '總筆數/每一頁多少筆數
            '總筆數 求餘數,餘數>0就加1頁
            If (CInt(rows_count) Mod 100) > 0 Then
                tot_x1 = tot_x1 + 1
            End If
            '==========================
            '頁數變動
            If this_page >= 7 Then
                If ((tot_x1 + 1) - ((this_page - 6) + 1)) >= maxpage Then
                    s1 = (this_page - 6) + 1
                    showpage = maxpage + (this_page - 6)
                Else
                    s1 = ((this_page - 6) + 1) + (((tot_x1 + 1) - ((this_page - 6) + 1)) - maxpage)
                    showpage = tot_x1
                End If

            Else
                '預設
                s1 = 1 '第一頁開始
                showpage = maxpage '顯示的頁數
            End If
            '==========================
            Dim str_ago As String = String.Empty, str_back As String = String.Empty, str_num As String = String.Empty
            For i As Integer = s1 To tot_x1
                str_num = CStr(i)
                If str_num.Length = 1 Then
                    str_num = "0" & str_num
                End If
                If i = this_page Then
                    str_temp1 = str_temp1 & "<a style=" & Chr(34) & "text-decoration:none" & Chr(34) & ">" & str_num & "</a>&nbsp;"
                    If i > 1 Then
                        str_ago = "<a href=" & Chr(34) & "test_paging.aspx?p=" & (i - 1) & Chr(34) & " style=" & Chr(34) & "text-decoration:none" & Chr(34) & ">&lt;</a>&nbsp;"
                    End If
                    If i < tot_x1 Then
                        str_back = "<a href=" & Chr(34) & "test_paging.aspx?p=" & (i + 1) & Chr(34) & " style=" & Chr(34) & "text-decoration:none" & Chr(34) & ">&gt;</a>&nbsp;"
                    End If
                Else
                    str_temp1 = str_temp1 & "<a href=" & Chr(34) & "test_paging.aspx?p=" & i & Chr(34) & ">" & str_num & "</a>&nbsp;"
                End If
                If i = showpage Then
                    Exit For
                End If
            Next
            Me.gv_p1.InnerHtml = str_ago & str_temp1 & str_back
        End If
    End Sub
End Class

2015年7月11日星期六

跑跑卡丁車劇場 KOIN幣

最近朋友邀約回流回去玩跑跑卡丁車，但因跟人玩競速沒有車實在沒辦法跟上別人，所以到網路上看能不能取得比較好的車子，發現有KOIN幣，以前過劇場都沒發現，網路上也有人提供一些情報，哪些關卡可以拿KOIN，而陸續又出了很多劇場，到網路上找，好像比較少人提到，在此分享。

1.機械戰爭
正義海盜船長-第7關 7 KOIN
機械鬥士的衝擊-第6關 7 KOIN

2.WKC冠軍賽
F1 世界盃冠軍賽-第4關 3 KOIN

3.極速熱浪
熱浪馬汀的挑戰！迎向勝利！-第1關 7 KOIN
街頭極速賽車-第2關 3 KOIN

4.闇影勢力
尋找星石碎片！ -第2關 3 KOIN
闇黑勢力降臨-第2關 3 KOIN

5.奇幻精靈
奇幻精靈：精靈國度~阿克納第7關 10 KOIN

6.月不落城
永夜的繁華城市-第8關 3 KOIN

7.黃金文明
黃金文明高狄的復活-第7關 5 KOIN

8.海盜紀元
危機重重！海賊島大冒險！-第12關 3 KOIN

9.繁榮山丘大冒險
新朋友！新挑戰！-第10關 7 KOIN

P.S以上拿到後KOIN，就沒有繼續玩下去了。

---------

以下是沒有KOIN可以拿的
1.侏儸紀大冒險
2.勞迪雷諾的秘密！
3.流星睏寶
4.夢幻樂園

以上如有錯誤指正，謝謝。如有過新劇場會持續更新。

巴哈姆特參考情報：http://forum.gamer.com.tw/C.php?bsn=08936&snA=141631

2015年6月27日星期六

ASP.NET 為自己的系統建立XML檔

參考資料1：[VB.NET]XML的建立與讀取
參考資料2：VB.NET中操作xml文件(插入節點、修改、刪除)

為自己的系統建立XML檔，可以將一些系統的設定寫在XML檔中，例如：路徑、時間等；如此一來就不用因為只是為了一些設定，對資料庫建立一個資料表存取，而且倘若如果沒有資料庫，我們也可以做系統的設定。

此篇針對XML做簡單的讀取、建立、修改、刪除某一個節點，作簡單的應用。

sysconfig.xml
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<system_config>
<a1 path="C:\temp\a1\" creation_time="2015/06/28 13:38:52" />
<a1attr path="C:\temp\a1\attr\" creation_time="2015/06/28 13:38:52" />
</system_config>
Default.aspx
<%@ Page Language="vb" AutoEventWireup="false" CodeBehind="Default.aspx.vb" Inherits="WebApplication_testxml._Default" %>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" >
<head runat="server">
<title>測試xml</title>
</head>
<body>
<form id="form1" runat="server">
<div>
<asp:Button ID="Button1" runat="server" Text="建立xml" /><br/>
<asp:Button ID="Button2" runat="server" Text="讀取xml" /><br/>
<asp:Button ID="Button3" runat="server" Text="修改xml" /><br/>
<asp:Button ID="Button5" runat="server" Text="刪除某一個節點" />此處刪除a1attr子節點<br/>
<asp:Button ID="Button4" runat="server" Text="重新建立xml" />
<asp:Label ID="Label1" runat="server" ></asp:Label>
</div>
</form>
</body>
</html>
Default.aspx.vb
Imports System.Xml
Imports System.IO
Partial Public Class _Default
Inherits System.Web.UI.Page
Dim xdoc As XmlDocument
Dim str_path As String = String.Empty

Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
If Not Page.IsPostBack Then
str_path = Server.MapPath("~/xml/")
If Directory.Exists(str_path) = False Then '目錄不存在
Directory.CreateDirectory(str_path) '建立目錄
End If
End If
End Sub

Protected Sub Button1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button1.Click
Dim xElement As XmlElement
Dim xElement2 As XmlElement
Try
str_path = Server.MapPath("~/xml/") & "sysconfig.xml"
If File.Exists(str_path) = True Then
'已存在
Label1.Text = str_path & " 檔案已存在"
Else
'不存在
'建立一個 XmlDocument 物件並加入 Declaration
xdoc = New XmlDocument
xdoc.AppendChild(xdoc.CreateXmlDeclaration("1.0", "UTF-8", "yes"))
'建立根節點物件並加入 XmlDocument 中 (第0層)
xElement = xdoc.CreateElement("system_config")

xdoc.AppendChild(xElement)
'在system_config下寫入一個節點名稱為a1(第1層)
xElement2 = xdoc.CreateElement("a1")
xElement2.SetAttribute("path", "C:\temp\a1\")
xElement2.SetAttribute("creation_time", DateTime.Now.ToString("yyyy/MM/dd HH:mm:ss"))
xElement.AppendChild(xElement2)
xElement2 = xdoc.CreateElement("a1attr")
xElement2.SetAttribute("path", "C:\temp\a1\attr\")
xElement2.SetAttribute("creation_time", DateTime.Now.ToString("yyyy/MM/dd HH:mm:ss"))
xElement.AppendChild(xElement2)
xdoc.Save(str_path)
Label1.Text = "建立完成,檔案儲存在" & str_path
End If

Catch ex As Exception
Label1.Text = ex.Message & System.Environment.NewLine & ex.StackTrace
End Try

End Sub

Protected Sub Button2_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button2.Click
Dim str_read As String = String.Empty
Dim xRoot As XmlNode
Dim xUsersNode As XmlNode
Dim xElement As XmlElement
Try
str_path = Server.MapPath("~/xml/") & "sysconfig.xml"
If File.Exists(str_path) = True Then
'存在,就讀取
xdoc = New XmlDocument
'讀取XML
xdoc.Load(str_path)
xRoot = CType(xdoc.DocumentElement, XmlNode)

'取得節點[a1]
xUsersNode = xRoot.SelectSingleNode("a1")
xElement = CType(xUsersNode, XmlElement)
str_read = str_read & "a1 路徑：" & xElement.GetAttribute("path") & "<br/>"
str_read = str_read & "a1 建立時間：" & xElement.GetAttribute("creation_time") & "<br/>"

'取得節點[a1attr]
xUsersNode = xRoot.SelectSingleNode("a1attr")
xElement = CType(xUsersNode, XmlElement)
str_read = str_read & "a1attr 路徑：" & xElement.GetAttribute("path") & "<br/>"
str_read = str_read & "a1attr 建立時間：" & xElement.GetAttribute("creation_time") & "<br/>"

Label1.Text = str_read

Else
'不存在
Label1.Text = "請先在" & str_path & " 建立xml"
End If
Catch ex As Exception
Label1.Text = ex.Message & System.Environment.NewLine & ex.StackTrace & "<br/>" & str_path
End Try

End Sub

Protected Sub Button3_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button3.Click
Dim xRoot As XmlNode
Dim xUsersNode As XmlNode
Dim xElement As XmlElement
Try
str_path = Server.MapPath("~/xml/") & "sysconfig.xml"
If File.Exists(str_path) = True Then
xdoc = New XmlDocument
'讀取
xdoc.Load(str_path)
xRoot = CType(xdoc.DocumentElement, XmlNode)
'取得節點[a1]
xUsersNode = xRoot.SelectSingleNode("a1")
xElement = CType(xUsersNode, XmlElement)
'修改a1 creation_time的值
xElement.SetAttribute("creation_time", DateTime.Now.ToString("yyyy/MM/dd HH:mm:ss")) '.GetAttribute("creation_time")

xdoc.Save(str_path)
Label1.Text = "修改完成"
Else
Label1.Text = "檔案不存在無法修改，請先建立xml檔"
End If
Catch ex As Exception
Label1.Text = ex.Message & System.Environment.NewLine & ex.StackTrace & "<br/>" & str_path
End Try

End Sub

Protected Sub Button4_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button4.Click
'重新建立,跟建立很像,就是拿掉判斷檔案存不存在,直接把檔案附蓋掉
Dim xElement As XmlElement
Dim xElement2 As XmlElement
Try
str_path = Server.MapPath("~/xml/") & "sysconfig.xml"
'建立一個 XmlDocument 物件並加入 Declaration
xdoc = New XmlDocument
xdoc.AppendChild(xdoc.CreateXmlDeclaration("1.0", "UTF-8", "yes"))
'建立根節點物件並加入 XmlDocument 中 (第0層)
xElement = xdoc.CreateElement("system_config")

xdoc.AppendChild(xElement)
'在system_config下寫入一個節點名稱為a1(第1層)
xElement2 = xdoc.CreateElement("a1")
xElement2.SetAttribute("path", "C:\temp\a1\")
xElement2.SetAttribute("creation_time", DateTime.Now.ToString("yyyy/MM/dd HH:mm:ss"))
xElement.AppendChild(xElement2)
xElement2 = xdoc.CreateElement("a1attr")
xElement2.SetAttribute("path", "C:\temp\a1\attr\")
xElement2.SetAttribute("creation_time", DateTime.Now.ToString("yyyy/MM/dd HH:mm:ss"))
xElement.AppendChild(xElement2)
xdoc.Save(str_path)
Label1.Text = "建立完成,檔案儲存在" & str_path
Catch ex As Exception
Label1.Text = ex.Message & System.Environment.NewLine & ex.StackTrace
End Try
End Sub

Protected Sub Button5_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button5.Click
Dim xRoot As XmlNode
Dim xUsersNode As XmlNode
Dim xElement As XmlElement
Try
str_path = Server.MapPath("~/xml/") & "sysconfig.xml"
If File.Exists(str_path) = True Then
xdoc = New XmlDocument
'讀取
xdoc.Load(str_path)
xRoot = CType(xdoc.DocumentElement, XmlNode)
'取得節點[a1]
xUsersNode = xRoot.SelectSingleNode("a1attr")
If Not xUsersNode Is Nothing Then
'存在
xRoot.RemoveChild(xUsersNode) '刪除a1attr子節點
'========分隔線=========
'如果要刪除,子節點全部的屬性,請將下方註解拿掉
'xElement = CType(xUsersNode, XmlElement)
'xElement.RemoveAll()
'========分隔線=========
'如果要刪除某個屬性,請將下方註解拿掉
'xElement = CType(xUsersNode, XmlElement)
'xElement.RemoveAttribute("creation_time") '刪除creation_time屬性
'========分隔線=========
xdoc.Save(str_path)
Label1.Text = "刪除完成"
Else
Label1.Text = "a1attr子節點不存在"
End If
Else
Label1.Text = "檔案不存在無法刪除節點，請先建立xml檔"
End If
Catch ex As Exception
Label1.Text = ex.Message & System.Environment.NewLine & ex.StackTrace & "<br/>" & str_path
End Try
End Sub
End Class

2015年6月24日星期三

VB.NET TextBox1跨執行緒作業無效

參考資料：vb.net-跨執行緒作業無效

因在執行緒中會有好幾個地方會呼叫TB_keyvalue方法，在呼叫的過程中，會變更TextBox1的值，此時會發生跨執行緒作業無效的問題；我修改了上方參考資料連結的程式碼，如下...

Private Delegate Sub UpdateUICB(ByVal TB1 As System.Windows.Forms.TextBox, ByVal str_ivalue As String, ByVal add_dt As Integer)

Sub TB_keyvalue(ByVal TB1 As System.Windows.Forms.TextBox, ByVal str_ivalue As String, Optional ByVal add_dt As Integer = 1)
 Dim str_dtime As String = String.Empty
 If add_dt = 1 Then
  str_dtime = "[" & DateTime.Now.ToString("yyyy/MM/dd HH:mm:ss") & "] "
 End If
 If Me.InvokeRequired() Then
  '你可以想像成,將TB_keyvalue方法指定給UpdateUICB
  Dim cb As New UpdateUICB(AddressOf TB_keyvalue)
  '當跑到Invoke時,你可以想像成程式碼去呼叫UpdateUICB,並把參數傳給它,此時就等於程式碼又去呼叫TB_keyvalue方法
  Me.Invoke(cb, TB1, str_dtime & str_ivalue, add_dt)
 Else
  If TB1.Text = "" Then
   TB1.Text = str_dtime & str_ivalue
  Else
   TB1.Text = str_dtime & str_ivalue & vbCrLf & TB1.Text
  End If
 End If
End Sub

P.S 我直接把我的想法寫在註解中，如有錯誤請指正，或想幫忙補充的，歡迎留言補充，謝謝。

2015年5月24日星期日

VB.NET 應用篇

2018/05/12
參考資料：自訂數值格式字串
當我的資料是9.50，要格式化為9.5，可以使用String.Format來作，方法如下。
'記得要Imports System.Globalization
String.Format(CultureInfo.InvariantCulture, "{0:0.0}",CDbl("9.50").ToString))

2017/10/14
假設今天資料庫的資料某個欄位值與某家公司所規定的值不一樣，但你希望資料庫的資料可以跟某家公司所規定的值一樣，舉個例子，如下：
我的資料庫值1、2、3
1 代表身心障礙人士子女(重度、極重度)
2 代表身心障礙人士子女(中度)
3 代表身心障礙人士子女(輕度)

某家公司規定的值A1、A2、A3
A1 代表極重度／重度身心障礙人士子女
A2 代表中度身心障礙人士子女
A3 代表輕度身心障礙人士子女

如果我要把我的值1、2、3，替換成A1、A2、A3，我們可以這樣作，如下：
Dim DType = New Dictionary(Of String, String)
DType.Add("1", "A1")
DType.Add("2", "A2")
DType.Add("3", "A3")

MsgBox(DType("1") & vbNewLine & DType("2") & vbNewLine & DType("3"))
'顯示出來的結果會是A1、A2、A3

2017/08/27
1.四捨五入
Dim d1 As Decimal = 4.69
Response.Write("d1=" & d1 & "<br/>")
Response.Write("d1/100=" & (d1 / 100) & "<br/>")
Response.Write("d1四捨五入到小數點第一位=" & Math.Round(d1, 1, MidpointRounding.AwayFromZero) & "<br/>")
Response.Write("d1四捨五入=" & Math.Round(d1, MidpointRounding.AwayFromZero) & "<br/>")
2.取得圖片高度、寬度
Dim b As System.Drawing.Bitmap = New System.Drawing.Bitmap(Server.MapPath("~/img/test.jpg"))
Response.write("Width=" & b.Width & " Height=" & b.Height)
b.Dispose()

2017/07/19
參考資料：Optional (Visual Basic)
有時候我會把一些常用到的程式碼寫成方法，要用的時候可以去呼叫它，呼叫方法時常需要給它很多參數資料，有些參數我不見得要給它值，希望它可以使用預設值，那我就可以在ByVal前面加上Optional，代表這個參數可有可無不見得要給它參數值，但是必須定義一個預設值給它，如下：
Sub fun1(ByVal a1 As Integer,Optional ByVal s1 As String = "s1", Optional ByVal s2 As String = "s2",Optional ByVal us_a1 As UShort = 0)
...
End Sub
如果在呼叫的過程中，我只想給s2這個參數給它一個值，那我可以這樣子給s2值，如下：
'方法1
fun1(100,s2:="Hello")
'方法2
fun1(100, ,"Hello")
我個人比較喜歡方法1，比較明確。

2017/06/27
判斷日期是否有效，例如：2017/06/27。
Dim str_date As String="2017/06/27"
If (IsDate(str_date)) = False Or (IsDate(str_date) = True And (str_date.Length < 10 Or str_date.Length > 10)) Then
'錯誤
Else
'符合2017/06/27
End If

2016/02/22
判斷IP是否有效。
  If Net.IPAddress.TryParse("140.130.192.3", Nothing) Then
    '有效
  Else
    '無效
  End If

2016/01/31
CheckBoxList項目存不存在
  If CheckBoxList1.Items.FindByValue("A") IsNot Nothing Then
    '存在
  Else
    '不存在
  End If

2015/12/13
VB.NET Winform 使用MoveDirectory(移動目錄)
  Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
    '將Directory1目錄(包含裡面的檔案)搬移到Directory2目錄
    '補充：如果你想要搬移資料夾且修改資料夾的名稱，你可以將C:\Directory2\Directory1改為C:\Directory2\ABC
    My.Computer.FileSystem.MoveDirectory("C:\Directory1", "C:\Directory2\Directory1")
  End Sub

2015/06/29
參考：規則運算式語言-快速參考、Regex.IsMatch 方法
用正規表示式判斷是否為數字
If Regex.IsMatch("123", "^\d+$") = False Then '數字會回傳true
   '不是數字
Else
   '是數字
End If

2015/05/25
1.取得星期幾
Dim objd1 As Date = New Date()
objd1 = "2014-12-01 08:52"
Response.Write("objd1=" & objd1.ToString("yyyy/MM/dd HH:mm:ss") & "<br/>")
'Weekday方法會回傳 1是星期日 2是星期一 3星期是二 4是星期三 5是星期四 6是星期五 7是星期六
Dim int_weekday As Integer = Weekday(objd1)
int_weekday = int_weekday - 1 '減1後 0星期日 1星期一 2星期二
If Not (int_weekday = 0 Or int_weekday = 6) Then
Response.Write("不是，星期日或星期六")
Else
Response.Write("是，星期日或星期六")
End If

2015年5月4日星期一

ASP.NET WebForm 應用篇

2018/03/44
1.GridView在Eval中設定日期時間格式為yyyy/MM/dd HH:mm:ss。
<%# Eval("date_time", "{0:yyyy/MM/dd HH:mm:ss}")%>

2017/10/14
1.取得從哪一個網頁過來的。
Page.Request.UrlReferrer.AbsoluteUri
2.取得從哪一個網頁過來的，只取網頁名稱。
System.IO.Path.GetFileName(Page.Request.UrlReferrer.AbsolutePath)

2016/01/07
1.使用Regex正規表示Split字串切割。
Dim str_array1() As String = Regex.Split("1.題目1<br/>2.題目2<br/>3.題目3<br/>4.題目4", "\<br\/\>")
For x1 As Integer = 0 To str_array1.Length - 1
Response.Write(str_array1(x1) & "<br/>")
Next

C#寫法
string[] str = Regex.Split("AAA<p>BBB<p>DDD",@"\<p\>");
Response.Write(str[0] + ";" + str[2] + ";" + str[1]);

2015/10/29
1.Cookie儲存中文，輸出後亂碼。
Response.Cookies("test1").Value=HttpUtility.UrlEncode(TB_title.Text)'寫入
Label1.Text=HttpUtility.UrlDecode(Request.Cookies("test1").Value)'輸出

2.清除某個cookie。
If Not Request.Cookies("test1") Is Nothing Then
Response.Cookies("test1").Expires = DateTime.Now.AddDays(-1) '設定cookie到期日,過期
End If

2015/05/05
設定GridView裡的某個Label顏色，但已16進位設定。
GridView1_RowDataBound事件寫入：
If e.Row.RowType = DataControlRowType.DataRow Then
Dim L1 As Label = CType(e.Row.FindControl("L1"), Label)
Dim c1 As New ColorConverter
L1.ForeColor = CType(c1.ConvertFromString("#FF9900"), Color)
End If

2015年3月17日星期二

ASP.NET DataList控制項 ItemDataBound 資料繫結事件

2015/03/18

Private Sub DataList1_ItemDataBound(ByVal sender As Object, ByVal e As System.Web.UI.WebControls.DataListItemEventArgs) Handles DataList1.ItemDataBound
If e.Item.ItemType = ListItemType.Item Or e.Item.ItemType = ListItemType.AlternatingItem Then
'每跑一筆資料將會經過此區域
'CType(e.Item.DataItem, DataRowView).Item("chk_cod").ToString '取得某個欄位資料
'CType(e.Item.FindControl("DropDownList1"), DropDownList) '取得DataList1 某個控制項
If IsDBNull(CType(e.Item.DataItem, DataRowView).Item("a1")) Then '此欄位是NULL
End If
End If
End Sub

2015年2月10日星期二

VB.NET 使用GMail寄信

參考資料：[ASP.NET 3.5] 使用 Gmail 寄信, 請問下面程式錯在哪裡 ?

大學時期專題所寫到的程式碼，在此作個紀錄。

Imports System.Net
Imports System.Net.Mail
Imports System.Text.RegularExpressions

Sub Send_EMail(ByVal Recipient As String, ByVal M_Subject As String, ByVal M_Content As String, ByVal S_Account As String, ByVal S_Name As String, ByVal S_Password As String, Optional ByVal Filepath() As String = Nothing)
'Recipient收件者,M_Subject主旨,M_Content內容,'S_Account寄件人帳號,S_Name寄件人名稱,S_Password寄件人密碼,Filepath儲存在Server檔案上的路徑
'==============================================
'傳過來的寄信內容,請先處理完後再傳進M_Content變數-處理寄信內容
'==============================================
If Recipient = "" Then
Exit Sub
Else
'mail格式不符,就不送出
If Regex.IsMatch(as_to, "\w+([-+.']\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*") = False Then
Exit Sub
End If
End If
Dim eMail As New MailMessage()
Dim attach As Attachment = Nothing
eMail.IsBodyHtml = True
'System.Net.Mail.MailAddress("寄件人的Gmail帳號@gmail.com", "寄件人名稱", System.Text.Encoding.UTF8)
eMail.From = New System.Net.Mail.MailAddress(S_Account, S_Name, System.Text.Encoding.UTF8)
eMail.SubjectEncoding = System.Text.Encoding.UTF8 '主旨編碼方式
eMail.BodyEncoding = Encoding.UTF8 '內容編碼方式

eMail.To.Add(New MailAddress(Recipient)) '收件者
eMail.Subject = M_Subject '主旨
eMail.Body = M_Content '內容

'====================================
'附加檔案
If Not Filepath Is Nothing Then
For i As Integer = 0 To Filepath.Length - 1
If Filepath(i) <> "" Then
attach = New Attachment(Filepath(i))
eMail.Attachments.Add(attach) '附加檔案
End If
Next
End If
'====================================
Dim client As System.Net.Mail.SmtpClient = New System.Net.Mail.SmtpClient()
client.Port = 587 '使用GMail,port必須使用587(25也可以),如果有其他的,例如:yahoo,hotmail等等,必須使用它們各自的port
client.Host = "smtp.gmail.com" '使用GMail,如果有其他的,例如:yahoo,hotmail等等,必須使用它們各自的host
client.EnableSsl = True '需要啟用SSL加密
client.UseDefaultCredentials = False
'client.Credentials = New System.Net.NetworkCredential("你的帳號@gmail.com", "你的gmail密碼")
client.Credentials = New System.Net.NetworkCredential(S_Account, S_Password)

client.Timeout = 500000 '建議5分鐘
client.Send(eMail)

If Not attach Is Nothing Then
attach.Dispose()
End If
eMail.Dispose()
End Sub

Step 1.然後在Button1_Click上呼叫Send_EMail並帶入參數，如下：

Send_EMail("要寄給誰的mail", "這裡是主旨", "哈囉~這裡是內容", "您的gmail帳號(例如:test@gmail.com)", "測試有限公司", "您的gmail密碼")

Step 2.最後請到您的GMail帳戶作設定，找到「安全性較低的應用程式」預設是關閉，請設定為開啟。

上述設定作完後，請測試是否成功寄信。

2015年1月26日星期一

VB.NET 字數限制

Dim str_temp As String = String.Empty, maxlength As Integer = 50, a1 As Integer = 0, a2 As Integer = 0
Dim n As System.Text.ASCIIEncoding = New System.Text.ASCIIEncoding()
Dim b() As Byte = Nothing
b = n.GetBytes(TextBox2.Text)
For i As Integer = 0 To b.Length - 1
If b(i) = 63 Then
a1 = a1 + 1
Else
a2 = a2 + 1
End If
Next

Response.Write("byte長度：" & b.Length & ";全形(包含中文字、標點符號)=" & a1 & ";半形(英文字、標點符號)=" & a2)

以上有錯誤請指正，謝謝

2015年1月23日星期五

ASP.NET DropDownList 程式碼新增Item

Dim dt1 As DataTable=Nothing
....假設dt1已經從資料庫中取回項目資料....
DropDownList1.DataTextField = "html_text" '顯示在網頁上的項目名稱
DropDownList1.DataValueField = "value" '項目的值
DropDownList1.DataSource = dt1.DefaultView
DropDownList1.DataBind() '資料繫結
'資料繫結後在DropDownList第一個項目前，再插入新的項目
DropDownList1.Items.Insert(0, New ListItem("請選擇審核人", "0"))

2015年1月20日星期二

[ASP.NET for VB.NET] String.Trim 無法刪除空白字元

參考資料1.Trimming Character Strings
參考資料2.魔鬼般的細節：使用 C# 的 String.Trim() 方法刪除空白字元

有時候會因為複製Excel檔裡的資料，貼到自己的程式中執行，在複製過來的資料中可能因為排版的關係，而產生一些特殊字元，使得您再怎麼刪除空白字元都無法刪除，解決辦法如下。

Dim str_data As String = " ABCDE "
Dim whiteSpaceDelimiters() As Char = _
{ChrW(&H9),ChrW(&HA),ChrW(&HB),ChrW(&HC),ChrW(&HD),ChrW(&H20), _
ChrW(&HA0),ChrW(&H2000),ChrW(&H2001),ChrW(&H2002),ChrW(&H2003), _
ChrW(&H2004),ChrW(&H2005),ChrW(&H2006),ChrW(&H2007),ChrW(&H2008), _
ChrW(&H2009),ChrW(&H200A),ChrW(&H200B),ChrW(&H3000),ChrW(&HFEFF) _
}
str_data = str_data.Trim(whiteSpaceDelimiters)
Response.Write("[" & str_data & "]")

'如果是C#
'char[] whiteSpaceDelimiters = new char[]
'{
''\u0009’, // CHARACTER TABULATION
''\u000A’, // LINE FEED
''\u000B’, // LINE TABULATION
''\u000C’, // FORM FEED
''\u000D’, // CARRIAGE RETURN
''\u0020’, // SPACE
''\u00A0’, // NO-BREAK SPACE
''\u2000’, // EN QUAD
''\u2001’, // EM QUAD
''\u2002’, // EN SPACE
''\u2003’, // EM SPACE
''\u2004’, // THREE-PER-EM SPACE
''\u2005’, // FOUR-PER-EM SPACE
''\u2006’, // SIX-PER-EM SPACE
''\u2007’, // FIGURE SPACE
''\u2008’, // PUNCTUATION SPACE
''\u2009’, // THIN SPACE
''\u200A’, // HAIR SPACE
''\u200B’, // ZERO WIDTH SPACE
''\u3000’, // IDEOGRAPHIC SPACE
''\uFEFF’ // ZERO WIDTH NO-BREAK SPACE
'};

2015年1月10日星期六

JavaScript VB.NET 修改html 標籤

參考資料：Regular expression 抓 HTML 標籤屬性與內容

說明：因有個需求必須從某個網頁，跨網域到某一台Server取資料，但資料的內容含有html標籤，而我又想要能針對a、img標籤可以正常顯示，因此運用字串搜尋的方式，將我想修改的標簽進行修改，主要的作法是搜尋到a標籤修改href、img標籤修改src。

如您有更好的寫法，請建議，謝謝。

ASP.NET-VB.NET語法版本：
Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
If Not Page.IsPostBack Then
Dim str_cont As String = String.Empty
'假設str_cont是取得後的資料
str_cont = "附件：<a href=""/boardfile/file/osa/%E6%B4%BB%E5%8B%95%E8%AA%AA%E6%98%8E1031231.pdf"" target=""_blank"">活動說明</a>、<a href=""/boardfile/file/cc/%E5%AF%A6%E6%96%BD%E8%BE%A6%E6%B3%951030930.docx"" target=""_blank"">實施辦法</a><br/><img alt=""活動海報"" src=""/boardfile/file/cc/poster1031003.jpg"" width=""640"" height=""902"" border=""0"" title=""活動海報"" /><br/>" & _
"一、為推廣並落實資訊教育，以及展示政府推動行政電子化之成效，臺北市電腦商業同業公會結合國內相關公會共同組成資訊月活動委員會，規劃辦理103年資訊月全國巡迴展示活動。"
str_cont = funbody(str_cont, "<a(.*?)>(.*?)<\/a\s*>", "href=") 'a標籤
str_cont = funbody(str_cont, "<img(.*?)>", "src=") 'img標籤
Response.Write(str_cont)
End If
End Sub

Function funbody(ByVal cont As String, ByVal Regex_where As String, ByVal edit_pro As String) As String
Dim x1 As Integer = 0, str_temp1 As String = String.Empty, str_temp2 As String = String.Empty, str_path As String = String.Empty,
strhtml_tag As String = String.Empty, strhtml_pro As String = String.Empty, si1 As Integer = 0, si2 As Integer = 0, si3 As Integer = 0 ', str_path As String = String.Empty
Dim regex As Regex = New Regex(Regex_where) '"<a\s+([\s\S]*?)>([\s\S]*?)<\/a\s*>"
Do
x1 = regex.Match(cont).Index
If x1 = 0 Then
str_temp2 = fun_string1(str_temp2, cont)
Exit Do '如果找不到標籤就跳出
Else
str_temp1 = cont.Substring(0, x1) '如果使用Mid擷取字串,起始位置要設定在1,如:Mid(cont, 1, x1)
str_temp2 = fun_string1(str_temp2, str_temp1)
cont = cont.Replace(str_temp1, "")
End If
If regex.Match(cont).Groups.Count > 0 Then
strhtml_tag = regex.Match(cont).Groups(0).Value '標籤
strhtml_pro = regex.Match(cont).Groups(1).Value '屬性
cont = cont.Replace(strhtml_tag, "")

si1 = strhtml_pro.IndexOf(edit_pro)
si2 = (strhtml_pro.IndexOf(Chr(34), si1)) + 1 '第一個雙引號
si3 = strhtml_pro.IndexOf(Chr(34), si2) '第二個雙引號
str_path = strhtml_pro.Substring(si2, (si3 - si2)) '取得屬性值
'因跨網域取資料的關西,所以搜尋對方的boardfile資料夾,來判斷對方是上傳到自己的server
If str_path.IndexOf("/boardfile/") <> -1 Then
strhtml_tag = strhtml_tag.Replace(str_path, "http://????" + str_path) 'http://???? 請修改為你自己要替換的網址
End If
str_temp2 = fun_string1(str_temp2, strhtml_tag)
End If
Loop
Return str_temp2
End Function

Function fun_string1(ByVal ori_string As String, ByVal addstring As String) As String
If ori_string = "" Then
ori_string = addstring
Else
ori_string = ori_string & addstring
End If
Return ori_string
End Function

P.S 如果要清除所有Html標籤，可以寫成 Dim regex As Regex = New Regex("<[^>]*>")

JavaScript版本：
<!doctype html>
<html>
<head>
<meta charset="utf-8">
<meta http-equiv="Pragma" content="No-cache" />
<title>Regular expression 抓 HTML 標籤屬性與內容</title>
<script type="text/javascript">
var r,str_cont;
//假設str_cont是取得後的資料
str_cont='附件：<a href="/boardfile/file/osa/%E6%B4%BB%E5%8B%95%E8%AA%AA%E6%98%8E1031231.pdf" target="_blank">活動說明</a>、<a href="/boardfile/file/cc/%E5%AF%A6%E6%96%BD%E8%BE%A6%E6%B3%951030930.docx" target="_blank">實施辦法</a><br/><img alt="活動海報" src="/boardfile/file/cc/poster1031003.jpg" width="640" height="902" border="0" title="活動海報" /><br/>一、為推廣並落實資訊教育，以及展示政府推動行政電子化之成效，臺北市電腦商業同業公會結合國內相關公會共同組成資訊月活動委員會，規劃辦理103年資訊月全國巡迴展示活動。';
r = /<a(.*?)>(.*?)<\/a\s*>/;
str_cont = funbody(str_cont,r,'href='); //a標籤
r = /<img(.*?)>/;
str_cont = funbody(str_cont,r,'src='); //img標籤
document.write(str_cont);
function funbody(cont,Regex_where,edit_pro){
var x1=0, str_temp1='', str_temp2='', str_path='', strhtml_tag='', strhtml_pro='', si1=0, si2=0, si3=0, arr;
while (true) {
x1=cont.search(Regex_where);
if(x1 == -1){
str_temp2 = fun_string1(str_temp2, cont);
break; //如果找不到a標籤就跳出
}else if (x1!=0){
str_temp1=cont.substring(0, x1); //第一次取出html標籤前的字串
str_temp2 = fun_string1(str_temp2, str_temp1);
cont=cont.replace(str_temp1,'');
};
arr = Regex_where.exec(cont);
if (arr != null){
strhtml_tag=arr[0];
strhtml_pro=arr[1];//屬性
cont=cont.replace(strhtml_tag,'');

si1=strhtml_pro.indexOf(edit_pro);
si2=(strhtml_pro.indexOf('"',si1))+1; //第一個雙引號
si3=strhtml_pro.indexOf('"',si2); //第二個雙引號
str_path=strhtml_pro.substring(si2, si3);
//因跨網域取資料的關西,所以搜尋對方的boardfile資料夾,來判斷對方是上傳到自己的server
if (str_path.indexOf('/boardfile/')!=-1){
//http://???? 請修改為你自己要替換的網址
strhtml_tag=strhtml_tag.replace(str_path,'http://????'+str_path);
};
str_temp2 = fun_string1(str_temp2, strhtml_tag);
};
};
return str_temp2;
};

function fun_string1(ori_string,addstring){
if (ori_string =='') {
ori_string = addstring;
}else{
ori_string = ori_string + addstring;
};
return ori_string;
};
</script>
</head>
<body >

</body>
</html>

訂閱：文章 (Atom)

2015年12月29日 星期二

2015年12月25日 星期五

2015年10月27日 星期二

2015年7月28日 星期二

2015年7月11日 星期六

2015年6月27日 星期六

2015年6月24日 星期三

2015年5月24日 星期日

2015年5月4日 星期一

2015年3月17日 星期二

2015年2月10日 星期二

2015年1月26日 星期一

2015年1月23日 星期五

2015年1月20日 星期二

2015年1月10日 星期六