! 排他ロックプログラム
! exLockWin.BAS Version 1.1 written by fuku@rouge.gr.jp

! 使い方
!
! DECLARE EXTERNAL FUNCTION ExLock_lock
! DECLARE EXTERNAL SUB ExLock_unlock
!
! LET lockPath$ = "R:\lockDir.LCK"
! LET lock = ExLock_lock(lockPath$)
! IF lock <> 0 THEN
!      ! ロック中に実行する処理
! END IF
! CALL ExLock_unlock(lockPath$, lock)
! END

! ロックディレクトリを作成する外部関数。
! 排他ロックが成功した場合は 0 以外を返す。
EXTERNAL FUNCTION ExLock_lock(path$)

OPTION CHARACTER Byte

! 西暦元年 1 月 1 日からの経過日数を求める。
FUNCTION Fairfield(y,m,d)
    ! フェアフィールドの公式 (-> 0 オリジンに変更)
    ! グレゴリオ暦を基本としているので 1582 年以前のうるう年は実際的でない
    IF m <= 2 THEN
        LET y = y - 1
        LET m = m + 12
    END IF
    LET Fairfield = 365*y + INT(y/4) - INT(y/100) + INT(y/400) + INT((306*(m+1))/10) + d - 428 - 1
END FUNCTION

! 現在日時を秒数で求める。
FUNCTION GetNow
    LET DateStr$ = DATE$
    LET TimeStr$ = TIME$

    LET yy = VAL(DateStr$(1:4)) ! 年
    LET mm = VAL(DateStr$(5:6)) ! 月
    LET dd = VAL(DateStr$(7:8)) ! 日
    LET h  = VAL(TimeStr$(1:2)) ! 時
    LET m  = VAL(TimeStr$(4:5)) ! 分
    LET s  = VAL(TimeStr$(7:8)) ! 秒

    LET GetNow = FairField(yy,mm,dd)*24*3600 + h*3600 + m*60 + s
END FUNCTION

! ディレクトリ (or ファイル) を探す。
! 十進 BASIC にはファイル日付を取得する機能が無いため Win32 API を使用する。
FUNCTION FindFirstFileA(p$,b$)
    assign "kernel32.dll","FindFirstFileA"
END FUNCTION

! FindFirstFileA を解放する。
SUB FindClose(n)
    assign "kernel32.dll","FindClose"
END SUB

! ディレクトリ (or ファイル) の時刻を求める。
SUB FileTimeToLocalFileTime(b$,lf$)
    assign "kernel32.dll","FileTimeToLocalFileTime"
END SUB

! ディレクトリ (or ファイル) の時刻をシステム時間に変換する。
SUB FileTimeToSystemTime(lf$,ft$)
    assign "kernel32.dll","FileTimeToSystemTime"
END SUB

! ディレクトリ (or ファイル) の作成日時を秒数で求める。
FUNCTION GetFileTime(path$)
    LET GetFileTime = -1    ! ディレクトリ (or ファイル) が無い場合は -1 を返す。

    LET buf$ = REPEAT$(" ", 602)    ! FindFirstFileA を使うには最大 602 バイト必要。
    LET n = FindFirstFileA(path$, buf$)
    IF n <> -1 THEN
        LET lw$ = buf$(21:28)   ! 最終書き込み日時を取得する。

        LET lf$ = REPEAT$(" ", 32)
        CALL FileTimeToLocalFileTime(lw$, lf$)

        LET ft$ = REPEAT$(" ", 32)
        CALL FileTimeToSystemTime(lf$, ft$)

        LET yy = ORD(ft$(1:1))   + 2^8*ORD(ft$(2:2))    ! 年
        LET mm = ORD(ft$(3:3))   + 2^8*ORD(ft$(4:4))    ! 月
        LET dd = ORD(ft$(7:7))   + 2^8*ORD(ft$(8:8))    ! 日
        LET h  = ORD(ft$(9:9))   + 2^8*ORD(ft$(10:10))  ! 時
        LET m  = ORD(ft$(11:11)) + 2^8*ORD(ft$(12:12))  ! 分
        LET s  = ORD(ft$(13:13)) + 2^8*ORD(ft$(14:14))  ! 秒

        LET GetFileTime = Fairfield(yy,mm,dd)*24*3600 + h*3600 + m*60 + s
    END IF
    CALL FindClose(n)
END FUNCTION

    ! ロックファイルの作成日時を取得する (Windows 専用)
    timeStamp = GetFileTime(path$)

    ! 3 分以上前に作成されたロックファイルを削除する
    ! ※何らかの原因で残ったままになったロックファイル
    IF timeStamp > -1 AND timeStamp < (GetNow - 180) THEN
        REMOVE DIRECTORY path$
    END IF

    ! ロックファイルを作成してみる
    ! ※5 回やってダメなら失敗とする
    LET lock = 0
    FOR i = 0 TO 4
        WHEN EXCEPTION IN
            MAKE DIRECTORY path$
            lock = 1    ! ロックを自分で作ったという印。
            EXIT FOR
        USE
            WAIT DELAY 0.2  ! 0.2 秒待つ。
        END WHEN
    NEXT i
    ExLock_lock = lock
END FUNCTION

! ロックディレクトリを削除する副プログラム。
EXTERNAL SUB ExLock_unlock(path$, lock)
    IF lock = 1 THEN    ! 自分で作ったロックファイルなら削除する。
        REMOVE DIRECTORY path$
        lock = 0
    END IF
END SUB