アルツの備忘録

最近、年のせいで物忘れが激しい。
そこで、いろんなことをここに記録して行きたいと思います。

VB + Winsock + Access 簡易翻訳

2008年02月10日 21時24分05秒 | Access
Access VBA で Winsock を使い簡易の翻訳サーバを作ってみた。
VBで作ったクライアントとTCP接続をして、Dlookupで和英、英和、あいまい検索をやってい、返信する。
Accessのデータテーブルは中学レベル1500件・高校レベル3500件を持っている(ネット上にあったものを利用)、クライアント側はVB6で作成している。
それぞれ、winsockコントロールを一個づつ配置する。

今後、ブラウザで検索できるAccess_Webサーバでも作ろうと思案中です。

<Access側>

Option Compare Database
Option Explicit                  '変数宣言を強制する

Private Sub コマンド0_Click() '終了処理
    Winsock1.Close            'ネットワーク切断
    DoCmd.Close
End Sub

Private Sub Form_Load()
On Error GoTo err_end:
    Winsock1.Close               '終了処理
    Winsock1.LocalPort = 1001    '接続要求受付ポート番号設定
    Winsock1.Listen              '接続要求待ち
    Exit Sub
err_end:
    MsgBox (Winsock1.State)
    
End Sub

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
    If Winsock1.State <> sckClosed Then    'Winsockの状態(閉じていない)
        Winsock1.Close    'Winsockを閉じる
    End If
    Winsock1.Accept requestID    '接続処理
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim dat As String, ans As String
    Dim n As Integer

    Winsock1.GetData dat
    'クライアントのコンピュータ名受信
    If Left(dat, 2) = "##" Then    'コンピュータ名かどうか判定
        Me.Text2.SetFocus
        Text2.Text = Mid(dat, 3)    'コンピュータ名を表示
        Exit Sub        'プロシージャを抜け出す
    End If
    
    Me.Text1.SetFocus
    Text1.Text = Trim(dat)
    
    '受信データの1文字目が全角か半角か調べる
    '半角の時、英和変換
    Dim moji As String
    moji = Left(dat, 1)

    If LenB(StrConv(moji, vbFromUnicode)) = 1 Then
        '英和変換
        ans = eiwa_Tango_chk(dat)
        '英和変換 あいまい検索
         If ans = "" Then
            ans = waei_Tango_chk(dat)
         End If
       Else
        '和英変換
        If ans = "" Then
            ans = waei_Tango_chk2(dat)
        End If
    End If
    
    '結果送信
    If ans <> "" Then
       Winsock1.SendData Trim(ans)
      Else
       Winsock1.SendData "わかりません"
    End If
    
End Sub

Function eiwa_Tango_chk(dat)
    Dim Tango As Variant
    
    Tango = DLookup("[日本語]", "Tango_1", "[英語]='" & dat & "'")
    
    If IsNull(Tango) Then
        Tango = DLookup("[日本語]", "Tango_2", "[英語]='" & dat & "'")
    End If
    
    If IsNull(Tango) Then
       eiwa_Tango_chk = ""
    Else
       eiwa_Tango_chk = Tango
    End If
End Function

Function waei_Tango_chk(dat)
    Dim Tango As Variant
    'Tango_1 中学レベル 1800
    Tango = DLookup("[英語]", "Tango_1", "[日本語] = '" & dat & "'")
    'Tango_2 高校レベル 3500
    If IsNull(Tango) Then
        Tango = DLookup("[英語]", "Tango_2", "[日本語] = '" & dat & "'")
    End If
    
    If IsNull(Tango) Then
       waei_Tango_chk = ""
    Else
       waei_Tango_chk = Tango
    End If

End Function

Function waei_Tango_chk2(dat)
    Dim Tango As Variant
    
    Tango = DLookup("[英語]", "Tango_1", "[日本語] like '*" & dat & "*'")
    
    If IsNull(Tango) Then
        Tango = DLookup("[英語]", "Tango_2", "[日本語] like '*" & dat & "*'")
    End If
    
    If IsNull(Tango) Then
       waei_Tango_chk2 = ""
    Else
       waei_Tango_chk2 = Tango
    End If

End Function

Private Sub Winsock1_Close()
    Me.Text2.SetFocus
    Text2.Text = ""        'コンピュータ名を消す
    Winsock1.Close        '接続を閉じる
    Winsock1.Listen        '接続要求を受け付ける
End Sub

----------------------------------------------------------------

<VB  クライアント側>

Private Sub Command1_Click()
    Winsock1.Close        '接続を閉じる
    Winsock1.RemoteHost = Text1.Text    'サーバのコンピュータ名設定
    Winsock1.RemotePort = 1001        'ポート番号設定
    Winsock1.Connect    '接続する
End Sub

Private Sub Command2_Click()
    Winsock1.SendData Text2.Text    'データを送信する
End Sub

Private Sub Command3_Click()
    Winsock1.Close    '接続を閉じる
    Unload Me
    End
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim dat As String
    Winsock1.GetData dat    'サーバからのデータ受信
    Text3.Text = dat
End Sub

Private Sub Winsock1_Connect()
    'サーバのコンピュータ名を表示
    Label4.Caption = "接続先:" & Winsock1.RemoteHost
    'サーバにクライアントのコンピュータ名を送信
    Winsock1.SendData "##" & Winsock1.LocalHostName
End Sub



最新の画像もっと見る

コメントを投稿