E-Mail(メッセージ)の作成          <TOP>

E-Mail(メッセージ)の作成の下準備をします。

ShellExecute 拡張子に関連付けられたプログラムを実行

UrlEscape %ASCIIに変換可能な安全ではない文字をエスケープシーケンスに変換

UrlUnescape エスケープシーケンスを普通の文字に変換

　

メーラーの「メッセージの作成」にデータを送ります。改行コードなど、そのまま送ることのできない文字をエスケープシーケンスに変換します。

「エンコード」クリックで変換された文字列の確認を、「デコード」クリックで元に戻ることの確認をしています。

文字数は、どの程度の文字数が送れるかをテストするためのものです。

フォームサイズの変更も可能です。

UrlEscapeは、1行998文字の制限がありました。1行998文字の処理を繰り返し、それらを加えていったらどうなるのかをテストしてみました。

区切る際、最後尾全角文字を分解してしまうようなことには対処していません。

「Mail起動」クリックでOutLookのメール作成を呼び出し、データをセットします。

※電子メールの仕様
1行の文字数は改行を含まないで78文字以下であるべきで、998文字を超えないこと。
改行は｢復帰(CR)+改行(LF)｣というシーケンスであること。　

　

'================================================================
'= E-Mail(メッセージ)の作成Ⅱ
'=---------------------------------------------------------------
'= 1行998文字に分割
'= 入力(コピー＆ペーストを含む)文字数を監視しながらテストをしています。
'=    (SendMail2.bas)
'================================================================
#include "Windows.bi"

' 拡張子に関連付けられたプログラムを実行
Declare Function Api_ShellExecute& Lib "shell32" Alias "ShellExecuteA" (ByVal hWnd&, ByVal lpOperation$, ByVal lpFile$, ByVal lpParameters$, ByVal lpDirectory$, ByVal nShowCmd&)

#define OUT_OF_MEMORY_OR_RESOURCES 0    'メモリまたはリソースが足りない
#define ERROR_FILE_NOT_FOUND 2          'ファイルが見つからない
#define ERROR_PATH_NOT_FOUND 3          'パスが見つからない
#define ERROR_BAD_FORMAT 11             '不正な形式の実行ファイル

#define SE_ERR_ACCESSDENIED 5           'OSが指定したファイルへのアクセスを拒否
#define SE_ERR_ASSOCINCOMPLETE 27       'ファイルに関連づけられた物が不完全かまたは無効
#define SE_ERR_DDEBUSY 30               '他のDDEプロセスが通信中だったので、DDE通信が完了できなかった
#define SE_ERR_DDEFAIL 29               'DDE通信が失敗
#define SE_ERR_DDETIMEOUT 28            'DDE通信でタイムアウトが発生
#define SE_ERR_DLLNOTFOUND 32           '指定したDLLファイルが見つからなかった
#define SE_ERR_FNF 2                    'ファイルが見つからなかった
#define SE_ERR_NOASSOC 31               '指定したファイルに関連づけられたアプリケーションが見つからなかった
#define SE_ERR_OOM 8                    '処理を完了するのに十分なメモリがなかった
#define SE_ERR_PNF 3                    '指定したパスが見つからなかった
#define SE_ERR_SHARE 26                 '共有違反が発生

#define SW_SHOWNORMAL 1                 'SW_RESTOREと同じ
#define c_CRLF "%0D%0A"
#define vbCrLf Chr$(13, 10)

' %ASCIIに変換可能な安全ではない文字をエスケープシーケンスに変換
Declare Function Api_UrlEscape& Lib "shlwapi" Alias "UrlEscapeA" (ByVal pszURL$, ByVal pszEscaped$, pcchEscaped&, ByVal dwFlags&)

' エスケープシーケンスを普通の文字に変換
Declare Function Api_UrlUnescape& Lib "shlwapi" Alias "UrlUnescapeA" (ByVal pszURL$, ByVal pszUnescaped$, pcchUnescaped&, ByVal dwFlags&)

#define MAX_PATH 5000                        '
#define ERROR_SUCCESS 0
#define URL_ESCAPE_SEGMENT_ONLY &H2000       'Indicates that pszURL contains only that section of the URL 
#define URL_ESCAPE_PERCENT &H1000            'Convert any % character found in the segment section of the URL 
#define URL_UNESCAPE_INPLACE &H100000        '
#define URL_INTERNAL_PATH &H800000
#define URL_DONT_ESCAPE_EXTRA_INFO &H2000000 'Used only in conjunction with URL_ESCAPE_SPACES_ONLY to prevent the conversion of characters in the query.
#define URL_ESCAPE_SPACES_ONLY &H4000000     'Convert only space characters to their escape sequences, including those space characters in the query portion of the URL.
#define URL_DONT_SIMPLIFY &H8000000

Var Shared Text(3) As Object
Var Shared Edit(2) As Object
Var Shared Button(2) As Object

For i = 0 To 3
    Text(i).Attach GetDlgItem("Text" & Trim$(Str$(i + 1))) : Text(i).SetFontSize 14
    If i < 3 Then
        Edit(i).Attach GetDlgItem("Edit" & Trim$(Str$(i + 1))) : Edit(i).SetFontSize 14
        Button(i).Attach GetDlgItem("Button" & Trim$(Str$(i + 1))) : Button(i).SetFontSize 14
    End If
