frmread.vb

日報管理システム&#65407 &#65392 &#65405 です よろしくお願いします

                            Controls("txtReport").Text &= _
                            xmlNo.NamespaceURI & Constants.vbCrLf

                    '■件数1の判断
                ElseIf xmlNo.Name.Equals("Count1") AndAlso _
                    xmlNo.NodeType = XmlNodeType.Element Then

                    '□件数1の表示
                    txtKensuu1.Text = xmlNo.NamespaceURI

                    '■件数2の判断
                ElseIf xmlNo.Name.Equals("Count2") AndAlso _
                    xmlNo.NodeType = XmlNodeType.Element Then

                    '□件数2の表示
                    txtKensuu2.Text = xmlNo.NamespaceURI

                    '■ｻｯﾊﾞﾀｲﾄﾙ1の判断
                ElseIf xmlNo.Name.Equals("SubTitle1") AndAlso _
                    xmlNo.NodeType = XmlNodeType.Element Then

                    '□ｻｯﾊﾞﾀｲﾄﾙ1の表示
                    Me.tabReport.TabPages("tbPage" & (Me.tabReport.TabCount - 1).ToString). _
                           Controls("txtBusyo0").Text &= _
                           xmlNo.NamespaceURI

                    '■ｻｯﾊﾞﾀｲﾄﾙ2の判断
                ElseIf xmlNo.Name.Equals("SubTitle2") AndAlso _
                    xmlNo.NodeType = XmlNodeType.Element Then

                    '□ｻｯﾊﾞﾀｲﾄﾙ2の表示
                    Me.tabReport.TabPages("tbPage" & (Me.tabReport.TabCount - 1).ToString). _
                          Controls("txtBusyo1").Text &= _
                          xmlNo.NamespaceURI

                End If

                Call SetNode(xmlNo)
            Next

        Catch ex As Exception

        End Try
    End Sub

    ''' <summary>
    ''' ﾚﾎﾟｰﾄ書き込む処理
    ''' </summary>
    ''' <param name="strPath">ファイル名を含むパス</param>
    ''' <remarks></remarks>
    Private Sub MakeNewXml(ByVal strPath As String)

        '■変数
        Dim xmlWriter As XmlTextWriter                              '書き込む用ｸﾗｽ
        Dim strList As String()                                     'ﾚﾎﾟｰﾄ内容記録用

        Try

            ''■ﾕｰｻﾞﾚﾎﾟｰﾄがなくなる場合 相応XMLﾌｧｲﾙを削除する
            'If Me.tabReport.TabPages.Count = 0 AndAlso _
            '        String.IsNullOrEmpty(Me.txtKensuu1.Text.Trim) AndAlso _
            '        String.IsNullOrEmpty(Me.txtKensuu1.Text.Trim) Then

            '    '□ﾌｧｲﾙの削除
            '    File.Delete(strPath)
            '    '□削除と更新ﾎﾞﾀﾝの設定
            '    Me.tsbUpdate.Enabled = False
            '    Me.tsbDelete.Enabled = False

            '    Return
            'End If

            '■書き込むｸﾗｽの生成
            xmlWriter = New XmlTextWriter(strPath.ToString, System.Text.Encoding.GetEncoding("UTF-8"))

            '■書き込む処理
            With xmlWriter
                '□出力書式設定
                .Formatting = Formatting.Indented
                '□階層の設定
                .Indentation = 3
                '□ﾊﾞｰｼﾞｮﾝ1.0でXML宣言書き込む
                .WriteStartDocument()
                '□開始ﾀｸﾞを書き込む
                .WriteStartElement("DATETIME", Now)

                '□件数をここに追加
                .WriteStartElement("Count1", Me.txtKensuu1.Text)
                .WriteStartElement("Count2", Me.txtKensuu2.Text)
                '□件数追加ここまで

                '□ﾚﾎﾟｰﾄﾀｲﾄﾙと内容を書き込む
                For i As Integer = 0 To Me.tabReport.TabPages.Count - 1
                    '□ﾚﾎﾟｰﾄﾀｲﾄﾙを書き込む
                    .WriteStartElement("Title", Me.tabReport.TabPages(i).Text)
                    .WriteStartElement("SubTitle1", Me.tabReport.TabPages(i).Controls("txtBusyo0").Text)
                    .WriteStartElement("SubTitle2", Me.tabReport.TabPages(i).Controls("txtBusyo1").Text)

                    '□ﾚﾎﾟｰﾄ内容の記録
                    strList = CType(Me.tabReport.TabPages(i).Controls(0), TextBox).Text.Split(vbCrLf)

                    '□ﾚﾎﾟｰﾄ内容を書き込む
                    For j As Integer = 0 To strList.Length - 1
                        .WriteStartElement("Naiyou" & j, strList(j).ToString)
                        .WriteEndElement()
                    Next

                    '□ﾚﾎﾟｰﾄﾀｲﾄﾙ終了ﾀｸﾞを書き込む
                    .WriteEndElement()

                Next
                '□開始ﾀｸﾞ終了ﾀｸﾞを書き込む
                .WriteEndElement()
                '□XML書き込むの終了
                .WriteEndDocument()
                '□刷新処理
                .Flush()
                '□解放処理
                .Close()

            End With

            '■ﾊﾞｲﾅﾘ化処理
            Call Me.ToBinary(strPath)

        Catch ex As Exception

            MsgBox(ex.ToString, , "MakeNewXml()失敗")
        Finally
            '■解放処理
            xmlWriter = Nothing
            Erase strList
        End Try

    End Sub

    ''' <summary>
    ''' 生成ﾊﾞｽの存在判断
    ''' </summary>
    ''' <param name="filePaths">既存のﾊﾞｽﾘｽﾄ</param>
    ''' <param name="filePath">生成のﾊﾞｽ</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function CheckPath(ByVal filePaths As String(), ByVal filePath As String) As Boolean
        Try

            '■既存ﾊﾞｽﾘｽﾄの遍歴
            For i As Integer = 0 To filePaths.Length - 1

                '□生成ﾊﾞｽがあるどうかの判断
                If filePaths(i).Equals(filePath) Then
                    '□存在の場合真を戻る
                    Return True
                End If
            Next

            '□存在しない場合仮を戻る
            Return False
        Catch ex As Exception

            MsgBox(ex.ToString, , "CheckPath()失敗")
        End Try

    End Function

    ''' <summary>
    ''' ﾚﾎﾟｰﾄﾊﾟﾀｰﾝの生成
    ''' </summary>
    ''' <param name="pTitle"></param>
    ''' <remarks></remarks>
    Private Sub SetReport(ByVal pTitle As String)

        '■変数
        Dim tbPage As New TabPage                               'ﾚﾎﾟｰﾄﾀｲﾄﾙ生成用
        Dim txtReport As New TextBox                            'ﾚﾎﾟｰﾄ内容表示用

        Try

            '■ﾚﾎﾟｰﾄﾀｲﾄﾙとﾚﾎﾟｰﾄ編集ｺﾝﾄﾛｰﾙの生成
            '□ﾚﾎﾟｰﾄﾀｲﾄﾙの生成
            tbPage = New TabPage
            tbPage.Name = "tbPage" & Me.tabReport.TabCount.ToString
            tbPage.Text = pTitle
            '□ﾚﾎﾟｰﾄﾀｲﾄﾙを画面に追加する
            Me.tabReport.TabPages.Add(tbPage)

            '□ﾚﾎﾟｰﾄ編集ｺﾝﾄﾛｰﾙの生成
            txtReport = New TextBox
            txtReport.ReadOnly = True
            '□表示用TextBoxのﾌﾟﾛﾊﾟﾃｨ設定
            txtReport.Name = "txtReport"
            txtReport.Multiline = True
            txtReport.ScrollBars = ScrollBars.Vertical
            txtReport.Font = New Font("MS P Gothic", 12, FontStyle.Regular)
            txtReport.Size = New Size(Me.tabReport.Width - 5, Me.tabReport.Height - 50)
            txtReport.Location = New Point(0, 35)
            txtReport.Dock = DockStyle.Bottom
            '□表示用TextBoxの追加
            Me.tabReport.TabPages(Me.tabReport.TabCount - 1).Controls.Add(txtReport)

            '■訪問部署ボックス生成（パネル上）
            Dim txtBusyo As New TextBox
            txtBusyo.ReadOnly = True
            Dim lblBusyo As New Label
            txtBusyo.Name = "txtBusyo0"
            tbPage.Controls.Add(txtBusyo)
            txtBusyo.Location = New Point(30, 0)
            txtBusyo.Size = New Size(250, 25)

            '■報告内容2ボックス生成（予備）
            Dim txtBusyo2 As New TextBox
            txtBusyo2.ReadOnly = True
            Dim lblBusyo2 As New Label
            txtBusyo2.Name = "txtBusyo1"
            tbPage.Controls.Add(txtBusyo2)
            txtBusyo2.Location = New Point(350, 0)
            txtBusyo2.Size = New Size(250, 25)

        Catch ex As Exception
            MsgBox(ex.ToString, , "SetReport()失敗")
        Finally
            '■解放処理
            tbPage = Nothing
            txtReport = Nothing
        End Try
    End Sub

    ''' <summary>
    ''' ﾌｧｲﾙﾊﾞｲﾅﾘ化ﾌｧｲﾙを書き込む
    ''' </summary>
    ''' <param name="pStrPath">変換元ﾌｧｲﾙﾊﾞｽ</param>
   ''' <remarks></remarks>
    Private Sub ToBinary(ByVal pStrPath As String)

        '■変数
        Dim inputStream As FileStream
        Dim encryptedStream As FileStream
        Dim strAftPath = ""
        Dim encryptionkey() As Byte

        Try

            strAftPath = pStrPath.Substring(0, pStrPath.Length - 3) & "bin"
            encryptionkey = System.Text.Encoding.ASCII.GetBytes("solution")

            '■暗号化する対象のFileStreamオブジェクト
            inputStream = New FileStream(pStrPath, FileMode.Open, FileAccess.Read)

            '■暗号化したものを書き込むためのFileStreamオブジェクト
            encryptedStream = New FileStream(strAftPath, FileMode.Create, FileAccess.Write)

            '■DESと呼ばれる方法で暗号化するためのオブジェクト
            Dim des As New DESCryptoServiceProvider()

            ' 鍵は64ビット(8バイト)のバイト配列である必要がある
            des.Key = encryptionkey

            ' 初期化ベクタ(暗号化と復号化の際には同じIVを必要とする)
            des.IV = encryptionkey

            ' CryptoStreamオブジェクトを作成する
            Dim transform As ICryptoTransform = des.CreateEncryptor() ' Encryptorを作成する
            Dim cryptoStream As New CryptoStream(encryptedStream, transform, CryptoStreamMode.Write)

            ' 暗号化する対象をバイト配列として読み込む
            Dim buffer() As Byte
            Dim length As Integer = CInt(inputStream.Length)

            ReDim buffer(length)

            inputStream.Read(buffer, 0, length)

            ' CryptoStreamによって暗号化して書き込む
            cryptoStream.Write(buffer, 0, length)

            ' CryptoStreamを閉じる
            cryptoStream.Close()

            ' FileStreamを閉じる
            inputStream.Close()
            encryptedStream.Close()

            '元XMLファイルの削除
            File.Delete(pStrPath)

        Catch ex As Exception
            MsgBox(ex.ToString, , "ToBinary()失敗")

        Finally
            strAftPath = Nothing
            Erase encryptionkey
            encryptionkey = Nothing
        End Try


    End Sub

    ''' <summary>
    ''' ﾌｧｲﾙﾊﾞｲﾅﾘ化ﾌｧｲﾙを読み取り
    ''' </summary>
    ''' <param name="pStrPath">変換元ﾌｧｲﾙﾊﾞｽ</param>
    ''' <remarks></remarks>
    Private Function FromBinary(ByVal pStrPath As String) As XmlDocument

        '■変数
        Dim xmlD As XmlDocument                            'XMLﾌｧｲﾙ読み取り用
        Dim encryptedStream As FileStream
        Dim encryptionkey() As Byte
        Dim encStream As CryptoStream
        Dim des As New DESCryptoServiceProvider
        Dim buffer() As Byte
        Dim strX As String = ""
        Dim sr As StreamReader

        Try

            '■暗号化のｷｰの生成
            encryptionkey = System.Text.Encoding.ASCII.GetBytes("solution")
            des.Key = encryptionkey
            des.IV = encryptionkey

            '■暗号化したﾌｧｲﾙ導入のFileStream
            encryptedStream = New FileStream(pStrPath, FileMode.Open, FileAccess.Read)

            '■暗号化ﾌｧｲﾙ解放用
            encStream = New CryptoStream(encryptedStream, des.CreateDecryptor(), CryptoStreamMode.Read)

            '■解放したﾊﾞｲﾄ記録用
            ReDim buffer(encryptedStream.Length)
            
            '■取得したﾊﾞｲﾄをXMLに転換する
            sr = New StreamReader(encStream)
            strX = sr.ReadToEnd

            '■暗号化ﾌｧｲﾙの読み込む
            sr.Close()
            '■CryptoStreamを閉じる
            encStream.Close()

            '■FileStreamを閉じる
            encryptedStream.Close()

            '■XmlDocumentの生成
            xmlD = New XmlDocument
            xmlD.LoadXml(strX)

            Return xmlD

        Catch ex As Exception
            Throw

        Finally
            '■解放処理
            des = Nothing
            strX = Nothing
            pStrPath = Nothing
            Erase buffer
            buffer = Nothing
            Erase encryptionkey
            encryptionkey = Nothing
        End Try

    End Function

#End Region

End Class