ab.com コミュニティ

コード: 全て選択

'VB及びVBAでの使用サンプルです。

'SMTPDLL関数
Public Declare Function DZLoadWinsock Lib "DZSMTP.dll" (ByVal err As Long) As Long
Public Declare Function DZUnloadWinsock Lib "DZSMTP.dll" () As Long
Public Declare Function DZSmtpConnect Lib "DZSMTP.dll" (ByVal sServerHost As String, ByVal sLocalHost As String, ByVal sPort As Integer) As Long
Public Declare Function DZSmtpDisConnect Lib "DZSMTP.dll" (ByVal shnd As Long) As Long
Public Declare Function DZSmtpSendMail Lib "DZSMTP.dll" (ByVal lSock As Long, ByVal sFrom As String, ByVal sTo As String, ByVal sCc As String, ByVal sBcc As String, _
                                                         ByVal sReply As String, ByVal sSubject As String, ByVal sBody As String, ByVal sAttach As String) As Long
Public Declare Function DZGetError Lib "DZSMTP.dll" (sMSG As Any) As Long
Public Declare Function DZPop3Connect Lib "DZSMTP.dll" (ByVal sServerHost As String, ByVal sPort As Integer) As Long
Public Declare Function DZPop3DisConnect Lib "DZSMTP.dll" (ByVal shnd As Long) As Long
Public Declare Function DZPop3Login Lib "DZSMTP.dll" (ByVal shnd As Long, ByVal sUser As String, ByVal sPassword As String) As Long

Public Sub SendMail()
  
  Dim ret As Variant
  Dim hSocket As Long
  Dim sMSG As String
  Dim lErr As Long
  Dim sFrom As String
  Dim sTo As String
  Dim sCc As String
  Dim sBcc As String
  Dim sReply As String
  Dim sSubject As String
  Dim sBody As String
  Dim sAttach As String
  
  'Winsockの生成及び初期化
  ret = DZLoadWinsock(1)  '固定
  If ret = -1 Then
    MsgBox "Socket:生成ができませんでした。", vbCritical, "エラー"
    Exit Sub
  End If
  '##POP3の事前認証が必要な場合(POP3認証が不要な場合は##～##までの行を削除してください。)
  'POP3サーバーへの接続(POP3サーバー名,ポート番号(0指定時自動取得) サーバーが"pop3.xxx.co.jp"の場合
  hSocket = DZPop3Connect("pop3.xxx.co.jp", 0)
  If hSocket = -1 Then
    sMSG = String(255, 0)
    lErr = DZGetError(ByVal sMSG)
    sMSG = StFromSz(sMSG)
    If lErr = 0 Then
      MsgBox "ＰＯＰサーバーに接続できません。" & vbCrLf & "サーバー名または接続ポートを確認してください。", vbCritical, "エラー"
    Else
      MsgBox "Code : " & lErr & vbCrLf & vbCrLf & sMSG
    End If
    Exit Sub
  End If
  'POP3サーバーへのユーザー認証(ソケットハンドル,POP3認証ユーザー名,パスワード) ユーザー名が"user"、パスワードが"password"の場合
  ret = DZPop3Login(hSocket, "user", "password")
  If ret = -1 Then
    sMSG = String(255, 0)
    lErr = DZGetError(ByVal sMSG)
    sMSG = StFromSz(sMSG)
    If lErr = 0 Then
      MsgBox "ＰＯＰサーバーに認証できません。" & vbCrLf & "ユーザー名またはパスワードを確認してください。", vbCritical, "エラー"
    Else
      MsgBox "Code : " & lErr & vbCrLf & vbCrLf & sMSG
    End If
    Exit Sub
  End If
  'POP3サーバーへの接続解除
  ret = DZPop3DisConnect(hSocket)  '固定
  '##
  'SMTPサーバーへの接続
  'DZSmtpConnect(SMTPサーバー名,自ドメイン名,ポート番号(0指定時自動取得) サーバーが"smtp.xxx.co.jp"、自ドメイン名が"xxx.co.jp"の場合
  hSocket = DZSmtpConnect("smtp.xxx.co.jp", "xxx.co.jp", 0)
  If hSocket = -1 Then
    sMSG = String(255, 0)
    lErr = DZGetError(ByVal sMSG)
    sMSG = StFromSz(sMSG)
    If lErr = 0 Then
      MsgBox "ＳＭＴＰサーバーに接続できません。" & vbCrLf & "サーバー名等を確認してください。", vbCritical, "エラー"
    Else
      MsgBox "Code : " & lErr & vbCrLf & vbCrLf & sMSG
    End If
    Exit Sub
  End If
  'メール送信
  sFrom = "xxx@xxx.co.jp"
  sTo = "xxx@xxx.ne.jp"       '","区切りで複数指定可
  sCc = "xxx@xxx.ne.jp"       '","区切りで複数指定可,省略時は""を設定
  sBcc = "xxx@xxx.ne.jp"      '","区切りで複数指定可,省略時は""を設定
  sReply = "xxx@xxx.ne.jp"    '省略時は""を設定
  sSubject = "テストメール"
  sBody = "テストメール送信"
  sAttach = "C:\xxx\xxx.txt"  '","区切りで複数指定可,省略時は""を設定
  'DZSmtpSendMail(ソケットハンドル,From,To,Cc,Bcc,Subject,本文,添付ファイルパス,Reply-To)
  ret = DZSmtpSendMail(hSocket, sFrom, sTo, sCc, sBcc, sSubject, sBody, sAttach, sReply)
  If ret = -1 Then
    sMSG = String(255, 0)
    lErr = DZGetError(ByVal sMSG)
    sMSG = StFromSz(sMSG)
    MsgBox "Code : " & lErr & vbCrLf & vbCrLf & sMSG
    Exit Sub
  End If
  'SMTPサーバーへの接続解除
  ret = DZSmtpDisConnect(hSocket)  '固定
  'Winsockの廃棄
  Call DZUnloadWinsock             '固定
  MsgBox "メール送信終了"

