Windowsまめちしきー。関連資料のショートカットを手元のフォルダにつくるというのは日常茶飯事であるが，あれ，どういうわけかプロパティに相対パスを入れなおしてもエラーになっちゃうんだよね。んもう，いけず。

絶対パスでいいときもあるが悪いときもある。よくあるのが定型業務の実行結果を日付入りのフォルダ名で分けて保存していくやつ。たいてい前回分をディレクトリ構造ごとコピーして今回ぶんをつくり，フォルダ｜ファイル名をちょちょいと変えて雛型にしますナ。で，みっつ上のフォルダへ跳ぶという意味でショートカットを置いといたらジツは古いオブジェクトを指しっぱなしになってて，うっかり前回のドキュメントをあけたのに気づかず上書きして壊しちゃった。思いだしても冷や汗が出ますナ。

例えば C:\temp\123\a.txt を指すショートカット C:\temp\123\456\a.lnk があるとする。今回123フォルダを C:\temp\789 にリネイムコピーしたとする。 ショートカットC:\temp\789\456\a.lnk ができているが，これを突いたら C:\temp\789\a.txt が出てきてもらいたいのに開くのは相変わらず C:\temp\123\a.txt ということですナ。

ショートカットは怖い。

んでショートカットライクにターゲットのドキュメントをあけるけどそこを相対パス（上の例だと"..\a.txt"）で指定するDOSバッチを書くとこうなる。

START "" /D "%~dp0" "[相対パス]"

VBScriptだとこう。

CreateObject("Shell.Application").ShellExecute "[相対パス]"

いづれもたった１行だが手で書くのはしんどいので――絶対パスを相対パスに書きなおさないと意味ないからネ――これを生成するVBScriptを書いてみた（DOSコマンド版(.BAT)）。下記のスクリプトを適当なフォルダに置いて，ショートカットを[SendTo]につくりおく。で，今回用の正しいショートカット（これは業務用）をいったんつくり，そのショートカットをExplorerで選んで右clickの[送る(N)]でスクリプトのショートカットに送るのだ。あー，ややこしややこし。

'Explorerから渡されたフルパスのショートカットを，
'リンク先の相対パスを START するDOSバッチファイルに差しかえる。

Dim objWS, objFS, objOut
Dim objSC, objLog
Dim pf, p, f, l, o
Dim str, tz

Set objWS = CreateObject("WScript.Shell")
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objLog = objFS.OpenTextFile(WScript.ScriptFullname & ".log", 8, True, -2)
tz = getStrTimeZone()
Call writeLog(WScript.ScriptName & " Start")

