''''''''''''''''''''''''''''''''''''
'          Jerzy Gebler            '
'       http:\\ocelot.com.pl       '
''''''''''''''''''''''''''''''''''''
' date:    14/09/01                '
''''''''''''''''''''''''''''''''''''
Option Compare Database
Option Explicit

Private Const max_semafor = 10
Private semafor_file(max_semafor) As Integer
Private semafor_path As String

Function SetSemaforPath(Optional NewPath As String) As String
On Error Resume Next

    If NewPath <> "" Then
        semafor_path = NewPath
        If Right(semafor_path, 1) = "\" Then semafor_path = Left(semafor_path, Len(semafor_path) - 1)
    End If
    
    If semafor_path = "" Then semafor_path = sciezka_do_wspolnego_katalogu
    
    SetSemaforPath = semafor_path
    err = 0

End Function

Function SemaforOn(Optional SemaforNo As Integer) As Boolean
On Error Resume Next

    SemaforOn = False
    
    If semafor_path = "" Then SetSemaforPath

    If SemaforNo < 0 Or SemaforNo > 10 Then
        MsgBox "Invalid semafor number: " & SemaforNo, vbCritical, "!!!"
        Exit Function
    End If
 
    If semafor_file(SemaforNo) = 0 Then
        
        semafor_file(SemaforNo) = FreeFile
        
        Open semafor_path & "\semafor" & SemaforNo & ".$$$" For Random Access Read Write Lock Read Write As semafor_file(SemaforNo)
        
        If err <> 0 Then
            err = 0
            semafor_file(SemaforNo) = 0
            Exit Function
        End If
        
        SemaforOn = True
        err = 0
    
    End If

End Function

Function SemaforOff(Optional SemaforNo As Integer) As Boolean
On Error Resume Next
    
    SemaforOff = False
    
    If semafor_path = "" Then SetSemaforPath
    
    If SemaforNo < 0 Or SemaforNo > 10 Then
        MsgBox "Invalid semafor number: " & SemaforNo, vbCritical, "!!!"
        Exit Function
    End If
    
    If semafor_file(SemaforNo) <> 0 Then
        Close semafor_file(SemaforNo)
        Kill semafor_path & "\semafor" & SemaforNo & ".$$$"
        semafor_file(SemaforNo) = 0
    End If

    SemaforOff = True
    err = 0

End Function