End Sub

Private Function StFromSz(szTmp As String) As String
  
  Dim ich As Integer
  
  ich = InStr(1, szTmp, vbNullChar, vbBinaryCompare)
  If ich Then
    StFromSz = left$(szTmp, ich - 1)
  Else
    StFromSz = szTmp
  End If

End Function

コード: 全て選択

Declare Function DZLoadWinsock Lib "DZSMTP.dll" (ByVal err As Long) As Long
Declare Function DZUnloadWinsock Lib "DZSMTP.dll" () As Long
Declare Function DZSmtpConnect Lib "DZSMTP.dll" (ByVal sServerHost As  BytePtr, ByVal sLocalHost As  BytePtr, ByVal sPort As Integer) As Long
Declare Function DZSmtpDisConnect Lib "DZSMTP.dll" (ByVal shnd As Long) As Long
Declare Function DZSmtpSendMail Lib "DZSMTP.dll" (ByVal lSock As Long, ByVal sFrom As  BytePtr, ByVal sTo As  BytePtr, ByVal sCc As  BytePtr, ByVal sBcc As  BytePtr, ByVal sReply As  BytePtr, ByVal sSubject As  BytePtr, ByVal sBody As  BytePtr, ByVal sAttach As  BytePtr) As Long
Declare Function DZGetError Lib "DZSMTP.dll" (ByVal sMSG As BytePtr) As Long
Declare Function DZPop3Connect Lib "DZSMTP.dll" (ByVal sServerHost As  BytePtr, ByVal sPort As Integer) As Long
Declare Function DZPop3DisConnect Lib "DZSMTP.dll" (ByVal shnd As Long) As Long
Declare Function DZPop3Login Lib "DZSMTP.dll" (ByVal shnd As Long, ByVal sUser As  BytePtr, ByVal sPassword As  BytePtr) As Long 

