「ファイルロック (排他制御) 的なもの」を編集中

この機能は[https://www.haijin-boys.com/software/mery/mery-3-3-0 Ver 3.3.2]でMery本体に実装されたため、それ以降のバージョンを使用しているユーザーはこのマクロを導入する必要はありません。

== 概要 ==
Meryで開いた文書を、無理やり(!?) ファイルロックするマクロです。

要は、Meryで文書を開いている間、その文書を他から弄られないようにします。

== 欠点 ==
* マクロにて、文書を閉じる (Document.Close) 処理を行っている場合、そのマクロに手を加える必要がある。
** Utility\FileLock.vbs を非同期で呼び出し、少し待機する という処理を追加。
* ファイルロック処理が、常にフラグ用ファイル有無を確認するという処理なので、文書をたくさん開くと、フォルダへのアクセスが頻発する。
** フォルダへのアクセスを抑えたバージョンは、現状 非公開 (コードが長ったらしいので..)。

== 構成 ==
:Mery\Macros
:│
:｜　　　　　【 必須 】
:├─ Utility
:│　　└ FileLock.vbs
:│　　→ マクロへの追加は不要
:│
:├─ FileLock｜Lock.vbs
:│　　→ イベント [ファイルを開いた時] [ファイルを保存した時] に登録を
:├─ FileLock｜Unlock.vbs
:│　　→ イベント [文書を閉じた時] [ファイルを保存する前] に登録を
:├─ FileLock｜Unlock all.vbs
:｜　　→ 文書を全アンロック (非常時用)
:│
:│　　　　　【 おまけ (サンプル) 】
:├─ Close｜Documents.vbs
:│　　→ すべての文書を閉じる (新規文書１つは残す)
:└─ Open｜Again.vbs
:　　　→ 自動選択で読み直し

== ソースコード ==
■ '''FileLock.vbs'''　… Macros\Utility フォルダの中に置く
<syntaxhighlight lang="vbscript">
'==============================================================================
'                           ファイルロック (Mery用)
'==============================================================================
' 指定されたファイル(１つ)の、ファイルロック状態を切り換える
' 
'   仕様
'    - 非同期で呼び出されることを想定
'       ( 同期だと、Mery が待機中のまま固まってしまう )
'    - コマンドライン引数で、動作を指定する
'       - １) モード
'          -  1： ロック        … 実行ファイルなどの場合、実行だけは可能
'          -  0： アンロック
'          - -1： 全アンロック (非常時用!?)
'       - ２) ロック対象ファイルの絶対パス (全アンロックの場合は不要)
'    - 監視は、各々のスクリプトが非同期で行う
' 
'   例 (Mery用マクロ)
'    - 準備
'       | Set sh = CreateObject("WScript.Shell")
'    - ロック
'       | sh.Run """Utility\FileLock.vbs"" 1 """ & Document.FullName & """"
'    - アンロック
'       | sh.Run """Utility\FileLock.vbs"" 0 """ & Document.FullName & """"
'       | Window.Sleep 350
'       |   '└ 監視する間隔を考慮し、少し待機 (Sleep) する必要あり
'       |        ( 設定値より長く Sleep をすべき / ただし、長すぎてもＮＧ.. )
'    - 全アンロック (非常時用!?)
'       | sh.Run """Utility\FileLock.vbs"" -1"
'       | Window.Sleep 350
'       |   '└ 監視する間隔を考慮し、少し待機 (Sleep) する必要あり
'       |        ( 設定値より長く Sleep をすべき / ただし、長すぎてもＮＧ.. )
'    - 補足
'       - Sell.Run の第３引数を、省略 or False にすると、非同期で実行される
'          ( ちなみに第２引数は、実行時のウィンドウの外観 )
' 
'   仕組み
'    - ロックは、まず ロック中フラグ用のファイル を作成し、
'      そのファイルが削除されるまで、スクリプトで対象ファイルを開いたまま待機
'    - アンロックは、ロックの際に作成した ロック中フラグ用のファイル を削除
' 
'   その他
'    - 管理者権限が必要な場合や、既にロック状態なものは、ロックできない
'    - ロック中フラグ用の一時フォルダ内のファイルは、ロックの対象外
'    - 手動でアンロックしたい場合、ロック中フラグ用のファイルを削除すればＯＫ
'------------------------------------------------------------------------------
' [x] 文書を開いたら開いただけ、バックグランドで VBScript (WSH) が動作する
' [x] ロック対象の絶対パスが長すぎると、正常に動作しない可能性がある
' [x] コマンドライン引数は、厳密なチェックは行っていない (不正な値はＮＧ)
' [x] 一時ファイルの作成先に管理者権限が必要な場合、正常に動作しない
'                                                       [x]バグ/欠陥 [･]その他
'------------------------------------------------------------------------------
'                                                                   2019-03-09
Option Explicit

'=== Global ===================================================================
Dim cfg : Set cfg = WScript.CreateObject("Scripting.Dictionary")
cfg.Add "Enable"    , True
  '└ ファイルロックを行わせる (当スクリプトを有効にする) かどうか <真理値>
cfg.Add "Interval"  , 250
  '└ ロック中フラグ用のファイルを監視する間隔 (ミリ秒) <整数:100~>
cfg.Add "TempFolder", "Temp"
  '└ 一時フォルダの名前 <文字列>
  '    - 変更の際は、Mery を終了させておくべき (ロック中の変更はＮＧ)
  '    - 当スクリプトと同じディレクトリに作成される
  '    - フォルダ名に使える文字限定
cfg.Add "LockFix"   , Array("Lock：", ".tmp")
  '└ ロック中フラグ用のファイル名に付ける辞 (接頭辞，接尾辞) <文字列の配列>
  '    - 変更の際は、Mery を終了させておくべき (ロック中の変更はＮＧ)
  '    - ファイル名に使える文字限定

Const MODE_LOCK       =  1      'ロック
Const MODE_UNLOCK     =  0      'アンロック
Const MODE_UNLOCK_ALL = -1      '全アンロック (非常時用!?)
Const MODE_INELIGIBLE = 99     '対象外

Dim fso, sh
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set sh  = WScript.CreateObject("WScript.Shell")
sh.CurrentDirectory = fso.GetParentFolderName(WScript.ScriptFullName)
If 0 = WScript.Arguments.Count Then
    MsgBox Join( Array( _
        "--- ファイルロック ---", _
        "", _
        "コマンドライン引数", _
        " - １) モード  …  [1] ロック  [0] アンロック  [-1] 全アンロック", _
        " - ２) ロック対象ファイルの絶対パス (全アンロックの場合は不要)", _
        "", _
        "※今回は、何もせずに終了します。" _
        ), vbLf ), vbInformation, _
        "VBScript (WSH) for Mery's macros"
ElseIf cfg("Enable") Then
    Main
End If
Set cfg = Nothing
Set sh  = Nothing
Set fso = Nothing

'=== Procedure ================================================================
Sub Main()
    Dim reg, oFile, bReadOnly, nMode, sLock, sFix(1)
    Set reg = WScript.CreateObject("VBScript.RegExp")

    nMode = CInt( WScript.Arguments(0) )
    If 1 < WScript.Arguments.Count Then
        If fso.GetAbsolutePathName( cfg("TempFolder") ) _
                        = fso.GetParentFolderName( WScript.Arguments(1) ) _
                Or Not fso.FileExists( WScript.Arguments(1) ) Then
            nMode = MODE_INELIGIBLE
        Else
            reg.Pattern = ":?\\"
            reg.Global  = True
            sLock = fso.BuildPath( _
                        cfg("TempFolder"), _
                        cfg("LockFix")(0) _
                            & reg.Replace( WScript.Arguments(1), "-" ) & "-" _
                            & reg.Execute( WScript.Arguments(1) ).Count _
                            & Hex( InStrRev( WScript.Arguments(1), "\" ) ) _
                            & cfg("LockFix")(1) )
        End If
    End If

    Select Case nMode
    'ロック
        Case MODE_LOCK
            'ロック中フラグ用のファイル を作成し、
            'それが削除されるまで、ファイルロック を行う (待機)
            '※ロック方法は、読み取り専用で開く ＆ 読み取り専用にする
            ' ( 既にロック中だった場合は、何もしない )
            If Not IsLocked( WScript.Arguments(1) ) Then
                On Error Resume Next
                fso.CreateFolder cfg("TempFolder")
                fso.GetFolder( cfg("TempFolder") ).Attributes = 2
                On Error GoTo 0
                Set oFile = fso.GetFile( WScript.Arguments(1) )
                If 1 And oFile.Attributes Then
                    bReadOnly = True
                Else
                    oFile.Attributes = oFile.Attributes + 1
                End If
                fso.CreateTextFile(sLock).Close
                Set oFile = fso.OpenTextFile( WScript.Arguments(1), 1 )
                Wait(sLock) : oFile.Close
                If Not bReadOnly Then
                    Set oFile = fso.GetFile( WScript.Arguments(1) )
                    oFile.Attributes = oFile.Attributes - 1
                End If
            End If

    'アンロック
        Case MODE_UNLOCK
            'ロック中フラグ用のファイル を削除
            If fso.FileExists(sLock) Then fso.DeleteFile sLock

    '全アンロック
        Case MODE_UNLOCK_ALL
            'ロック中フラグ用のファイル と思しきものを、すべて削除
            reg.Pattern = "([\^\$\+\.\(\)\[\]\{\}])"
            reg.Global  = True
            sFix(0) = reg.Replace( cfg("LockFix")(0), "\$1" )
            sFix(1) = reg.Replace( cfg("LockFix")(1), "\$1" )
            reg.Pattern = "^" & sFix(0) & ".+" & sFix(1) & "$"
            reg.Global  = False
            For Each oFile In fso.GetFolder( cfg("TempFolder") ).Files
                If reg.Test(oFile.Name) Then _
                    fso.DeleteFile fso.BuildPath( cfg("TempFolder"), oFile.Name )
            Next
    End Select

    Set oFile = Nothing
    Set reg   = Nothing
End Sub

'--- 待機 ---------------------------------------------------------------------
' Summary | 指定ファイルが存在する間、待機する
'   Param | - フラグ用ファイルのパス
'  Return | －
'    Note | －
Sub Wait( ByVal sFile )
    Do While fso.FileExists(sFile) : WScript.Sleep cfg("Interval") : Loop
End Sub

'--- ファイルロックの判定 -----------------------------------------------------
' Summary | ファイルロックされているかどうかを返す
'   Param | - ファイルの絶対パス
'  Return | ファイルロックされているかどうか
'    Note | ・ファイル名を変更できるかどうかで判定している
'         | ・ファイルロックされていない ＆ 読み取り専用 の場合は、False が返る
Function IsLocked( ByVal sFile )
    Dim oFile, sName

    IsLocked = False
    Set oFile = fso.GetFile(sFile)
    sName = oFile.Name
    On Error Resume Next
    oFile.Name = fso.GetTempName()  '読み取り専用 でも成功する (変更される)
    If 0 <> Err.Number Then
        IsLocked = True
    Else
        oFile.Name = sName
    End If
    On Error GoTo 0

    Set oFile = Nothing
End Function
</syntaxhighlight>

■ '''FileLock｜Lock.vbs'''　… イベント登録を忘れずに
<syntaxhighlight lang="vbscript">
#title = "文書をロック"
'------------------------------------------------------------------------------
'    Summary | 開いてある文書をファイルロックする
' Assumption | イベントで実行 (ファイルを開いた時 / ファイルを保存した時)
' 
' ・バグ/欠陥
'    - マクロによるアクションの場合、
'      イベントは発生せず、よってこのマクロが実行されない
'------------------------------------------------------------------------------
'                                                                   2019-03-09
Option Explicit

Dim fso, sh, i
Set fso = CreateObject("Scripting.FileSystemObject")
Set sh  = CreateObject("WScript.Shell")
sh.CurrentDirectory = fso.GetParentFolderName(ScriptFullName)
For i = 0 To Editor.Documents.Count - 1
    sh.Run """Utility\FileLock.vbs"" 1 """ _
                    & Editor.Documents.Item(i).FullName & """"
Next
Set sh  = Nothing
Set fso = Nothing
</syntaxhighlight>

■ '''FileLock｜Unlock.vbs'''　… イベント登録を忘れずに
<syntaxhighlight lang="vbscript">
#title = "文書をアンロック"
'------------------------------------------------------------------------------
'    Summary | ファイルロックしてある文書をアンロックする
' Assumption | イベントで実行 (文書を閉じた時 / ファイルを保存する前)
' 
' ・バグ/欠陥
'    - マクロによるアクションの場合、
'      イベントは発生せず、よってこのマクロが実行されない
'------------------------------------------------------------------------------
'                                                                   2019-03-09
Option Explicit

Dim fso, sh
Set fso = CreateObject("Scripting.FileSystemObject")
Set sh  = CreateObject("WScript.Shell")
If "" <> Document.FullName Then
    sh.CurrentDirectory = fso.GetParentFolderName(ScriptFullName)
    sh.Run """Utility\FileLock.vbs"" 0 """ & Document.FullName & """"
    Window.Sleep 350
      '└ 必ず、Utility\FileLock.vbs の Interval 設定より大きな値にすべき
      '    ( ただし、大きすぎると再ロックまでの時間がかかってしまう.. )
End If
Set sh  = Nothing
Set fso = Nothing
</syntaxhighlight>

■ '''FileLock｜Unlock all.vbs'''
<syntaxhighlight lang="vbscript">#title = "文書を全アンロック"
'------------------------------------------------------------------------------
'    Summary | ファイルロックしてある文書をすべてアンロックする
' Assumption | ポップアップメニュー etc. (非常時用!?)
'------------------------------------------------------------------------------
'                                                                   2019-03-09
Option Explicit

Dim fso, sh
Set fso = CreateObject("Scripting.FileSystemObject")
Set sh  = CreateObject("WScript.Shell")
sh.CurrentDirectory = fso.GetParentFolderName(ScriptFullName)
sh.Run """Utility\FileLock.vbs"" -1"
Window.Sleep 350
  '└ 必ず、Utility\FileLock.vbs の Interval 設定より大きな値にすべき
  '    ( ただし、大きすぎると再ロックまでの時間がかかってしまう.. )
Set sh  = Nothing
Set fso = Nothing
</syntaxhighlight>

■ '''Close｜Documents.vbs'''
<syntaxhighlight lang="vbscript">
#title = "すべての文書を閉じる"
'------------------------------------------------------------------------------
'    Summary | 現エディタウィンドウの、すべての文書を閉じる (新規文書１つは残す)
' Assumption | ポップアップメニュー，ツールバー
'------------------------------------------------------------------------------
'                                                                   2019-03-09
Option Explicit

Dim fso, sh
Set fso = CreateObject("Scripting.FileSystemObject")
Set sh  = CreateObject("WScript.Shell")
sh.CurrentDirectory = fso.GetParentFolderName(ScriptFullName)
Do While 1 < Editor.Documents.Count
    sh.Run """Utility\FileLock.vbs"" 0 """ _
                    & Editor.ActiveDocument.FullName & """"
    Editor.ActiveDocument.Close
Loop
If 0 < Editor.Documents.Count Then
    sh.Run """Utility\FileLock.vbs"" 0 """ _
                    & Editor.ActiveDocument.FullName & """"
    Editor.ActiveDocument.Close
End If
Set sh  = Nothing
Set fso = Nothing
</syntaxhighlight>

■ '''Open｜Again.vbs'''
<syntaxhighlight lang="vbscript">
#title = "自動選択で読み直し"
'------------------------------------------------------------------------------
'    Summary | 編集中の文書を、エンコーディング自動選択で読み直す
' Assumption | ポップアップメニュー，ツールバー
' 
' ・バグ/欠陥
'    - タブ位置が、一番右側に開き直されてしまう (本当は同じ位置に開き直したい)
'------------------------------------------------------------------------------
'                                                                   2019-03-09
Option Explicit

Dim fso, sh, sPath, nCount
Set fso = CreateObject("Scripting.FileSystemObject")
Set sh  = CreateObject("WScript.Shell")
sh.CurrentDirectory = fso.GetParentFolderName(ScriptFullName)
sPath  = Editor.ActiveDocument.FullName
nCount = Editor.Documents.Count
sh.Run """Utility\FileLock.vbs"" 0 """ & sPath & """"
Window.Sleep 350
  '└ 必ず、Utility\FileLock.vbs の Interval 設定より大きな値にすべき
  '    ( ただし、大きすぎると再ロックまでの時間がかかってしまう.. )
Editor.ActiveDocument.Close
If 1 < nCount Then Editor.NewFile
Editor.OpenFile(sPath)
Set sh  = Nothing
Set fso = Nothing
</syntaxhighlight>