ABOUT LMS


Option Explicit

' Reg Key Security Options...
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
                       KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
                       KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
                     
' Reg Key ROOT Types...
Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_SUCCESS = 0
Const REG_SZ = 1                         ' Unicode nul terminated string
Const REG_DWORD = 4                      ' 32-bit number

Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
Const gREGVALSYSINFOLOC = "MSINFO"
Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
Const gREGVALSYSINFO = "PATH"

Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long


Private Sub cmdSysInfo_Click()
  Call StartSysInfo
End Sub

Private Sub cmdOK_Click()
  Unload Me
End Sub

Private Sub Form_Load()
    Me.Caption = "About " & App.Title
    lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision
    lblTitle.Caption = App.Title
End Sub

Public Sub StartSysInfo()
    On Error GoTo SysInfoErr
  
    Dim rc As Long
    Dim SysInfoPath As String
    
    ' Try To Get System Info Program Path\Name From Registry...
    If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
    ' Try To Get System Info Program Path Only From Registry...
    ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
        ' Validate Existance Of Known 32 Bit File Version
        If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
            SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
            
        ' Error - File Can Not Be Found...
        Else
            GoTo SysInfoErr
        End If
    ' Error - Registry Entry Can Not Be Found...
    Else
        GoTo SysInfoErr
    End If
    
    Call Shell(SysInfoPath, vbNormalFocus)
    
    Exit Sub
SysInfoErr:
    MsgBox "System Information Is Unavailable At This Time", vbOKOnly
End Sub

Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
    Dim i As Long                                           ' Loop Counter
    Dim rc As Long                                          ' Return Code
    Dim hKey As Long                                        ' Handle To An Open Registry Key
    Dim hDepth As Long                                      '
    Dim KeyValType As Long                                  ' Data Type Of A Registry Key
    Dim tmpVal As String                                    ' Tempory Storage For A Registry Key Value
    Dim KeyValSize As Long                                  ' Size Of Registry Key Variable
    '------------------------------------------------------------
    ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
    '------------------------------------------------------------
    rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key
    
    If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Error...
    
    tmpVal = String$(1024, 0)                             ' Allocate Variable Space
    KeyValSize = 1024                                       ' Mark Variable Size
    
    '------------------------------------------------------------
    ' Retrieve Registry Key Value...
    '------------------------------------------------------------
    rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
                         KeyValType, tmpVal, KeyValSize)    ' Get/Create Key Value
                        
    If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Errors
    
    If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then           ' Win95 Adds Null Terminated String...
        tmpVal = Left(tmpVal, KeyValSize - 1)               ' Null Found, Extract From String
    Else                                                    ' WinNT Does NOT Null Terminate String...
        tmpVal = Left(tmpVal, KeyValSize)                   ' Null Not Found, Extract String Only
    End If
    '------------------------------------------------------------
    ' Determine Key Value Type For Conversion...
    '------------------------------------------------------------
    Select Case KeyValType                                  ' Search Data Types...
    Case REG_SZ                                             ' String Registry Key Data Type
        KeyVal = tmpVal                                     ' Copy String Value
    Case REG_DWORD                                          ' Double Word Registry Key Data Type
        For i = Len(tmpVal) To 1 Step -1                    ' Convert Each Bit
            KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))   ' Build Value Char. By Char.
        Next
        KeyVal = Format$("&h" + KeyVal)                     ' Convert Double Word To String
    End Select
    
    GetKeyValue = True                                      ' Return Success
    rc = RegCloseKey(hKey)                                  ' Close Registry Key
    Exit Function                                           ' Exit
    
GetKeyError:      ' Cleanup After An Error Has Occured...
    KeyVal = ""                                             ' Set Return Val To Empty String
    GetKeyValue = False                                     ' Return Failure
    rc = RegCloseKey(hKey)                                  ' Close Registry Key
End Function




BROWSE BOOKS




Private Sub cancel_Click()
Me.Hide
MainForm.Show
End Sub
Private Sub First_Click()
Adodc1.Recordset.MoveFirst
End Sub

Private Sub Last_Click()
Adodc1.Recordset.MoveLast
End Sub

Private Sub Next_Click()
Adodc1.Recordset.MoveNext
If Adodc1.Recordset.EOF Then
    MsgBox "You are on the last record"
    Adodc1.Recordset.MoveLast
