ab.com コミュニティ

コード: 全て選択

'定数宣言
Const JC_ERROR		=	 0
Const JC_UNKNOWN	=	 0
Const JC_SJIS		=	 4
Const JC_JIS		=	 8
Const JC_EUC		=	12

Declare Function encode64 Lib "base64" (Source As BytePtr, Ret As BytePtr, ByVal Length As Long) As Long
Declare Function decode64 Lib "base64" (base As BytePtr, Ret As BytePtr, ByVal Length As Long) As Long

'JcodeConvert：文字列の文字コードを変換します
Declare Function JcodeConvert Lib "jcode" (
	nSource As Long,			'変換元の文字列の文字コード
	nDest As Long,				'変換先の文字列の文字コード
	lpSource As *Char,			'変換元の文字列
	lpDest As *Char				'変換先の文字列
) As Long
	
'JcodeDetect：文字列の文字コードを判別します
Declare Function JcodeDetect Lib "jcode" (
	lpString As *Char,			'判別する文字列
	nDefault As Long			'デフォルトの文字コード
) As Long

'JcodeEncToJis：EUC文字列をJIS文字列に変換します
Declare Function JcodeEucToJis Lib "jcode" (
	lpSource As *Char,			'変換元の文字列
    lpDest As *Char				'変換先の文字列
) As DWord

'JcodeEucToSjis：EUC文字列をシフトJIS文字列に変換します
Declare Function JcodeEucToSjis Lib "jcode" (
	lpSource As *Char,			'変換元の文字列
	lpDest As *Char				'変換先の文字列
) As DWord

'JcodeJisToEuc：JIS文字列をEUC文字列に変換します
Declare Function JcodeJisToEuc Lib "jcode" (
	lpSource As *Char,			'変換元の文字列
	lpDest As *Char				'変換先の文字列
) As DWord

'JcodeJisToSjis：JIS文字列をシフトJIS文字列に変換します
Declare Function JcodeJisToSjis Lib "jcode" (
	lpSource As *Char,			'変換元の文字列
	lpDest As *Char				'変換先の文字列
) As DWord

'JcodeSjisToEuc：シフトJIS文字列をEUC文字列に変換します
Declare Function JcodeSjisToEuc Lib "jcode" (
	lpSource As *Char,			'変換元の文字列
	lpDest As *Char				'変換先の文字列
) As DWord

'JcodeSjisToJis：シフトJIS文字列をJIS文字列に変換します
Declare Function JcodeSjisToJis Lib "jcode" (
	lpSource As *Char,			'変換元の文字列
	lpDest As *Char				'変換先の文字列
) As DWord

'JcodeVersion：jcode.dllのバージョンを取得します
Declare Function JcodeVersion Lib "jcode" (
	lpBuffer As *Char			'バージョンを格納するバッファ
) As Long

コード: 全て選択

