Programming Tool Box/SIMS_2.iso/demo/rec_lock/exmpl1_1.frm

Visual Basic Form | 1995-02-27 | 20.4 KB | 560 lines

VERSION 2.00
Begin Form frm_Example_1
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Record Locking Pro 1.01 Demo - Example 1"
   ClientHeight    =   6615
   ClientLeft      =   1050
   ClientTop       =   450
   ClientWidth     =   7770
   ControlBox      =   0   'False
   Height          =   7140
   Icon            =   EXMPL1_1.FRX:0000
   KeyPreview      =   -1  'True
   Left            =   990
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6615
   ScaleWidth      =   7770
   Top             =   -15
   Width           =   7890
   Begin CommandButton cmd_Exit
      Cancel          =   -1  'True
      Caption         =   "Ende"
      Height          =   375
      Left            =   5820
      TabIndex        =   22
      Top             =   1500
      Width           =   1515
   End
   Begin TextBox txt_Lock_Timeout
      Height          =   285
      Left            =   4860
      MaxLength       =   4
      TabIndex        =   3
      Top             =   1080
      Width           =   1395
   End
   Begin Frame fra_
      BackColor       =   &H00C0C0C0&
      Caption         =   "Record-Locking-Pro-Routinen"
      Height          =   4335
      Left            =   360
      TabIndex        =   27
      Top             =   2100
      Width           =   6975
      Begin CommandButton cmd_Get_Lock_Mode
         Caption         =   "Function -> Get_Lock_Mode"
         Height          =   435
         Left            =   3540
         TabIndex        =   21
         Top             =   3720
         Width           =   3315
      End
      Begin CommandButton cmd_Get_Lock_User
         Caption         =   "Function -> Get_Lock_User"
         Height          =   435
         Left            =   3540
         TabIndex        =   20
         Top             =   3240
         Width           =   3315
      End
      Begin CommandButton cmd_Get_Lock_Timeout
         Caption         =   "Function -> Get_Lock_Timeout"
         Height          =   435
         Left            =   3540
         TabIndex        =   19
         Top             =   2760
         Width           =   3315
      End
      Begin CommandButton cmd_Get_Lock_Seconds
         Caption         =   "Function -> Get_Lock_Seconds"
         Height          =   435
         Left            =   3540
         TabIndex        =   18
         Top             =   2280
         Width           =   3315
      End
      Begin CommandButton cmd_Get_Lock_Time
         Caption         =   "Function -> Get_Lock_Time"
         Height          =   435
         Left            =   3540
         TabIndex        =   17
         Top             =   1800
         Width           =   3315
      End
      Begin CommandButton cmd_Get_Lock_Date
         Caption         =   "Function -> Get_Lock_Date"
         Height          =   435
         Left            =   3540
         TabIndex        =   16
         Top             =   1320
         Width           =   3315
      End
      Begin CommandButton cmd_Is_Record_Locked
         Caption         =   "Function -> Is_Record_Locked"
         Height          =   435
         Left            =   3540
         TabIndex        =   15
         Top             =   840
         Width           =   3315
      End
      Begin CommandButton cmd_Is_Record_Locked_Gen
         Caption         =   "Function -> Is_Record_Locked_Gen"
         Height          =   435
         Left            =   3540
         TabIndex        =   14
         Top             =   360
         Width           =   3315
      End
      Begin CommandButton cmd_Unlock_Record
         Caption         =   "Sub -> Unlock_Record"
         Height          =   435
         Left            =   120
         TabIndex        =   13
         Top             =   3720
         Width           =   3315
      End
      Begin CommandButton cmd_Lock_Record
         Caption         =   "Sub -> Lock_Record"
         Height          =   435
         Left            =   120
         TabIndex        =   12
         Top             =   3240
         Width           =   3315
      End
      Begin CommandButton cmd_Clear_Table
         Caption         =   "Sub -> Clear_Table"
         Height          =   435
         Left            =   120
         TabIndex        =   11
         Top             =   2760
         Width           =   3315
      End
      Begin CommandButton cmd_Init_Locking
         Caption         =   "Sub -> Init_Locking"
         Height          =   435
         Left            =   120
         TabIndex        =   6
         Top             =   360
         Width           =   3315
      End
      Begin CommandButton cmd_Done_Locking
         Caption         =   "Sub -> Done_Locking"
         Height          =   435
         Left            =   120
         TabIndex        =   7
         Top             =   840
         Width           =   3315
      End
      Begin CommandButton cmd_Get_Login_Date
         Caption         =   "Function -> Get_Login_Date"
         Height          =   435
         Left            =   120
         TabIndex        =   8
         Top             =   1320
         Width           =   3315
      End
      Begin CommandButton cmd_Get_Login_Time
         Caption         =   "Function -> Get_Login_Time"
         Height          =   435
         Left            =   120
         TabIndex        =   9
         Top             =   1800
         Width           =   3315
      End
      Begin CommandButton cmd_Get_Login_Seconds
         Caption         =   "Function -> Get_Login_Seconds"
         Height          =   435
         Left            =   120
         TabIndex        =   10
         Top             =   2280
         Width           =   3315
      End
   End
   Begin OptionButton opt_Lock_by_Edit
      Caption         =   "Lock-by-Edit"
      Height          =   255
      Left            =   3780
      TabIndex        =   5
      Top             =   1560
      Width           =   1755
   End
   Begin OptionButton opt_Lock_by_Select
      Caption         =   "Lock-by-Select"
      Height          =   255
      Left            =   1980
      TabIndex        =   4
      Top             =   1560
      Value           =   -1  'True
      Width           =   1755
   End
   Begin TextBox txt_Record_ID
      Height          =   285
      Left            =   1920
      MaxLength       =   8
      TabIndex        =   2
      Top             =   1080
      Width           =   1395
   End
   Begin TextBox txt_Table_Name
      Height          =   285
      Left            =   1920
      MaxLength       =   40
      TabIndex        =   1
      Top             =   660
      Width           =   5295
   End
   Begin TextBox txt_User_Name
      Height          =   285
      Left            =   1920
      MaxLength       =   20
      TabIndex        =   0
      Top             =   240
      Width           =   2715
   End
   Begin Label lab_
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "Lock-Timeout"
      Height          =   255
      Index           =   4
      Left            =   3360
      TabIndex        =   28
      Top             =   1140
      Width           =   1395
   End
   Begin Label lab_
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "Sperrmethode"
      Height          =   255
      Index           =   3
      Left            =   180
      TabIndex        =   26
      Top             =   1620
      Width           =   1635
   End
   Begin Shape sha_
      BackStyle       =   1  'Opaque
      Height          =   375
      Left            =   1920
      Top             =   1500
      Width           =   3675
   End
   Begin Label lab_
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "Datensatz-ID"
      Height          =   255
      Index           =   2
      Left            =   180
      TabIndex        =   25
      Top             =   1140
      Width           =   1635
   End
   Begin Label lab_
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "Name der Tabelle/Abfrage"
      Height          =   435
      Index           =   1
      Left            =   180
      TabIndex        =   24
      Top             =   600
      Width           =   1635
   End
   Begin Label lab_
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "Benutzername"
      Height          =   255
      Index           =   0
      Left            =   180
      TabIndex        =   23
      Top             =   300
      Width           =   1635
   End