'ここまで


'メールを送信するための自作関数
Sub SendMail()
	'変数宣言
	Dim ret As Long
	Dim hSocket As Long
	Dim SMTPSName[255] As Byte
	Dim DomainName[255] As Byte
	Dim sMSG[256] As Byte
	Dim lErr As Long
	Dim sFrom[255] As Byte
	Dim sFromName[255] As Byte
	Dim sTo[255] As Byte
	Dim sToName[255] As Byte
	Dim sCc[255] As Byte
	Dim sBc[255] As Byte
	Dim sReply[255] As Byte
	Dim sSubject[255] As Byte
	Dim sBody As String
	Dim sAttach[255] As Byte

	'まずEditBox_Main内のタブを半角スペースに変換
	ChangeTabToSpace()

	'各エディットボックス内の内容を取得する
	GetDlgItemText(hMainWnd, EditBox_SMTPServer, SMTPSName, 256)
	GetDlgItemText(hMainWnd, EditBox_DomainName, DomainName, 256)
	GetDlgItemText(hMainWnd, EditBox_FromAddress, sFrom, 256)
	GetDlgItemText(hMainWnd, EditBox_FromName, sFromName, 256)
	GetDlgItemText(hMainWnd, EditBox_ToAddress, sTo, 256)
	GetDlgItemText(hMainWnd, EditBox_ToName, sToName, 256)
	GetDlgItemText(hMainWnd, EditBox_Subject, sSubject, 256)
	GetDlgItemText(hMainWnd, EditBox_AttachFile, sAttach, 256)

	'本文の内容を取得
	Dim hEdit As DWord
	Dim Length As Long
	hEdit=GetDlgItem(hMainWnd, EditBox_Main)
	Length=GetWindowTextLength(hEdit)
	sBody=ZeroString(Length + 1)
	GetWindowText(hEdit, sBody, Length + 1)

	'Winsockの生成及び初期化
	ret = DZLoadWinsock(1)  '固定
	If ret = -1 Then 
		MessageBox(hMainWnd, "WinSockの生成に失敗", "Error - LightMailSender", MB_OK or MB_ICONERROR)
		Exit Sub
	End If

	If SendMessage(GetDlgItem(hMainWnd, PBSCheckBox), BM_GETCHECK, 0, 0)=BST_CHECKED Then
		Dim POPSName[255] As Byte, UserID[255] As Byte, PassWord[255] As Byte
		GetWindowText(GetDlgItem(hMainWnd, POPServerName_EditBox), POPSName, 256)
		GetWindowText(GetDlgItem(hMainWnd, UserID_EditBox), UserID, 256)
		GetWindowText(GetDlgItem(hMainWnd, PassWord_EditBox), PassWord, 256)
		
		'POPサーバーに接続
		hSocket = DZPop3Connect(POPSName, 0)
		If hSocket = -1 Then
			lErr = DZGetError(sMSG)
			If lErr = 0 Then
				MessageBox(hMainWnd, Ex"ＰＯＰサーバーに接続できません。\r\nＰＯＰサーバー名を確認してください\r\n" + sMSG, _
					"Error - LightMailSender", MB_OK or MB_ICONERROR)
				goto *SendMail
			End If
		End If

		ret = DZPop3Login(hSocket, UserID, PassWord)
  		If ret = -1 Then
    		lErr = DZGetError(sMSG)
    		If lErr = 0 Then
				MessageBox(hMainWnd, Ex"認証エラーです。\r\nユーザー名とパスワードを確認してください。\r\n" + sMSG, _
					"Error - LightMailSender", MB_OK or MB_ICONERROR)
				goto *SendMail
			End If
		End If
		'POP3サーバーへの接続解除
  		ret = DZPop3DisConnect(hSocket)  '固定
	End If

	'ここからＳＭＴＰサーバーとの通信
	hSocket = DZSmtpConnect(SMTPSName, DomainName, 0)
	If hSocket = -1 Then
    	lErr = DZGetError(sMSG)
    	If lErr = 0 Then
			MessageBox(hMainWnd, Ex"ＳＭＴＰサーバーに接続できません。\r\nＳＭＴＰサーバー名を確認してください", _
				"Error - LightMailSender", MB_OK or MB_ICONERROR)
			goto *SendMail
		End If
	End If

	'メール送信準備
	lstrcpy(sFrom, sFromName + "<" + sFrom + ">")
	lstrcpy(sTo, sToName + "<" + sTo + ">")