Function SendMailThread(dw As Word) As Dword
	Dim TextBuffer As String	'テキストバッファの格納用
	Dim strJISMain As String	'テキストをJISに変換するときのバッファ
	Dim length As Long			'テキストの長さ
	Dim temporary As String		'送信時のテキスト一時保存用

	Dim buffer As BytePtr
	Dim i As Long, i2 As Long

	'[送信] [閉じる]ボタンを無効にする
	EnableWindow(GetDlgItem(hSendMail, CommandButton1), FALSE)
	EnableWindow(GetDlgItem(hSendMail, CommandButton2), FALSE)

	'各エディットボックスの内容を取得する
	Dim szServerName[255] As Byte		'サーバー名
	Dim szForm[255] As Byte				'送信元アドレス
	Dim szFromName As BytePtr			'送信元名
	Dim szTo[255] As Byte				'送信先アドレス
	Dim szToName As BytePtr				'送信先名
	Dim szSubject As BytePtr			'件名
	Dim lpszJISString As BytePtr		'JIS変換時のバッファ
	Dim lpszBASE64String As BytePtr		'BASE64変換時のバッファ
	Dim lpstrBuffer[225] As Byte		'テキストボックスからのバッファ
	GetWindowText(GetDlgItem(hSendMail, EditBox1), szServerName, 256)
	GetWindowText(GetDlgItem(hSendMail, EditBox2), szForm, 256)
	GetWindowText(GetDlgItem(hSendMail, EditBox3), szTo, 256)
	'GetWindowText(GetDlgItem(hSendMail, EditBox4), szSubject, 256)

	'DLL内の関数を使って送信者名、送信先名、件名を取得（iso-2022-jpエンコード）
	'送信者名------------------------------------------------------------------
	GetDlgItemText(hSendMail, EditBox5, lpstrBuffer, 255)
	If lstrlen(lpstrBuffer)=0 Then
		lstrcpy(lpstrBuffer, " ")
	End If
	lpszJISString=malloc(JcodeSjisToJis(lpstrBuffer, NULL)+10)
	JcodeSjisToJis(lpstrBuffer, lpszJISString)
	lpszBASE64String=malloc(encode64(lpszJISString, NULL, lstrlen(lpszJISString)+10))
	encode64(lpszJISString, lpszBASE64String, lstrlen(lpszJISString))
	szFromName=malloc(lstrlen(lpszBASE64String)+19)
	lstrcpy(szFromName, "=?ISO-2022-JP?B?" & lpszBASE64String & "?=")
	'送信先名------------------------------------------------------------------
	GetDlgItemText(hSendMail, EditBox6, lpstrBuffer, 255)
	If lstrlen(lpstrBuffer)=0 Then
		lstrcpy(lpstrBuffer, " ")
	End If
	lpszJISString=realloc(lpszJISString, JcodeSjisToJis(lpstrBuffer, NULL)+10)
	JcodeSjisToJis(lpstrBuffer, lpszJISString)
	lpszBASE64String=realloc(lpszBASE64String, encode64(lpszJISString, NULL, lstrlen(lpszJISString)+10))
	encode64(lpszJISString, lpszBASE64String, lstrlen(lpszJISString))
	szToName=malloc(lstrlen(lpszBASE64String)+19)
	lstrcpy(szToName, "=?ISO-2022-JP?B?" & lpszBASE64String & "?=")
	'件名---------------------------------------------------------------------
	GetDlgItemText(hSendMail, EditBox4, lpstrBuffer, 255)
	If lstrlen(lpstrBuffer)=0 Then
		lstrcpy(lpstrBuffer, " ")
	End If
	lpszJISString=realloc(lpszJISString, JcodeSjisToJis(lpstrBuffer, NULL)+10)
	JcodeSjisToJis(lpstrBuffer, lpszJISString)
	lpszBASE64String=realloc(lpszBASE64String, encode64(lpszJISString, NULL, lstrlen(lpszJISString)+10))
	encode64(lpszJISString, lpszBASE64String, lstrlen(lpszJISString))
	szSubject=malloc(lstrlen(lpszBASE64String)+19)
	lstrcpy(szSubject, "=?ISO-2022-JP?B?" & lpszBASE64String & "?=")

	'テキストデータを格納するためのバッファ領域を確保し、テキストを取得
	Dim hEdit As Long
	hEdit=GetDlgItem(hMainWnd, EditBox1)
	length=GetWindowTextLength(hEdit)
	TextBuffer=ZeroString(length+1)
	GetWindowText(hEdit, TextBuffer, length+1)
	'テキストをBASE64エンコードして取得
	strJISMain=ZeroString(JcodeSjisToJis(TextBuffer, NULL)+1)
	JcodeSjisToJis(TextBuffer, StrPtr(strJISMain))
	TextBuffer=ZeroString(Len(strJISMain)+1)
	temporary=ZeroString(Len(strJISMain)+3)
	TextBuffer=strJISMain

	'ISO-2022-JP文字列を考慮してbuffer変数のサイズを設定
	buffer=malloc(10*1024)

	'WinSock Ver 1.1の初期化
	Dim wsaData AS WSADATA				'ソケットの初期化情報
	WSAStartup(MAKEWORD(1, 1), wsaData)

	'サーバーを探す
	Dim lpHost As *HOSTENT				'ホスト情報
	lpHost=gethostbyname(szServerName)
	If lpHost=0 Then
		wsprintf(buffer, "%sが見つかりません", szServerName)
		SetDlgItemText(hSendMail, Static_Recv, buffer)

		'[送信] [閉じる]ボタンを有効にする
		EnableWindow(GetDlgItem(hSendMail, CommandButton1), TRUE)
		EnableWindow(GetDlgItem(hSendMail, CommandButton2), TRUE)
		Exit Function
	End If

	'ソケットをオープン
	Dim s As DWord						'ソケット
	s=socket(AF_INET, SOCK_STREAM, 0)
	If s=0 Then
		SetDlgItemText(hSendMail, Static_Recv, "ソケットのオープンに失敗")

		'[送信] [閉じる]ボタンを有効にする
		EnableWindow(GetDlgItem(hSendMail, CommandButton1), TRUE)
		EnableWindow(GetDlgItem(hSendMail, CommandButton2), TRUE)
		Exit Function
	End If

	'メール用のポート番号を取得
	Dim lpServ As *SERVENT				'サービス情報
	Dim sockaddress As SOCKADDR_IN	'アドレス情報
	lpServ = getservbyname("mail", NULL)
	If lpServ=0 Then
		'デフォルトのポート番号を取得
		sockaddress.sin_port=htons(IPPORT_SMTP)
	Else
		sockaddress.sin_port=lpServ->s_port
	End If

	sockaddress.sin_family=AF_INET
	sockaddress.sin_addr=GetDWord(GetDWord(lpHost->h_addr_list))

	'サーバーに接続
	If connect(s, sockaddress, Len(sockaddress)) Then
		SetDlgItemText(hSendMail, Static_Recv, "サーバーへの接続に失敗")

		'[送信] [閉じる]ボタンを有効にする
		EnableWindow(GetDlgItem(hSendMail, CommandButton1), TRUE)
		EnableWindow(GetDlgItem(hSendMail, CommandButton2), TRUE)
		Exit Function
	End If

	FillMemory(buffer, 256, 0)
	recv(s, buffer, 256, 0)
	SetDlgItemText(hSendMail, Static_Recv, buffer)

	wsprintf(buffer, Ex"HELO %s\r\n", szServerName)				'HELOコマンドを送信
	send(s, buffer, lstrlen(buffer), 0)
	FillMemory(buffer, 256, 0)
	recv(s, buffer, 256, 0)
	SetDlgItemText(hSendMail, Static_Recv, buffer)

	wsprintf(buffer, Ex"MAIL FROM:<%s>\r\n", szForm)			'MAIL FROMコマンドを送信
	send(s, buffer, lstrlen(buffer), 0)
	FillMemory(buffer, 256, 0)
	recv(s, buffer, 256, 0)
	SetDlgItemText(hSendMail, Static_Recv, buffer)

	wsprintf(buffer, Ex"RCPT TO:<%s>\r\n", szTo)				'RCPT TOコマンドを送信
	send(s, buffer, lstrlen(buffer), 0)
	FillMemory(buffer, 256, 0)
	recv(s, buffer, 256, 0)
	SetDlgItemText(hSendMail, Static_Recv, buffer)

	lstrcpy(buffer, Ex"DATA\r\n")								'DATAコマンドを送信
	send(s, buffer, lstrlen(buffer), 0)
	FillMemory(buffer, 256, 0)
	recv(s, buffer, 256, 0)
	SetDlgItemText(hSendMail, Static_Recv, buffer)

	'送信時間を送信
	Dim st As SYSTEMTIME
	Dim lpstrSendTime[255] As Byte
	Dim strDayOfWeek As String
	Dim strMonth As String
	GetLocalTime(st)
	Select Case st.wMonth
		Case 1
			strMonth="Jan"
		Case 2
			strMonth="Feb"
		Case 3
			strMonth="Mar"
		Case 4
			strMonth="Apr"
		Case 5
			strMonth="May"
		Case 6
			strMonth="Jun"
		Case 7
			strMonth="Jul"
		Case 8
			strMonth="Aug"
		Case 9
			strMonth="Sep"
		Case 10
			strMonth="Oct"
		Case 11
			strMonth="Nov"
		Case 12
			strMonth="Dec"
	End Select
	Select Case st.wDayOfWeek
		Case 0
			strDayOfWeek="Sun"
		Case 1
			strDayOfWeek="Mon"
		Case 2
			strDayOfWeek="Tue"
		Case 3
			strDayOfWeek="Wed"
		Case 4
			strDayOfWeek="Thu"
		Case 5
			strDayOfWeek="Fri"
		Case 6
			strDayOfWeek="Sat"
	End Select
	wsprintf(lpstrSendTime, Ex"Date: %s, %d %s %d %02d:%02d:%02d\r\n", strDayOfWeek, st.wDay, strMonth, st.wYear, st.wHour, st.wMinute, st.wMinute)
	send(s, lpstrSendTime, lstrlen(lpstrSendTime), 0)

	'FROMを送信
	FillMemory(buffer, 256, 0)
	wsprintf(buffer, Ex"From: %s <%s>\r\n", szFromName, szForm)
	send(s, buffer, lstrlen(buffer), 0)

	'TOを送信
	FillMemory(buffer, 256, 0)
	wsprintf(buffer, Ex"To: %s <%s>\r\n", szToName, szTo)
	send(s, buffer, lstrlen(buffer), 0)

	'件名を送信
	FillMemory(buffer, 256, 0)
	wsprintf(buffer, Ex"Subject: %s \r\n", szSubject)
	send(s, buffer, lstrlen(buffer), 0)

	'メーラー名を送信
	FillMemory(buffer, 256, 0)
	lstrcpy(buffer, Ex"X-Mailer: Test-Mailer\r\n")
	send(s, buffer, lstrlen(buffer), 0)

	'MIMEタイプを送信
	FillMemory(buffer, 256, 0)
	lstrcpy(buffer, Ex"Content-Type: text/plain; charset=\qISO-2022-JP\q\r\n")
	send(s, buffer, lstrlen(buffer), 0)

	lstrcpy(buffer, Ex"\r\n")
	send(s, buffer, lstrlen(buffer), 0)

	'メール本文を送信
	i=0
	i2=0
	Do
		If (TextBuffer=13 and TextBuffer[i+1]=10) or TextBuffer=0 Then
			'改行
			temporary[i2]=0
			lstrcat(temporary, Ex"\r\n")

			'送信
			send(s, temporary, lstrlen(temporary), 0)

			If TextBuffer=0 Then Exit Do

			i=i+2
			i2=0
			Continue
		End If
		temporary[i2]=TextBuffer

		i=i+1
		i2=i2+1
	Loop

	lstrcpy(buffer, Ex".\r\n")
	send(s, buffer, lstrlen(buffer), 0)
	FillMemory(buffer, 256, 0)
	recv(s, buffer, 256, 0)
	SetDlgItemText(hSendMail, Static_Recv, buffer)

	lstrcpy(buffer, Ex"QUIT\r\n")									'QUITコマンドを送信
	send(s, buffer, lstrlen(buffer), 0)
	FillMemory(buffer, 256, 0)
	recv(s, buffer, 256, 0)
	SetDlgItemText(hSendMail, Static_Recv, buffer)

	'ソケットへの接続を閉じる
	shutdown(s, SD_BOTH)
	closesocket(s)

	'WinSockが使用したメモリを開放
	WSACleanup()

	SetDlgItemText(hSendMail, Static_Recv, "送信が完了しました")

	'[送信] [閉じる]ボタンを有効にする
	EnableWindow(GetDlgItem(hSendMail, CommandButton1), TRUE)
	EnableWindow(GetDlgItem(hSendMail, CommandButton2), TRUE)
End Function