1. はじめに：DWG標準ロック（.dwl/.dwl2）の限界とRDBMS集中の必然性
AutoCADのネイティブな同時排他制御は、図面と同一ディレクトリに生成される一時ファイル群——いわゆる`.dwl`および`.dwl2`に依存している。スタンドアロンのファイルサーバ環境であればこれでも一定の衝突防止を果たしてきたが、現代の分散設計環境、特にVPN経由のリモートアクセスやクラウドストレージ同期（SharePoint, Box等）、あるいは社内PDM/PLMとの連携において、ファイルベースの排他制御は容易に破綻する。
ファイル同期の遅延による競合ファイルの量産、プロセス異常終了に伴うロックファイルの残留（ゴーストロック）、そして「誰が、どの端末で、いつからその図面を占有しているのか」を社内全体から横断的にクエリできない不透明性。これらを根本解決する唯一の手段は、ファイルシステムから排他制御の責務を剥奪し、ACID特性を備えたRDBMS（SQL Server）へ集中化することである。
本稿では、AutoCAD VBAからActiveX Data Objects（ADO）を介し、SQL Server上でミリ秒精度の「確定的チェックアウト機構」を構築するアーキテクチャを詳解する。環境変数偽装を許さないWindows APIベースの端末同定、デッドロックを排除するアトミックな更新SQL、そしてCOMオブジェクトの厳密なライフサイクル管理まで、エンタープライズ水準の実装を提示する。
—
2. データベーススキーマ設計：デッドロックなき排他テーブル
まず、SQL Server側に配置する管理テーブルを定義する。ネットワーク切断やCAD強制終了による「放置されたロック」を検出するため、単なるフラグ管理ではなく、プロセスID、MACアドレス、最終ハートビート時刻を保持させる設計とする。
— 図面排他管理テーブル
CREATE TABLE dbo.DrawingCheckouts (
DrawingGuid UNIQUEIDENTIFIER NOT NULL DEFAULT NEWSEQUENTIALID(),
DrawingPathHash CHAR(64) NOT NULL, — 正規化されたフルパスのSHA-256
DrawingFullPath NVARCHAR(1000) NOT NULL,
CheckoutStatus TINYINT NOT NULL DEFAULT 1, — 1: Locked, 0: Released
LockedByUserId NVARCHAR(100) NOT NULL,
LockedByMachine NVARCHAR(100) NOT NULL,
ProcessId INT NOT NULL,
LockTimestamp DATETIME2(3) NOT NULL DEFAULT SYSUTCDATETIME(),
LastHeartbeat DATETIME2(3) NOT NULL DEFAULT SYSUTCDATETIME(),
CONSTRAINT PK_DrawingCheckouts PRIMARY KEY CLUSTERED (DrawingPathHash)
);
CREATE NONCLUSTERED INDEX IX_DrawingCheckouts_Status_Time
ON dbo.DrawingCheckouts (CheckoutStatus, LastHeartbeat);
排他取得のコアロジックは、クライアントサイドでの`SELECT -> IF -> INSERT`というナイーブな多段階ステップを踏んではならない。マルチクライアント環境下ではレースコンディションを招く。SQL Serverの`UPDLOCK, HOLDLOCK`ヒント、あるいはアトミックな`MERGE`文を用いて、単一のクエリトランザクション内で「空き確認」と「占有」を完結させる必要がある。
—
3. 実行基盤の特定：環境変数に依存しないWindows APIの実装
VBAの`Environ(“USERNAME”)`や`Environ(“COMPUTERNAME”)`は、プロセス空間内で容易に改ざん可能であり、監査証跡としての信頼性に欠ける。シニアエンジニアであれば、OSのカーネルおよびネットワークサブシステムから直接、真正な情報を取得するAPIバインドを組むべきである。
標準モジュール（`modSystemIdentity.bas`）に以下の低レイヤ呼び出しを実装する。
Option Explicit
‘ ==============================================================================
‘ モジュール名: modSystemIdentity
‘ 責務: OSカーネルから偽装不可能な実行コンテキスト（UID/ホスト/PID）を抽出する
‘ ==============================================================================
If VBA7 Then
Private Declare PtrSafe Function GetUserNameW Lib “advapi32.dll” ( _
ByVal lpBuffer As LongPtr, _
ByRef nSize As Long) As Long
Private Declare PtrSafe Function GetComputerNameExW Lib “kernel32.dll” ( _
ByVal NameType As Long, _
ByVal lpBuffer As LongPtr, _
ByRef nSize As Long) As Long
Private Declare PtrSafe Function GetCurrentProcessId Lib “kernel32.dll” () As Long
Else
Private Declare Function GetUserNameW Lib “advapi32.dll” ( _
ByVal lpBuffer As Long, _
ByRef nSize As Long) As Long
Private Declare Function GetComputerNameExW Lib “kernel32.dll” ( _
ByVal NameType As Long, _
ByVal lpBuffer As Long, _
ByRef nSize As Long) As Long
Private Declare Function GetCurrentProcessId Lib “kernel32.dll” () As Long
End If
Private Const ComputerNameDnsFullyQualified As Long = 3
Private Const MAX_BUFFER_SIZE As Long = 32767
”’
”’
Public Function GetAuthenticUserName() As String
Dim buffer(MAX_BUFFER_SIZE – 1) As Integer
Dim size As Long
size = MAX_BUFFER_SIZE
If GetUserNameW(VarPtr(buffer(0)), size) <> 0 Then
‘ size にはNull終端文字が含まれるため size – 1 を切り出す
If size > 1 Then
GetAuthenticUserName = Left$(bufferToString(buffer), size – 1)
End If
Else
GetAuthenticUserName = “UNKNOWN_USER”
End If
End Function
”’
”’
Public Function GetAuthenticComputerName() As String
Dim buffer(MAX_BUFFER_SIZE – 1) As Integer
Dim size As Long
size = MAX_BUFFER_SIZE
If GetComputerNameExW(ComputerNameDnsFullyQualified, VarPtr(buffer(0)), size) <> 0 Then
If size > 0 Then
GetAuthenticComputerName = Left$(bufferToString(buffer), size)
End If
Else
GetAuthenticComputerName = “UNKNOWN_HOST”
End If
End Function
”’
”’
Public Function GetAuthenticProcessId() As Long
GetAuthenticProcessId = GetCurrentProcessId()
End Function
Private Function bufferToString(ByRef buf() As Integer) As String
bufferToString = String(UBound(buf) + 1, vbNullChar)
Dim i As Long
For i = 0 To UBound(buf)
Mid$(bufferToString, i + 1, 1) = ChrW$(buf(i))
Next i
End Function
—
4. ADOを用いたアトミック・チェックアウト・コントローラ
次に、ADO（ActiveX Data Objects 2.8以降）を用い、SQL Serverとの接続および排他コマンドの実行エンジンをクラスモジュール（`clsDrawingLockManager.cls`）として構築する。
接続文字列には、パフォーマンスとセキュリティの観点から`MSOLEDBSQL`（OLE DB Driver for SQL Server）を採用し、Integrated Security（Windows認証）によるKerberos認証を前提とする。
Option Explicit
‘ ==============================================================================
‘ クラス名: clsDrawingLockManager
‘ 責務: SQL Serverに対する原子的なロックの獲得・解放、および状態監視
‘ ==============================================================================
Private Const DB_CONN_STR As String = _
“Provider=MSOLEDBSQL;” & _
“Data Source=sql-cluster-prod.corp.local;” & _
“Initial Catalog=CadManagementDB;” & _
“Integrated Security=SSPI;” & _
“Application Name=AutoCAD_VBA_LockEngine;” & _
“DataTypeCompatibility=80;”
Private m_cn As Object ‘ ADODB.Connection
Private Sub Class_Initialize()
‘ 遅延バインディングにより環境依存の参照設定不整合を防止
On Error Resume Next
Set m_cn = CreateObject(“ADODB.Connection”)
m_cn.ConnectionString = DB_CONN_STR
m_cn.ConnectionTimeout = 5
m_cn.CommandTimeout = 5
m_cn.Open
On Error GoTo 0
End Sub
Private Sub Class_Terminate()
‘ 明示的破棄：COMリソースおよび未解放コネクションの即時回収
If Not m_cn Is Nothing Then
If m_cn.State = 1 Then ‘ 1 = adStateOpen
m_cn.Close
End If
Set m_cn = Nothing
End If
End Sub
”’
”’
”’
Public Function AcquireCheckout( _
ByVal drawingPath As String, _
ByRef outConflictUser As String, _
ByRef outConflictMachine As String, _
ByRef outLockTime As String) As Boolean
AcquireCheckout = False
outConflictUser = vbNullString
outConflictMachine = vbNullString
outLockTime = vbNullString
If m_cn Is Nothing Then Exit Function
If m_cn.State <> 1 Then Exit Function
Dim pathHash As String
pathHash = ComputeSHA256(UCase$(Trim$(drawingPath)))
Dim userName As String: userName = modSystemIdentity.GetAuthenticUserName()
Dim machineName As String: machineName = modSystemIdentity.GetAuthenticComputerName()
Dim pid As Long: pid = modSystemIdentity.GetAuthenticProcessId()
Dim cmd As Object
Set cmd = CreateObject(“ADODB.Command”)
Set cmd.ActiveConnection = m_cn
cmd.CommandType = 1 ‘ adCmdText
‘ アトミックに排他を判定・更新するT-SQL
‘ 過去30分以内にハートビートがない行はクラッシュとみなしてオーバーライドを許可する設計例
cmd.CommandText = _
“SET NOCOUNT ON; ” & _
“BEGIN TRANSACTION; ” & _
” DECLARE @Now DATETIME2(3) = SYSUTCDATETIME(); ” & _
” DECLARE @ExistingUser NVARCHAR(100), @ExistingMachine NVARCHAR(100), @ExistingTime DATETIME2(3); ” & _
” SELECT @ExistingUser = LockedByUserId, @ExistingMachine = LockedByMachine, @ExistingTime = LockTimestamp ” & _
” FROM dbo.DrawingCheckouts WITH (UPDLOCK, HOLDLOCK) ” & _
” WHERE DrawingPathHash = ?; ” & _
” ” & _
” IF @ExistingUser IS NULL ” & _
” BEGIN ” & _
” INSERT INTO dbo.DrawingCheckouts (DrawingPathHash, DrawingFullPath, CheckoutStatus, LockedByUserId, LockedByMachine, ProcessId, LockTimestamp, LastHeartbeat) ” & _
” VALUES (?, ?, 1, ?, ?, ?, @Now, @Now); ” & _
” SELECT 1 AS Result, ” AS Occupier, ” AS Machine, ” AS LTime; ” & _
” END ” & _
” ELSE ” & _
” BEGIN ” & _
” IF (@ExistingUser = ? AND @ExistingMachine = ?) ” & _
” BEGIN ” & _
” UPDATE dbo.DrawingCheckouts SET CheckoutStatus = 1, ProcessId = ?, LastHeartbeat = @Now WHERE DrawingPathHash = ?; ” & _
” SELECT 1 AS Result, ” AS Occupier, ” AS Machine, ” AS LTime; ” & _
” END ” & _
” ELSE ” & _
” BEGIN ” & _
” SELECT 0 AS Result, @ExistingUser AS Occupier, @ExistingMachine AS Machine, CONVERT(NVARCHAR(30), @ExistingTime, 126) AS LTime; ” & _
” END ” & _
” END ” & _
“COMMIT TRANSACTION;”
‘ パラメータの厳密なアタッチ
With cmd
.Parameters.Append .CreateParameter(“@p1”, 129, 1, 64, pathHash) ‘ adChar, adParamInput
.Parameters.Append .CreateParameter(“@p2”, 129, 1, 64, pathHash)
.Parameters.Append .CreateParameter(“@p3”, 202, 1, 1000, drawingPath) ‘ adVarWChar
.Parameters.Append .CreateParameter(“@p4”, 202, 1, 100, userName)
.Parameters.Append .CreateParameter(“@p5”, 202, 1, 100, machineName)
.Parameters.Append .CreateParameter(“@p6”, 3, 1, , pid) ‘ adInteger
.Parameters.Append .CreateParameter(“@p7”, 202, 1, 100, userName)
.Parameters.Append .CreateParameter(“@p8”, 202, 1, 100, machineName)
.Parameters.Append .CreateParameter(“@p9”, 3, 1, , pid)
.Parameters.Append .CreateParameter(“@p10”, 129, 1, 64, pathHash)
End With
Dim rs As Object
On Error GoTo ErrorHandler
Set rs = cmd.Execute()
If Not rs.EOF Then
If rs(“Result”).Value = 1 Then
AcquireCheckout = True
Else
outConflictUser = rs(“Occupier”).Value
outConflictMachine = rs(“Machine”).Value
outLockTime = rs(“LTime”).Value
AcquireCheckout = False
End If
End If
Cleanup:
If Not rs Is Nothing Then
If rs.State = 1 Then rs.Close
Set rs = Nothing
End If
Set cmd = Nothing
Exit Function
ErrorHandler:
‘ データベース到達不可などの例外時はフェイルセーフ（安全側に倒すか強制読取にするか）
AcquireCheckout = False
Resume Cleanup
End Function
”’
”’
Public Sub ReleaseCheckout(ByVal drawingPath As String)
If m_cn Is Nothing Then Exit Sub
If m_cn.State <> 1 Then Exit Sub
Dim pathHash As String
pathHash = ComputeSHA256(UCase$(Trim$(drawingPath)))
Dim pid As Long: pid = modSystemIdentity.GetAuthenticProcessId()
Dim cmd As Object
Set cmd = CreateObject(“ADODB.Command”)
Set cmd.ActiveConnection = m_cn
cmd.CommandType = 1
cmd.CommandText = _
“DELETE FROM dbo.DrawingCheckouts ” & _
“WHERE DrawingPathHash = ? AND ProcessId = ?;”
cmd.Parameters.Append cmd.CreateParameter(“@p1”, 129, 1, 64, pathHash)
cmd.Parameters.Append cmd.CreateParameter(“@p2″, 3, 1, , pid)
On Error Resume Next
cmd.Execute
Set cmd = Nothing
On Error GoTo 0
End Sub
”’
”’
Private Function ComputeSHA256(ByVal text As String) As String
Dim enc As Object, sha As Object
Dim bytes() As Byte, hash() As Byte
Dim i As Long, result As String
Set enc = CreateObject(“System.Text.UTF8Encoding”)
Set sha = CreateObject(“System.Security.Cryptography.SHA256Managed”)
bytes = enc.GetBytes_4(text)
hash = sha.ComputeHash_2(bytes)
For i = LBound(hash) To UBound(hash)
result = result & Right$(“0” & Hex$(hash(i)), 2)
Next i
ComputeSHA256 = LCase$(result)
Set enc = Nothing
Set sha = Nothing
End Function
—
5. AutoCADイベントへの確実なフック：`ThisDrawing`とグローバルイベント
AutoCAD VBAにおいて、文書が開かれた瞬間を捕捉するには`AcadApplication`レベルの`BeginDocClose`および`EndOpen`イベント、あるいはドキュメントごとの`ThisDrawing`モジュール内イベントを正確にハンドリングしなければならない。
特に、「他者がロック中の図面を開いてしまった場合、いかにして安全に編集不能（リードオンリー）にするか、あるいは強制的に閉じさせるか」が制御の要となる。
ThisDrawingモジュールにおける介入実装
Option Explicit
‘ ==============================================================================
‘ 設置場所: 各テンプレート(DWT)またはアクティブ図面の ThisDrawing モジュール
‘ ==============================================================================
Private Sub AcadDocument_BeginDocClose(Cancel As Boolean)
On Error Resume Next
Dim lockMgr As clsDrawingLockManager
Set lockMgr = New clsDrawingLockManager
‘ 当該図面が保存されているパスを持つ場合のみロック解除を発行
If ThisDrawing.Path <> vbNullString Then
lockMgr.ReleaseCheckout ThisDrawing.FullName
End If
Set lockMgr = Nothing
On Error GoTo 0
End Sub
グローバル管理クラスによるオープン時インターセプト
ユーザーが任意の手段（ダブルクリック、ドラッグ＆ドロップ、`OPEN`コマンド）で図面を開いた瞬間のインターセプトは、`AcadApplication`のイベントクラスで行う。
Option Explicit
‘ ==============================================================================
‘ クラス名: clsAppEvents (VBAプロジェクトの自動起動マクロからインスタンス化)
‘ ==============================================================================
Private WithEvents m_App As AutoCAD.AcadApplication
Private m_LockMgr As clsDrawingLockManager
Public Sub Initialize()
Set m_App = AutoCAD.Application
Set m_LockMgr = New clsDrawingLockManager
End Sub
Private Sub Class_Terminate()
Set m_App = Nothing
Set m_LockMgr = Nothing
End Sub
Private Sub m_App_EndOpen(ByVal FileName As String)
‘ 新規作成（未保存）ドキュメントはチェック対象外
If InStr(FileName, “\”) = 0 Then Exit Sub
Dim conflictUser As String
Dim conflictMachine As String
Dim lockTime As String
Dim success As Boolean
success = m_LockMgr.AcquireCheckout(FileName, conflictUser, conflictMachine, lockTime)
If Not success Then
‘ 排他競合の発生
Dim msg As String
msg = “【警告: 図面排他ロック検知】” & vbCrLf & vbCrLf & _
“この図面は既に他の設計者によって編集ロックされています。” & vbCrLf & vbCrLf & _
“■ 占有者: ” & conflictUser & vbCrLf & _
“■ 端末名: ” & conflictMachine & vbCrLf & _
“■ ロック時刻: ” & lockTime & vbCrLf & vbCrLf & _
“変更を破棄して直ちに読み取り専用として再オープンするか、” & vbCrLf & _
“作業を中止して図面を閉じてください。”
MsgBox msg, vbCritical Or vbSystemModal, “排他制御システム”
‘ ドキュメントのReadOnlyフラグを強制、またはCloseメソッドのスケジューリング
‘ ※イベント内部での直接CloseはAutoCAD COMの同期モデルを破壊するため、
‘ SendCommandを介して非同期にクローズ処理を投入するのが安定動作の鉄則。
ThisDrawing.SendCommand “_CLOSE ” & vbCr
End If
End Sub
—
6. ゴーストロックの清掃：フェイルオーバー戦略
デスクトップCAD環境における最大の難敵は、AutoCADの強制終了（Crash/タスクマネージャーからの強制終了）や、OSのブルースクリーン、電源断である。これらが発生した場合、`BeginDocClose`は発火せず、SQL Server上にロックレコードが永久に残留する。
この「ゴーストロック」を排除するために、2重の防壁を構築する。
1. ハートビート方式（クライアント起点）
VBA内のタイマーイベント（`SetTimer` API）またはAutoCADのアイドルループを利用し、例えば5分ごとに`LastHeartbeat`を更新する。テーブル走査時、最終ハートビートから30分以上経過しているレコードは「死存セッション」とみなし、他クライアントによるロック奪取（強制解放）を自動で許可する。
2. 起動時オーディット（AutoCAD起動時）
AutoCAD起動スクリプト（`acad.lsp`やVBAの自動実行ルーチン）において、自ホスト名かつ自ユーザー名でありながら、現在の稼働中プロセスに存在しないPIDに紐づく過去のロックレコードをSQL Serverから一掃する。
— ゴーストロック回収ストアドプロシージャの概念
CREATE PROCEDURE dbo.PurgeOrphanLocks
@Machine NVARCHAR(100),
@ActivePids NVARCHAR(MAX) — カンマ区切りの現在稼働中PIDリスト
AS
BEGIN
SET NOCOUNT ON;
DECLARE @PidTable TABLE (Pid INT);
— (※カンマ区切りをテーブル展開するロジック)
DELETE FROM dbo.DrawingCheckouts
WHERE LockedByMachine = @Machine
AND ProcessId NOT IN (SELECT Pid FROM @PidTable);
END;
—
7. まとめ：堅牢なレガシー・インテグレーションの真価
AutoCAD VBAは「古い」と評されることが多い。しかし、内部構造を紐解けば、Windows APIによるOSネイティブ機能への無制限アクセス、COMモデルによる強力なCAD制御、そしてADOによるエンタープライズDBとの結合など、最前線の基幹システムと何ら遜色のないアーキテクチャを組むポテンシャルを秘めている。
本稿で示したチェックアウトシステムの本質は以下の通りである。
1. ファイルシステムを信用しない： 排他はトランザクション保証されたRDBMSで集中管理する。
2. クライアント環境変数を信用しない： Windows APIを用い、カーネルレベルで確実なUID/PIDを特定する。
3. COMのライフサイクルを完全に掌握する： 不要になったRecordset、Command、Connectionは即時解放し、AutoCADプロセスの肥大化とリークを徹底排除する。
表面的なリファレンス知識を超え、システムの境界線（OS、CADエンジン、DB）におけるデータの整合性と例外系を制御しきること。これこそが、数十年稼働し続けるミッションクリティカルな設計情報システムを支えるアーキテクトの矜持である。