debug
	'メール送信
	ret = DZSmtpSendMail(hSocket, sFrom, sTo, sCc, sBc, sSubject, StrPtr(sBody), sAttach, sReply)
	If ret = -1 Then
    	lErr = DZGetError(sMSG)
    	MessageBox(hMainWnd, "メール送信に失敗しました。" + Ex"\r\n" + sMSG, "Error - LigthMailSender", MB_OK or MB_ICONERROR)
    	goto *SendMail
  	End If

	MessageBox(hMainWnd, "メールを送信しました。", "LightMailSender", MB_OK)
*SendMail
	'SMTPサーバーへの接続解除
  	ret = DZSmtpDisConnect(hSocket)  	'固定
  	'Winsockの廃棄
  	DZUnloadWinsock()					'固定
End Sub

コード: 全て選択

'ここからメール送信ＤＬＬ内関数の呼び出し
Declare Function DZLoadWinsock Lib "DZSMTP.dll" (ByVal err As Long) As Long
Declare Function DZUnloadWinsock Lib "DZSMTP.dll" () As Long
Declare Function DZSmtpConnect Lib "DZSMTP.dll" (ByVal sServerHost As String, ByVal sLocalHost As String, ByVal sPort As Integer) As Long
Declare Function DZSmtpDisConnect Lib "DZSMTP.dll" (ByVal shnd As Long) As Long
Declare Function DZSmtpSendMail Lib "DZSMTP.dll" (ByVal lSock As Long, ByVal sFrom As String, ByVal sTo As String, ByVal sCc As String, ByVal sBcc As String, _
                                                  ByVal sReply As String, ByVal sSubject As String, ByVal sBody As String, ByVal sAttach As String) As Long
Declare Function DZGetError Lib "DZSMTP.dll" (ByVal sMSG As VoidPtr) As Long
Declare Function DZPop3Connect Lib "DZSMTP.dll" (ByVal sServerHost As String, ByVal sPort As Integer) As Long
Declare Function DZPop3DisConnect Lib "DZSMTP.dll" (ByVal shnd As Long) As Long
Declare Function DZPop3Login Lib "DZSMTP.dll" (ByVal shnd As Long, ByVal sUser As String, ByVal sPassword As String) As Long
'ここまで


