diff --git a/.github/workflows/validate.yml b/.github/workflows/validate.yml new file mode 100644 index 0000000..0612584 --- /dev/null +++ b/.github/workflows/validate.yml @@ -0,0 +1,17 @@ +name: Validate repository + +on: + push: + pull_request: + +permissions: + contents: read + +jobs: + validate: + runs-on: windows-latest + steps: + - uses: actions/checkout@v4 + - name: Validate VBA source and README + shell: pwsh + run: ./Tests/Validate-Repository.ps1 diff --git a/README.md b/README.md index fe7e0b7..c9cad33 100644 --- a/README.md +++ b/README.md @@ -1,2 +1,133 @@ -# VBA_WinsockAPI_UDP_Sample +# Excel VBA Winsock UDP Sample +Excel VBAからWindowsのWinsock APIを直接呼び出し、ローカルPC内でUDP通信を試すための学習用サンプルです。 + +追加のActiveXコントロールや外部ライブラリは使用しません。VBA標準モジュール1ファイルで、UDPの受信側と送信側の基本的な処理順序を確認できます。 + +> [!IMPORTANT] +> UDPは接続確認や再送を行わないため、送信成功が相手の受信成功を保証しません。このリポジトリは学習用です。認証や暗号化はなく、インターネットへ公開する用途には適していません。 + +## このサンプルで確認できること + +- `WSAStartup` / `WSACleanup`によるWinsockの初期化と終了 +- `socket` / `bind` / `recvfrom`によるUDP受信 +- `socket` / `sendto`によるUDP送信 +- `closesocket`によるソケットの解放 +- `PtrSafe`と`LongPtr`を使った32ビット/64ビットOffice対応 +- 別のExcelプロセスを受信側として起動する方法 + +## 動作環境 + +- Windows +- Excel 2010以降(VBA 7) +- 32ビット版または64ビット版Office +- マクロを保存できるExcelブック(`.xlsm`または`.xlsb`) + +macOS版ExcelではWindows DLLを呼び出せないため動作しません。 + +## ファイル + +| ファイル | 内容 | +| --- | --- | +| `VBA_WinsockAPI_UDP_Sample.bas` | UDP受信、UDP送信、動作確認用マクロを含む標準モジュール | +| `SECURITY.md` | 脆弱性情報を非公開で連絡する場合の案内 | + +## 使い方 + +### 1. 標準モジュールを取り込む + +1. マクロ有効ブックを作成し、一度保存します。 +2. `Alt` + `F11`でVisual Basic Editorを開きます。 +3. メニューの「ファイル」→「ファイルのインポート」を選びます。 +4. `VBA_WinsockAPI_UDP_Sample.bas`を選択します。 +5. 「デバッグ」→「VBAProjectのコンパイル」を実行します。 + +### 2. 受信側を起動する + +`MainForMultiProcess`を実行します。 + +同じブックが読み取り専用で別のExcelプロセスに開かれ、1秒後に`UDPRecvFrom`が開始します。既定では`127.0.0.1:60051`でデータグラムを待ちます。 + +### 3. 送信側から送る + +最初のExcelへ戻り、次のいずれかを実行します。 + +| マクロ | 送信内容 | 受信側の動作 | +| --- | --- | --- | +| `testHELLO` | `HELLO` | 送信元のIPアドレスとポート番号を表示 | +| `testElse` | `else message` | 受信文字列を表示 | +| `testQUIT` | `QUIT` | 受信ループを終了 | + +`testQUIT`は受信ループだけを終了します。別プロセスのExcel自体は自動終了しないため、内容を確認してから手動で閉じてください。 + +## 通信の流れ + +### 受信側 + +```text +WSAStartup → socket → bind → recvfrom → closesocket → WSACleanup +``` + +### 送信側 + +```text +WSAStartup → socket → sendto → closesocket → WSACleanup +``` + +## 接続先を変更する + +モジュール先頭付近の次の定数を変更します。 + +```vb +Private Const DEFAULT_SERVER_IP As String = "127.0.0.1" +Private Const DEFAULT_SERVER_PORT As Long = 60051 +``` + +初めて試す場合は、外部から接続できないループバックアドレス`127.0.0.1`のまま使用してください。 + +## TCPサンプルとの違い + +| 項目 | UDP | TCP | +| --- | --- | --- | +| 接続処理 | なし | `connect` / `accept`あり | +| 到達・順序の保証 | なし | あり | +| メッセージの境界 | データグラム単位 | バイトストリーム | +| このサンプルの送受信API | `sendto` / `recvfrom` | `send` / `recv` | + +TCP版は[`VBA_WinsockAPI_TCP_Sample`](https://github.com/papanda925/VBA_WinsockAPI_TCP_Sample)にあります。 + +## 制限事項 + +- IPv4のみ対応 +- 受信バッファは2,048文字の固定長 +- 文字列はASCII範囲での利用を想定 +- `recvfrom`は同期・ブロッキング処理 +- 通信の認証・暗号化・再送制御はなし + +`DoEvents`はブロッキング中の`recvfrom`を非同期化するものではありません。このサンプルでは、Excelの操作用プロセスと受信用プロセスを分けて影響を限定しています。 + +## トラブルシューティング + +### 送信しても何も表示されない + +受信側のExcelプロセスが起動していること、送信側と受信側でIPアドレスとポート番号が一致していることを確認してください。UDPでは受信側が起動する前に送ったデータは保持されません。 + +### `Address already in use`に相当するエラーになる + +同じポートを使う受信処理が既に起動している可能性があります。別プロセスのExcelを閉じるか、`DEFAULT_SERVER_PORT`を未使用のポートへ変更してください。 + +### 64ビットOfficeでAPI宣言エラーになる + +最新版の`.bas`を取り込み直し、「デバッグ」→「VBAProjectのコンパイル」を実行してください。ソケットはWindowsのハンドルであるため、変数とAPIの戻り値に`LongPtr`を使用しています。 + +## 参考資料 + +- [64-bit Visual Basic for Applications overview](https://learn.microsoft.com/office/vba/language/concepts/getting-started/64-bit-visual-basic-for-applications-overview) +- [socket function](https://learn.microsoft.com/windows/win32/api/winsock2/nf-winsock2-socket) +- [sendto function](https://learn.microsoft.com/windows/win32/api/winsock2/nf-winsock2-sendto) +- [recvfrom function](https://learn.microsoft.com/windows/win32/api/winsock2/nf-winsock2-recvfrom) +- [closesocket function](https://learn.microsoft.com/windows/win32/api/winsock2/nf-winsock2-closesocket) + +## Repository scope + +This is an educational Excel VBA sample for direct UDP communication through the Windows Winsock API. diff --git a/Tests/Validate-Repository.ps1 b/Tests/Validate-Repository.ps1 new file mode 100644 index 0000000..18eeda7 --- /dev/null +++ b/Tests/Validate-Repository.ps1 @@ -0,0 +1,75 @@ +$ErrorActionPreference = 'Stop' + +$repositoryRoot = Split-Path -Parent $PSScriptRoot +$sourcePath = Join-Path $repositoryRoot 'VBA_WinsockAPI_UDP_Sample.bas' +$readmePath = Join-Path $repositoryRoot 'README.md' + +[System.Text.Encoding]::RegisterProvider([System.Text.CodePagesEncodingProvider]::Instance) +$source = [System.Text.Encoding]::GetEncoding(932).GetString( + [System.IO.File]::ReadAllBytes($sourcePath) +) +$readme = [System.IO.File]::ReadAllText($readmePath) +$failures = [System.Collections.Generic.List[string]]::new() + +function Assert-Match { + param( + [Parameter(Mandatory)] + [string]$Text, + + [Parameter(Mandatory)] + [string]$Pattern, + + [Parameter(Mandatory)] + [string]$Message + ) + + if ($Text -notmatch $Pattern) { + $failures.Add($Message) + } +} + +function Assert-NotMatch { + param( + [Parameter(Mandatory)] + [string]$Text, + + [Parameter(Mandatory)] + [string]$Pattern, + + [Parameter(Mandatory)] + [string]$Message + ) + + if ($Text -match $Pattern) { + $failures.Add($Message) + } +} + +Assert-Match $source '(?im)^Option Explicit\s*$' 'Option Explicit is required.' +Assert-Match $source '(?im)Function SOCKET .+ As LongPtr\s*$' 'socket must return LongPtr.' +Assert-Match $source '(?im)Function closesocket .+LongPtr.+ As Long\s*$' 'closesocket must receive a LongPtr handle.' +Assert-Match $source '(?im)Function recvfrom .+ByRef fromAddrSize As Long\) As Long\s*$' 'recvfrom must receive the address length by reference.' +Assert-NotMatch $source '(?i)wsock32\.dll' 'Use ws2_32.dll consistently.' +Assert-NotMatch $source '(?im)^\s*(Application\.Quit|ThisWorkbook\.Close)\s*$' "The sample must not close the user's Excel session." +Assert-Match $readme '(?m)^## 使い方\s*$' 'README must contain setup and usage instructions.' +Assert-Match $readme '(?m)^## 制限事項\s*$' 'README must describe limitations.' +Assert-Match $readme '(?m)^## トラブルシューティング\s*$' 'README must contain troubleshooting guidance.' + +$subStarts = ([regex]::Matches($source, '(?im)^\s*(Public\s+|Private\s+)?Sub\s+\w+')).Count +$subEnds = ([regex]::Matches($source, '(?im)^\s*End Sub\s*$')).Count +$functionStarts = ([regex]::Matches($source, '(?im)^\s*(Public\s+|Private\s+)?Function\s+\w+')).Count +$functionEnds = ([regex]::Matches($source, '(?im)^\s*End Function\s*$')).Count + +if ($subStarts -ne $subEnds) { + $failures.Add("Sub/End Sub count mismatch: $subStarts/$subEnds") +} +if ($functionStarts -ne $functionEnds) { + $failures.Add("Function/End Function count mismatch: $functionStarts/$functionEnds") +} + +if ($failures.Count -gt 0) { + $failures | ForEach-Object { Write-Error $_ } + exit 1 +} + +Write-Host 'Repository validation passed.' diff --git a/VBA_WinsockAPI_UDP_Sample.bas b/VBA_WinsockAPI_UDP_Sample.bas index ede8a93..3c3f0af 100644 --- a/VBA_WinsockAPI_UDP_Sample.bas +++ b/VBA_WinsockAPI_UDP_Sample.bas @@ -11,9 +11,9 @@ Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000 Private Const FORMAT_MESSAGE_IGNORE_INSERTS As Long = &H200 Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK As Long = &HFF 'FormatMessage(API) -Private Declare PtrSafe Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Long, _ +Private Declare PtrSafe Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, ByVal lpSource As LongPtr, _ ByVal dwMessageId As Long, ByVal dwLanguageId As Long, _ - ByVal lpBuffer As String, ByVal nSize As Long, Arguments As LongPtr) _ + ByVal lpBuffer As String, ByVal nSize As Long, ByVal Arguments As LongPtr) _ As Long '* --- WSAStartup / WSACleanup --- */ @@ -30,12 +30,12 @@ Public Type WSAData szSystemStatus As String * WSASYS_STATUS_SIZE iMaxSockets As Integer iMaxUDPDG As Integer - lpVendorInfo As Long + lpVendorInfo As LongPtr End Type 'WSAStartup / WSACleanup(API) Public Declare PtrSafe Function WSAStartup Lib "Ws2_32.dll" (ByVal wVersionRequested As Integer, ByRef lpWSADATA As WSAData) As Long -Public Declare PtrSafe Function WSACleanup Lib "wsock32.dll" () As Long +Public Declare PtrSafe Function WSACleanup Lib "ws2_32.dll" () As Long '* --- Network�@ --- */ Private Enum AF @@ -76,30 +76,30 @@ Public Type SOCKADDR_IN sin_zero2 As Long End Type -Private Const INVALID_SOCKET = -1 +Private Const INVALID_SOCKET As Long = -1 Private Const SOCKET_ERROR As Long = -1 +Private Const DEFAULT_SERVER_IP As String = "127.0.0.1" +Private Const DEFAULT_SERVER_PORT As Long = 60051 +Private Const RECEIVE_BUFFER_SIZE As Long = 2048 'socket / closesocket(API) -Public Declare PtrSafe Function SOCKET Lib "wsock32.dll" Alias "socket" (ByVal lngAf As LongPtr, ByVal lngType As LongPtr, ByVal lngProtocol As LongPtr) As Long -Public Declare PtrSafe Function closesocket Lib "Ws2_32.dll" (ByVal socketHandle As Long) As Long +Public Declare PtrSafe Function SOCKET Lib "ws2_32.dll" Alias "socket" (ByVal lngAf As Long, ByVal lngType As Long, ByVal lngProtocol As Long) As LongPtr +Public Declare PtrSafe Function closesocket Lib "ws2_32.dll" (ByVal socketHandle As LongPtr) As Long 'sendto(API) -Private Declare PtrSafe Function sendto Lib "Ws2_32.dll" (ByVal s As Long, ByVal buf As String, ByVal length As Long, ByVal Flags As Long, ByRef remoteAddr As SOCKADDR_IN, ByVal remoteAddrSize As Long) As Long +Private Declare PtrSafe Function sendto Lib "ws2_32.dll" (ByVal s As LongPtr, ByVal buf As String, ByVal length As Long, ByVal Flags As Long, ByRef remoteAddr As SOCKADDR_IN, ByVal remoteAddrSize As Long) As Long 'recvfrom(API) -Public Declare PtrSafe Function recvfrom Lib "wsock32.dll" (ByVal SOCKET As LongPtr, ByVal buf As String, ByVal length As LongPtr, ByVal Flags As Long, FromAddr As SOCKADDR_IN, fromAddrSize As Long) As Long +Public Declare PtrSafe Function recvfrom Lib "ws2_32.dll" (ByVal socketHandle As LongPtr, ByVal buf As String, ByVal length As Long, ByVal Flags As Long, ByRef FromAddr As SOCKADDR_IN, ByRef fromAddrSize As Long) As Long 'bind(API) -Private Declare PtrSafe Function bind Lib "Ws2_32.dll" (ByVal s As Long, ByRef Name As SOCKADDR_IN, ByVal namelen As Long) As Long +Private Declare PtrSafe Function bind Lib "ws2_32.dll" (ByVal s As LongPtr, ByRef Name As SOCKADDR_IN, ByVal namelen As Long) As Long 'htons(API) -Private Declare PtrSafe Function htons Lib "Ws2_32.dll" (ByVal hostshort As Long) As Integer -Private Declare PtrSafe Function ntohs Lib "Ws2_32.dll" (ByVal netshort As Long) As Integer +Private Declare PtrSafe Function htons Lib "ws2_32.dll" (ByVal hostshort As Integer) As Integer +Private Declare PtrSafe Function ntohs Lib "ws2_32.dll" (ByVal netshort As Integer) As Integer ' inet_addr(API) IP‚ðƒhƒbƒgŒ`Ž®(x.x.x.x)‚©‚ç“à•”Œ`Ž®‚ɕύX Private Declare PtrSafe Function inet_addr Lib "Ws2_32.dll" (ByVal cp As String) As Long 'IPv4‚܂½‚ÍIPv6ƒCƒ“ƒ^�[ƒlƒbƒgƒlƒbƒgƒ��[ƒNƒAƒhƒŒƒX‚©‚çƒCƒ“ƒ^�[ƒlƒbƒg•W�€Œ`Ž®‚̕¶Žš—ñ‚ɕϊ· -Private Declare PtrSafe Function InetNtopW Lib "Ws2_32.dll" (ByVal Family As Integer, ByRef pAddr As Long, ByVal pStringBuf As String, ByVal StringBufSize As Integer) As Long - -'* --- Sleep --- */ -Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) +Private Declare PtrSafe Function InetNtopW Lib "ws2_32.dll" (ByVal Family As Integer, ByRef pAddr As Long, ByVal pStringBuf As String, ByVal StringBufSize As LongPtr) As LongPtr 'ƒGƒ‰�[ƒR�[ƒh‚ðFormatMessage‚ʼn“lj”\‚ɕϊ· Public Function GetFormatMessageString(Optional ByVal dwMessageId As Long = 0) As String @@ -116,7 +116,7 @@ Public Function GetFormatMessageString(Optional ByVal dwMessageId As Long = 0) A lpBuffer = String(1024, vbNullChar) result = FormatMessage(dwFlags, 0&, dwMessageId, 0&, lpBuffer, Len(lpBuffer), 0&) If (result > 0) Then - lpBuffer = Left(lpBuffer, InStr(lpBuffer, vbNullChar) - 1) 'Null�I’[‚܂Ŏ擾 + lpBuffer = Left$(lpBuffer, result) Else lpBuffer = "" End If @@ -130,23 +130,23 @@ Public Function MAKEWORD(Lo As Byte, Hi As Byte) As Integer End Function Public Sub UDPRecvFrom() - Dim ip As String: ip = "127.0.0.1" - Dim remotePort As Long: remotePort = 60051 - Dim RetCode As Long - + Dim WinsockStarted As Boolean Dim remoteAddr As SOCKADDR_IN - Dim ListenSocketHandle As Long - Const RecvBuffSize As Long = 2048 - Dim recvBuffer As String * RecvBuffSize + Dim remoteAddrSize As Long + Dim ListenSocketHandle As LongPtr + Dim recvBuffer As String * RECEIVE_BUFFER_SIZE Dim recvResult As Long + ListenSocketHandle = INVALID_SOCKET + Dim WSAD As WSAData RetCode = WSAStartup(MAKEWORD(2, 2), WSAD) If RetCode <> 0 Then MsgBox "WSAStartup failed with error�F" & GetFormatMessageString(RetCode) Exit Sub End If + WinsockStarted = True ListenSocketHandle = SOCKET(AF.AF_INET, SOCKTYPE.SOCK_DGRAM, PROTOCOL.IPPROTO_UDP) If ListenSocketHandle = INVALID_SOCKET Then @@ -155,8 +155,8 @@ Public Sub UDPRecvFrom() End If remoteAddr.sin_family = AF_INET - remoteAddr.sin_addr = inet_addr(ip) - remoteAddr.sin_port = htons(remotePort) + remoteAddr.sin_addr = inet_addr(DEFAULT_SERVER_IP) + remoteAddr.sin_port = htons(Convert_u_short_PortNumber(DEFAULT_SERVER_PORT)) RetCode = bind(ListenSocketHandle, remoteAddr, LenB(remoteAddr)) If RetCode = SOCKET_ERROR Then @@ -166,13 +166,13 @@ Public Sub UDPRecvFrom() Do While True DoEvents -' Sleep 200 - recvBuffer = String(RecvBuffSize, vbNullChar) - recvResult = recvfrom(ListenSocketHandle, recvBuffer, RecvBuffSize, 0, remoteAddr, LenB(remoteAddr)) + recvBuffer = String(RECEIVE_BUFFER_SIZE, vbNullChar) + remoteAddrSize = LenB(remoteAddr) + recvResult = recvfrom(ListenSocketHandle, recvBuffer, RECEIVE_BUFFER_SIZE, 0, remoteAddr, remoteAddrSize) If (recvResult > 0) Then Dim ipBuffer As String - ipBuffer = Left(recvBuffer, InStr(recvBuffer, vbNullChar) - 1) 'Null�I’[‚܂Ŏ擾 + ipBuffer = Left$(recvBuffer, recvResult) '‚¿‚å‚Á‚Ɖü‘¢‚±‚±‚œd•¶�§Œä 'Žd—l�F 'HELLO -> HELLO VBA Winsock API ‚Ɠš‚¦‚é�B @@ -197,16 +197,14 @@ Public Sub UDPRecvFrom() Loop EXIT_POINT: - If closesocket(ListenSocketHandle) = SOCKET_ERROR Then - MsgBox "closesocket failed with error�F" & GetFormatMessageString(Err.LastDllError) - End If - If WSACleanup() <> 0 Then + If ListenSocketHandle <> INVALID_SOCKET Then + If closesocket(ListenSocketHandle) = SOCKET_ERROR Then + MsgBox "closesocket failed with error�F" & GetFormatMessageString(Err.LastDllError) + End If + End If + If WinsockStarted And WSACleanup() <> 0 Then MsgBox "Windows Sockets error occurred in Cleanup.", vbExclamation - End If - - '‚±‚±‚Ŏ©•ªŽ©�g‚ð•‚¶‚é�B - ThisWorkbook.Close - Application.Quit + End If End Sub @@ -216,12 +214,13 @@ Public Sub UDPSendTo(ByRef Msg As String) Dim RetCode As Long Dim WSAData As WSAData - Dim SendSocketHandle As Long + Dim SendSocketHandle As LongPtr Dim DstAddr As SOCKADDR_IN + Dim WinsockStarted As Boolean + + SendSocketHandle = INVALID_SOCKET 'ƒpƒ‰ƒ��[ƒ^ - Dim ip As String: ip = "127.0.0.1" - Dim TargetPort As Long: TargetPort = 60051 Dim strbuffer As String strbuffer = Msg @@ -231,6 +230,7 @@ Public Sub UDPSendTo(ByRef Msg As String) MsgBox "WSAStartup failed with error�F" & GetFormatMessageString(RetCode) Exit Sub End If + WinsockStarted = True 'UDP socket SendSocketHandle = SOCKET(AF.AF_INET, SOCKTYPE.SOCK_DGRAM, PROTOCOL.IPPROTO_UDP) @@ -240,8 +240,8 @@ Public Sub UDPSendTo(ByRef Msg As String) End If DstAddr.sin_family = AF.AF_INET - DstAddr.sin_addr = inet_addr(ip) - DstAddr.sin_port = htons(Convert_u_short_PortNumber(TargetPort)) + DstAddr.sin_addr = inet_addr(DEFAULT_SERVER_IP) + DstAddr.sin_port = htons(Convert_u_short_PortNumber(DEFAULT_SERVER_PORT)) 'sendto ‘—�M RetCode = sendto(SendSocketHandle, strbuffer, Len(strbuffer), 0, DstAddr, Len(DstAddr)) @@ -253,12 +253,14 @@ Public Sub UDPSendTo(ByRef Msg As String) End If EXIT_POINT: - If closesocket(SendSocketHandle) = SOCKET_ERROR Then - MsgBox "closesocket failed with error�F" & GetFormatMessageString(Err.LastDllError) - End If - If WSACleanup() <> 0 Then + If SendSocketHandle <> INVALID_SOCKET Then + If closesocket(SendSocketHandle) = SOCKET_ERROR Then + MsgBox "closesocket failed with error�F" & GetFormatMessageString(Err.LastDllError) + End If + End If + If WinsockStarted And WSACleanup() <> 0 Then MsgBox "Windows Sockets error occurred in Cleanup.", vbExclamation - End If + End If End Sub Function PrintIPAndPortNumber(ByRef Addr As SOCKADDR_IN) As String