End If
End Sub

Private Sub Previous_Click()
Adodc1.Recordset.MovePrevious
If Adodc1.Recordset.BOF Then
    MsgBox "You are on the first record"
    Adodc1.Recordset.MoveFirst
End If
End Sub

Private Sub Form_Load()
Adodc1.Recordset.MoveFirst
End Sub


BROWSE GENRE



Private Sub cancel_Click()
Me.Hide
MainForm.Show
End Sub

Private Sub First_Click()
Adodc1.Recordset.MoveFirst
End Sub

Private Sub Form_Load()
Adodc1.Recordset.MoveFirst
End Sub

Private Sub Last_Click()
Adodc1.Recordset.MoveLast
End Sub

Private Sub Next_Click()
Adodc1.Recordset.MoveNext
If Adodc1.Recordset.EOF Then
    MsgBox "You are on the last record"
    Adodc1.Recordset.MoveLast
End If
End Sub

Private Sub Previous_Click()
Adodc1.Recordset.MovePrevious
If Adodc1.Recordset.BOF Then
    MsgBox "You are on the first record"
    Adodc1.Recordset.MoveFirst
End If
End Sub

BROWSE MEMBERS


Private Sub cancel_Click()
Me.Hide
Form1.Show
End Sub
Private Sub First_Click()
Adodc1.Recordset.MoveFirst
End Sub


Private Sub Form_Load()
Adodc1.Recordset.MoveFirst
End Sub

Private Sub Last_Click()
Adodc1.Recordset.MoveLast
End Sub

Private Sub Next_Click()
Adodc1.Recordset.MoveNext
If Adodc1.Recordset.EOF Then
    MsgBox "You are on the last record"
    Adodc1.Recordset.MoveLast
End If
End Sub

Private Sub Previous_Click()
Adodc1.Recordset.MovePrevious
If Adodc1.Recordset.BOF Then
    MsgBox "You are on the first record"
    Adodc1.Recordset.MoveFirst
End If
End Sub


CHANGEP



Private Sub cancel_Click()
Unload Me
End Sub

Private Sub Form_Load()
OK.Enabled = False
End Sub



Private Sub OK_Click()
Adodc1.Recordset.Fields(0).Value = newpass.Text
Adodc1.Recordset.Update
Unload Me
LMSOptions.Show
End Sub

Private Sub oldpass_LostFocus()
If Text1.Text = oldpass.Text Then
    OK.Enabled = True
Else
    MsgBox "Invalid Password, try again!", , "Login"
    oldPassword.SetFocus
    SendKeys "{Home}+{End}"
End If
End Sub

ISSUE





Private Sub Command1_Click()
Adodc1.Recordset.MoveFirst
While Not Adodc1.Recordset.EOF
    If Adodc1.Recordset.Fields("MID").Value = Text1.Text Then
        BID1.Text = Str(Adodc1.Recordset.Fields("BOOK1").Value)
        BID2.Text = Str(Adodc1.Recordset.Fields("BOOK2").Value)
        BID3.Text = Str(Adodc1.Recordset.Fields("BOOK3").Value)
        BID4.Text = Str(Adodc1.Recordset.Fields("BOOK4").Value)
    Else
        Adodc1.Recordset.MoveNext
    End If
Wend
End Sub

Private Sub Form_Load()
Label2.Caption = Date
End Sub


LMSOPTIONS


Private Sub apply_Click()
Adodc1.Recordset.Update
End Sub

Private Sub cancel_Click()
Unload Me
End Sub

Private Sub changepass_Click()
ChangeP.Show
End Sub

Private Sub Form_Load()
Adodc1.Refresh
End Sub

Private Sub OK_Click()
Adodc1.Recordset.Update
Unload Me
End Sub


LOGINFORM

Option Explicit

Public LoginSucceeded As Boolean

Private Sub cmdCancel_Click()
    LoginSucceeded = False
    End
End Sub

Private Sub cmdOK_Click()
       If txtPassword.Text = Text1.Text Then
        LoginSucceeded = True
        Me.Hide
        MainForm.Show
       Else
        MsgBox "Invalid Password, try again!", , "Login"
        txtPassword.SetFocus
        SendKeys "{Home}+{End}"
       End If
End Sub

Private Sub Command1_Click()
txtPassword.Text = ""
txtUserName.Text = ""
End Sub



