[eMail] 送信前にメール本文をチェックする: [FORCE]

[eMail] 送信前にメール本文をチェックする

いつからですかねぇ
UTF8メールがおおでを振って行き交うようになったのは…
CJKとか…国別言語別対応面倒だからUTFにしちゃえばいいでしょ
なのかなぁ
まぁ、後数年？経てば、色々なケースが適応されて
文字化け？問題も解決するんでしょうか。
（例えば：本文は全てJIS内だけど、添付ファイルのファイル名がUTFで本文インライン上に配置されているとか）
さて
メール送信前にメール本文中の文字をチェックするスクリプトです
業務で作成したのを少し手直ししたので公開

手順
１：解凍したスクリプトはスクリプトメニューに

２：メール本文を書いたら

３：メール本文全てを選択して

４：メール本文をコピーします

５：出来たらスクリプトメニューから実行

６：JIS外の文字があると〓に置き換えます

(*
クリップボード内のテキストに
JIS外の文字があるか？を確認して
テキストエディットに貼付けます
JIS外の文字は〓に置き換えます。
テキストエディターにペースト後
〓を赤く塗ります
クリップボード内のテキストを取得する際に
処理によって違う場合？に置き換わるので
？マークは緑に塗り注意喚起します
https://force4u.cocolog-nifty.com/
*)

(*
※ここは設定項目です
メールアプリによる改行の扱いの違いを設定
AppleMail app = 0
Thunderbird = 1
Microsoft Entourage 13 = 2
*)
property theEmailApp : 0


------------------------------------ 
on run
------------デフォルトのディレクトリ
tell application "Finder"
-----このスクリプトへのパスを格納
set theDefaultLocation to ((container of (path to me)) as text) as text
end tell
------辞書ファイル（といってもテキストですが）
set theJisDic to "ISO-2022-JP-Dic.txt"
-----ファイルまでのパスをエイリアスにして格納
set theJisDicPath to (theDefaultLocation & theJisDic) as alias
------------ファイルを「open」に渡す
open theJisDicPath
end run


on open objDrop
-----辞書ファイルのエイリアスを取得
set theFileAlias to objDrop as alias
------選択したファイルのUNIXパスを取得
set theUnixPass to POSIX path of theFileAlias as text
----辞書ファイルを読み込みUTF8で格納する
set theData to (do shell script "cat " & theUnixPass) as «class utf8»
----格納したデータをテキストにする
set theData to theData as text
-----クリップボードから取得した時の値の初期化
set theMailText to ""
----メールアプリ毎の文字と改行の処理
try
----AppleMail
if theEmailApp is 0 then
-----クリップボードの中身をテキストで格納
set theMailText to get (the clipboard as «class utf8»)
-----テキストに変更
set theMailText to theMailText as text
-----区切り文字を改行コードに変更
set AppleScript's text item delimiters to {"\n"}

-----Thunderbird
else if theEmailApp is 1 then
-----クリップボードの中身をテキストで格納
set theMailText to get (the clipboard as «class utf8»)
-----テキストに変更
set theMailText to theMailText as text
-----区切り文字を改行コードに変更
set AppleScript's text item delimiters to {"\n"}

-----Microsoft Entourage（まぁ不要ですけど…）
else if theEmailApp is 2 then
-----クリップボードの中身をテキストで格納
set theMailText to get (the clipboard as Unicode text)
-----テキストに変更
set theMailText to theMailText as text
-----区切り文字を改行コードに変更
set AppleScript's text item delimiters to {"\r"}
end if
end try
-----改行毎にリストにして格納
set theFileTypeList to every text item of theMailText as list
-----区切り文字を戻す
set AppleScript's text item delimiters to {""}
-----何行あるか？(データ件数＝繰り返し数）を数える
set numListLine to count of theFileTypeList
-----行数カウンタ初期化
set numLine to 0 as number
-----文字の置き換えが発生したか？カウンタ
set numNoJisChr to 0
-----繰り返しカウンターも初期化
set numListLineCnt to 0 as number
-----行毎の繰り返し
repeat numListLine times
-----行カウンターアップ
set numListLineCnt to numListLineCnt + 1 as number
-----行数カウンタ行を１行だけ取得して格納
set theLineDate to (item numListLineCnt of theFileTypeList) as text
-----文字数数える
set numPcnt to (count of theLineDate) as number
----文字毎のだぶるクオテーションを区切り文字に
set AppleScript's text item delimiters to {""}
------文字毎にリストに格納する
set theLineDate1 to every text item of theLineDate as list
-------文字毎の繰り返しカウンターを初期化
set numCntRepeat to 0 as number
-----文字毎の繰り返し
repeat numPcnt times
-----文字カウンターアップ
set numCntRepeat to numCntRepeat + 1
-----１文字づつ
set theChkMailText to (item numCntRepeat of theLineDate) as text
------辞書ファイルの中に文字があるか？調べる
if theData contains theChkMailText then
---あればそのまま
else
-----辞書ファイルに無い文字があったら
-----置き換え文字を〓に指定
set theText to "〓" as text
-----辞書外の文字カウンタUP
set numNoJisChr to numNoJisChr + 1
log theChkMailText
------辞書ファイルの中に無い文字だったら〓に置き換える
set theMailText to doReplace(theMailText, theChkMailText, theText)
end if
-----文字毎リピートの終わり
end repeat
-----行毎リピートの終わり
end repeat

------結果発表
if numNoJisChr is 0 then
-----置き換えが発生しなかったらOKダイアログ
tell application "Finder"
display alert "メールチェックOK" as informational giving up after 1
end tell
else
-----文字の置き換えが発生したらテキストエディタに表示する
-----色指定
set redColor to {65535, 0, 0}
set greenColor to {0, 41354, 0}
-----?マークを緑に塗るための文字指定
set theQText to "?" as text
----置き換え終わった文字をクリップボードに戻す
set the clipboard to theMailText as text
------結果をテキストエディタに表示する
tell application "TextEdit" to launch
tell application "TextEdit"
----新しいドキュメントを作成する
make new document with properties {text:theMailText}
tell text of document 1
---置き換え文字を赤く塗る
set the color of every character where it is theText to redColor
set the color of every character where it is theQText to greenColor

end tell
end tell
tell application "TextEdit" to activate
end if
end open






----------------#ここから文字の置き換えサブルーチン
to doReplace(theText, orgStr, newStr)
set oldDelim to AppleScript's text item delimiters
set AppleScript's text item delimiters to orgStr
set tmpList to every text item of theText
set AppleScript's text item delimiters to newStr
set tmpStr to tmpList as text
set AppleScript's text item delimiters to oldDelim
return tmpStr
end doReplace