VB.net DLLのメモリリークについて (ID:143362)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

下記の通りVB.net2008で非同期でpingを行い、結果をpostmessageで送信するDLLを作成し、VB6で定期的に呼び出し、使用しています。
しかし、VB6側でDLLを呼ぶたびにメモリ使用量がどんどん増えていき困っています。
DLL内でなんらかの開放が抜けていると思うのですがアドバイスをお願いします。

以下VB6呼び出しソース(参照設定済み)
Private Sub Timer_NWCHK_Timer()

Text3.Text = "" '応答内容を初期化
    On Error GoTo Err_Proc
    Dim obj As Netchk.Netchk ' (a)
    Dim ret As Long
    Set obj = New Netchk.Netchk ' (b)
    If NWCHKPATH <> "" Then
      ret = obj.ping(NWCHKPATH, Me.hWnd) ' (c)'DMZに対してping送信 レスポンスは後程DLLがSendMassageで非同期でtext3に入れてくれる
    End If
    Set obj = Nothing
    
Err_Proc:
End Sub

↓以下VB.netソース

Option Strict On

Public Class Netchk

Public Declare Function RegisterWindowMessage Lib "user32.dll" _
            Alias "RegisterWindowMessageA" (ByVal lpString As String) As Integer

Declare Function PostMessageStr Lib "user32.dll" Alias "PostMessageA" _
       (ByVal hwnd As Integer, ByVal MSG As Integer, _
        ByVal wParam As Integer, ByVal lParam As Integer) As Integer

'Pingオブジェクト
    Dim mainPing As System.Net.NetworkInformation.Ping = Nothing

Public Val_hd As Integer
    Public WM_USER_PING As Integer

Public ReadOnly Property Ping(ByVal add As String, ByVal hd As Integer) As Boolean

Get
            '後にPostMessageで使用するメッセージ値はRegisterWindowMessageで取得しておく
            WM_USER_PING = RegisterWindowMessage("WM_USER_PING")
            Val_hd = hd

'Pingオブジェクトの作成
            If mainPing Is Nothing Then
                mainPing = New System.Net.NetworkInformation.Ping()
                'イベントハンドラを追加
                AddHandler mainPing.PingCompleted, AddressOf Ping_PingCompleted
            End If
            'Pingのオプションを設定
            'TTLを64、フラグメンテーションを無効にする
            Dim opts As New System.Net.NetworkInformation.PingOptions(64, True)
            'Pingで送信する32バイトのデータを作成
            Dim bs As Byte() = System.Text.Encoding.ASCII.GetBytes(New String("A"c, 32))

'タイムアウトを10秒
            mainPing.SendAsync(add, 10000, bs, opts, Nothing)

opts = Nothing
            bs = Nothing
            mainPing = Nothing

Return True

End Get

End Property

Private Sub Ping_PingCompleted(ByVal sender As Object, _
            ByVal e As System.Net.NetworkInformation.PingCompletedEventArgs)
        Dim Ret As Integer

If e.Cancelled Then

Ret = PostMessageStr(Val_hd, WM_USER_PING, 1, 2)
        ElseIf Not (e.Error Is Nothing) Then
            Ret = PostMessageStr(Val_hd, WM_USER_PING, 1, 1)
        Else
            '結果を取得
            If e.Reply.Status = System.Net.NetworkInformation.IPStatus.Success Then

Console.WriteLine("Reply from {0}:bytes={1} time={2}ms TTL={3}", _
                    e.Reply.Address, e.Reply.Buffer.Length, _
                    e.Reply.RoundtripTime, e.Reply.Options.Ttl)

Ret = PostMessageStr(Val_hd, WM_USER_PING, 1, 7)

Else
                Ret = PostMessageStr(Val_hd, WM_USER_PING, 1, 3)
            End If
        End If
    End Sub
End Class

←解決時は質問者本人がここをチェックしてください。

戻る