MAINFORM


Private Declare Function mciSendString Lib "winmm.dll" _
    Alias "mciSendStringA" (ByVal lpstrCommand As String, _
    ByVal lpstrReturnString As String, _
    ByVal uReturnLength As Long, _
    ByVal hwndCallback As Long) As Long
    
Private Sub AboutMenu_Click()
AboutLMS.Show
End Sub

Private Sub AddBookM_Click()
AddBook.Show (1)
End Sub

Private Sub AddGenreM_Click()
AddGenre.Show (1)
End Sub

Private Sub BrBookM_Click()
BrowseBooks.Show (1)
End Sub

Private Sub BrGenreM_Click()
BrowseGenre.Show (1)
End Sub

Private Sub BrMemberM_Click()
BrowseMembers.Show (1)
End Sub

Private Sub BrShelfM_Click()
BrowseShelf.Show (1)
End Sub

Private Sub ExitMenu_Click()
Dim errorCode As Integer
Dim returnStr As Integer
Dim cmd As String * 255
cmd = "close welcome"
errorCode = mciSendString(cmd, returnStr, 255, 0)
cmd = "close goodbye"
errorCode = mciSendString(cmd, returnStr, 255, 0)
cmd = "open " & Chr(34) & App.Path & "\goodbye.wav " & Chr(34) & " type waveaudio alias goodbye"
errorCode = mciSendString(cmd, returnStr, 255, 0)
If errorCode <> 0 Then
    MsgBox "There was an error on opening the goodbye.WAV file." & vbCrLf _
           & "Please make sure the goodbye.WAV file in the same folder as the application"
    Exit Sub
End If
errorCode = mciSendString("play goodbye", returnStr, 255, 0)
End
End Sub

Private Sub Form_Load()
Calendar1.Value = Date
Dim errorCode As Integer
Dim returnStr As Integer
Dim cmd As String * 255
cmd = "close welcome"
errorCode = mciSendString(cmd, returnStr, 255, 0)
cmd = "open " & Chr(34) & App.Path & "\welcome.wav " & Chr(34) & " type waveaudio alias welcome"
errorCode = mciSendString(cmd, returnStr, 255, 0)
If errorCode <> 0 Then
    MsgBox "There was an error on opening the welcome.WAV file." & vbCrLf _
           & "Please make sure the welcome.WAV file in the same folder as the application"
    Exit Sub
End If
errorCode = mciSendString("play welcome", returnStr, 255, 0)
End Sub

Private Sub IssueCmd_Click()
Issue.Show (1)
End Sub

Private Sub ModBookM_Click()
ModBooks.Show (1)
End Sub

Private Sub ModGenreM_Click()
ModGenre.Show (1)
End Sub

Private Sub ModMemberM_Click()
ModMembers.Show (1)
End Sub


Private Sub PreferencesMenu_Click()
LMSOptions.Show
End Sub

Private Sub ReserveMenu_Click()
ReserveBook.Show (1)
End Sub

Private Sub ReturnCmd_Click()
ReturnBook.Show (1)
End Sub

Private Sub SrBookM_Click()
SearchBook.Show (1)
End Sub

Private Sub SrGenreM_Click()
SearchGenre.Show (1)
End Sub

Private Sub SrMemberM_Click()
SearchMember.Show (1)
End Sub

Private Sub Form_Unload(cancel As Integer)
    Dim errorCode As Integer
    Dim returnStr As Integer
    Dim cmd As String * 255
    cmd = "close goodbye"
    errorCode = mciSendString(cmd, returnStr, 255, 0)
End Sub



MODBOOKS


Option Explicit

Private Sub cancel_Click()
Unload Me
End Sub

Private Sub SearchButton_Click()
Adodc1.Recordset.MoveFirst
On Error GoTo SQLError
    Adodc1.Recordset.Find (GenerateSQL())
       Exit Sub

SQLError:
    MsgBox Err.Description
End Sub

Private Sub Form_Load()
    cmbFields.Clear
    'Adodc1.Recordset.MoveFirst
    Dim fld As Field
    For Each fld In Adodc1.Recordset.Fields
        cmbFields.AddItem fld.Name
    Next
    cmbFields.ListIndex = 0
End Sub

Private Function GenerateSQL() As String
    GenerateSQL = cmbFields.Text & "=" & txtSearchValue.Text