' Example 1 - Record-Locking-Pro-Routinen
Option Explicit
Const Lock_File_Name = "REC_LOCK.DAT"
Sub cmd_Clear_Table_Click ()
    Dim Table_Name As String
    Table_Name = txt_Table_Name.Text
    Clear_Table Table_Name
    Show_Status_1
End Sub
Sub cmd_Done_Locking_Click ()
    Done_Locking
    Show_Status_1
End Sub
Sub cmd_Exit_Click ()
    If glb_User_Name <> "" Then Done_Locking
    Unload Me
    End
End Sub
Sub cmd_Get_Lock_Date_Click ()
    Dim Table_Name As String
    Dim Record_ID As Long
    Table_Name = txt_Table_Name.Text
    Record_ID = txt_Record_ID.Text
    MsgBox "FUNKTIONSERGEBNIS:" & Chr$(13) & Chr$(13) & "Sperrdatum: " & Get_Lock_Date(Table_Name, Record_ID)
    Show_Status_2
End Sub
Sub cmd_Get_Lock_Mode_Click ()
    Dim Lock_Mode
    Lock_Mode = Get_Lock_Mode()
    Select Case Lock_Mode
        Case -1
            MsgBox "FUNKTIONSERGEBNIS:" & Chr$(13) & Chr$(13) & "Sperrmethode: " & Str$(Lock_Mode)
        Case 0
            MsgBox "FUNKTIONSERGEBNIS:" & Chr$(13) & Chr$(13) & "Sperrmethode: " & Str$(Lock_Mode) & " (Lock-by-Select)"
        Case 1
            MsgBox "FUNKTIONSERGEBNIS:" & Chr$(13) & Chr$(13) & "Sperrmethode: " & Str$(Lock_Mode) & " (Lock-by-Edit)"
    End Select
    Show_Status_1
