Private Sub Form_Load()
On Error Resume Next
Dim sConnectionString

sConnectionString = "PROVIDER=SQLOLEDB.1;PASSWORD=;" & _
         "PERSIST SECURITY INFO=FALSE;USER ID=mybase_user;" & _
         "INITIAL CATALOG=mybase;DATA SOURCE=server14"
Application.CurrentProject.OpenConnection sConnectionString

If Err.Number =  30002  Or Err.Number = - 2147217843  Or Err.Number = - 2147467259  Then
MsgBox "Неправильное имя пользователя или пароль" & vbCrLf & Err.Description
Exit Sub
End If
Call SetRegistry(Me.PassForm_nam)
Call SetRegistry(Me.F_pass)
Call ctlstatus
'If CurrentProject.IsConnected Then DoCmd.Close acForm, Me.name
End Sub

Private Sub Кнопка8_Click()
On Error GoTo exit_sub
Dim a
If IsNull(Me![PassForm_nam]) = True Then
    MsgBox ("Введите имя!!!")
    Me.PassForm_nam.SetFocus
Else
    Dim cn As ADODB.Connection
    Dim sqlstr As String
    sqlstr = "driver={SQL Server};server=server14;uid=mybase_user;pwd=;database=mybase"

    Set cn = New ADODB.Connection
    cn.ConnectionString = sqlstr
    cn.Open
    Prava_yes = cn.Execute("dbo.MySP N'" & Forms!passform.PassForm_nam & "'").Fields( 0 )
    PS = cn.Execute("dbo.look_pass N'" & Forms!passform.PassForm_nam & "'").Fields( 0 )
    If PS = F_pass Then
        If Prava_yes Then
            Me.Perm = "*"
        Else
            Open_ADV_REP = Trim(Forms!passform!PassForm_nam)
        End If
     Else
        MsgBox ("Пароль неверный!!!")
        Me.F_pass = Null
        Me.F_pass.SetFocus
        a =  1 
    End If
End If
cn.Close
If a =  1  Then GoTo exit_sub
Application.CurrentProject.CloseConnection

Dim sConnectionString As String
sConnectionString = "PROVIDER=SQLOLEDB.1;PASSWORD=" & PS & ";" & _
         "PERSIST SECURITY INFO=TRUE;USER ID=" & Me.PassForm_nam & ";" & _
         "INITIAL CATALOG=mybase;DATA SOURCE=server14"
Application.CurrentProject.OpenConnection sConnectionString

Call SetRegistry(Me.servername)
Call SetRegistry(Me.databasename)
Call SetRegistry(Me.PassForm_nam)
Call SetRegistry(Me.F_pass)

Dim status
If CurrentProject.IsConnected Then
status = "connected"
Else
status = ""
End If

Call SaveSetting(Left(CurrentProject.Name, Len(CurrentProject.Name) -  4 ), "baseconnect", "status", status)
Me.Visible = False

exit_sub:

If Err.Number =  30002  Or Err.Number = - 2147217843  Or Err.Number = - 2147467259  Then
MsgBox "Неправильное имя пользователя или пароль" & vbCrLf & Err.Description
End If
Exit Sub
End Sub

Option Compare Database
Option Explicit
Public FindStrClient As String 'Строка для поиска клиента при вызове формы поиска
Public IdClient As Integer
Public SelectedProject As String
Public Partners_fplan_detail As Integer

Declare Function IsZoomed Lib "user32" (ByVal hWnd As Long) As Long

Sub FormMaximize()
On Error Resume Next
    If Not IsZoomed(Screen.ActiveForm.hWnd) Then
        Echo False
        DoCmd.Maximize
        Echo True
    End If
End Sub

Public Sub Reload_form(FRM_NAME As String)
If CurrentProject.AllForms(FRM_NAME).IsLoaded Then DoCmd.Close acForm, FRM_NAME
DoCmd.OpenForm FRM_NAME
End Sub


Public Sub Reload_Report(REP_NAME As String, Optional View As Access.AcView = acViewPreview)
If CurrentProject.AllReports(REP_NAME).IsLoaded Then DoCmd.Close acReport, REP_NAME
DoCmd.OpenReport REP_NAME, View
End Sub


Public Sub SetRegistry(Ctl As Control)
Call SaveSetting(Left(CurrentProject.Name, Len(CurrentProject.Name) -  4 ), Ctl.Parent.Name, Ctl.Name, Nz(Ctl.Value, ""))
End Sub

Public Sub GetRegistry(Ctl As Control, Optional DefaultValue)
Dim v1
v1 = GetSetting(Left(CurrentProject.Name, Len(CurrentProject.Name) -  4 ), Ctl.Parent.Name, Ctl.Name)
If v1 = "" Then Ctl.Value = DefaultValue Else Ctl.Value = v1
End Sub

Public Function CallHelp()
On Error Resume Next
Dim oShell
Set oShell = CreateObject("WScript.Shell")
Call oShell.Run("\\kkk\help\partners.hlp",  1 , False)
End Function

Public Sub ChangeHelpLocation()
Dim frm
For Each frm In CurrentProject.AllForms
DoCmd.OpenForm frm.Name, acDesign
Forms(frm.Name).HelpFile = "\\kkk\help\partners.hlp"
DoCmd.Close acForm, frm.Name, acSaveYes

'Frm.HelpFile = "\\kkk\help\partners.hlp"

Next frm
End Sub

Public Function Getsysprjcode()
Getsysprjcode = GetSetting(Left(CurrentProject.Name, Len(CurrentProject.Name) -  4 ), "Public", "Getsysprjcode")
End Function

Public Function SETsysprjcode(prj As String)
Call SaveSetting(Left(CurrentProject.Name, Len(CurrentProject.Name) -  4 ), "Public", "Getsysprjcode", prj)
End Function

Private Sub Form_Unload(Cancel As Integer)
Application.CurrentProject.CloseConnection
End Sub

Create  PROCEDURE dbo.look_PASS
@Passform_nam nvarchar( 100 ) output
as 
SET nocount on
select dbo.permissions.pass from dbo.permissions
where dbo.permissions.name=@Passform_nam

ALTER  procedure MySP (@PName as varchar( 100 ))
AS

SET NOCOUNT ON

IF exists (SELECT ADV_REP_Admin FROM Permissions WHERE Name=@PName)
SELECT Cast( 1  AS bit) AS RetCode

ELSE
SELECT Cast( 0  As bit) AS RetCode