Archive for 3月, 2009

2009/03/31 破損画像チェック

画像の破損チェックを行うサブルーチンです。以前に、JPEG画像についてはJEPGマーカーの有無により破損確認を行うサブルーチンを掲載していましたが、JEPGマーカーの確認だけでは不十分で、オープンできるのに不完全な画像(QuickTimeでインポートしても、ムービー書き出し時にエラーになる)といったものにも遭遇していました。

brokenimg.jpg

▲オープンできるが、ムービー書き出し時にエラーになる画像の実例

AppleScript Users MLの過去ログを整理していたら、まったく関係ないところで出てきた記述がそのまま画像ファイルの破損チェックに使えることを再発見。

ただ、Image Eventsでオープンしてサイズを取得するだけで、対象が破損している場合にはエラーになります。しかも、手持ちのさまざまな壊れ方をしている「破損画像コレクション」でチェックを行ったところ、オープンできないものは当然として、中途半端にオープンできるようなものまで検出可能でした。

本サブルーチンでは、PICT、Photoshop、BMP、QuickTime Image、GIF、JPEG、MacPaint、JPEG2、SGI、TGA、PDF、PNG、TIFF……などの、よく見る形式やほとんど見たことのない形式の画像の破損検出に対応しています。実際、JPEGとPhotoshop形式については確認を行いました。

Image Eventsではなく、コマンドラインのsipsコマンドで情報取得時にエラーを起こせないか試してみたのですが、sipsでは問題なく画像サイズを取得できてしまっていました。

スクリプト名:破損画像チェック
set theFile to choose file
set aRes to breakImageCheck(theFile) of me
> true / false

破損画像チェック
(通常時:true、破損時:false が返ってくる)
対象形式:PICT/Photoshop/BMP/QuickTime Image/GIF/JPEG/MacPaint/JPEG2/SGI/PSD/TGA/Text/PDF/PNG/TIFF
on breakImageCheck(theFile)
  try
    tell application Image Events
      set {theWidth, theHeight} to dimensions of image theFile
    end tell
    
return true normal image
  on error
    return false broken image
  end try
end breakImageCheck

▼新規書類に ▼カーソル位置に ▼ドキュメント末尾に

2009/03/30 AppleScriptによる並列処理実験用アプレット

AppleScriptによる並列処理実験に用いたアプレットです。

とくに、手の込んだところはひとつもないのですが、このAppleScriptを保存する際に、「アプリケーションバンドル」形式で保存し、さらにオプションで「実行後、自動的に終了しない」チェックボックスをオンにしておく必要があります。

sub.zip

スクリプト名:sub
on run
  identifyMe()
end run

on identifyMe()
  activate
  
  
tell application System Events
    set pName to name of every process whose frontmost is true and visible of it is true
  end tell
  
set aName to contents of first item of pName
  
  
display dialog aName buttons {”OK“} giving up after 1
end identifyMe

▼新規書類に ▼カーソル位置に ▼ドキュメント末尾に

2009/03/30 指定ファイルがバンドル形式のアプレットかどうかチェック

AppleScriptによる並列処理の実験Scriptで使用したものですが……指定のファイルがAppleScriptで作成したバンドル形式のアプレットかどうかをチェックするサブルーチンです。

スクリプト名:指定ファイルがバンドル形式のアプレットかどうかチェック
set a to choose file
set apRes to chkAppScriptBundle(a) of me
> true / false

on chkAppScriptBundle(a)
  set aInfo to info for a
  
set fType to file type of aInfo "APPL"
  
set fCreator to file creator of aInfo "aplt"
  
set typeIdentifier to type identifier of aInfo "com.apple.application-bundle"
  
  
log {fType, fCreator, typeIdentifier}
  
  
if {fType, fCreator, typeIdentifier} = {"APPL", "aplt", "com.apple.application-bundle"} then
    return true
  else
    return false
  end if
end chkAppScriptBundle

▼新規書類に ▼カーソル位置に ▼ドキュメント末尾に

2009/03/30 指定文字列ではじまるプロセスをすべて終了させる

