ファイルロック (排他制御) 的なもの
ナビゲーションに移動
検索に移動
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 フォルダの中に置く
'==============================================================================
' ファイルロック (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■ FileLock｜Lock.vbs … イベント登録を忘れずに
#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■ FileLock｜Unlock.vbs … イベント登録を忘れずに
#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■ FileLock｜Unlock all.vbs
#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■ Close｜Documents.vbs
#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■ Open｜Again.vbs
#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スポンサーリンク
