コード: 全て選択
'ここからメール送信ＤＬＬ内関数の呼び出し
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