Next

Var Shared EMail As String

'================================================================
'=
'================================================================
Declare Sub Length_DSP edecl ()
Sub Length_DSP()
    Var Temp As String

    Temp = Edit(2).GetWindowText
    Text(3).SetWindowText "文字数：" & Str$(Len(Temp))
End Sub

'================================================================
'=
'================================================================
Declare Function Encode(sUrl As String) As String
Function Encode(sUrl As String) As String
    Var buff As String
    Var dwSize As Long
    Var dwFlags As Long

    If Len(sUrl) > 0 Then
        buff = Space$(MAX_PATH)
        dwSize = Len(buff)
        dwFlags = URL_DONT_SIMPLIFY

        If Api_UrlEscape(sUrl, buff, dwSize, dwFlags) = ERROR_SUCCESS Then
            Encode = Left$(buff, dwSize)
            Button(2).EnableWindow -1
        Else
            A% = MessageBox("", "制限文字数を越えています！", 0, 2)
        End If
    End If
End Function

'================================================================
'=
'================================================================
Declare Function Decode(sUrl As String) As String
Function Decode(sUrl As String) As String
    Var buff As String
    Var dwSize As Long
    Var dwFlags As Long

    If Len(sUrl) > 0 Then
        buff = Space$(MAX_PATH)
        dwSize = Len(buff)
        dwFlags = URL_DONT_SIMPLIFY

        If Api_UrlUnescape(sUrl, buff, dwSize, dwFlags) = ERROR_SUCCESS Then
            Decode = Left$(buff, dwSize)
            Button(2).EnableWindow 0
        Else
            A% = MessageBox("", "制限文字数を越えています！", 0, 2)
        End If
    End If
End Function

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Button(2).EnableWindow 0
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var Temp As String
    Var Body As String
    Var i As Integer
    Var OneLine As Integer

    EMail = ""
    Body = ""
    OneLine = 998

    'E-Mail アドレス
    Temp = Trim$(Edit(0).GetWindowText)
    If Len(Temp) = 0 Then
        A% = MessageBox("Attention!", "E-Mail アドレスを入力してください！", 0, 2)
        Edit(0).SetFocus
        Exit Sub
    Else
        EMail = EMail & "mailto:" & Temp
    End If

    '件名
    Temp = Trim$(Edit(1).GetWindowText)
    If Len(Temp) <> 0 Then
        EMail = EMail & "?Subject=" & Temp
    End If

    '本文
    Temp = rTrim$(Edit(2).GetWindowText)
    If Len(Temp) <> 0 Then
        For i = 1 To (Len(Temp) \ OneLine) + 1
            Body = Body & Encode(Mid$(Temp, (i - 1) * OneLine + 1, OneLine))
            Edit(2).SetWindowText Body
        Next

        EMail = EMail & "&body=" & Body
    End If

    Length_DSP
End Sub

'================================================================
'=
'================================================================
Declare Sub Button2_on edecl ()
Sub Button2_on()
    Var Temp As String

    Temp = rTrim$(Edit(2).GetWindowText)

    If Len(Temp) <> 0 Then
        Temp = Decode(Temp)
        Edit(2).SetWindowText Temp
    End If
    Length_DSP
End Sub

'================================================================
'=
'================================================================
Declare Sub Button3_on edecl ()
Sub Button3_on()
    Var Ret As Long

    Ret = Api_ShellExecute(GethWnd, "Open", EMail, ByVal 0, ByVal 0, SW_SHOWNORMAL)

    If Ret <= 32 Then
        Select Case Ret
            Case OUT_OF_MEMORY_OR_RESOURCES
                A% = MessageBox("", "メモリまたはリソースが足りません。", 0, 2)
            Case ERROR_FILE_NOT_FOUND
                A% = MessageBox("", "ファイルが見つかりません。", 0, 2)
            Case ERROR_PATH_NOT_FOUND
                A% = MessageBox("", "パスが見つかりません。", 0, 2)
            Case ERROR_BAD_FORMAT
                A% = MessageBox("", "不正な形式の実行ファイルです。", 0, 2)
            Case SE_ERR_ACCESSDENIED
                A% = MessageBox("", "アクセスは拒否されました。", 0, 2)
            Case SE_ERR_ASSOCINCOMPLETE
                A% = MessageBox("", "関連付けが不完全です。", 0, 2)
            Case SE_ERR_NOASSOC
                A% = MessageBox("", "関連付けが指定されていません。", 0, 2)
            Case Else
                A% = MessageBox("", "ファイルを開けません。", 0, 2)
        End Select
    End If
End Sub

'================================================================
'=
'================================================================
Declare Sub Edit3_Change edecl ()
Sub Edit3_Change()
    Length_DSP
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_Resize edecl ()
Sub MainForm_Resize()
    If GetWidth < 600 Or GetHeight < 350 Then
        SetWindowSize 600, 350
    End If

    Edit(2).SetWindowSize GetWidth - 74, GetHeight - 138
    Text(3).MoveWindow 14, GetHeight - 68
    Button(0).MoveWindow GetWidth - 244, GetHeight - 66
    Button(1).MoveWindow GetWidth - 166, GetHeight - 66
    Button(2).MoveWindow GetWidth - 90, GetHeight - 66
End Sub


'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End