End Sub
Sub cmd_Get_Lock_Seconds_Click ()
    Dim Table_Name As String
    Dim Record_ID As Long
    Table_Name = txt_Table_Name.Text
    Record_ID = txt_Record_ID.Text
    MsgBox "FUNKTIONSERGEBNIS:" & Chr$(13) & Chr$(13) & "Sperrzeit in Sek.: " & Get_Lock_Seconds(Table_Name, Record_ID)
    Show_Status_2
End Sub
Sub cmd_Get_Lock_Time_Click ()
    Dim Table_Name As String
    Dim Record_ID As Long
    Table_Name = txt_Table_Name.Text
    Record_ID = txt_Record_ID.Text
    MsgBox "FUNKTIONSERGEBNIS:" & Chr$(13) & Chr$(13) & "Sperrzeit: " & Get_Lock_Time(Table_Name, Record_ID)
    Show_Status_2
End Sub
Sub cmd_Get_Lock_Timeout_Click ()
    Dim Table_Name As String
    Dim Record_ID As Long
    Dim Lock_Timeout As Integer
    Table_Name = txt_Table_Name.Text
    Record_ID = txt_Record_ID.Text
    Lock_Timeout = Get_Lock_Timeout(Table_Name, Record_ID)
    Select Case Lock_Timeout
        Case -1
            MsgBox "FUNKTIONSERGEBNIS:" & Chr$(13) & Chr$(13) & "Lock-Timeout = " & Str$(Lock_Timeout)
        Case 0
            MsgBox "FUNKTIONSERGEBNIS:" & Chr$(13) & Chr$(13) & "Lock-Timeout = " & Str$(Lock_Timeout) & Chr$(13) & Chr$(13) & "Keine Zeitmarke f
r die automatische Entsperr
berwachung eingestellt."
        Case Else
            MsgBox "FUNKTIONSERGEBNIS:" & Chr$(13) & Chr$(13) & "Lock-Timeout = " & Str$(Lock_Timeout)
    End Select
    Show_Status_2
End Sub
Sub cmd_Get_Lock_User_Click ()
    Dim Table_Name As String
    Dim Record_ID As Long
    Table_Name = txt_Table_Name.Text
    Record_ID = txt_Record_ID.Text
    MsgBox "FUNKTIONSERGEBNIS:" & Chr$(13) & Chr$(13) & "Lock-User: " & Get_Lock_User(Table_Name, Record_ID)
    Show_Status_2
End Sub
Sub cmd_Get_Login_Date_Click ()
    MsgBox "FUNKTIONSERGEBNIS:" & Chr$(13) & Chr$(13) & "Login-Datum: " & Get_Login_Date()
    Show_Status_1
End Sub
Sub cmd_Get_Login_Seconds_Click ()
    MsgBox "FUNKTIONSERGEBNIS:" & Chr$(13) & Chr$(13) & "Login-Sekunden: " & Get_Login_Seconds()
    Show_Status_1
End Sub
Sub cmd_Get_Login_Time_Click ()
    MsgBox "FUNKTIONSERGEBNIS:" & Chr$(13) & Chr$(13) & "Login-Zeit: " & Get_Login_Time()
    Show_Status_1
