新しいアカウントで始めました。

身の回りの写真とトレッキングの写真が中心です。

VBで遊んでました。ブローチバックアップデータを閲覧する。大体OK。

2017-06-10 15:18:55 | パソコン

Imports System.Net.Mime.MediaTypeNames
Imports Microsoft.Office.Interop

Public Class Form1

    Dim lstobj As New ArrayList
    Dim MaxKen As Integer
    Dim xlApplication As New Excel.Application
    Dim xlBooks As Excel.Workbooks = xlApplication.Workbooks


    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click

        Dim line As String
        Dim storedline As String

        Dim ofd As New OpenFileDialog
        ofd.FileName = "burouchi2008.csv"
        ofd.InitialDirectory = "d:\users\isamg2\documents\"
        ofd.Title = "開くファイルを選択して下さい。"
        ofd.Filter = "CSV(*.csv)|burouchi*.csv"
        'ofd.FilterIndex = 1

        If ofd.ShowDialog() = Windows.Forms.DialogResult.OK Then
            'Console.WriteLine(ofd.FileName)
        End If
        Dim reader As New System.IO.StreamReader( _
                        ofd.FileName, System.Text.Encoding.UTF8)
        '"d:\users\isamg2\documents\burouchi2008.csv", System.Text.Encoding.UTF8)
        TextBox1.Clear()

        Dim i As Integer = 0
        storedline = ""

        'リストボックスを使う準備
        ListBox1.Items.Clear()
        ListBox1.BeginUpdate()
        Do Until reader.EndOfStream

            Dim oOya As New OyaClass
            lstobj.Add(oOya)

            line = reader.ReadLine()
            TextBox1.AppendText(line.Substring(0) & ControlChars.CrLf)

            storedline = storedline & line & ControlChars.CrLf

            If line = "--------" Then   '"--------"はBobyの終了
                KakikomiKaiseki(storedline, lstobj(i), i)
                'TextBox1.Clear()
                i += 1
                storedline = ""
            End If
        Loop

        ListBox1.EndUpdate()
        MaxKen = i      'MaxKen データがある件数0から始まるので最後は-1する。

        reader.Close()

        KakikomiFileSyuturyoku()

    End Sub

    Private Sub KakikomiKaiseki(ByVal storedline As String, ByRef obj As OyaClass, _
                                ByVal maini As Integer)

        Dim i As Integer = storedline.IndexOf("TITLE:")
        Dim str As String = storedline.Substring(i + "TITLE:".Length)
        Dim j As Integer = str.IndexOf(vbCrLf)
        Dim str2(3) As String
        str2(0) = str.Substring(0, j)       'TITLEの分離

        i = storedline.IndexOf("PRIMARY CATEGORY:")
        If i = -1 Then                      'Primary Categoryが無いときがあるので
            str2(1) = ""
        Else
            str = storedline.Substring(i + "PRIMARY CATEGORY:".Length)
            j = str.IndexOf(vbCrLf)
            str2(1) = str.Substring(0, j)   'PRIMARY CATEGORYの分離
        End If

        i = storedline.IndexOf("DATE:")
        str = storedline.Substring(i + "DATE:".Length)
        j = str.IndexOf(vbCrLf)
        str2(2) = str.Substring(0, j)       'DATEの分離

        i = storedline.IndexOf("BODY:")
        str = storedline.Substring(i + "BODY:".Length + vbCrLf.Length)
        str = str.Replace(vbCrLf, "")       'Bodyの実体が次の行から始まっている

        j = str.IndexOf("-----")
        str2(3) = str.Substring(0, j)      'BODYの分離


        obj.ID = maini
        obj.Title = str2(0)
        obj.PriCategory = str2(1)
        obj.CreateDate = str2(2)
        obj.Body = str2(3)


        ListBox1.Items.Add(lstobj(maini).ID.ToString() & lstobj(maini).Title)

        'ここにコメントの処理が入る
        Dim auth(10) As String
        Dim hizu(10) As String
        Dim con(10) As String


        Dim l As Integer
        str = storedline
        For l = 0 To 10                  'コメントは10個まで調べる
            i = str.IndexOf("COMMENT:")
            If Not i = -1 Then
                str = str.Substring(i + "COMMENT:".Length + vbCrLf.Length)
                'i = str.IndexOf("AUTHOR:")
                j = str.IndexOf(vbCrLf)
                auth(l) = str.Substring("AUTHOR:".Length, j - "AUTHOR:".Length)

                str = str.Substring(j)

                i = str.IndexOf("DATE:")
                str = str.Substring(i)

                j = str.IndexOf(vbCrLf)
                hizu(l) = str.Substring("DATE:".Length, j - "DATE:".Length)

                str = str.Substring(j)
                i = str.IndexOf("-----")
                con(l) = str.Substring(0, i)

                str = str.Substring(i + "-----".Length)
            Else
                Exit For
            End If

        Next l

        Dim MaxCom As Integer = l - 1

        For i = 0 To MaxCom
            obj.Comments(i) = New Comment()
        Next

        For i = 0 To MaxCom
            obj.Comments(i).CID = i
            obj.Comments(i).CAuthor = auth(i)
            obj.Comments(i).CCreateDate = hizu(i)
            obj.Comments(i).CCommentStr = con(i)
        Next


    End Sub

    Private Sub KakikomiFileSyuturyoku()

        Dim writer As New System.IO.StreamWriter( _
                "d:\users\isamg2\documents\brcsamary.csv", False, System.Text.Encoding.Default)
        Dim i As Integer
        For i = 0 To MaxKen - 1
            writer.Write(lstobj(i).ID)
            writer.Write("," & lstobj(i).Title)
            writer.Write("," & lstobj(i).PriCategory)
            writer.Write("," & lstobj(i).CreateDate)
            writer.Write("," & vbCrLf)

        Next

        writer.Close()
        MessageBox.Show("インデックスを作成しました。")
        Me.TextBox1.Clear()

        xlBooks.Open("d:\users\isamg2\documents\brcsamary.xlsm")
        xlApplication.Visible = True

        TextBox2.Text = 0

    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, e As System.EventArgs) Handles Button2.Click, TextBox2.TextChanged
        Dim num As Integer
        num = CInt(TextBox2.Text)

        TextBox1.Clear()
        TextBox1.Text = "Sq:" & lstobj(num).ID.ToString & vbCrLf
        TextBox1.Text = TextBox1.Text & "Title:" & lstobj(num).Title & vbCrLf
        TextBox1.Text = TextBox1.Text & "Category:" & lstobj(num).PriCategory & vbCrLf
        TextBox1.Text = TextBox1.Text & "Date:" & lstobj(num).CreateDate & vbCrLf
        TextBox1.Text = TextBox1.Text & "Body:" & lstobj(num).Body & vbCrLf

        Dim s As String
        s = TextBox1.Text.Replace(vbCrLf, "<br/>")
        WebBrowser1.DocumentText = _
        "<html><body><br/>" & _
            s & _
        "</body></html>"


        Dim i As Integer
        TextBox3.Text = ""

        For i = 0 To 10
            If IsNothing(lstobj(num).Comments(i)) Then Exit For
            TextBox3.Text = TextBox3.Text & lstobj(num).Comments(i).CID.ToString() & vbCrLf
            TextBox3.Text = TextBox3.Text & lstobj(num).Comments(i).CAuthor & vbCrLf
            TextBox3.Text = TextBox3.Text & lstobj(num).Comments(i).CCreateDate & vbCrLf
            TextBox3.Text = TextBox3.Text & lstobj(num).Comments(i).CCommentStr & vbCrLf
        Next
    End Sub

    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load

        WebBrowser1.DocumentText = _
       "<html><body><br/>" & _
       "" & _
       "</body></html>"

    End Sub

    Private Sub webBrowser1_Navigating( _
    ByVal sender As Object, ByVal e As WebBrowserNavigatingEventArgs) _
    Handles WebBrowser1.Navigating

        Dim document As System.Windows.Forms.HtmlDocument = WebBrowser1.Document

    End Sub

    Private Sub Button3_Click(sender As System.Object, e As System.EventArgs) Handles ListBox1.SelectedIndexChanged

        TextBox2.Text = ListBox1.SelectedIndex

    End Sub

    Private Sub Button3_Click_1(sender As System.Object, e As System.EventArgs) Handles Button3.Click
        Dim data As IDataObject = Clipboard.GetDataObject()     'クリップボードから文字(数字)テキストボックスへ

        If (data.GetDataPresent(DataFormats.Text)) Then
            TextBox2.Text = data.GetData(DataFormats.Text).ToString()
        End If

    End Sub

    Private Sub Button4_Click(sender As System.Object, e As System.EventArgs) Handles Button4.Click

        lstobj = Nothing        'オブジェクトを解放
        xlApplication.ActiveWorkbook.Close(SaveChanges:=False)

        xlApplication.Quit()    'Excelを終了の手続き
        System.Runtime.InteropServices.Marshal.ReleaseComObject(xlBooks)
        System.Runtime.InteropServices.Marshal.ReleaseComObject(xlApplication)
        Me.Close()              'Form1クローズ

    End Sub