End Function



MODGENRE






Option Explicit

Private Sub cancel_Click()
Unload Me
End Sub

Private Sub SearchButton_Click()
Adodc1.Recordset.MoveFirst
On Error GoTo SQLError
    Adodc1.Recordset.Find (GenerateSQL())
       Exit Sub

SQLError:
    MsgBox Err.Description
End Sub

Private Sub Form_Load()
    cmbFields.Clear
    'Adodc1.Recordset.MoveFirst
    Dim fld As Field
    For Each fld In Adodc1.Recordset.Fields
        cmbFields.AddItem fld.Name
    Next
    cmbFields.ListIndex = 0
End Sub

Private Function GenerateSQL() As String
    GenerateSQL = cmbFields.Text & "=" & txtSearchValue.Text
End Function



MODMEMBERS

Option Explicit

Private Sub SearchButton_Click()
Adodc1.Recordset.MoveFirst
On Error GoTo SQLError
    Adodc1.Recordset.Find (GenerateSQL())
       Exit Sub

SQLError:
    MsgBox Err.Description
End Sub

Private Sub Form_Load()
    cmbFields.Clear
    Dim fld As Field
    For Each fld In Adodc1.Recordset.Fields
        cmbFields.AddItem fld.Name
    Next
    cmbFields.ListIndex = 0
End Sub

Private Function GenerateSQL() As String
    GenerateSQL = cmbFields.Text & "=" & txtSearchValue.Text
End Function



SEARCHBOOK

Option Explicit

Private Sub cancel_Click()
Unload Me
MainForm.Show
End Sub


Private Sub SearchButton_Click()
Adodc1.Recordset.MoveFirst
On Error GoTo SQLError
    Adodc1.Recordset.Find (GenerateSQL())
       Exit Sub

SQLError:
    MsgBox Err.Description
End Sub

Private Sub Form_Load()
    cmbFields.Clear
    Dim fld As Field
    For Each fld In Adodc1.Recordset.Fields
        cmbFields.AddItem fld.Name
    Next
    cmbFields.ListIndex = 0
End Sub

Private Function GenerateSQL() As String
    GenerateSQL = cmbFields.Text & "=" & txtSearchValue.Text
End Function


SEARCHGENRE





Option Explicit


Private Sub cancel_Click()
Unload Me
End Sub

Private Sub SearchButton_Click()
Adodc1.Recordset.MoveFirst
On Error GoTo SQLError
    Adodc1.Recordset.Find (GenerateSQL())
       Exit Sub

SQLError:
    MsgBox Err.Description
End Sub

Private Sub Form_Load()
    cmbFields.Clear
    'Adodc1.Recordset.MoveFirst
    Dim fld As Field
    For Each fld In Adodc1.Recordset.Fields
        cmbFields.AddItem fld.Name
    Next
    cmbFields.ListIndex = 0
End Sub

Private Function GenerateSQL() As String
    GenerateSQL = cmbFields.Text & "=" & txtSearchValue.Text
End Function





SEARCHMEMBER

Option Explicit

Private Sub cancel_Click()
Unload Me
MainForm.Show
End Sub


Private Sub SearchButton_Click()
Adodc1.Recordset.MoveFirst
On Error GoTo SQLError
    Adodc1.Recordset.Find (GenerateSQL())
       Exit Sub

SQLError:
    MsgBox Err.Description
End Sub

Private Sub Form_Load()
    cmbFields.Clear
    Dim fld As Field
    For Each fld In Adodc1.Recordset.Fields
        cmbFields.AddItem fld.Name
    Next
    cmbFields.ListIndex = 0
End Sub

Private Function GenerateSQL() As String
    GenerateSQL = cmbFields.Text & "=" & txtSearchValue.Text
End Function





Private Sub txtSearchValue_KeyPress(KeyAscii As Integer)
Adodc1.Recordset.MoveFirst
On Error GoTo SQLError
    Adodc1.Recordset.Find (GenerateSQL())
       Exit Sub

SQLError:
    MsgBox Err.Description
End Sub


SPLASHSCREEN



Private Sub Form_Load()
Call loading
End Sub

Private Sub Timer1_Timer()
Unload Me
LoginForm.Show
End Sub

Private Sub loading()
Load LoginForm
End Sub