'Argumentをひとつづつ処理
For each pf in WScript.Argments
    Call writeLog("Argment: " & pf)
    If objFS.FileExsists(pf) Then              '拡張子の確認
    'Explorerに渡されたパスが存在するとき，
        if UCase(objFS.GetExtentsionName(pf)) = "LNK" Then
        'それがショートカット（LNK拡張子）なら処理対象とする。
            p = objFS.GetParentFolderName(pf)  '所属フォルダ名取得
            f = objFS.GetFileName(pf)          'ファイル名取得
            o = pf & ".BAT"                    '生成するBATのファイル名
            'ショートカット代用BATの生成
            Set objOut = objFS.CreateTextFile(o)
            'ショートカットのリンク先を取得する。
            Set objSC = objWS.CreateShortCut(pf)
            l = objSC.TargetPath
            '相対パスを導出する。
            str = getRelativePath(p, l)
            Call writeLog("JumpTo: " & l)
            Call writeLog("Output: " & o)

            '元のショートカット名をコメント出力
            objOut.WriteLine("REM 元のショートカット: " & pf)
            'そのリンク先をコメント出力
            objOut.WriteLine("REM リンク先: " & l)
            'DOSコマンドを出力
            objOut.WriteLine("START """" /D ""%~dp0"" """ & str & """")
            objOut.Close

            '元のショートカットを削除するか確認
            str = "変換前のショートカットを削除しますか。" & vbLf & vbLf _
                & "ファイル: " & f & vbLf _
                & "リンク先: " & l
            Select Case Msgbox(str, vbYesNo + vbQuestion, WScript.ScriptName)
            Case vbYes
            '[はい]で削除
                objFS.DeleteFile pf, True
                Call writeLog("Del: " & pf)
            Case Else
            '
            End Select
        Else
            Call writeLog("Not ShortCut!")
        End IF
    Else
        Call writeLog("Not Found!")
    End If
Next

Call writeLog(WScript.ScriptName & "End")
objLog.Close

Set objLog = Nothing
Set objOut = Nothing
Set objSC = Nothing
Set objFS = Nothing
Set objWH = Nothing


Function getRelativepath(fromPath, toPath)
'FromパスとToパスを比較してToパスへの相対パスを返す。
    Dim aryF, aryT
    Dim str
    Dim i, j, k

    str = fromPath
    If Right(str, 1) = "\" Then
        str = Left(fromPath, Len(fromPath) - 1)
    End If
    aryF = Split(str, "\")    

    str = toPath
    If Right(str, 1) = "\" Then
        str = Left(toPath, Len(toPath) - 1)
    End If
    aryT = Split(str, "\")    

    i = 0      'Fromパス階層カウンタ
    j = -1     '同一パススイッチ
    k = 0      '上位階層スイッチ

    Do Until (i > UBound(aryF))
    'Fromパスの階層を辿る
        If (i > UBound(aryT)) Or (k = 1) Then
        'Toパス階層を超過したぶんは".."
            aryF(i) = ".."
        ElseIf i = UBound(aryT) Then
        'Toパスの最下層なら".."で上位階層スイッチON
            aryF(i) = ".."
            k = 1
        Else
        'From・Toの同じ階層を比較
            If aryF(i) = aryT(i) Then
            '内容が同じなら相対パスとして消去
                aryF(i) = ""
                aryT(i) = ""
                j = 1          '同一パススイッチON
            Else
            '違ったらFrom階層に".."
                aryF(i) = ".."
                k = 1
            End If
        End If
        i = i + 1
    Loop
    '階層を連結する。
    If j < 0 Then
    '結果的に階層の一致がひとつもなければToパスそのまま
        str = t
    Else
    '一致した階層があるとき，
        If Instr(aryT(UBound), ".") > 0 Then
            str = ""
        Else
        'Toパスがフォルダならひとつ余計に上に上がる。
            str = "..\"
        End
        'Fromパスを連結
        For each i in aryF
            If Len(i) > 0 Then
            '階層が空文字でなければ
                Select Case str
                Case ""
                   str = i
                Case "..\"
                   str = str & i
                Case Else
                   str = str & "\" & i
                End Select
            End If
        Next
        'Toパスを連結
        For each i in aryT
            If Len(i) > 0 Then
            '階層が空文字でなければ
                Select Case str
                Case ""
                   str = i
                Case Else
                   str = str & "\" & i
                End Select
            End If
        Next
    End If
    getRelativePath = str
End Function


Function writeLog(s)
'実行ログを逐次出力する。
    Dim str
    Dim d

    d = Now()
    str = cStr(Year(d)) & "-" _
        & formatDec0(Month(d), 2) & "-" _
        & formatDec0(Day(d), 2) & "T" _
        & formatHMS(d, ":") & strTz & " " & s
    objLog.WriteLine(str)
End Function


Function formatHMS(d, s)
'時刻dをsで連結して返す。
    Dim str
    str = formatDec0(Hour(d), 2) & s _
        & formatDec0(Minute(d), 2) & s _
        & formatDec0(Second(d), 2)
    formatHMS = str
End Function


Function formatDec0(d, c)
'数値dに前ZEROをつけてc桁ぶん返す。
    formatDec0 = Right(String(c, "0") & cStr(d), c)
End Function


Function getStrTimeZone()
'ご当地TimeZoneのBiasを "+|-" + HH:mm で返す。
'日本なら "+09:00"
    Dim objLoc, objTz
    Dim a, b

    'TimeZoneを取得
    Set objLoc = WScript.CreateObject("WbemScripting.SWbemLocator")
    Set objTz = objLoc.ConnectServer.ExecQuery("Select * From Win32_TimeZone")
    'Biasを取得（日本なら 540）
    For each a in objTz
        b = a.Bias
    next
    Set objTz = Nothing
    Set objLoc = Nothing

    a = "+"
    If b < 0 Then
        a = "-"
    End If

    getStrTimeZone = a & Left(FormatHMS(TimeSerial(0, Abs(b), 0), ":"), 5)
End Function

先の例で言うと，C:\temp\789\a.txt を指すショートカット C:\temp\789\456\a.lnk を新しくつくりなおした上で C:\temp\789\456\a.lnk をスクリプトに[SendTo]すれば "..\a.txt" を開く C:\temp\789\456\a.lnk.BAT ができるのだ。

元にしたショートカットは削除する方針であるが，誤操作で意図しないショートカットを送ってしまう可能性はあるのでいちおう消すかどうか訊くようにしており，かつログを残す。ログはスクリプトの本体と同じフォルダに吐く。

一度このバッチファイルを生成すれば，以降のフォルダごとのコピーでは跳び先が相対パスで守られる……ハズだ。

※当然ながら上のスクリプトの動作は保証しません。ロジックがしょっぱいのは仕様だッ。

---

午前中豪快な狐の嫁入りを見られたがまだ台風は津山の辺り。

---

志の輔の『牡丹灯籠』の口演が何と１時間38分１秒。おれの手持ちの録音の最長記録が圓生師匠の『松葉屋瀬川』１時間23分36秒だったから大幅更新だ（ちなみに吉朝さんの『地獄八景亡者戯』が１時間14分55秒）。すごいわねー。

---

ウチの玄関に宅配ドライヴァ各社の行列ができたのは偶然だ。

---

137. クイックルワイパー 立体吸着ドライシート２枚・立体吸着ウエットシート２枚入り [Goods]｜Kao｜花王
     • ジツは２度目の購入。ドライで使ってて，もういいやと思って捨てちゃったんだよね。
138. クイックルワイパー 立体吸着ウェットシート 16枚入 [Supply]｜Kao｜花王
     • amazonまだ荒れてるなあ。莫迦だねえ……。
139. ごま摺り団子 16個入り [Food]｜松栄堂｜通いわて
     • 冷食なので食べられるのは自然解凍した数時間後。何だこれッ!?ンマイなぁぁあぁぁーッと言うくらいうまい。おれ的にはキャラコレの一環であり，これはジョジョ第８部で劇中絶賛されたお菓子のモデルとされているものなのだ。
       参考: ジョジョリオンに登場する「ごま蜜団子」のモデル、松栄堂「ごま摺り団子」 - オレンヂ
140. チェーンフック 3311 [Goods]｜SUPER B｜SUPER B
     • でかいマイラ_コンデンサみたいだが，チェーンを切ったり繋いだりするとき両手の代わりに支えて局所的にテンションを解放するためのフックである。真ん中の膨らみはただのツマミ。こんなの針金ハンガーで作れるぢゃんてなもんで実際なんの造作もなかろうが，ぢゃあ時給300円で作ってよと言われたらめんどくさいでしょ？
141. bathstyle double coating シャンプースタンド<小> H-8840 [Goods]｜パール金属｜パール金属
     • アルミっぽい色合いだが鉄棒のアクリル樹脂塗装。シリコーンのゴム足つき。シャンプーのボトルがみっつ並ぶくらいかな。
142. 魔法少女まどか☆マギカ (5) [Blu-ray]｜新房昭之（監督）・Magica Quartet（原作）｜ANIPLEX
     • おれ，第９話だけリアルタイムに観てたんだ。いよいよその続き。
       言うまでもなくほむらラヴ♥である。
       ライナーノートの四コママンガだけ集めて1000円で売ってもみな満足すると思う。
143. メロウＺ ロングライフ 環形蛍光ランプ 32形/40形 昼白色 FCL32-40ENC-LL-2P [Supply]｜東芝ライテック｜東芝
     • amazonらしくもの凄でかい箱で来た。まだ環形蛍光灯型LEDは出てないんだよねえ。
144. Latex Glove-Powdered D-1125C M 100 [Supply]｜DisTech｜MEDICOM
     • 汚れ作業用に買った使い捨て手袋で，医療行為的にはたぶん無力。"M"を見落としてＭサイズを買ってしまったが伸びまくるので無問題。すごくゴム臭い。
       探したタイミングが悪かったか，今はもっと安いのが出てるね。

• ソニー、12枚の光ディスクを1ストレージ化する技術を開発 -AV Watch

わはは，サイバーなようなレガシーなような。ディスクは新しい規格なの？

攻殻だったかでFDを何千枚つかうマイシステムが出てきてさすがにナイと思った。

---

いつも回遊する土手道が舗装しなおされててびっくり。い・いつの間に，そしてどうやって。確かに先週は行かなかったが，そりゃ台風が来てたからだぞ。

• 『My Tracks』 GPS記録アプリ～あなたの移動が丸裸に！～ | andronavi (アンドロナビ)

きょうになって見つけたんだけど，これどうかなあ。

---

SonicStageでATRACからWAVに変換するときタイトルやら演者やらの情報が削げちゃったのを MediaMonkey に取りこんで泣きながらタグづけしてるんだけど，こっちの台帳（DB化してある）が基本的に80年代のFM放送の聞き書きなので今ネットで引きなおしてみるとちょいちょいスペルミスだの勘違いだのがあり，時を経てそれが判明するのはおもしろい。ミック_ジャガーは Mick Jaguar ぢゃないんですよ皆さん。

---

新しい保険証が来た。

---

149. ゴルゴ13 (162)｜さいとう・たかを｜リイド社
     • 記憶の風化をじっと待つ勢力はそこかしこにありそうだ。他にホヤ・タイヤ・原発の三題噺とサンボマスター。

しかたありませんな。

買ってみました。

充電スタンドを附けて56k円。たけーよ。シカシ赤外線リモコン装備という（学習型では）One & Only のAndro機だでな。

取りあえずAriaをWiFiスポットに仕立て，Googleアカウントに紐づけーのソニーのユーザ登録ーのと初期設定をやってるうちにシステムアップデートのお呼びが掛かり，あっさり Android 3.2 に上がってしまったヨ。

筐体は全面プラッチックで気合いの入ったソニー機にしては安っぽい。まぁそのぶん質量が小さいのだと諦めよう。液晶保護パネルもただのアクリルであり，劇残りの指紋をティシューで拭いただけで傷が走りそうだ。ソフトケースも附属していないから――トレシーさえ附いてない――この機械を家の外に持ちだしちゃだめである。

おっと，Tablet S さんをdisるのはそこまでだ。Andro3.x機としてのスジの良さは備えているので，まぁネットブックのがっかり臭を再び醸すことはないだろう。何てかひってかひ，Palmの末裔という感じがするのよ。いや，ほんまにほんまに。

---

150. Sony Tablet S SGPT112JP/S [Hardware]｜SONY｜SONY
     • もうノートPCは要らないや，というのがあながち強がりでもない Android 3.2 Tablet（既に3.1→3.2のupdaterが出ている）。netbookのような惨めな思いはしないぞ。高いけどな。
151. Sony Tablet S 専用クレードル SGPDS1 [Hardware]｜SONY｜SONY
     • 置けば充電端子が嵌まって充電されるという，他になんにもしないスタンド。ディスプレイの傾斜角は２段階わずかに変えられる。

ほむらは時間を遡行したら体もその時点に戻るのかね。「家族八景」だったか「七瀬ふたたび」のタイムトラベラは肉体年齢はそのままだから妙におとなびたヒトになるという設定だったが。魔法なんだから何とでもなるか。

---

• CNN.co.jp：ビートルズ、人種隔離の会場での出演拒否 ６５年の米公演

ビートルズネタはなるべく拾う。

---

オマツリ月間の２週目。いろいろあらーな。