End Class
Public Class OyaClass
    Private _ID As Integer
    Public Property ID() As Integer
        Get
            Return _ID
        End Get
        Set(value As Integer)
            _ID = value
        End Set
    End Property

    Private _Title As String
    Public Property Title() As String
        Get
            Return _Title
        End Get
        Set(value As String)
            _Title = value
        End Set
    End Property

    Private _PriCategory As String
    Public Property PriCategory() As String
        Get
            Return _PriCategory
        End Get
        Set(value As String)
            _PriCategory = value
        End Set
    End Property

    Private _CreateDate As String
    Public Property CreateDate() As String
        Get
            Return _CreateDate
        End Get
        Set(value As String)
            _CreateDate = value
        End Set
    End Property
    '=========================================================
    Private _Body As String
    Public Property Body() As String
        Get
            Return _Body
        End Get
        Set(value As String)
            _Body = value
        End Set
    End Property

    Public Comments(10) As Comment

    Public Sub New()
        ID = 0
        Title = ""
        PriCategory = ""
        CreateDate = ""
        Body = ""

    End Sub
End Class
Public Class Comment
    Private _CID As Integer
    Public Property CID() As Integer
        Get
            Return _CID
        End Get
        Set(value As Integer)
            _CID = value
        End Set
    End Property

    Private _CAuthor As String
    Public Property CAuthor() As String
        Get
            Return _CAuthor
        End Get
        Set(value As String)
            _CAuthor = value
        End Set
    End Property

    Private _CCreateDate As String
    Public Property CCreateDate() As String
        Get
            Return _CCreateDate
        End Get
        Set(value As String)
            _CCreateDate = value
        End Set
    End Property

    Private _CCommentStr As String
    Public Property CCommentStr() As String
        Get
            Return _CCommentStr
        End Get
        Set(value As String)
            _CCommentStr = value
        End Set
    End Property

    Public Sub New()
        CID = 0
        CAuthor = ""
        CCreateDate = ""
        CCommentStr = ""

    End Sub
End Class

ジャンル:
ウェブログ
コメント   この記事についてブログを書く
この記事をはてなブックマークに追加
« VBで遊んでました。ブローチ... | トップ | VBで遊んでました。ブローチ... »
最近の画像もっと見る

コメントを投稿

パソコン」カテゴリの最新記事

トラックバック

この記事のトラックバック  Ping-URL