End Sub
Sub cmd_Init_Locking_Click ()
    Dim User_Name As String
    Dim Lock_Mode As Integer
    User_Name = txt_User_Name.Text
    If opt_Lock_by_Select.Value Then
        Lock_Mode = lock_by_Select
    Else
        Lock_Mode = lock_by_Edit
    End If
    Init_Locking Lock_File_Name, User_Name, Lock_Mode
    Show_Status_1
End Sub
Sub cmd_Is_Record_Locked_Click ()
    Dim Table_Name As String
    Dim Record_ID As Long
    Dim Result As Integer
    Table_Name = txt_Table_Name.Text
    Record_ID = txt_Record_ID.Text
    Result = Is_Record_Locked(Table_Name, Record_ID)
    Select Case Result
        Case st_Record_Not_Locked
            MsgBox "FUNKTIONSERGEBNIS:" & Chr$(13) & Chr$(13) & "Datensatz nicht gesperrt"
        Case st_Lock_By_Same
            MsgBox "FUNKTIONSERGEBNIS:" & Chr$(13) & Chr$(13) & "Datensatz vom akt. Benutzer gesperrt; keine automatische Entsperr
berwachung oder Zeitmarke noch nicht
berschritten"
        Case st_Lock_By_Others
            MsgBox "FUNKTIONSERGEBNIS:" & Chr$(13) & Chr$(13) & "Datensatz von einem anderem User gesperrt; keine automatische Entsperr
berwachung oder Zeitmarke noch nicht
berschritten"
        Case st_Lock_By_Same_Out
            MsgBox "FUNKTIONSERGEBNIS:" & Chr$(13) & Chr$(13) & "Datensatz vom akt. Benutzer gesperrt; Zeitmarke f
r die Sperrung
berschritten, Entsperrung wird empfohlen"
        Case st_Lock_By_Others_Out
            MsgBox "FUNKTIONSERGEBNIS:" & Chr$(13) & Chr$(13) & "Datensatz von einem anderem User gesperrt; Zeitmarke f
r die Sperrung
berschritten, Entsperrung wird empfohlen"
    End Select
    Show_Status_2
End Sub
Sub cmd_Is_Record_Locked_Gen_Click ()
    Dim Table_Name As String
    Dim Record_ID As Long
    Table_Name = txt_Table_Name.Text
    Record_ID = txt_Record_ID.Text
    If Is_Record_Locked_Gen(Table_Name, Record_ID) Then
        MsgBox "FUNKTIONSERGEBNIS:" & Chr$(13) & Chr$(13) & "Datensatz (generell) gesperrt"
    Else
        MsgBox "FUNKTIONSERGEBNIS:" & Chr$(13) & Chr$(13) & "Datensatz nicht gesperrt"
    End If
    Show_Status_2
End Sub
Sub cmd_Lock_Record_Click ()
    Dim Table_Name As String
    Dim Record_ID As Long
    Dim Lock_Timeout As Integer
    Table_Name = txt_Table_Name.Text
    Record_ID = txt_Record_ID.Text
    Lock_Timeout = txt_Lock_Timeout.Text
    Lock_Record Table_Name, Record_ID, Lock_Timeout
    Show_Status_1
End Sub
Sub cmd_Unlock_Record_Click ()
    Dim Table_Name As String
    Dim Record_ID As Long
    Table_Name = txt_Table_Name.Text
    Record_ID = txt_Record_ID.Text
    Unlock_Record Table_Name, Record_ID
    Show_Status_1
End Sub
Function File_Exists (File_Name As String)
    File_Exists = (Dir(File_Name) <> "")
End Function
Sub Form_Load ()
    ChDir App.Path
    Center_Form Me
    Draw_Form_Frame Me, 40, 40
    txt_User_Name.Text = "Test_User"
    txt_Table_Name.Text = "Test_Table"
    txt_Record_ID.Text = 1
    txt_Lock_Timeout.Text = 20
    opt_Lock_by_Select.Value = True
