ＥｘｃｅｌＶＢＡでのｗｉｎｓｏｃｋの利用

質問

だいぶ以前に、ＶＢ６を使ってマニュアル片手にｔｃｐやｕｄｐによるＬＡＮ内での双方向データ転送（チャットごっこ）ができるものを作った経験があります。
最近、Ｅｘｃｅｌ2010のＶＢＡを使って当時のようなものを作ってみたいと考え、ＣＱ出版の「ＶＢＡによるＴＣＰ／ＩＰプログラミング入門」を購入しました。読んだ限りではなんとかなりそうに思ったのですが、その中で、「Ｗｉｎｓｏｃｋコントロールはプログラム開発し配布するためにはそのライセンスが必要でライセンスなしではＷｉｎｓｏｃｋコントロールを配置してダイアログを作成できない」という記述がありました。つまりはＶＢ６などのライセンスがある環境でないと作り始めることができないようです。
幸いＶＢ６はうちの古いパソコンに入っていますから、そちらに入っているＥｘｃｅｌでＷｉｎｓｏｃｋコントロールを配置しただけのＶＢＡファイルを作り、今のＥｘｃｅｌ2010に持って来て修正していくのであれば作業は可能らしいのですが、いずれは破棄するであろうパソコンに依存しないといけないという流れがしっくり来ません。
また、ＶＢ６を今の環境に移せば解決する話だとも思いますが、今後ＶＢＡは使ってもＶＢ６を使うことはないだろうということと、容量等の事情から、できればこちらに入れるようなことはしたくありません。

必要に迫られてもいなく少々わがままな事情も合わせての話ですが、何か解決方法がありましたら提案・指摘などをお願いいたします。

回答No.1

nda23 · ベストアンサー

直接WinSockのDLLを使えば問題ありません。
DLLの関数は必ずクラスモジュール上で定義し、
インスタンス化してから使います。
'定数
Private Const AF_INET　　　　　As Long = 2
Private Const SOCK_STREAM　As Long = 1
Private Const IPPROTO_TCP　As Long = 6
Private Const INVALID_SOCKET As Long = -1
Private Type sockaddr_in
アドレスファミリ As Integer
ポート番号 As Integer
IPアドレス As Long
予備(7) As Byte
End Type
'初期化
Private Declare Function WSAStartup Lib "WS2_32" _
　　(ByVal バージョン As Integer,データ As Byte) As Long
'クリア
Private Declare Function WSACleanup Lib "WS2_32" _
　　() As Long
'ソケット作成
Private Declare Function socket Lib "WS2_32" _
　　(ByVal アドレスファミリ As Long, ByVal ソケット形式 As Long, _
　　ByVal プロトコル As Long) As Long
'アドレス変換
Private Declare Function inet_addr Lib "WS2_32" _
　　(ByVal IPアドレス As String) As Long, _
'接続
Private Declare Function connect "WS2_32" _
　　(ByVal ソケット As Long, アドレス As sockaddr_in, _
　　ByVal アドレス長 As Long) As Long, _
'送信(文字列)
Private Declare Function sendA "WS2_32" Alias "send" _
　　(ByVal ソケット As Long, ByVal データ As String, _
　　ByVal データ長長 As Long, ByVal フラグ As Long) As Long, _
'送信(バイナリ)
Private Declare Function sendB "WS2_32" Alias "send" _
　　(ByVal ソケット As Long, データ As Byte, _
　　ByVal データ長長 As Long, ByVal フラグ As Long) As Long, _
'受信(バイナリ)
Private Declare Function recvB "WS2_32" Alias "send" _
　　(ByVal ソケット As Long, データ As Byte, _
　　ByVal データ長長 As Long, ByVal フラグ As Long) As Long, _
'ソケット閉鎖
Private Declare Function closesocket Lib "WS2_32" _
　　(ByVal ソケット As Long) As Long
サンプル
Public Sub サンプル()
Dim 戻り値 As Long
Dim ソケット As Long
Dim アドレス As sockaddr_in

'初期化する
ReDim データ(397) As Byte
戻り値 = WSAStartup(&H202, データ(0))
Erase データ '初期化で返されるデータは不要なので棄てる
If 戻り値 <> 0 Then
　　MsgBox "初期化エラー Code=" & Err.LastDllError
　　Exit Sub
End If
'必ずクリーンアップを通るよう制御する
Do
　　'TCPIPストリーム(HTTPやFTP用)のソケットを作る
　　ソケット = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
　　If ソケット = INVALID_SOCKET Then
　　　　MsgBox "ソケット作成エラー Code=" & Err.LastDllError
　　　　Exit Do
　　End If
　　'サーバに接続する
　　アドレス.アドレスファミリ = AF_INET
　　アドレス.ポート番号 = 23 '★FTPのポート番号
　　アドレス.IPアドレス = inet_addr("192.168.0.1")
　　戻り値 = connect(ソケット, アドレス, Len(アドレス))
　　If 戻り値 <> 0 Then
　　　　MsgBox "接続エラー Code=" & Err.LastDllError
　　　　Exit Do
　　End If
　　Dim コマンド As String
　　Dim 応答 As String
　　Dim 文字 As Byte
　　Do
　　　　'１バイトずつ受信する
　　　　戻り値 = recvB(ソケット, 文字, 1, 0)
　　　　'戻り値は受信バイト数なので0以下はエラー(切断）である
　　　　If 戻り値 <= 0 Then
　　　　　　MsgBox "受信エラー Code=" & Err.LastDllError
　　　　　　Exit Do
　　　　End If
　　　　応答 = 応答 & Chr(文字)
　　　　'FTPでは応答の末尾は改行なので、検出したらループを抜ける
　　　　If 文字 = 10 Then Exit Do
　　Loop
　　'その後はプロトコルに従い、sendやrecvでデータを送受信する

　　'ソケットを閉じる
　　closesocket ソケット
Loop Until True
WSACleanup
End Sub

実際のプログラム例はネットに沢山あります。
但し、殆どがC言語用なので、上記のようにVBに
定義して使います。
データ型はint→Long、WORD→Integer、char→StringまたはByte
ByVal/ByRefの使い分けは単に変数を使う所はByVal、*のある
ポインタならByRefです。

少し厄介なのが受信です。recvはブロック型で、指定バイト数を
受信するまで制御が戻りません。非ブロック型にするか、受信の
有無を調べるか、あるウィンドウに受信を通知してもらってから、
受信するようにします。この３個の方法でWindowsライクなのは
３番目ですが、VBAでは難しいので1番目の方法がよいでしょう。

クラスモジュールにする理由は障害発生時にDLL内部データが
破壊され、その後回復しないためです。標準モジュール内に
関数を定義すると、VBA空間にデータが残るため、プログラムから
解放する方法がありません。クラスモジュールで定義した場合は
クラスを解放（Set 変数 = Nothing)すればデータも解放されます。
次に新しいクラスのインスタンスを作ればDLLも新たにロードされ
るので、障害をひきずりません。

お礼

丁寧なソースまで載せていただきありがとうございます。
なかなか難易度は高そうですが、コメントしていただいてますので、比較しながらなんとかなりそうです。
どうもありがとうございました。