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
最新の画像［もっと見る］
アクセス
トータル
ランキング
