by situmon » 2005年7月22日(金) 13:07
以前の掲示板に投稿したメールの送信のサンプルです。
POP before SMTP にも対応しています。
メールの質問が意外と多いようなので投稿しました。
以下のソースをそのままコンパイルすれば動作します。
昔のソースなので読みにくくてすみません。
(ActiveBasic最新版で動くように修正しました 2006/4/15 10:22)
コード: 全て選択
'関数の定義ここから
Const WSADESCRIPTION_LEN = 256
Const WSASYS_STATUS_LEN = 128
Const SOCKET_ERROR = -1
Const INVALID_SOCKET = -1
' Winsockの実装の詳細を定義する構造体の宣言
Type WSAData
wVersion As Integer
wHighVersion As Integer
szDescription(WSADESCRIPTION_LEN) As Byte
szSystemStatus(WSASYS_STATUS_LEN) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type
' ソケットのアドレスを保存する構造体
Type in_addr
S_addr As Long
End Type
' ソケットの情報を保存する構造体
Type sockaddr_in
sin_family As Integer
sin_port As Word
sin_addr As in_addr
sin_zero(7) As Byte
End Type
'ネットワーク上にある既知の、接続するソケットのアドレスを受け取る構造体
Type sockaddr
sa_family As Word
sa_data[13] As Byte
End Type
' ホストの情報を保存する構造体
Type hostent
h_name As Long
h_aliases As Long
h_addrtype As Integer
h_length As Integer
h_addr_list As Long
End Type
' アドレスファミリーを示す定数の宣言
Const AF_UNSPEC = 0
Const AF_UNIX = 1
Const AF_INET = 2
Const AF_IMPLINK = 3
Const AF_PUP = 4
Const AF_CHAOS = 5
Const AF_NS = 6
Const AF_IPX = AF_NS
Const AF_ISO = 7
Const AF_OSI = AF_ISO
Const AF_ECMA = 8
Const AF_DATAKIT = 9
Const AF_CCITT = 10
Const AF_SNA = 11
Const AF_DECnet = 12
Const AF_DLI = 13
Const AF_LAT = 14
Const AF_HYLINK = 15
Const AF_APPLETALK = 16
Const AF_NETBIOS = 17
Const AF_VOICEVIEW = 18
Const AF_FIREFOX = 19
Const AF_UNKNOWN1 = 20
Const AF_BAN = 21
Const AF_ATM = 22
Const AF_INET6 = 23
Const AF_CLUSTER = 24
Const AF_12844 = 25
Const AF_MAX = 26
' ソケットの種類を示す定数の宣言
Const SOCK_STREAM = 1
Const SOCK_DGRAM = 2
Const SOCK_RAW = 3
Const SOCK_RDM = 4
Const SOCK_SEQPACKET = 5
' ローカルのアドレスのどれかを使用することを示す定数の宣言
Const INADDR_ANY = &H0
'ソケット関数
Declare Function accept Lib "wsock32.dll" (ByVal s As Long,ByRef addr As sockaddr_in,ByVal addrlen As Long) As Long
Declare Function WSAAccept Lib "ws2_32.dll" (ByVal s As Long,addr As Long,addrlen As Long,ByVal lpfnCondition As Long,ByVal dwCallbackData As Long) As Long
Declare Function bind Lib "wsock32.dll" (ByVal s As Long,ByRef sName As sockaddr_in, ByVal namelen As Long) As Long
Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long
Declare Function connect Lib "wsock32.dll" (ByVal s As Long,ByRef sName As sockaddr_in, ByVal namelen As Long) As Long
Declare Function ioctlsocket Lib "wsock32.dll" (ByVal s As Long, ByVal cmd As Long, argp As Long) As Long
Declare Function listen Lib "wsock32.dll" (ByVal s As Long, ByVal backlog As Long) As Long
Declare Function recv Lib "wsock32.dll" (ByVal s As Long, ByVal buf As BytePtr, ByVal lngLen As Long, ByVal flags As Long) As Long
Declare Function recvfrom Lib "wsock32.dll" (ByVal s As Long, buf As BytePtr, ByVal lngLen As Long, ByVal flags As Long,ByRef from As sockaddr_in, fromlen As Long) As Long
Declare Function send Lib "wsock32.dll" (ByVal s As Long, buf As BytePtr, ByVal lngLenlen As Long, ByVal flags As Long) As Long
Declare Function sendto Lib "wsock32.dll" (ByVal s As Long, buf As BytePtr, ByVal lngLen As Long, ByVal flags As Long,ByRef sTo As sockaddr_in, ByVal tolen As Long) As Long
Declare Function setsockopt Lib "wsock32.dll" (ByVal s As Long, ByVal level As Long, ByVal optname As Long, optval As String, ByVal optlen As Long) As Long
Declare Function shutdown Lib "wsock32.dll" (ByVal s As Long, ByVal how As Long) As Long
Declare Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal lngType As Long, ByVal protocol As Long) As Long
Declare Function recvb Lib "wsock32.dll" Alias "recv" (ByVal s As Long, buf As VoidPtr, ByVal lngLen As Long, ByVal flags As Long) As Long
Declare Function sendb Lib "wsock32.dll" Alias "send" (ByVal s As Long, buf As VoidPtr, ByVal lngLen As Long, ByVal flags As Long) As Long
'バイトオーダー変換
Declare Function htonl Lib "wsock32.dll" (ByVal hostlong As Long) As Long
Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Word
Declare Function ntohl Lib "wsock32.dll" (ByVal netlong As Long) As Long
Declare Function ntohs Lib "wsock32.dll" (ByVal netshort As Long) As Word
'アドレス変換
Declare Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long
Declare Function inet_ntoa Lib "wsock32.dll" (ByVal lngIn As Long) As Long
'データベース関数
Declare Function gethostbyaddr Lib "wsock32.dll" (addr As Long, ByVal lngLen As Long, ByVal lngType As Long) As Long
Declare Function gethostbyname Lib "wsock32.dll" (ByVal strName As String) As Long
Declare Function gethostname Lib "wsock32.dll" (ByVal strName As String, ByVal namelen As Long) As Long
Declare Function getpeername Lib "wsock32.dll" (ByVal s As Long,ByRef sName As sockaddr_in, namelen As Long) As Long
Declare Function getprotobyname Lib "wsock32.dll" (ByVal strName As String) As Long
Declare Function getprotobynumber Lib "wsock32.dll" (ByVal lngNumber As Long) As Long
Declare Function getservbyname Lib "wsock32.dll" (ByVal strName As String, ByVal proto As String) As Long
Declare Function getservbyport Lib "wsock32.dll" (ByVal Port As Long, ByVal proto As String) As Long
Declare Function getsockname Lib "wsock32.dll" (ByVal s As Long,ByRef sName As sockaddr_in, namelen As Long) As Long
Declare Function getsockopt Lib "wsock32.dll" (ByVal s As Long, ByVal level As Long, ByVal optname As Long, optval As String, optlen As Long) As Long
'拡張機能
Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequested As Long,ByRef lpWSAData As WSAData) As Long
Declare Function WSACleanup Lib "wsock32.dll" () As Long
Declare Function WSAAsyncGetServByName Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal strName As String, ByVal proto As String, buf As String, ByVal buflen As Long) As Long
Declare Function WSAAsyncGetServByPort Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal Port As Long, ByVal proto As String, buf As String, ByVal buflen As Long) As Long
Declare Function WSAAsyncGetProtoByName Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal protoname As String, buf As String, ByVal buflen As Long) As Long
Declare Function WSAAsyncGetProtoByNumber Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal number As Long, buf As String, ByVal buflen As Long) As Long
Declare Function WSAAsyncGetHostByName Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal hostname As String, buf As String, ByVal buflen As Long) As Long
Declare Function WSAAsyncGetHostByAddr Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, lngAddr As Long, ByVal lngLen As Long, ByVal lngType As Long, buf As String, ByVal buflen As Long) As Long
Declare Function WSAAsyncSelect Lib "wsock32.dll" (ByVal s As Long, ByVal hWnd As Long, ByVal wMsg As Long, ByVal lngEvent As Long) As Long
Declare Function WSACancelAsyncRequest Lib "wsock32.dll" (ByVal hAsyncTaskHandle As Long) As Long
Declare Function WSACancelBlockingCall Lib "wsock32.dll" () As Long
Declare Function WSAGetLastError Lib "wsock32.dll" () As Long
Declare Function WSAIsBlocking Lib "wsock32.dll" () As Long
Declare Sub WSASetLastError Lib "wsock32.dll" (ByVal lngErr As Long)
Declare Function WSASetBlockingHook Lib "wsock32.dll" (ByVal lngFunc As Long) As Long
Declare Function WSAUnhookBlockingHook Lib "wsock32.dll" () As Long
'ここまで
'自作関数の定義ここから
Function GIPADD(ByVal ipstr As String) As Long
Dim lhost As Long
Dim uhost As hostent
Dim lhostbAdd As Long
Dim lhostAdd As Long
Dim SockAdd As sockaddr_in
Dim HADD As Long
lhost=gethostbyname(ipstr)
If lhost <> 0 Then
memcpy(VarPtr(uhost),lhost,Len(uhost))
With uhost
memcpy(VarPtr(lhostbAdd),.h_addr_list,Len(lhostbAdd))
memcpy(VarPtr(lhostAdd),lhostbAdd,.h_length)
End With
GIPADD=lhostAdd
Else
GIPADD=0
End If
End Function
'ここまで
'ここからがプログラム本体です
#N88BASIC
Dim WDATA As WSAData
Dim APILONG As Long
Dim Sock As Long
Dim BufLen As Long
Dim SBUF As String
Dim RBUF As String
Dim WBUF As String
Dim Port As Word
Dim HADD As Long
Dim SockAdd As sockaddr_in
Dim WarkBUF As String
Dim HOSTBUF As String
Dim SMTPBUF As String
Dim POPBUF As String
Dim POPUSER As String
Dim POPPASS As String
Dim Before As String
Dim RES As Byte
Dim SUBJEBUF As String
Dim MAILBUF As String
Dim SENDADDBUF As String
Dim MYADDBUF As String
Dim COMNB As Byte
RES=0
COMNB=0
'DLLの起動
APILONG=WSAStartup(MAKEWORD(1,1),WDATA)
Input "SMTPサーバのアドレスを入力してください。";SMTPBUF
Input "あなたのメールアドレスを入力してください。";MYADDBUF
Input "送信先のメールアドレスを入力してください。";SENDADDBUF
Input "メールの件名を入力して下さい。";SUBJEBUF
Input "メールの本文を入力して下さい。";MAILBUF
Print "POP before SMTP のSMTPサーバですか?(y/n)";
Input Before
If Before="y" Then
Input "POPサーバのアドレスを入力してください。";POPBUF
Input "POPサーバのユーサー名を入力してください。";POPUSER
Input "POPサーバのパスワードを入力してください。";POPPASS
'ソケットの作成
Sock=socket(AF_INET,SOCK_STREAM,0)
HADD=GIPADD(POPBUF)
With SockAdd
.sin_family=AF_INET
.sin_port=htons(110)
.sin_addr.S_addr=HADD
End With
'3ハンドシェイクによるコネクションの確立
APILONG=connect(Sock,SockAdd,Len(SockAdd))
If Not(APILONG=0) Then
MsgBox 0,"コネクトに失敗しました。","MAILC",MB_OK+MB_TOPMOST
closesocket(Sock)
WSACleanup()
End
End If
'レスポンス受信
RBUF=String$(256,Chr$(0))
APILONG=recv(Sock,StrPtr(RBUF),Len(RBUF),0)
If APILONG<1 Then
MsgBox 0,"コネクションが切断しました","MAILC",MB_OK+MB_TOPMOST
closesocket(Sock)
WSACleanup()
End
End If
RES=RES+1
MsgBox 0,RBUF,"レスポンス-"+Str$(RES)+"("+Str$(APILONG)+"Byte)",MB_OK+MB_TOPMOST
'コマンド送信
SBUF="USER "+POPUSER+Ex"\r\n"
BufLen=Len(SBUF)
COMNB=COMNB+1
MsgBox 0,SBUF,"コマンド -"+Str$(RES),MB_OK+MB_TOPMOST
APILONG=send(Sock,StrPtr(SBUF),BufLen,0)
'レスポンス受信
RBUF=String$(256,Chr$(0))
APILONG=recv(Sock,StrPtr(RBUF),Len(RBUF),0)
If APILONG<1 Then
MsgBox 0,"コネクションが切断しました","MAILC",MB_OK+MB_TOPMOST
closesocket(Sock)
WSACleanup()
End
End If
RES=RES+1
MsgBox 0,RBUF,"レスポンス-"+Str$(RES)+"("+Str$(APILONG)+"Byte)",MB_OK+MB_TOPMOST
'コマンド送信
SBUF="PASS "+POPPASS+Ex"\r\n"
BufLen=Len(SBUF)
COMNB=COMNB+1
MsgBox 0,SBUF,"コマンド -"+Str$(RES),MB_OK+MB_TOPMOST
APILONG=send(Sock,StrPtr(SBUF),BufLen,0)
'レスポンス受信
RBUF=String$(256,Chr$(0))
APILONG=recv(Sock,StrPtr(RBUF),Len(RBUF),0)
If APILONG<1 Then
MsgBox 0,"コネクションが切断しました","MAILC",MB_OK+MB_TOPMOST
closesocket(Sock)
WSACleanup()
End
End If
RES=RES+1
MsgBox 0,RBUF,"レスポンス-"+Str$(RES)+"("+Str$(APILONG)+"Byte)",MB_OK+MB_TOPMOST
'コマンド送信
SBUF="QUIT"+Ex"\r\n"
BufLen=Len(SBUF)
COMNB=COMNB+1
MsgBox 0,SBUF,"コマンド -"+Str$(RES),MB_OK+MB_TOPMOST
APILONG=send(Sock,StrPtr(SBUF),BufLen,0)
'レスポンス受信
RBUF=String$(256,Chr$(0))
APILONG=recv(Sock,StrPtr(RBUF),Len(RBUF),0)
If APILONG<1 Then
MsgBox 0,"コネクションが切断しました","MAILC",MB_OK+MB_TOPMOST
closesocket(Sock)
WSACleanup()
End
End If
RES=RES+1
'ソケットのクローズ
closesocket(Sock)
MsgBox 0,RBUF,"レスポンス-"+Str$(RES)+"("+Str$(APILONG)+"Byte)",MB_OK+MB_TOPMOST
End If
'ソケットの作成
Sock=socket(AF_INET,SOCK_STREAM,0)
HADD=GIPADD(SMTPBUF)
With SockAdd
.sin_family=AF_INET
.sin_port=htons(25)
.sin_addr.S_addr=HADD
End With
'3ハンドシェイクによるコネクションの確立
APILONG=connect(Sock,SockAdd,Len(SockAdd))
If Not(APILONG=0) Then
MsgBox 0,"コネクトに失敗しました。","MAILC",MB_OK+MB_TOPMOST
closesocket(Sock)
WSACleanup()
End
End If
'レスポンス受信
RBUF=String$(256,Chr$(0))
APILONG=recv(Sock,StrPtr(RBUF),Len(RBUF),0)
If APILONG<1 Then
MsgBox 0,"コネクションが切断しました","MAILC",MB_OK+MB_TOPMOST
closesocket(Sock)
WSACleanup()
End
End If
RES=RES+1
MsgBox 0,RBUF,"レスポンス-"+Str$(RES)+"("+Str$(APILONG)+"Byte)",MB_OK+MB_TOPMOST
'コマンド送信
SBUF="HELO "+SMTPBUF+Ex"\r\n"
BufLen=Len(SBUF)
COMNB=COMNB+1
MsgBox 0,SBUF,"コマンド -"+Str$(RES),MB_OK+MB_TOPMOST
APILONG=send(Sock,StrPtr(SBUF),BufLen,0)
'レスポンス受信
RBUF=String$(256,Chr$(0))
APILONG=recv(Sock,StrPtr(RBUF),Len(RBUF),0)
If APILONG<1 Then
MsgBox 0,"コネクションが切断しました","MAILC",MB_OK+MB_TOPMOST
closesocket(Sock)
WSACleanup()
End
End If
RES=RES+1
MsgBox 0,RBUF,"レスポンス-"+Str$(RES)+"("+Str$(APILONG)+"Byte)",MB_OK+MB_TOPMOST
'コマンド送信
SBUF="MAIL FROM: <"+MYADDBUF+Ex">\r\n"
BufLen=Len(SBUF)
COMNB=COMNB+1
MsgBox 0,SBUF,"コマンド -"+Str$(RES),MB_OK+MB_TOPMOST
APILONG=send(Sock,StrPtr(SBUF),BufLen,0)
'レスポンス受信
RBUF=String$(256,Chr$(0))
APILONG=recv(Sock,StrPtr(RBUF),Len(RBUF),0)
If APILONG<1 Then
MsgBox 0,"コネクションが切断しました","MAILC",MB_OK+MB_TOPMOST
closesocket(Sock)
WSACleanup()
End
End If
RES=RES+1
MsgBox 0,RBUF,"レスポンス-"+Str$(RES)+"("+Str$(APILONG)+"Byte)",MB_OK+MB_TOPMOST
'コマンド送信
SBUF="RCPT TO: <"+SENDADDBUF+Ex">\r\n"
BufLen=Len(SBUF)
COMNB=COMNB+1
MsgBox 0,SBUF,"コマンド -"+Str$(RES),MB_OK+MB_TOPMOST
APILONG=send(Sock,StrPtr(SBUF),BufLen,0)
'レスポンス受信
RBUF=String$(256,Chr$(0))
APILONG=recv(Sock,StrPtr(RBUF),Len(RBUF),0)
If APILONG<1 Then
MsgBox 0,"コネクションが切断しました","MAILC",MB_OK+MB_TOPMOST
closesocket(Sock)
WSACleanup()
End
End If
RES=RES+1
MsgBox 0,RBUF,"レスポンス-"+Str$(RES)+"("+Str$(APILONG)+"Byte)",MB_OK+MB_TOPMOST
'コマンド送信
SBUF="DATA"+Ex"\r\n"
BufLen=Len(SBUF)
COMNB=COMNB+1
MsgBox 0,SBUF,"コマンド -"+Str$(RES),MB_OK+MB_TOPMOST
APILONG=send(Sock,StrPtr(SBUF),BufLen,0)
'レスポンス受信
RBUF=String$(256,Chr$(0))
APILONG=recv(Sock,StrPtr(RBUF),Len(RBUF),0)
If APILONG<1 Then
MsgBox 0,"コネクションが切断しました","MAILC",MB_OK+MB_TOPMOST
closesocket(Sock)
WSACleanup()
End
End If
RES=RES+1
MsgBox 0,RBUF,"レスポンス-"+Str$(RES)+"("+Str$(APILONG)+"Byte)",MB_OK+MB_TOPMOST
'コマンド送信
SBUF="Subject:"+SUBJEBUF+Ex"\r\n"
BufLen=Len(SBUF)
COMNB=COMNB+1
MsgBox 0,SBUF,"コマンド -"+Str$(RES),MB_OK+MB_TOPMOST
APILONG=send(Sock,StrPtr(SBUF),BufLen,0)
'コマンド送信
SBUF=MAILBUF+Ex"\r\n"
BufLen=Len(SBUF)
COMNB=COMNB+1
MsgBox 0,SBUF,"コマンド -"+Str$(RES),MB_OK+MB_TOPMOST
APILONG=send(Sock,StrPtr(SBUF),BufLen,0)
'コマンド送信
SBUF="."+Ex"\r\n"
BufLen=Len(SBUF)
COMNB=COMNB+1
MsgBox 0,SBUF,"コマンド -"+Str$(RES),MB_OK+MB_TOPMOST
APILONG=send(Sock,StrPtr(SBUF),BufLen,0)
'レスポンス受信
RBUF=String$(256,Chr$(0))
APILONG=recv(Sock,StrPtr(RBUF),Len(RBUF),0)
If APILONG<1 Then
MsgBox 0,"コネクションが切断しました","MAILC",MB_OK+MB_TOPMOST
closesocket(Sock)
WSACleanup()
End
End If
RES=RES+1
MsgBox 0,RBUF,"レスポンス-"+Str$(RES)+"("+Str$(APILONG)+"Byte)",MB_OK+MB_TOPMOST
'コマンド送信
SBUF="QUIT"+Ex"\r\n"
BufLen=Len(SBUF)
COMNB=COMNB+1
MsgBox 0,SBUF,"コマンド -"+Str$(RES),MB_OK+MB_TOPMOST
APILONG=send(Sock,StrPtr(SBUF),BufLen,0)
'レスポンス受信
RBUF=String$(256,Chr$(0))
APILONG=recv(Sock,StrPtr(RBUF),Len(RBUF),0)
If APILONG<1 Then
MsgBox 0,"コネクションが切断しました","MAILC",MB_OK+MB_TOPMOST
closesocket(Sock)
WSACleanup()
End
End If
RES=RES+1
MsgBox 0,RBUF,"レスポンス-"+Str$(RES)+"("+Str$(APILONG)+"Byte)",MB_OK+MB_TOPMOST
'ソケットのクローズ
closesocket(Sock)
WSACleanup()
End
以前の掲示板に投稿したメールの送信のサンプルです。
POP before SMTP にも対応しています。
メールの質問が意外と多いようなので投稿しました。
以下のソースをそのままコンパイルすれば動作します。
昔のソースなので読みにくくてすみません。
(ActiveBasic最新版で動くように修正しました 2006/4/15 10:22)
[code]
'関数の定義ここから
Const WSADESCRIPTION_LEN = 256
Const WSASYS_STATUS_LEN = 128
Const SOCKET_ERROR = -1
Const INVALID_SOCKET = -1
' Winsockの実装の詳細を定義する構造体の宣言
Type WSAData
wVersion As Integer
wHighVersion As Integer
szDescription(WSADESCRIPTION_LEN) As Byte
szSystemStatus(WSASYS_STATUS_LEN) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type
' ソケットのアドレスを保存する構造体
Type in_addr
S_addr As Long
End Type
' ソケットの情報を保存する構造体
Type sockaddr_in
sin_family As Integer
sin_port As Word
sin_addr As in_addr
sin_zero(7) As Byte
End Type
'ネットワーク上にある既知の、接続するソケットのアドレスを受け取る構造体
Type sockaddr
sa_family As Word
sa_data[13] As Byte
End Type
' ホストの情報を保存する構造体
Type hostent
h_name As Long
h_aliases As Long
h_addrtype As Integer
h_length As Integer
h_addr_list As Long
End Type
' アドレスファミリーを示す定数の宣言
Const AF_UNSPEC = 0
Const AF_UNIX = 1
Const AF_INET = 2
Const AF_IMPLINK = 3
Const AF_PUP = 4
Const AF_CHAOS = 5
Const AF_NS = 6
Const AF_IPX = AF_NS
Const AF_ISO = 7
Const AF_OSI = AF_ISO
Const AF_ECMA = 8
Const AF_DATAKIT = 9
Const AF_CCITT = 10
Const AF_SNA = 11
Const AF_DECnet = 12
Const AF_DLI = 13
Const AF_LAT = 14
Const AF_HYLINK = 15
Const AF_APPLETALK = 16
Const AF_NETBIOS = 17
Const AF_VOICEVIEW = 18
Const AF_FIREFOX = 19
Const AF_UNKNOWN1 = 20
Const AF_BAN = 21
Const AF_ATM = 22
Const AF_INET6 = 23
Const AF_CLUSTER = 24
Const AF_12844 = 25
Const AF_MAX = 26
' ソケットの種類を示す定数の宣言
Const SOCK_STREAM = 1
Const SOCK_DGRAM = 2
Const SOCK_RAW = 3
Const SOCK_RDM = 4
Const SOCK_SEQPACKET = 5
' ローカルのアドレスのどれかを使用することを示す定数の宣言
Const INADDR_ANY = &H0
'ソケット関数
Declare Function accept Lib "wsock32.dll" (ByVal s As Long,ByRef addr As sockaddr_in,ByVal addrlen As Long) As Long
Declare Function WSAAccept Lib "ws2_32.dll" (ByVal s As Long,addr As Long,addrlen As Long,ByVal lpfnCondition As Long,ByVal dwCallbackData As Long) As Long
Declare Function bind Lib "wsock32.dll" (ByVal s As Long,ByRef sName As sockaddr_in, ByVal namelen As Long) As Long
Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long
Declare Function connect Lib "wsock32.dll" (ByVal s As Long,ByRef sName As sockaddr_in, ByVal namelen As Long) As Long
Declare Function ioctlsocket Lib "wsock32.dll" (ByVal s As Long, ByVal cmd As Long, argp As Long) As Long
Declare Function listen Lib "wsock32.dll" (ByVal s As Long, ByVal backlog As Long) As Long
Declare Function recv Lib "wsock32.dll" (ByVal s As Long, ByVal buf As BytePtr, ByVal lngLen As Long, ByVal flags As Long) As Long
Declare Function recvfrom Lib "wsock32.dll" (ByVal s As Long, buf As BytePtr, ByVal lngLen As Long, ByVal flags As Long,ByRef from As sockaddr_in, fromlen As Long) As Long
Declare Function send Lib "wsock32.dll" (ByVal s As Long, buf As BytePtr, ByVal lngLenlen As Long, ByVal flags As Long) As Long
Declare Function sendto Lib "wsock32.dll" (ByVal s As Long, buf As BytePtr, ByVal lngLen As Long, ByVal flags As Long,ByRef sTo As sockaddr_in, ByVal tolen As Long) As Long
Declare Function setsockopt Lib "wsock32.dll" (ByVal s As Long, ByVal level As Long, ByVal optname As Long, optval As String, ByVal optlen As Long) As Long
Declare Function shutdown Lib "wsock32.dll" (ByVal s As Long, ByVal how As Long) As Long
Declare Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal lngType As Long, ByVal protocol As Long) As Long
Declare Function recvb Lib "wsock32.dll" Alias "recv" (ByVal s As Long, buf As VoidPtr, ByVal lngLen As Long, ByVal flags As Long) As Long
Declare Function sendb Lib "wsock32.dll" Alias "send" (ByVal s As Long, buf As VoidPtr, ByVal lngLen As Long, ByVal flags As Long) As Long
'バイトオーダー変換
Declare Function htonl Lib "wsock32.dll" (ByVal hostlong As Long) As Long
Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Word
Declare Function ntohl Lib "wsock32.dll" (ByVal netlong As Long) As Long
Declare Function ntohs Lib "wsock32.dll" (ByVal netshort As Long) As Word
'アドレス変換
Declare Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long
Declare Function inet_ntoa Lib "wsock32.dll" (ByVal lngIn As Long) As Long
'データベース関数
Declare Function gethostbyaddr Lib "wsock32.dll" (addr As Long, ByVal lngLen As Long, ByVal lngType As Long) As Long
Declare Function gethostbyname Lib "wsock32.dll" (ByVal strName As String) As Long
Declare Function gethostname Lib "wsock32.dll" (ByVal strName As String, ByVal namelen As Long) As Long
Declare Function getpeername Lib "wsock32.dll" (ByVal s As Long,ByRef sName As sockaddr_in, namelen As Long) As Long
Declare Function getprotobyname Lib "wsock32.dll" (ByVal strName As String) As Long
Declare Function getprotobynumber Lib "wsock32.dll" (ByVal lngNumber As Long) As Long
Declare Function getservbyname Lib "wsock32.dll" (ByVal strName As String, ByVal proto As String) As Long
Declare Function getservbyport Lib "wsock32.dll" (ByVal Port As Long, ByVal proto As String) As Long
Declare Function getsockname Lib "wsock32.dll" (ByVal s As Long,ByRef sName As sockaddr_in, namelen As Long) As Long
Declare Function getsockopt Lib "wsock32.dll" (ByVal s As Long, ByVal level As Long, ByVal optname As Long, optval As String, optlen As Long) As Long
'拡張機能
Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequested As Long,ByRef lpWSAData As WSAData) As Long
Declare Function WSACleanup Lib "wsock32.dll" () As Long
Declare Function WSAAsyncGetServByName Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal strName As String, ByVal proto As String, buf As String, ByVal buflen As Long) As Long
Declare Function WSAAsyncGetServByPort Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal Port As Long, ByVal proto As String, buf As String, ByVal buflen As Long) As Long
Declare Function WSAAsyncGetProtoByName Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal protoname As String, buf As String, ByVal buflen As Long) As Long
Declare Function WSAAsyncGetProtoByNumber Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal number As Long, buf As String, ByVal buflen As Long) As Long
Declare Function WSAAsyncGetHostByName Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal hostname As String, buf As String, ByVal buflen As Long) As Long
Declare Function WSAAsyncGetHostByAddr Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, lngAddr As Long, ByVal lngLen As Long, ByVal lngType As Long, buf As String, ByVal buflen As Long) As Long
Declare Function WSAAsyncSelect Lib "wsock32.dll" (ByVal s As Long, ByVal hWnd As Long, ByVal wMsg As Long, ByVal lngEvent As Long) As Long
Declare Function WSACancelAsyncRequest Lib "wsock32.dll" (ByVal hAsyncTaskHandle As Long) As Long
Declare Function WSACancelBlockingCall Lib "wsock32.dll" () As Long
Declare Function WSAGetLastError Lib "wsock32.dll" () As Long
Declare Function WSAIsBlocking Lib "wsock32.dll" () As Long
Declare Sub WSASetLastError Lib "wsock32.dll" (ByVal lngErr As Long)
Declare Function WSASetBlockingHook Lib "wsock32.dll" (ByVal lngFunc As Long) As Long
Declare Function WSAUnhookBlockingHook Lib "wsock32.dll" () As Long
'ここまで
'自作関数の定義ここから
Function GIPADD(ByVal ipstr As String) As Long
Dim lhost As Long
Dim uhost As hostent
Dim lhostbAdd As Long
Dim lhostAdd As Long
Dim SockAdd As sockaddr_in
Dim HADD As Long
lhost=gethostbyname(ipstr)
If lhost <> 0 Then
memcpy(VarPtr(uhost),lhost,Len(uhost))
With uhost
memcpy(VarPtr(lhostbAdd),.h_addr_list,Len(lhostbAdd))
memcpy(VarPtr(lhostAdd),lhostbAdd,.h_length)
End With
GIPADD=lhostAdd
Else
GIPADD=0
End If
End Function
'ここまで
'ここからがプログラム本体です
#N88BASIC
Dim WDATA As WSAData
Dim APILONG As Long
Dim Sock As Long
Dim BufLen As Long
Dim SBUF As String
Dim RBUF As String
Dim WBUF As String
Dim Port As Word
Dim HADD As Long
Dim SockAdd As sockaddr_in
Dim WarkBUF As String
Dim HOSTBUF As String
Dim SMTPBUF As String
Dim POPBUF As String
Dim POPUSER As String
Dim POPPASS As String
Dim Before As String
Dim RES As Byte
Dim SUBJEBUF As String
Dim MAILBUF As String
Dim SENDADDBUF As String
Dim MYADDBUF As String
Dim COMNB As Byte
RES=0
COMNB=0
'DLLの起動
APILONG=WSAStartup(MAKEWORD(1,1),WDATA)
Input "SMTPサーバのアドレスを入力してください。";SMTPBUF
Input "あなたのメールアドレスを入力してください。";MYADDBUF
Input "送信先のメールアドレスを入力してください。";SENDADDBUF
Input "メールの件名を入力して下さい。";SUBJEBUF
Input "メールの本文を入力して下さい。";MAILBUF
Print "POP before SMTP のSMTPサーバですか?(y/n)";
Input Before
If Before="y" Then
Input "POPサーバのアドレスを入力してください。";POPBUF
Input "POPサーバのユーサー名を入力してください。";POPUSER
Input "POPサーバのパスワードを入力してください。";POPPASS
'ソケットの作成
Sock=socket(AF_INET,SOCK_STREAM,0)
HADD=GIPADD(POPBUF)
With SockAdd
.sin_family=AF_INET
.sin_port=htons(110)
.sin_addr.S_addr=HADD
End With
'3ハンドシェイクによるコネクションの確立
APILONG=connect(Sock,SockAdd,Len(SockAdd))
If Not(APILONG=0) Then
MsgBox 0,"コネクトに失敗しました。","MAILC",MB_OK+MB_TOPMOST
closesocket(Sock)
WSACleanup()
End
End If
'レスポンス受信
RBUF=String$(256,Chr$(0))
APILONG=recv(Sock,StrPtr(RBUF),Len(RBUF),0)
If APILONG<1 Then
MsgBox 0,"コネクションが切断しました","MAILC",MB_OK+MB_TOPMOST
closesocket(Sock)
WSACleanup()
End
End If
RES=RES+1
MsgBox 0,RBUF,"レスポンス-"+Str$(RES)+"("+Str$(APILONG)+"Byte)",MB_OK+MB_TOPMOST
'コマンド送信
SBUF="USER "+POPUSER+Ex"\r\n"
BufLen=Len(SBUF)
COMNB=COMNB+1
MsgBox 0,SBUF,"コマンド -"+Str$(RES),MB_OK+MB_TOPMOST
APILONG=send(Sock,StrPtr(SBUF),BufLen,0)
'レスポンス受信
RBUF=String$(256,Chr$(0))
APILONG=recv(Sock,StrPtr(RBUF),Len(RBUF),0)
If APILONG<1 Then
MsgBox 0,"コネクションが切断しました","MAILC",MB_OK+MB_TOPMOST
closesocket(Sock)
WSACleanup()
End
End If
RES=RES+1
MsgBox 0,RBUF,"レスポンス-"+Str$(RES)+"("+Str$(APILONG)+"Byte)",MB_OK+MB_TOPMOST
'コマンド送信
SBUF="PASS "+POPPASS+Ex"\r\n"
BufLen=Len(SBUF)
COMNB=COMNB+1
MsgBox 0,SBUF,"コマンド -"+Str$(RES),MB_OK+MB_TOPMOST
APILONG=send(Sock,StrPtr(SBUF),BufLen,0)
'レスポンス受信
RBUF=String$(256,Chr$(0))
APILONG=recv(Sock,StrPtr(RBUF),Len(RBUF),0)
If APILONG<1 Then
MsgBox 0,"コネクションが切断しました","MAILC",MB_OK+MB_TOPMOST
closesocket(Sock)
WSACleanup()
End
End If
RES=RES+1
MsgBox 0,RBUF,"レスポンス-"+Str$(RES)+"("+Str$(APILONG)+"Byte)",MB_OK+MB_TOPMOST
'コマンド送信
SBUF="QUIT"+Ex"\r\n"
BufLen=Len(SBUF)
COMNB=COMNB+1
MsgBox 0,SBUF,"コマンド -"+Str$(RES),MB_OK+MB_TOPMOST
APILONG=send(Sock,StrPtr(SBUF),BufLen,0)
'レスポンス受信
RBUF=String$(256,Chr$(0))
APILONG=recv(Sock,StrPtr(RBUF),Len(RBUF),0)
If APILONG<1 Then
MsgBox 0,"コネクションが切断しました","MAILC",MB_OK+MB_TOPMOST
closesocket(Sock)
WSACleanup()
End
End If
RES=RES+1
'ソケットのクローズ
closesocket(Sock)
MsgBox 0,RBUF,"レスポンス-"+Str$(RES)+"("+Str$(APILONG)+"Byte)",MB_OK+MB_TOPMOST
End If
'ソケットの作成
Sock=socket(AF_INET,SOCK_STREAM,0)
HADD=GIPADD(SMTPBUF)
With SockAdd
.sin_family=AF_INET
.sin_port=htons(25)
.sin_addr.S_addr=HADD
End With
'3ハンドシェイクによるコネクションの確立
APILONG=connect(Sock,SockAdd,Len(SockAdd))
If Not(APILONG=0) Then
MsgBox 0,"コネクトに失敗しました。","MAILC",MB_OK+MB_TOPMOST
closesocket(Sock)
WSACleanup()
End
End If
'レスポンス受信
RBUF=String$(256,Chr$(0))
APILONG=recv(Sock,StrPtr(RBUF),Len(RBUF),0)
If APILONG<1 Then
MsgBox 0,"コネクションが切断しました","MAILC",MB_OK+MB_TOPMOST
closesocket(Sock)
WSACleanup()
End
End If
RES=RES+1
MsgBox 0,RBUF,"レスポンス-"+Str$(RES)+"("+Str$(APILONG)+"Byte)",MB_OK+MB_TOPMOST
'コマンド送信
SBUF="HELO "+SMTPBUF+Ex"\r\n"
BufLen=Len(SBUF)
COMNB=COMNB+1
MsgBox 0,SBUF,"コマンド -"+Str$(RES),MB_OK+MB_TOPMOST
APILONG=send(Sock,StrPtr(SBUF),BufLen,0)
'レスポンス受信
RBUF=String$(256,Chr$(0))
APILONG=recv(Sock,StrPtr(RBUF),Len(RBUF),0)
If APILONG<1 Then
MsgBox 0,"コネクションが切断しました","MAILC",MB_OK+MB_TOPMOST
closesocket(Sock)
WSACleanup()
End
End If
RES=RES+1
MsgBox 0,RBUF,"レスポンス-"+Str$(RES)+"("+Str$(APILONG)+"Byte)",MB_OK+MB_TOPMOST
'コマンド送信
SBUF="MAIL FROM: <"+MYADDBUF+Ex">\r\n"
BufLen=Len(SBUF)
COMNB=COMNB+1
MsgBox 0,SBUF,"コマンド -"+Str$(RES),MB_OK+MB_TOPMOST
APILONG=send(Sock,StrPtr(SBUF),BufLen,0)
'レスポンス受信
RBUF=String$(256,Chr$(0))
APILONG=recv(Sock,StrPtr(RBUF),Len(RBUF),0)
If APILONG<1 Then
MsgBox 0,"コネクションが切断しました","MAILC",MB_OK+MB_TOPMOST
closesocket(Sock)
WSACleanup()
End
End If
RES=RES+1
MsgBox 0,RBUF,"レスポンス-"+Str$(RES)+"("+Str$(APILONG)+"Byte)",MB_OK+MB_TOPMOST
'コマンド送信
SBUF="RCPT TO: <"+SENDADDBUF+Ex">\r\n"
BufLen=Len(SBUF)
COMNB=COMNB+1
MsgBox 0,SBUF,"コマンド -"+Str$(RES),MB_OK+MB_TOPMOST
APILONG=send(Sock,StrPtr(SBUF),BufLen,0)
'レスポンス受信
RBUF=String$(256,Chr$(0))
APILONG=recv(Sock,StrPtr(RBUF),Len(RBUF),0)
If APILONG<1 Then
MsgBox 0,"コネクションが切断しました","MAILC",MB_OK+MB_TOPMOST
closesocket(Sock)
WSACleanup()
End
End If
RES=RES+1
MsgBox 0,RBUF,"レスポンス-"+Str$(RES)+"("+Str$(APILONG)+"Byte)",MB_OK+MB_TOPMOST
'コマンド送信
SBUF="DATA"+Ex"\r\n"
BufLen=Len(SBUF)
COMNB=COMNB+1
MsgBox 0,SBUF,"コマンド -"+Str$(RES),MB_OK+MB_TOPMOST
APILONG=send(Sock,StrPtr(SBUF),BufLen,0)
'レスポンス受信
RBUF=String$(256,Chr$(0))
APILONG=recv(Sock,StrPtr(RBUF),Len(RBUF),0)
If APILONG<1 Then
MsgBox 0,"コネクションが切断しました","MAILC",MB_OK+MB_TOPMOST
closesocket(Sock)
WSACleanup()
End
End If
RES=RES+1
MsgBox 0,RBUF,"レスポンス-"+Str$(RES)+"("+Str$(APILONG)+"Byte)",MB_OK+MB_TOPMOST
'コマンド送信
SBUF="Subject:"+SUBJEBUF+Ex"\r\n"
BufLen=Len(SBUF)
COMNB=COMNB+1
MsgBox 0,SBUF,"コマンド -"+Str$(RES),MB_OK+MB_TOPMOST
APILONG=send(Sock,StrPtr(SBUF),BufLen,0)
'コマンド送信
SBUF=MAILBUF+Ex"\r\n"
BufLen=Len(SBUF)
COMNB=COMNB+1
MsgBox 0,SBUF,"コマンド -"+Str$(RES),MB_OK+MB_TOPMOST
APILONG=send(Sock,StrPtr(SBUF),BufLen,0)
'コマンド送信
SBUF="."+Ex"\r\n"
BufLen=Len(SBUF)
COMNB=COMNB+1
MsgBox 0,SBUF,"コマンド -"+Str$(RES),MB_OK+MB_TOPMOST
APILONG=send(Sock,StrPtr(SBUF),BufLen,0)
'レスポンス受信
RBUF=String$(256,Chr$(0))
APILONG=recv(Sock,StrPtr(RBUF),Len(RBUF),0)
If APILONG<1 Then
MsgBox 0,"コネクションが切断しました","MAILC",MB_OK+MB_TOPMOST
closesocket(Sock)
WSACleanup()
End
End If
RES=RES+1
MsgBox 0,RBUF,"レスポンス-"+Str$(RES)+"("+Str$(APILONG)+"Byte)",MB_OK+MB_TOPMOST
'コマンド送信
SBUF="QUIT"+Ex"\r\n"
BufLen=Len(SBUF)
COMNB=COMNB+1
MsgBox 0,SBUF,"コマンド -"+Str$(RES),MB_OK+MB_TOPMOST
APILONG=send(Sock,StrPtr(SBUF),BufLen,0)
'レスポンス受信
RBUF=String$(256,Chr$(0))
APILONG=recv(Sock,StrPtr(RBUF),Len(RBUF),0)
If APILONG<1 Then
MsgBox 0,"コネクションが切断しました","MAILC",MB_OK+MB_TOPMOST
closesocket(Sock)
WSACleanup()
End
End If
RES=RES+1
MsgBox 0,RBUF,"レスポンス-"+Str$(RES)+"("+Str$(APILONG)+"Byte)",MB_OK+MB_TOPMOST
'ソケットのクローズ
closesocket(Sock)
WSACleanup()
End
[/code]