End Sub
Sub Show_Status_1 ()
    Select Case glb_Last_Status
        Case st_No_Error
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "alles o.k."
        Case st_DOS_Error
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "DOS-Fehler"
        Case st_No_File_Name
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "Name der Record-Locking-Verwaltungsdatei fehlt"
        Case st_No_User_Name
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "Username fehlt"
        Case st_Max_Users
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "max. Anzahl User erreicht"
        Case st_File_Destroyed
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "Record-Locking-Verwaltungsdatei ist zerst
        Case st_User_Not_Found
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "User nicht gefunden"
        Case st_No_Table_Name
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "Name der Datenbank-Tabelle bzw. Abfrage fehlt"
        Case st_Max_Tables
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "max. Anzahl Tabellen erreicht"
        Case st_Lock_By_Same
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "Datensatz vom akt. Benutzer gesperrt; keine automatische Entsperr
berwachung oder Zeitmarke noch nicht
berschritten"
        Case st_Lock_By_Others
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "Datensatz von einem anderem User gesperrt; keine automatische Entsperr
berwachung oder Zeitmarke noch nicht
berschritten"
        Case st_Lock_By_Same_Out
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "Datensatz vom akt. Benutzer gesperrt; Zeitmarke f
r die Sperrung
berschritten, Entsperrung wird empfohlen"
        Case st_Lock_By_Others_Out
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "Datensatz von einem anderem User gesperrt; Zeitmarke f
r die Sperrung
berschritten, Entsperrung wird empfohlen"
        Case st_Max_Records
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "max. Anzahl sperrbarer Datens
tze erreicht"
        Case st_Table_Not_Found
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "Datenbank-Tabelle bzw. Abfrage nicht gefunden"
        Case st_Record_Not_Found
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "Datensatz nicht gefunden"
    End Select
End Sub
Sub Show_Status_2 ()
    Select Case glb_Last_Status
        Case st_Record_Not_Locked
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "Datensatz ist nicht gesperrt"
        Case st_DOS_Error
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "DOS-Fehler"
        Case st_No_File_Name
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "Name der Record-Locking-Verwaltungsdatei fehlt"
        Case st_No_User_Name
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "Username fehlt"
        Case st_Max_Users
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "max. Anzahl User erreicht"
        Case st_File_Destroyed
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "Record-Locking-Verwaltungsdatei ist zerst
        Case st_User_Not_Found
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "User nicht gefunden"
        Case st_No_Table_Name
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "Name der Datenbank-Tabelle bzw. Abfrage fehlt"
        Case st_Max_Tables
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "max. Anzahl Tabellen erreicht"
        Case st_Lock_By_Same
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "Datensatz vom akt. Benutzer gesperrt; keine automatische Entsperr
berwachung oder Zeitmarke noch nicht
berschritten"
        Case st_Lock_By_Others
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "Datensatz von einem anderem User gesperrt; keine automatische Entsperr
berwachung oder Zeitmarke noch nicht
berschritten"
        Case st_Lock_By_Same_Out
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "Datensatz vom akt. Benutzer gesperrt; Zeitmarke f
r die Sperrung
berschritten, Entsperrung wird empfohlen"
        Case st_Lock_By_Others_Out
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "Datensatz von einem anderem User gesperrt; Zeitmarke f
r die Sperrung
berschritten, Entsperrung wird empfohlen"
        Case st_Max_Records
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "max. Anzahl sperrbarer Datens
tze erreicht"
        Case st_Table_Not_Found
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "Datenbank-Tabelle bzw. Abfrage nicht gefunden"
        Case st_Record_Not_Found
            MsgBox "STATUS:" & Chr$(13) & Chr$(13) & "Datensatz nicht gefunden"
    End Select
End Sub
Sub txt_Lock_Timeout_KeyPress (KeyAscii As Integer)
    If KeyAscii <> 8 Then
        If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
    End If
End Sub
Sub txt_Record_ID_KeyPress (KeyAscii As Integer)
    If KeyAscii <> 8 Then
        If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
    End If
End Sub
Sub txt_User_Name_LostFocus ()
    glb_User_Name = txt_User_Name.Text
End Sub