AppleScriptによる並列処理の実験Scriptで立ち上げた大量のアプレットを、終了させるためのAppleScriptです。

System EventsにUNIXプロセスIDを確認して、シェルのkillコマンドで終了させて回ってみたものがこれです。

スクリプト名:指定文字列ではじまるプロセスをすべて終了させる
tell application "System Events"
  set appL to (unix id of every process whose name begins with "sub")
end tell

repeat with i in appL
  set j to contents of i
  
do shell script "kill -HUP " & j
end repeat

▼新規書類に ▼カーソル位置に ▼ドキュメント末尾に

ただし、実際にやってみたら普通にAppleScriptのquitコマンドを実行して回るだけでも大丈夫だったので、それも書いておきます。ここでは、sub1からsub10までの名前のアプレットを終了させています。

スクリプト名:指定文字列ではじまるプロセスをすべて終了させるv2
property maxNum : 10

repeat with i from 1 to maxNum
  set aName to ("sub" & i as string) & ".app"
  
tell application aName
    quit
  end tell
end repeat

▼新規書類に ▼カーソル位置に ▼ドキュメント末尾に

2009/03/30 アプレットをコピーしてリネーム v2

AppleScriptによる並列処理実験Scriptのv2です。v1では、複数のアプレットがDockに表示され……16プロセス起動すると同じアイコンが16個並んでしまいましたが、このv2ではInfo.plistのLSUIElementエントリを作成して、Dockに表示しないようにします。

あとは、アプレットを複製する場所を~/Library/Caches/TemporaryItemsあたりにでもして、終了後の実行ファイルの削除あたりを行うようにライブラリを整理すればいい感じでしょうか。

スクリプト名:アプレットをコピーしてリネーム v2
property maxNum : 10

set aFile to choose file
選択したファイルがバンドル形式のアプレットかどうかをチェック
set apRes to chkAppBundle(aFile) of me
if apRes = false then return

set aFile to aFile as alias

repeat with i from 1 to maxNum
  set aName to (”sub & i as string) & .app
  
  
ファイルをコピーしてリネーム
  
tell application Finder
    set dRes to (duplicate aFile)
    
set dRes to dRes as alias
    
set name of dRes to aName
  end tell
  
  
各アプレットのCFBundleNameを書き換えてLaunch
  
set newApp to renameAppBundle(dRes, aName) of me
  
tell application Finder
    open newApp
  end tell
end repeat

指定アプレットのInfo.plistを書き換える
on renameAppBundle(aFile, aName)
  アプリケーションバンドル内のInfo.plistへのフルパスを組み立てる
  
set aFile to aFile as alias
  
  
set aPosixFile to POSIX path of aFile
  
set pListpath to aPosixFile & Contents/Info.plist
  
  
CFBundleNameを書き換える
  
tell application System Events
    set plistRec to (value of property list file pListpath)
    
set |CFBundleName| of plistRec to aName
    
set plistRec to plistRec & {|LSUIElement|:1} Dockに表示させない
    
set value of property list file pListpath to plistRec
  end tell
  
  
return aFile
end renameAppBundle

指定ファイルがバンドル形式のアプレットかどうかチェック
on chkAppBundle(a)
  set aInfo to info for a
  
set fType to file type of aInfo “APPL”
  
set fCreator to file creator of aInfo “aplt”
  
set typeIdentifier to type identifier of aInfo “com.apple.application-bundle”
  
  
log {fType, fCreator, typeIdentifier}
  
  
if {fType, fCreator, typeIdentifier} = {”APPL“, aplt“, com.apple.application-bundle“} then
    return true
  else
    return false
  end if
end chkAppBundle

▼新規書類に ▼カーソル位置に ▼ドキュメント末尾に

2009/03/30 アプレットをコピーしてリネーム v1

AppleScriptによる並列処理の実験Scriptです。あらかじめ、他にバンドル形式のアプレットをAppleScriptで作成しておき……そのアプレットをコピーしつつバンドル内のInfo.plistの中のエントリを書き換えて別名のアプレットに仕立て上げ、別々のプロセスとして扱えるようにします。

