はじめに
今回は、前回作成したニュースアプリを、UI改善によって、よりそれらしいものに出来ないか考えていきます。
・URLリンクの修正
→履歴のDataGridViewのURL列を消去して、別の場所をリンクとして使うように変更する。
・タグ機能で検索できるようにする
→前回作ったキーワード機能が、検索の際には死に機能だったので、それを有効活用する形で考える。
→生成AIを使って、記事追加時にタグ付けできるようにする。
・新しいFormを用意する
→そこを、掲示板や関連記事、タグ表示など、多機能的なページとして使う。
タイトルをURLリンクにする
これは、前回作ったURLの列をVisible=Falseにして
タイトルの列のColumnTypeをLinkColumnにして
「特定の列がクリックされると"URLの列に書かれた"のリンクが開く」仕様の発動条件を、URLの列（2列目）からタイトルの列（1列目）に変更するだけです。
なお、URLの列自体は隠し列となっているだけなので、隠す前後で列のカウントがずれることはありません。
Private Sub DataGridView_履歴_CellContentClick(sender As Object, e As DataGridViewCellEventArgs) Handles DataGridView_履歴.CellContentClick
' タイトル 列がクリックされた場合
If e.ColumnIndex = DataGridView_履歴.Columns(0).Index AndAlso e.RowIndex >= 0 Then
Dim url As String = DataGridView_履歴.Rows(e.RowIndex).Cells(1).Value.ToString()
Try
System.Diagnostics.Process.Start(New ProcessStartInfo With {
.FileName = url,
.UseShellExecute = True
})
Catch ex As Exception
MessageBox.Show("リンクを開けません: " & ex.Message)
End Try
End If
（略）
データ表示()
End Sub
URLの列が隠れて、代わりにタイトルの列でリンクが踏めると思います。
タグ機能での検索
これも、以前やったような内容です。
SSMS側のテーブルの列に、タグの列を何個か追加したら
USE [NEWS]
GO
SET ANSI_NULLS ON
GO
SET QUOTED_IDENTIFIER ON
GO
-- プロシージャ定義部
ALTER PROCEDURE [dbo].[タグ検索_抽出]
@キーワード nvarchar(100)
AS
-- 処理部
BEGIN
SET NOCOUNT ON;
SELECT
タイトル,
URL,
公開日
FROM [dbo].[履歴]
WHERE キーワード=@キーワード
or タグ1=@キーワード
or タグ2=@キーワード
or タグ3=@キーワード
or タグ4=@キーワード
or タグ5=@キーワード
ORDER BY 公開日 desc
END
こんな感じで、タグ1~5にかけて、キーワードをWHEREで検索するだけです。
ひとまず検索するキーワードは１つでいいでしょう。
検索機能のVB側の作り方は、何度もやってるので省略します。
該当のストアドに、@キーワードの変数を送るだけです。
すると、検索するとこんなふうに表示されると思います。
さっきタグに「ぬ」と書いたやつが出てるので、これはもう作れてると言っていいでしょう。
タグの自動生成
今回は、Groq APIを使ってタグの自動生成をしていきます。
こちらのサイトからAPIキーを取得します。
なお、公開鍵の名前は自由に決められますが、使う方の鍵（秘密鍵）は、鍵の生成時にしか文字列を確認出来ないので、必ず生成した段階でメモしましょう（１敗）
次に、VB.NET側でタグ生成関数を作っていきます。
基本的にはAPIキーと入力テキストを書き込んで、その後にプロンプトを書き込んで…という流れです。
今回はほぼAIに説明含めて生成してもらっているので、詳しい説明は省きます。
「Groq APIで、以下の仕様のプロンプトを作れるようなプログラムを作って
使用感さえ合っていれば、品質は問わない
・VB.NETで使うことが前提
・VB.NETの変数に「子どもたちはAIについてどう考えているのか」みたいなのが入力されていたら、それを読み込み 「子ども」「AI」みたいな関連しそうなタグを、5個形成する」
↓
Private Async Sub タグ生成(ByVal text As String)
Try
' 1) .env から API キー読込（例：GROQ_API_KEY=xxx）
Env.Load()
Dim apiKey As String = Env.GetString("GROQ_API_KEY")
If String.IsNullOrWhiteSpace(apiKey) Then
MessageBox.Show("GROQ_API_KEY が見つかりません。.env を確認してください。")
Return
End If
' 2) 入力テキスト（例：「子どもたちはAIについてどう考えているのか」）
Dim userInput As String = text
If String.IsNullOrWhiteSpace(userInput) Then
MessageBox.Show("入力テキストが空です。")
Return
End If
' 3) タグ生成の指示（出力はCSVのみ／5個／日本語）
Dim systemPrompt As String =
"あなたは日本語のタグ抽出器です。入力文から関連度の高いタグを5個だけ生成します。" &
"出力はカンマ区切りのタグのみ。説明や余分な語、#記号、引用符、前後の語は付けないでください。"
Dim userPrompt As String =
$"入力文: {userInput}" & vbLf &
"条件: タグは名詞中心で簡潔に。一般化しすぎず、固有名詞を含めてもよい。出力はカンマ区切りのみ。"
' 4) Groq Chat Completions 形式のリクエスト
Dim payload As New With {
.model = ModelId,
.messages = New Object() {
New With {.role = "system", .content = systemPrompt},
New With {.role = "user", .content = userPrompt}
},
.temperature = 0.2,
.max_tokens = 64
}
Dim json As String = JsonSerializer.Serialize(payload,
New JsonSerializerOptions With {.DefaultIgnoreCondition = JsonIgnoreCondition.WhenWritingNull})
Using client As New HttpClient()
client.DefaultRequestHeaders.Clear()
client.DefaultRequestHeaders.Add("Authorization", $"Bearer {apiKey}")
Dim content As New StringContent(json, Encoding.UTF8, "application/json")
Dim resp = Await client.PostAsync(GroqApiUrl, content)
If Not resp.IsSuccessStatusCode Then
Dim errBody = Await resp.Content.ReadAsStringAsync()
MessageBox.Show($"APIエラー: {resp.StatusCode}{Environment.NewLine}{errBody}")
Return
End If
Dim body As String = Await resp.Content.ReadAsStringAsync()
' レスポンス例：choices[0].message.content にテキスト
Dim doc = JsonDocument.Parse(body)
Dim tagsCsv As String =
doc.RootElement.GetProperty("choices")(0).GetProperty("message").GetProperty("content").GetString()
' 5) 後処理：CSV→配列、前後空白除去、空要素除去、最大5件に丸め
Dim tags As List(Of String) =
tagsCsv.Split(","c).
Select(Function(s) s.Trim()).
Where(Function(s) s.Length > 0).
Take(5).
ToList()
If tags.Count = 0 Then
MessageBox.Show("タグが生成されませんでした。プロンプトや入力を調整してください。")
Return
End If
MessageBox.Show("抽出されたタグ: " & String.Join(", ", tags))
End Using
Catch ex As Exception
MessageBox.Show("例外: " & ex.Message)
End Try
End Sub
実行結果としては、このようなタグの生成ができたと思います。
こんな感じで作ったタグを、次は前に作った「記事_追加」プロシージャを作り変えて、タグが５個入るように作り変えたテーブルに入れていこうと思います。
まずは上記のタグ生成関数で、生成したタグ情報をリスト形式で送るように、同期処理等を見直して作り直してみます。
Private Async Function タグ生成(ByVal text As String) As Task(Of List(Of String))
Try
' 1) .env から API キー読込（例：GROQ_API_KEY=xxx）
Env.Load()
Dim apiKey As String = Env.GetString("GROQ_API_KEY")
If String.IsNullOrWhiteSpace(apiKey) Then
MessageBox.Show("GROQ_API_KEY が見つかりません。.env を確認してください。")
Return New List(Of String)() ' 空のリストを返す
End If
' 2) 入力テキスト（例：「子どもたちはAIについてどう考えているのか」）
Dim userInput As String = text
If String.IsNullOrWhiteSpace(userInput) Then
MessageBox.Show("入力テキストが空です。")
Return New List(Of String)() ' 空のリストを返す
End If
' 3) タグ生成の指示（出力はCSVのみ／2〜5個／日本語）
Dim systemPrompt As String =
"あなたは日本語のタグ抽出器です。入力文から関連度の高いタグを5個だけ生成します。" &
"出力は必ず半角カンマ(,)区切りの単語のみ。日本語の読点「、」や改行は絶対に使わないでください。" &
"説明や余分な語、#記号、引用符、前後の語は付けないでください。"
Dim userPrompt As String =
$"入力文: {userInput}" & vbLf &
"条件: タグは名詞中心で簡潔に。一般化しすぎず、固有名詞を含めてもよい。出力はカンマ区切りのみ。"
' 4) Groq Chat Completions 形式のリクエスト
Dim payload As New With {
.model = ModelId,
.messages = New Object() {
New With {.role = "system", .content = systemPrompt},
New With {.role = "user", .content = userPrompt}
},
.temperature = 0.2,
.max_tokens = 64
}
Dim json As String = JsonSerializer.Serialize(payload,
New JsonSerializerOptions With {.DefaultIgnoreCondition = JsonIgnoreCondition.WhenWritingNull})
Using client As New HttpClient()
client.DefaultRequestHeaders.Clear()
client.DefaultRequestHeaders.Add("Authorization", $"Bearer {apiKey}")
Dim content As New StringContent(json, Encoding.UTF8, "application/json")
Dim resp = Await client.PostAsync(GroqApiUrl, content)
If Not resp.IsSuccessStatusCode Then
Dim errBody = Await resp.Content.ReadAsStringAsync()
MessageBox.Show($"APIエラー: {resp.StatusCode}{Environment.NewLine}{errBody}")
Return New List(Of String)() ' 空のリストを返す
End If
Dim body As String = Await resp.Content.ReadAsStringAsync()
' レスポンス例：choices[0].message.content にテキスト
Dim doc = JsonDocument.Parse(body)
Dim tagsCsv As String =
doc.RootElement.GetProperty("choices")(0).GetProperty("message").GetProperty("content").GetString()
' 5) 後処理：CSV→配列、前後空白除去、空要素除去、最大5件に丸め
Dim tags As List(Of String) =
tagsCsv.Replace("、", ","). ' ← 全角カンマを半角に変換
Split(","c).
Select(Function(s) s.Trim()).
Where(Function(s) s.Length > 0).
Take(5).
ToList()
Return tags
End Using
Catch ex As Exception
Throw
End Try
End Function
次に、リスト形式で送られてきたタグ情報5つを、ストアドへ送る変数として入れます。
Private Async Sub InsertNewsArticleSP(keyword As String, title As String, url As String, publishedAt As DateTime)
' タグ生成（非同期呼び出し）
Dim tags As List(Of String) = Await タグ生成(title)
' タグ数が不足していたら空文字で補う
While tags.Count < 5
tags.Add("")
End While
' サーバ、データベース名を取得
Dim server As String = Env.GetString("SERVER")
Dim db As String = Env.GetString("DATABASE")
Dim connectionString As String = "Server=" + server + ";Database=" + db + ";Trusted_Connection=True;TrustServerCertificate=True;"
Using conn As New Microsoft.Data.SqlClient.SqlConnection(connectionString)
conn.Open()
Using cmd As New Microsoft.Data.SqlClient.SqlCommand("記事_追加", conn)
cmd.CommandType = CommandType.StoredProcedure
cmd.Parameters.AddWithValue("@キーワード", keyword)
cmd.Parameters.AddWithValue("@タイトル", title)
cmd.Parameters.AddWithValue("@Url", url)
cmd.Parameters.AddWithValue("@公開日", publishedAt)
' タグを5つ追加（不足分は空文字）
cmd.Parameters.AddWithValue("@タグ1", tags(0))
cmd.Parameters.AddWithValue("@タグ2", tags(1))
cmd.Parameters.AddWithValue("@タグ3", tags(2))
cmd.Parameters.AddWithValue("@タグ4", tags(3))
cmd.Parameters.AddWithValue("@タグ5", tags(4))
cmd.ExecuteNonQuery()
End Using
End Using
End Sub
この結果として、タグを５つ取得したデータをテーブルに書きこめました。
（今回は取得する記事は２つ取得するようURLを書き換えました。）
試しに、Windows云々の記事のタグ１にあったWindowsを確認すると、こんな感じで出ます。
今回はタグ付けが可能かどうかが目的なので、質自体は適当で問題ないのですが、この辺のプロンプトや利用する文章生成APIなども、実用化するうえでは課題になってくるかと思われます。
Form2を作る
ここまでやったところで「タイトルのところを、URLへのリンクではなく、いったんForm2へのリンクにしてほしい。Form2にリンクや掲示板など、いろんな機能を追加してほしい」というシチュエーションを仮定します。
本当は投稿者の気まぐれなのですが…。
しかし実際、この辺は動画紹介サイトとかを参考に変更している他、前の現場でも似たような構成の画面はあったので、やっておいて損はないと思います。
まずはForm2のデザインを突貫で作ります。
そしたら、DataGridViewのタイトル部分を、そのタイトルとURLの名前をForm2に送る形でForm2を開けるようにします。
If e.ColumnIndex = DataGridView_履歴.Columns(0).Index AndAlso e.RowIndex >= 0 Then
Try
' Form1 と同じサイズ・位置で Form2 を開く
Dim f2 As New Form2()
f2.SetTitle(DataGridView_履歴.Rows(e.RowIndex).Cells(0).Value.ToString())
f2.SetURL(DataGridView_履歴.Rows(e.RowIndex).Cells(1).Value.ToString())
f2.StartPosition = FormStartPosition.Manual
f2.Show() ' モードレスで開く（Form1も触れる）
Catch ex As Exception
MessageBox.Show("Form2 を開けません: " & ex.Message)
End Try
End If
(略)
そしたら、Form2側のコードで、URLのLinkLabelを動かせるようにするだけ。
Imports System.Security.Policy
Public Class Form2
Public Sub SetTitle(title As String)
Label_タイトル.Text = title
End Sub
Public Sub SetURL(linkurl As String)
LinkLabel_URL.Text = linkurl
End Sub
Private Sub Form2_Load(sender As Object, e As EventArgs) Handles MyBase.Load
End Sub
Private Sub LinkLabel_URL_LinkClicked(sender As Object, e As LinkLabelLinkClickedEventArgs) _
Handles LinkLabel_URL.LinkClicked
Try
System.Diagnostics.Process.Start(New ProcessStartInfo With {
.FileName = LinkLabel_URL.Text,
.UseShellExecute = True
})
Catch ex As Exception
MessageBox.Show("リンクを開けません: " & ex.Message)
End Try
End Sub
End Class
ここで、タイトルなどを扱う関数の冒頭が、Public Sub SetTitle(title As String)
みたいに、Publicになっているのがわかるかと思います。
簡単に言うと、今まではPrivate（同フォーム内のみ有効）で関数を作っていたのを、フォームをまたぐ操作が必要になったのでPublic（フォームが違っても有効）にしたということです。
実際に作ったのがこちら
SQLを利用して掲示板機能を作る。
次に、Form2に掲示板を作っていきます。
コメント履歴表示のDataGridViewと、コメント用のTextBoxと、投稿ボタンを作ります。
SQLテーブルにも、このように列を作ります。
そしたら、投稿ボタンを押下したときに、現在の記事名と、名前と、コメントの情報をストアドに送ります。
Private Sub Button_投稿_Click(sender As Object, e As EventArgs) Handles Button_投稿.Click
Dim articleName As String = Label_タイトル.Text
Dim name As String = TextBox_名前.Text.Trim()
Dim comment As String = TextBox_コメント.Text.Trim()
If String.IsNullOrWhiteSpace(name) OrElse String.IsNullOrWhiteSpace(comment) Then
MessageBox.Show("名前とコメントを入力してください。")
Return
End If
Try
Env.Load()
Dim server As String = Env.GetString("SERVER")
Dim db As String = Env.GetString("DATABASE")
Dim connectionString As String =
"Server=" + server + ";Database=" + db + ";Trusted_Connection=True;TrustServerCertificate=True;"
Using conn As New Microsoft.Data.SqlClient.SqlConnection(connectionString)
conn.Open()
Using cmd As New Microsoft.Data.SqlClient.SqlCommand("掲示板_追加", conn)
cmd.CommandType = CommandType.StoredProcedure
cmd.Parameters.AddWithValue("@記事名", articleName)
cmd.Parameters.AddWithValue("@名前", name)
cmd.Parameters.AddWithValue("@コメント", comment)
cmd.ExecuteNonQuery()
End Using
End Using
TextBox_名前.Clear()
TextBox_コメント.Clear()
LoadComments() ' 投稿後に最新50件を再読み込み
Catch ex As Exception
MessageBox.Show("投稿に失敗しました: " & ex.Message)
End Try
End Sub
掲示板_追加のストアドはこんな感じ。投稿日時はストアドで記入していきます。
USE [NEWS]
GO
SET ANSI_NULLS ON
GO
SET QUOTED_IDENTIFIER ON
GO
-- プロシージャ定義部
ALTER PROCEDURE [dbo].[掲示板_追加]
@記事名 NVARCHAR(500),
@名前 NVARCHAR(100),
@コメント NVARCHAR(MAX)
AS
BEGIN
SET NOCOUNT ON;
INSERT INTO 掲示板 (記事名, 名前, コメント, 投稿日時)
VALUES (@記事名, @名前, @コメント, GETDATE());
END
あとは、逆にストアドから送られてくるデータを読み込むところも作ります。
この際、記事名をストアドに送り、その記事名と一致するものだけ表示するような処理をしないと、投稿したFormに関わらず、全てのコメントを取得してしまうので注意。
Private Sub LoadComments()
Try
Env.Load()
Dim server As String = Env.GetString("SERVER")
Dim db As String = Env.GetString("DATABASE")
Dim connectionString As String =
"Server=" + server + ";Database=" + db + ";Trusted_Connection=True;TrustServerCertificate=True;"
Using conn As New Microsoft.Data.SqlClient.SqlConnection(connectionString)
conn.Open()
Using cmd As New Microsoft.Data.SqlClient.SqlCommand("掲示板_取得", conn)
cmd.CommandType = CommandType.StoredProcedure
cmd.Parameters.AddWithValue("@記事名", Label_タイトル.Text)
Using reader = cmd.ExecuteReader()
DataGridView_掲示板.Rows.Clear()
While reader.Read()
DataGridView_掲示板.Rows.Add(
reader("名前").ToString(),
reader("コメント").ToString(),
Convert.ToDateTime(reader("投稿日時")).ToString("yyyy/MM/dd HH:mm:ss")
)
End While
End Using
End Using
End Using
Catch ex As Exception
MessageBox.Show("掲示板の読み込みに失敗しました: " & ex.Message)
End Try
End Sub
ストアド側
USE [NEWS]
GO
SET ANSI_NULLS ON
GO
SET QUOTED_IDENTIFIER ON
GO
-- プロシージャ定義部
ALTER PROCEDURE [dbo].[掲示板_取得]
@記事名 nvarchar(100)
AS
BEGIN
SET NOCOUNT ON;
SELECT TOP 50 記事名, 名前, コメント, 投稿日時
FROM 掲示板
WHERE 記事名=@記事名
ORDER BY 投稿日時 DESC
END
実行結果は以下の通り。
適当に書いて
これを投稿（投稿を押した時点で、テーブルに保存されたコメントを読み込む処理LoadComments() も発動している）
テーブルにコメントが有ることを確認。
他のForm2では、このコメントは読み込まれない。
タグの再登録
先ほどタグの自動生成機能を作りましたが、Form2の方で閲覧者が自由にタグを変更できるようにする機能も作っていきたいと思います。
なお、検索時に使ったキーワードは、あえて変更できないタグとして扱うようにします。
Private Sub Button_タグ更新_Click(sender As Object, e As EventArgs) Handles Button_タグ更新.Click
Try
Env.Load()
Dim server As String = Env.GetString("SERVER")
Dim db As String = Env.GetString("DATABASE")
Dim connectionString As String =
"Server=" + server + ";Database=" + db + ";Trusted_Connection=True;TrustServerCertificate=True;"
Using conn As New Microsoft.Data.SqlClient.SqlConnection(connectionString)
conn.Open()
Using cmd As New Microsoft.Data.SqlClient.SqlCommand("掲示板タグ_変更", conn)
cmd.CommandType = CommandType.StoredProcedure
cmd.Parameters.AddWithValue("@記事名", Label_タイトル.Text)
cmd.Parameters.AddWithValue("@タグ1", DataGridView_タグ.Rows(0).Cells(1).Value.ToString())
cmd.Parameters.AddWithValue("@タグ2", DataGridView_タグ.Rows(0).Cells(2).Value.ToString())
cmd.Parameters.AddWithValue("@タグ3", DataGridView_タグ.Rows(0).Cells(3).Value.ToString())
cmd.Parameters.AddWithValue("@タグ4", DataGridView_タグ.Rows(0).Cells(4).Value.ToString())
cmd.Parameters.AddWithValue("@タグ5", DataGridView_タグ.Rows(0).Cells(5).Value.ToString())
cmd.ExecuteNonQuery()
End Using
End Using
TextBox_名前.Clear()
TextBox_コメント.Clear()
LoadComments() ' 投稿後に最新50件を再読み込み
Catch ex As Exception
MessageBox.Show("投稿に失敗しました: " & ex.Message)
End Try
End Sub
タグ変更のストアドは、UPDATE句を使って、以下のように作ってみました。
USE [NEWS]
GO
SET ANSI_NULLS ON
GO
SET QUOTED_IDENTIFIER ON
GO
-- プロシージャ定義部
ALTER PROCEDURE [dbo].[掲示板タグ_変更]
@記事名 nvarchar(100),
@タグ1 Nvarchar(50),
@タグ2 Nvarchar(50),
@タグ3 Nvarchar(50),
@タグ4 Nvarchar(50),
@タグ5 Nvarchar(50)
AS
-- 処理部
BEGIN
SET NOCOUNT ON;
UPDATE [dbo].[履歴]
SET
タグ1 = @タグ1,
タグ2 = @タグ2,
タグ3 = @タグ3,
タグ4 = @タグ4,
タグ5 = @タグ5
WHERE タイトル IN (
SELECT TOP 1 タイトル FROM [dbo].[履歴] WHERE タイトル = @記事名
);
END
タグ更新を実行してみます。
こんな感じで適当にタグが付けられているのを
タグ更新を押してタグを更新すると
テーブルがその通りに書き換わりました。
念の為新しく登録したタグで検索を行った場合も、この通り表示することができました。
おわりに
今回は、実際のニュース記事などを参考に、記事のタグ付け機能や掲示板機能などをつけてみました。
タグに関しては記事数、タグ数ともに少ないので、個人制作レベルではあんまり有効ではないかと思われると思いますが、大規模なサイトになるにつれて、検索手段として有効に働いてくるはずです。
また掲示板に関しては「機密情報とかあったり、リンク先のニュースサイトの掲示板を荒らしたくないから公の場では喋れないけど、このような場があれば遠慮なく議論できる」という用途で使えるのかなと思います。
今後の展望としてはひとまず、おすすめ表示として、類似するタグが多くついているページを表示すること、コメント数の表示などが挙げられるかと思います。
この記事を見て、似たようなものを作りたい人がいれば、作ってみてください。
このアプリ自体、復習や技術共有などを目的に作ったけっこう突貫工事なものなので、この記事を読んだ方なら、やろうと思えば根本的により良いものを作れるかと思います。
Discussion