VERSION 5.00
Begin VB.Form SendMessageForm 
   BorderStyle     =   3  '固定ﾀﾞｲｱﾛｸﾞ
   Caption         =   "メッセージ送信ツール"
   ClientHeight    =   4260
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5640
   BeginProperty Font 
      Name            =   "ＭＳ ゴシック"
      Size            =   12
      Charset         =   128
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "SendMessage.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4260
   ScaleWidth      =   5640
   StartUpPosition =   2  '画面の中央
   Begin VB.ComboBox cmbSendList 
      Height          =   360
      ItemData        =   "SendMessage.frx":0442
      Left            =   240
      List            =   "SendMessage.frx":0444
      TabIndex        =   5
      Top             =   360
      Width           =   5175
   End
   Begin VB.CommandButton cmdEnd 
      Caption         =   "終了"
      Height          =   495
      Left            =   240
      TabIndex        =   4
      Top             =   3600
      Width           =   5175
   End
   Begin VB.CommandButton cmdSend 
      Caption         =   "送信"
      Height          =   495
      Left            =   240
      TabIndex        =   3
      Top             =   2880
      Width           =   5175
   End
   Begin VB.TextBox txtSendMessage 
      Height          =   1455
      Left            =   240
      MultiLine       =   -1  'True
      TabIndex        =   2
      Top             =   1200
      Width           =   5175
   End
   Begin VB.Label lblSendMessage 
      AutoSize        =   -1  'True
      BackStyle       =   0  '透明
      Caption         =   "送信メッセージ内容"
      Height          =   240
      Left            =   240
      TabIndex        =   1
      Top             =   960
      Width           =   2160
   End
   Begin VB.Label lblSendComputerName 
      AutoSize        =   -1  'True
      BackStyle       =   0  '透明
      Caption         =   "送信先コンピュータ名"
      Height          =   240
      Left            =   240
      TabIndex        =   0
      Top             =   120
      Width           =   2400
   End
End
Attribute VB_Name = "SendMessageForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'メッセージを送信ＡＰＩ（数値型版）
Private Declare Function NetMessageBufferSend Lib "Netapi32.dll" ( _
    ByVal lngServerName As Long, _
    ByVal lngMessageName As Long, _
    ByVal lngFromName As Long, _
    ByVal lngMessageBuffer As Long, _
    ByVal lngMessageByteCount As Long) As Long

'自分のコンピュータ名を取得ＡＰＩ
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" _
    (ByVal lpBuffer As String, nSize As Long) As Long

Private Sub Form_Load()
    Dim intFileNo As Integer
    Dim lngApiRet As Long
    Dim strLineWork As String
    Dim strOpenFilePath As String
    Dim strComputerName As String * 255

    'コンピュータ名を取得
    lngApiRet = GetComputerName(strComputerName, 255)

    '初期送信先を自分に設定
    cmbSendList.Text = Left(strComputerName, InStr(1, strComputerName, Chr(0), vbTextCompare) - 1)

    '送信先リスト取得
    strOpenFilePath = App.Path & "\" & App.EXEName & ".ini"
    If Dir(strOpenFilePath) <> "" Then
        intFileNo = FreeFile()
        Open strOpenFilePath For Input Access Read Shared As #intFileNo
        Do While Not EOF(intFileNo)
            Line Input #intFileNo, strLineWork
            cmbSendList.AddItem strLineWork
        Loop
        Close intFileNo
    End If

End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set SendMessageForm = Nothing
    End
End Sub

Private Sub cmdEnd_Click()
    '終了
    Unload Me
End Sub

Private Sub cmdSend_Click()
    Dim lngApiRet As Long
    Dim strSendName As String
    Dim byteSendComputer() As Byte
    Dim byteSendMessage() As Byte

    '送信文字無し
    If Len(txtSendMessage.Text) <= 0 Then
        Exit Sub
    End If

    '送信先無し
    If Len(cmbSendList.Text) <= 0 Then
        Exit Sub
    End If

    '二重送信禁止
    cmbSendList.Enabled = False
    txtSendMessage.Enabled = False
    cmdSend.Enabled = False
    cmdEnd.Enabled = False

    '送信先抜き出し（空白手前まで）
    If InStr(1, cmbSendList.Text, " ", vbTextCompare) > 0 Then
        strSendName = Trim(Left(cmbSendList.Text, InStr(1, cmbSendList.Text, " ", vbTextCompare)))
    Else
        strSendName = cmbSendList.Text
    End If

    '型変換
    byteSendComputer = strSendName & Chr(0)
    byteSendMessage = txtSendMessage.Text & Chr(0)

    ' メッセージを送信
    lngApiRet = NetMessageBufferSend(0, _
                                     VarPtr(byteSendComputer(0)), _
                                     0, _
                                     VarPtr(byteSendMessage(0)), _
                                     LenB(txtSendMessage.Text))

    MsgBox "送信が完了しました", vbInformation, "送信完了"


    '送信規制解除
    cmbSendList.Enabled = True
    txtSendMessage.Enabled = True
    cmdSend.Enabled = True
    cmdEnd.Enabled = True

End Sub