最近のMacは最低でもデュアルコア、最高で16コアというマルチコア化まっしぐらの状況なので、時間のかかる処理については並列処理を考えたほうが得策です。AppleScript自体に並列処理のための機能は……複数のアプレット間でプロセス間通信を行ったりプロパティを参照し合ったりというぐらい。いまひとつマルチコア時代に適した便利な機能を持っていませんが、なければ作るまでのこと。

そこで、アプレットのファイルをコピーして必要なプロセス分用意し、さらにそのバンドル内のInfo.plistを書き換えて、別プロセスとして扱えるように細工します。

これで、プロセス名(アプリケーション名)を個別に指定してハンドラを呼び出したり、プロパティの参照/書き換えを行ったりできるので、1つの時間のかかる処理(大量のJPEG画像ファイルの破損チェックなど)を複数プロセスの生成・起動により時間短縮できるものと思われます。

複数のアプレットから特定のアプリケーション(QuickTime Playerなど)に同時アクセスするのは得策ではないため、それらのリクエストを受け付けるキューイング用のアプレットを別途用意するなどの対策は必要になってくることでしょう。

私の手元にはDual Coreのマシンしかないので、どこからか実験用に16コアのMac Proでも貸していただければ、さまざまな検証も行えるのですが(^ー^;。

スクリプト名:アプレットをコピーしてリネーム v1
property maxNum : 10

set aFile to choose file
選択したファイルがバンドル形式のアプレットかどうかをチェック
set apRes to chkAppBundle(aFile) of me
if apRes = false then return

set aFile to aFile as alias

repeat with i from 1 to maxNum
  set aName to (”sub & i as string) & .app
  
  
ファイルをコピーしてリネーム
  
tell application Finder
    set dRes to (duplicate aFile)
    
set dRes to dRes as alias
    
set name of dRes to aName
  end tell
  
  
各アプレットのCFBundleNameを書き換えてLaunch
  
set newApp to renameAppBundle(dRes, aName) of me
  
tell application Finder
    open newApp
  end tell
end repeat

(*
delay 1

repeat with i from 1 to maxNum
  set aName to (”sub” & i as string) & “.app”
  tell application aName
    identifyMe()
  end tell
  delay 1
end repeat
*)

指定アプレットのInfo.plistを書き換える
on renameAppBundle(aFile, aName)
  アプリケーションバンドル内のInfo.plistへのフルパスを組み立てる
  
set aFile to aFile as alias
  
  
set aPosixFile to POSIX path of aFile
  
set pListpath to aPosixFile & Contents/Info.plist
  
  
CFBundleNameを書き換える
  
tell application System Events
    set plistRec to (value of property list file pListpath)
    
set |CFBundleName| of plistRec to aName
    
set value of property list file pListpath to plistRec
  end tell
  
  
return aFile
end renameAppBundle

指定ファイルがバンドル形式のアプレットかどうかチェック
on chkAppBundle(a)
  set aInfo to info for a
  
set fType to file type of aInfo “APPL”
  
set fCreator to file creator of aInfo “aplt”
  
set typeIdentifier to type identifier of aInfo “com.apple.application-bundle”
  
  
log {fType, fCreator, typeIdentifier}
  
  
if {fType, fCreator, typeIdentifier} = {”APPL“, aplt“, com.apple.application-bundle“} then
    return true
  else
    return false
  end if
end chkAppBundle

▼新規書類に ▼カーソル位置に ▼ドキュメント末尾に

2009/03/17 アドレスブックで表示中のPersonに画像をTIFF変換して読み込み

選択した画像をTIFFに変換してファイルに書き込んだのちに変数に読み込み、アドレスブックで表示中のPersonの画像として設定するAppleScriptです。

スクリプト名:アドレスブックで表示中のPersonに画像をTIFF変換して読み込み
set aFile to choose file

set aType to retImageType(aFile) of me
if aType = "TIFF" then
  set sRes to aFile
else if aType is in {"JPEG", " PSD", "PNG", "PDF", "GIF"} then
  set sRes to convertToTIFF(aFile) of me
end if

エラー時の対応
if sRes = false then
  display dialog "Error in saving image"
  
return
end if

set aaa to path of sRes
set idata to read file aaa as TIFF picture

tell application "Address Book"
  set aPerson to selection
  
set aSel to first item of aPerson
  
if (exists image of aSel) then
    beep
  else
    set image of aSel to idata
  end if
  
save addressbook
end tell

指定画像を128×128のTIFFに変換する
on convertToTIFF(aFile)
  ファイルの親フォルダへのパス
  
tell application "Finder"
    set aFol to (folder of aFile) as alias
  end tell
  
set aFol to aFol as Unicode text
  
  
ファイル名から拡張子を外した文字列
  
tell application "Finder"
    set aName to name of aFile
  end tell
  
set aName to retFileNameWithoutExt(aName) of me
  
  
set aFullPath to aFol & aName & ".tiff"
  
  
tell application "Image Events"
    launch
    
activate
    
set this_image to open aFile
    
set {widthNum, heightNum} to dimensions of this_image
    
scale this_image to size 128
    
try
      set sRes to (save this_image as TIFF in file aFullPath)
    on error
      set sRes to false
    end try
  end tell
  
  
return sRes
end convertToTIFF

ファイル名から拡張子を外す
on retFileNameWithoutExt(fileNameStr)
  set fLen to length of fileNameStr
  
set revText to (reverse of (characters of fileNameStr)) as string 逆順テキストを作成
  
set anOffset to offset of "." in revText
  
set fRes to text 1 thru (fLen - anOffset) of fileNameStr
  
return fRes
end retFileNameWithoutExt

on retImageType(aFile)
  tell application "Image Events"
    launch
    
activate
    
set this_image to open aFile
    
set fRes to file type of this_image
    
close aFile
  end tell
  
return fRes as string
end retImageType

▼新規書類に ▼カーソル位置に ▼ドキュメント末尾に

2009/03/13 辞書.appで指定の単語を検索する v2

指定の単語で辞書.appを検索するAppleScriptです。何も加工しないで日本語の文字を渡すと検索されないので、URLエンコードしてパラメータをつけて実行します。

dict2.jpg

dict3.jpg

スクリプト名:辞書.appで指定の単語を検索する v2
set aText to text returned of (display dialog なんかいれてね default answer “”)
set encText to encodeURL(aText) of me

set aURL to dict:// & encText
open location aURL

on encodeURL(str)
  return do shell script (”python -c \”import sys, urllib; print urllib.quote(sys.argv[1]) \” as Unicode text) & quoted form of str
end encodeURL

▼新規書類に ▼カーソル位置に ▼ドキュメント末尾に

2009/03/13 辞書.appで指定の単語を検索する

辞書.appで指定の単語を検索するAppleScriptです。辞書.appはURLプロトコル「dict://」に対応しているので、open location命令でURLイベントを発生させれば、プロトコルに対応する辞書.appが起動して検索が行われます。

dict1.jpg

スクリプト名:辞書.appで指定の単語を検索する
set aURL to dict:// & chick
open location aURL

▼新規書類に ▼カーソル位置に ▼ドキュメント末尾に

2009/03/11 USBに接続されたUSBメモリの情報を取得する

MLでUSBメモリのシリアル番号の調べ方について話が出ていたので、自分で納得できるレベルまで作り込んでみました。

USBに接続されたストレージの、シリアル番号、ベンダー(メーカー)ID、マウントポイント、名前、書き込み可/不可、bsd名称、空き容量、ファイルシステム種別、ドライブ総容量について返します。USB系ストレージが接続されていない場合にはカラのリストを返します。

usbmems.jpg

drives.jpg

ただ、すべてのUSBメモリの情報を抽出して動作確認したわけではありませんし、ましてSANYOのICレコーダー「Xacti」のように、USB端子につなぐと「Untitled」と「Untitled 1」の2つのボリウムがマウントされる仕様になっている製品に対してでも理想的なデータを返すといった保証はありませんので……ごく当たり前のUSBメモリの情報を抜き出す、というレベルです。

実戦投入するには、もうちょっといろいろといじめてみる必要性を感じます。

スクリプト名:USBに接続されたUSBメモリの情報を取得する
set tmpPath to POSIX path of (path to temporary items from system domain)
set aFileName to (do shell script /usr/bin/uuidgen“)
set outPath to tmpPath & aFileName & .plist
do shell script system_profiler -xml SPUSBDataType > & outPath

tell application System Events
  set vRec to value of property list file (outPath as string)
  
set v1Rec to _items of (first item of vRec)
  
  
set dList to {}
  
set sList to {}
  
repeat with i in v1Rec
    set hitF to false
    
try
      set j to _items of i
      
set hitF to true
    end try
    
    
if hitF = true then
      repeat with jj in j
        try
          set jjj to volumes of jj
          
set sNum to d_serial_num of jj
          
set vStr to b_vendor_id of jj
          
          
repeat with ii in jjj
            set the end of dList to {serialNum:sNum, venderName:vStr, dData:contents of ii}
          end repeat
        end try
      end repeat
    end if
  end repeat
end tell

dList

> {{serialNum:”7f12db856195ef”, venderName:”0×056e (Elecom Co., Ltd.)”, dData:{mount_point:”/Volumes/NO NAME”, _name:”NO NAME”, writable:”yes”, bsd_name:”disk2s1″, free_space:”3.75 GB”, file_system:”MS-DOS FAT32″, |size|:”3.77 GB”}}, {serialNum:”M004101800001″, venderName:”0×4146″, dData:{mount_point:”/Volumes/ぴよまる”, _name:”ぴよまる”, writable:”yes”, bsd_name:”disk1s9″, free_space:”56 MB”, file_system:”HFS+”, |size|:”123.1 MB”}}}

▼新規書類に ▼カーソル位置に ▼ドキュメント末尾に

2009/03/10 XMLからXPathで指定した階層のテキストを取得する

AppleScriptで真剣にXMLを扱おうとする場合に、揃えておくべきものがいくつかあります。

まずは、対象となるXMLデータを編集するなりブラウズするための「XMLエディタ」。とくに、XML中の場所(パス)を特定する「XPath」を表示する機能は必須です。

XPathの表示機能があるフリーのMac OS X用XMLエディタは、探した範囲では「XMLSpear」1本でした(フリーでなければいくつかありましたが……)。XMLSpearはJavaで作ってあってAppleScriptからコントロールできないものですが、この際文句は言えません。

xmlspear01.jpg

次に、Satimage SoftwareのXMLLib OSAX。XMLの操作を行うのに、XMLLib OSAXは欠かせません。他の言語処理系で常識的にある機能をAppleScriptに提供するフリーのOSAXです。これを、スクリプトエディタをいったん終了させ、~/Library/ScriptingAdditionsフォルダに入れておきます。→ XMLLib OSAXダウンロードページ

あとはまあ、こんな風にXMLファイルを読み込んでXPathを指定してデータを取り出したりすることになります。もう、XMLLibはMac OS Xに標準搭載してほしいぐらい役立ちまくっています。

下記サンプルは、~/Library/Preferencesにあるcom.apple.applescript.plistファイルを処理させてみたものです(同じファイルを指定して実行してみても、結果は人によって違います)。

xml02.jpg

ちなみに、XMLLib OSAXはUTF-8のXMLにしか対応していないようなので、風変りなSJISのXML書類などに遭遇してしまった場合には、iconvコマンドなどで変換&XML中のエンコーディング指定部分をUTF-8に置換してから読み込んでみてください。

スクリプト名:XMLからXPathで指定した階層のテキストを取得する
set anXMLfile to choose file
set XMLbody to XMLOpen anXMLfile
set the_root to XMLRoot XMLbody
set aXMLRes to XMLGetText (XMLXPath the_root with /plist/dict[1]/dict[1]/key“)
> {”Garage Band”, “GifBuilder”, “Image Capture Scripting”, “Image Capture Scripting.app”, “InDesign 2.0.2″, “Script Etitor”}

▼新規書類に ▼カーソル位置に ▼ドキュメント末尾に

2009/03/10 Safariのダウンロードフォルダを求めるv3

Mark J Reedによる、Shell使いまくりのルーチン。ちょっと手直ししてエラー対策などを行っています。

パスに日本語の文字が入っていたときにJava風エンコードされた文字が返ってきてしまうのですが、それを強制的にデコードする処理が入っており……これはなかなか便利だと思われます。

スクリプト名:Safariのダウンロードフォルダを求めるv3
set dFol to getSafariDownloadFolder() of me
> alias “Cherry:Users:maro:Documents:ダウンロード:”

By Mark J Reed
on getSafariDownloadFolder()
  try
    set folderName to do shell script defaults read com.apple.safari DownloadsPath
    
set dPOSIXpath to do shell script python -c ‘import os; print os.path.expanduser(u\” & folderName & \”.encode(\”utf-8\”))’
    
set downloadFolder to POSIX file dPOSIXpath as alias
  on error
    set downloadFolder to “”
  end try
  
return downloadFolder
end getSafariDownloadFolder

▼新規書類に ▼カーソル位置に ▼ドキュメント末尾に

2009/03/10 Safariのダウンロードフォルダを求めるv2

Shell Scriptを併用せずに、Safariのダウンロードフォルダを求めるPhillip AkerのAppleScriptです。

結局、最後に得られるパスがホームディレクトリからの相対パスのテキストだったので、それをMac OSのパスに直す(v4)のにshell scriptが必要になってしまうわけですが、極力AppleScriptネイティブの機能を使って書くとこうなるという見本でしょうか。

スクリプト名:Safariのダウンロードフォルダを求めるv2
By Phillip Aker
set pp to POSIX path of (path to preferences)
set bid to bundle identifier of (info for (path to application "Safari"))
set sp to pp & bid & ".plist"
tell application "System Events"
  set dldir to get value of property list item "DownloadsPath" of property list file sp
end tell
> "~/Documents/ダウンロード"

▼新規書類に ▼カーソル位置に ▼ドキュメント末尾に

2009/03/09 アプリケーションに命令を行う記述方法で最短のもの

ひどくなまりのつよい記述方法であり、可読性が著しく下がるため推奨はしないのですが、アプリケーションにこんな記法でも命令できるという(悪い)見本です。

スクリプト名:アプリケーションに命令を行う記述方法で最短のもの
application "Mail" activate

▼新規書類に ▼カーソル位置に ▼ドキュメント末尾に

2009/03/09 Mail.appに登録されている各MLのフォルダ直下にあるメールのうち昨日の0時0分以降に受信したものを個別に数える

Mail.appに登録されているメール振り分けルールのうち、ルール名に「ML」がついているルールの振り分け先フォルダを求め、各メールフォルダの直下に存在するメールのうち、前日の0:00以降に受信したメールの本数をすべてカウントします。

mail05.jpg

メール振り分けルールのうち、「ML」がついているものが、メーリングリスト関連(と仮定して処理)。

MLの投稿数をランキング表示するAppleScript StudioのGUIつきアプリを作った際の初期試作品です。

スクリプト名:Mail.appに登録されている各MLのフォルダ直下にあるメールのうち昨日の0時0分以降に受信したものを個別に数える
global mList, mList_r

set yesterdayDate to ((current date) - 1 * days)
set time of yesterdayDate to 0
set mList to {}
set mList_r to a reference to mList

set mlLocList to getMLRulesStorage() of me
tell application "Mail"
  repeat with i in mlLocList
    tell i
      set mCount to count (every message whose date received > yesterdayDate)
    end tell
    
if mCount > 0 then
      set the end of mList_r to {name of i as string, mCount}
    end if
  end repeat
end tell

set bList to shellSortListDecending(mList, 2) of me
bList

Mail.appのRuleのうち名称に「_ML」が入っているものの、保存先メールボックスを抽出
on getMLRulesStorage()
  tell application "Mail"
    set mbList to move message of every rule whose name contains "ML" and name of it does not contain "会社"
  end tell
  
return mbList
end getMLRulesStorage

シェルソートで入れ子のリストを昇順ソート
on shellSortListAscending(a, keyItem)
  set n to length of a
  
set cols to {1391376, 463792, 198768, 86961, 33936, 13776, 4592, 1968, 861, 336, 112, 48, 21, 7, 3, 1}
  
repeat with h in cols
    if (h (n - 1)) then
      repeat with i from h to (n - 1)
        set v to item (i + 1) of a
        
set j to i
        
repeat while (j h) and ((contents of item keyItem of item (j - h + 1) of a) > (item keyItem of v))
          set (item (j + 1) of a) to (item (j - h + 1) of a)
          
set j to j - h
        end repeat
        
set item (j + 1) of a to v
      end repeat
    end if
  end repeat
  
return a
end shellSortListAscending

シェルソートで入れ子のリストを降順ソート
on shellSortListDecending(a, keyItem)
  set n to length of a
  
set cols to {1391376, 463792, 198768, 86961, 33936, 13776, 4592, 1968, 861, 336, 112, 48, 21, 7, 3, 1}
  
repeat with h in cols
    if (h (n - 1)) then
      repeat with i from h to (n - 1)
        set v to item (i + 1) of a
        
set j to i
        
repeat while (j h) and ((contents of item keyItem of item (j - h + 1) of a) < (item keyItem of v))
          set (item (j + 1) of a) to (item (j - h + 1) of a)
          
set j to j - h
        end repeat
        
set item (j + 1) of a to v
      end repeat
    end if
  end repeat
  
return a
end shellSortListDecending

▼新規書類に ▼カーソル位置に ▼ドキュメント末尾に

2009/03/09 Mailで表示しているフォルダで送信日時が重複しているメールを削除v1

Mail.appで表示しているフォルダ中で送信日時(日付、時:分:秒)が重複しているメールを削除するAppleScriptです。

たとえば、たまたまメーリングリストに登録しているメールアドレスを他のものに変更する作業を行ったとして、たまたま2つのアドレスが重複して登録されている時間帯があって……同じメールを重複して受信してしまっているような時に、これを送信日時で検出して削除を行います。

すべて処理対象にすると処理対象が多すぎることが予想されたため、指定日時「以降」のメールのみを対象とするように絞り込みを行っています。

Mail.appでは複数のビューワーウィンドウを表示できるので、複数あった場合には最前面のビューワーウィンドウが対象となります。

mail01.jpg

こんな風にメールフォルダが階層構造になっていて……

mail02.jpg

最前面のビューワーで選択されているメールフォルダが対象で……

mail03.jpg

重複しているメールを……

mail04.jpg

すべて削除します。

スクリプト名:Mailで表示しているフォルダで送信日時が重複しているメールを削除v1

set yesterdayDate to "2009/3/1" 指定日時以降を対象とする
set yesterdayDate to date yesterdayDate

set aMailBox to getSelectedOneMailBox() of me
tell application "Mail"
  
  
tell aMailBox
    set mList to (every message whose date sent > yesterdayDate)
  end tell
  
  
set sList to {}
  
repeat with i in mList
    set the end of sList to date sent of i
  end repeat
  
  
  
set {itemList, ssList} to detectDuplicationSimple(sList) of me
  
  
repeat with i in itemList
    set anMessage to item i of mList
    
tell anMessage
      delete
    end tell
  end repeat
end tell

リスト中の重複検出
on detectDuplicationSimple(cList)
  copy cList to ccList
  
  
set j to length of ccList
  
set dupList to {}
  
set itemList to {}
  
  
repeat with i from 2 to j
    set first_item to item 1 of ccList
    
    
set ccList to rest of ccList
    
if first_item is in ccList then
      set the end of dupList to first_item
      
set the end of itemList to (i - 1)
    end if
  end repeat
  
  
return {itemList, dupList}
end detectDuplicationSimple

Message Viewerで現在表示中のメールボックスの情報を1つのみ返す
on getSelectedOneMailBox()
  tell application "Mail"
    tell message viewer 1
      set mbList to selected mailboxes
    end tell
  end tell
  
if length of mbList is equal to 0 then
    return ""
  end if
  
  
set aMailBox to contents of (item 1 of mbList)
  
return aMailBox
end getSelectedOneMailBox

▼新規書類に ▼カーソル位置に ▼ドキュメント末尾に