'メールを送信するための自作関数
Sub SendMail()
	'変数宣言
	Dim ret As Long
	Dim hSocket As Long
	Dim SMTPSName[255] As Byte
	Dim sMSG As String
	Dim lErr As Long
	Dim sFrom[255] As Byte
	Dim sFromName[255] As Byte
	Dim sTo[255] As Byte
	Dim sToName[255] As Byte
	Dim sCc As String
	Dim sBcc As String
	Dim sReply As String
	Dim sSubject[255] As Byte
	Dim sBody As String
	Dim sAttach[255] As Byte

	'まずEditBox_Main内のタブを半角スペースに変換
	ChangeTabToSpace()

	'各エディットボックス内の内容を取得する
	GetDlgItemText(hMainWnd, EditBox_SMTPServer, SMTPSName, 256)
	GetDlgItemText(hMainWnd, EditBox_FromAddress, sFrom, 256)
	GetDlgItemText(hMainWnd, EditBox_FromName, sFromName, 256)
	GetDlgItemText(hMainWnd, EditBox_ToAddress, sTo, 256)
	GetDlgItemText(hMainWnd, EditBox_ToName, sToName, 256)
	GetDlgItemText(hMainWnd, EditBox_Subject, sSubject, 256)
	GetDlgItemText(hMainWnd, EditBox_AttachFile, sAttach, 256)

	'本文の内容を取得
	Dim hEdit As DWord
	Dim Length As Long
	hEdit=GetDlgItem(hMainWnd, EditBox_Main)
	Length=GetWindowTextLength(hEdit)
	sBody=ZeroString(Length + 1)
	GetWindowText(hEdit, sBody, Length + 1)

	'Winsockの生成及び初期化
	ret = DZLoadWinsock(1)  '固定
	If ret = -1 Then 
		MessageBox(hMainWnd, "WinSockの生成に失敗", "Error - LightMailSender", MB_OK or MB_ICONERROR)
		Exit Sub
	End If

	If SendMessage(GetDlgItem(hMainWnd, PBSCheckBox), BM_GETCHECK, 0, 0)=BST_CHECKED Then
		Dim POPSName[255] As Byte, UserID[255] As Byte, PassWord[255] As Byte
		GetWindowText(GetDlgItem(hMainWnd, POPServerName_EditBox), POPSName, 256)
		GetWindowText(GetDlgItem(hMainWnd, UserID_EditBox), UserID, 256)
		GetWindowText(GetDlgItem(hMainWnd, PassWord_EditBox), PassWord, 256)
		
		'POPサーバーに接続
		hSocket = DZPop3Connect(MakeStr(POPSName), 0)
		If hSocket = -1 Then
			lErr = DZGetError(sMSG)
			If lErr = 0 Then
				MessageBox(hMainWnd, Ex"ＰＯＰサーバーに接続できません。\r\nＰＯＰサーバー名を確認してください", _
					"Error - LightMailSender", MB_OK or MB_ICONERROR)
				goto *SendMail
			End If
		End If

		ret = DZPop3Login(hSocket, MakeStr(UserID), MakeStr(PassWord))
  		If ret = -1 Then
    		lErr = DZGetError(sMSG)
    		If lErr = 0 Then
				MessageBox(hMainWnd, Ex"認証エラーです。\r\nユーザー名とパスワードを確認してください。", _
					"Error - LightMailSender", MB_OK or MB_ICONERROR)
				goto *SendMail
			End If
		End If
		'POP3サーバーへの接続解除
  		ret = DZPop3DisConnect(hSocket)  '固定
	End If

	'ここからＳＭＴＰサーバーとの通信
	hSocket = DZSmtpConnect(MakeStr(SMTPSName), "", 0)
	If hSocket = -1 Then
    	lErr = DZGetError(sMSG)
    	If lErr = 0 Then
			MessageBox(hMainWnd, Ex"ＳＭＴＰサーバーに接続できません。\r\nＳＭＴＰサーバー名を確認してください", _
				"Error - LightMailSender", MB_OK or MB_ICONERROR)
			goto *SendMail
		End If
	End If

	'メール送信準備
	wsprintf(sFrom, "%s <%s>", sFromName, sFrom)
	wsprintf(sTo, "%s <%s>", sToName, sTo)

	'メール送信
	ret = DZSmtpSendMail(hSocket, MakeStr(sFrom), MakeStr(sTo), sCc, sBcc, MakeStr(sSubject), sBody, MakeStr(sAttach), sReply)
	If ret = -1 Then
    	lErr = DZGetError(sMSG)
    	MessageBox(hMainWnd, "メール送信に失敗しました。" + Ex"\r\n" + sMSG, "Error - LigthMailSender", MB_OK or MB_ICONERROR)
    	goto *SendMail
  	End If

*SendMail
	'SMTPサーバーへの接続解除
  	ret = DZSmtpDisConnect(hSocket)  	'固定
  	'Winsockの廃棄
  	DZUnloadWinsock()					'固定
End Sub