frmlogin.frm

Visual basic 数据库编程技术与实例源码 源码

    Closed.Refresh
End Sub

Private Sub cmdCancel_Click()
    Me.Hide
    'UnloadAllForms
    'Call DoExitWindows
    End
End Sub

Private Sub cmdCancel_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton(" Cancel", cmdCancel, 0, 0, 73, 50, Source, 74, 0, 1)
End Sub

Private Sub cmdCancel_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton(" Cancel", cmdCancel, 0, 0, 73, 50, Source, 0, 0, 1)
End Sub

Private Sub cmdOk_Click()
    Dim strs As String
    If Get_User(txtUserName, txtPassword) Then
        'frmLogin.db.Close 'DISABLED TO ENABLED MULTI-LOG IN
        Me.Hide
        frmMain.Show
        frmMain.Company_Name = IIf(dummy2("COMPANY_NAME") = "", "DEMO COPY", Trim(dummy2("COMPANY_NAME")))
        Today = Now
        frmMain.StatusMessage = " 当前用户: " + txtUserName + _
                                "           " + Format(Today, "dddd ") + "    " + Format(Today, "yyyy-mm-dd")
        frmMain.MenuList.SetFocus
    Else
        ctr = ctr + 1
        If ctr = 4 Then
           End
        Else
           Call MessageBox("frmLogin", "非法用户!!!!   请重试....  你还剩" + str(4 - ctr) + " 机会", 0)
           SendKeys "{Home}+{End}"
        End If
   End If
End Sub

Private Sub cmdOk_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton("     Ok", cmdOk, 0, 0, 73, 50, Source, 74, 0, 1)
End Sub

Private Sub cmdOk_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton("     Ok", cmdOk, 0, 0, 73, 50, Source, 0, 0, 1)
End Sub

Private Sub Form_Load()
    On Error Resume Next
    Dim Thwnd As Long
    Dim RetValue
    'RetValue = ChangeRes(800, 600, 32)
    Call CreateMacOSTitleBar(titleBar, " 系统登录 ")
    Call MacButton("     Ok", cmdOk, 0, 0, 73, 50, Source, 0, 0, 1)
    Call MacButton(" Cancel", cmdCancel, 0, 0, 73, 50, Source, 0, 0, 1)
    Call BitBlt(Help.hDC, 0, 0, 73, 50, Source.hDC, 0, 90, SRCCOPY)
    Help.Refresh
    Call BitBlt(Closed.hDC, 0, 0, 73, 50, Source.hDC, 0, 107, SRCCOPY)
    Closed.Refresh
    Call ColForm(BoxContainer, 217, 211, 213, 125)
    frmWallpaper.Show
    KeyPreview = True
    
    Set myDB = New adodb.Connection
    myDB.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" + App.Path + "\DATABASE\POS.mdb"
    myDB.Open

    
   Set dummy2 = New adodb.Recordset
    dummy2.Open "select * from SETUP order by COMPANY_NAME", myDB, 1, 3
    
    If dummy2.EOF Then
        dummy2.AddNew
        dummy2("COMPANY_NAME") = "迪迪超市"
        dummy2.Update
    End If
    If dummy2("OPTION_ALAS") = True Then '操作系统启动时自动登录
        FileCopy App.Path & "\POS2000.LNK", Mid$(App.Path, 1, 3) & "WINDOWS\START MENU\PROGRAMS\STARTUP\POS2000.LNK"
    Else
        Kill Mid$(App.Path, 1, 3) & "WINDOWS\START MENU\PROGRAMS\STARTUP\POS2000.LNK"
    End If
    If dummy2("OPTION_HWT") = True Then '隐藏操作系统的任务栏
        Thwnd = FindWindow("Shell_traywnd", "")
        Call SetWindowPos(Thwnd, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)
    Else
        Thwnd = FindWindow("Shell_traywnd", "")
        Call SetWindowPos(Thwnd, 0, 0, 0, 0, 0, SWP_SHOWWINDOW)
    End If
    If dummy2("OPTION_HDI") = True Then '隐藏桌面菜单
        hDesk = FindWindow("progman", vbNullString)
        Call ShowWindow(hDesk, SW_HIDE)
    Else
        hDesk = FindWindow("progman", vbNullString)
        Call ShowWindow(hDesk, SW_NORMAL)
    End If
    If dummy2("OPTION_E3DT") = True Then '是否是30天的试用版本
        Call frmLogin.TrialerActivation
    End If
    If dummy2("OPTION_DRCM") = True Then '取消鼠标右键单击事件
        BeginRightMouseTrap
    Else
        EndRightMouseTrap
    End If
    If dummy2("OPTION_DCADATS") = True Then '禁止CTRL-ALT-DELETE/ALT-TAB 组合键
        Call DisableCtrlAltDelete(True)
    Else
        Call DisableCtrlAltDelete(False)
    End If
    If dummy2("OPTION_DPW") = True Then '取消墙纸
        frmWallpaper.Hide
    Else
        frmWallpaper.Show
    End If
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyEscape:
                Me.Hide
                UnloadAllForms
                End
    End Select
    If (Shift = vbAltMask) Then
        Select Case KeyCode
            Case vbKeyF4
                    KeyCode = 0
        End Select
    End If
End Sub



Private Sub Help_Click()
'
End Sub

Private Sub Help_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call BitBlt(Help.hDC, 0, 0, 73, 50, Source.hDC, 19, 90, SRCCOPY)
    Help.Refresh
End Sub

Private Sub Help_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call BitBlt(Help.hDC, 0, 0, 73, 50, Source.hDC, 0, 90, SRCCOPY)
    Help.Refresh
End Sub



Function TrialerActivation()
    On Error Resume Next
    If GetStringValue("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS", "Times Opened") = "Error" Then
        CreateKey "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS"
        SetStringValue "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS", "Times Opened", "1"
    End If
    If GetStringValue("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS", "Times Opened") = "" Then
        SetStringValue "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS", "Times Opened", "1"
    End If
    If GetStringValue("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS", "Expire Date") = "Error" Then
        CreateKey "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS"
        SetStringValue "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS", "Expire Date", Now + 29
        SetStringValue "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS", "Trial Start Date", Now
    End If
    If GetStringValue("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS", "Expire Date") = "" Then
        SetStringValue "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS", "Expire Date", Now + 29
        SetStringValue "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS", "Trial Start Date", Now
    End If
        CreateKey "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS"
        SetStringValue "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS", "Todays Date", Now
        SetStringValue "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS", "Copyright", App.LegalCopyright
        SetStringValue "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS", "Trade Mark", App.LegalTrademarks
        SetStringValue "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS", "Version", App.Major & "." & App.Minor & "." & App.Revision

    Exit Function
End Function

Public Function days360(dt1 As Date, dt2 As Date) As Long
    Dim z1 As Long, z2 As Long
    Dim d1 As Long, d2 As Long
    Dim m1 As Long, m2 As Long
    Dim Y1 As Long, Y2 As Long
    d1 = Day(dt1)
    m1 = Month(dt1)
    Y1 = Year(dt1)
    d2 = Day(dt2)
    m2 = Month(dt2)
    Y2 = Year(dt2)
    If d1 = 31 Then
        z1 = 30
    Else
        z1 = d1
    End If
    If d2 = 31 And d1 >= 30 Then
        z2 = 30
    Else
        z2 = d2
    End If
    days360 = (Y2 - Y1) * 360 + (m2 - m1) * 30 + (z2 - z1)
End Function

Private Sub titleBar_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call DragForm(Me)
End Sub

Function Get_User(p_user As String, p_pass As String) As Boolean
    Dim strs As String
    Dim tempstr As String
    strs = ""
    tempstr = Decode_Pass(p_pass)
    strs = "select * from USER_PASSWORD where USER_NAME = '" & p_user & "'" _
            & " and USER_PASSWORD = '" & p_pass & "'" 'Decode_Pass(p_pass) & "'"
    Debug.Print strs
    Set dummy = New adodb.Recordset
    dummy.Open strs, myDB, 1, 3
    If Not dummy.BOF Then
        Get_User = True
        frmMain.MenuList.Clear
        If dummy("USER_ALLOW_SM") = True Then frmMain.MenuList.AddItem "供应商(S)"
        If dummy("USER_ALLOW_PM") = True Then frmMain.MenuList.AddItem "商品信息(P)"
        If dummy("USER_ALLOW_CM") = True Then frmMain.MenuList.AddItem "商品分类(G)"
        If dummy("USER_ALLOW_ST") = True Then frmMain.MenuList.AddItem "前台销售(F)"
        If dummy("USER_ALLOW_RT") = True Then frmMain.MenuList.AddItem "入库信息(I)"
        If dummy("USER_ALLOW_SHR") = True Then frmMain.MenuList.AddItem "销售报表(K)"
        If dummy("USER_ALLOW_RHR") = True Then frmMain.MenuList.AddItem "入库报表(L)"
        If dummy("USER_ALLOW_SPSR") = True Then frmMain.MenuList.AddItem "分类报表(T)"
        If dummy("USER_ALLOW_PLR") = True Then frmMain.MenuList.AddItem "商品报表(Y)"
        If dummy("USER_ALLOW_SLR") = True Then frmMain.MenuList.AddItem "供应商报表(M)"
        If dummy("USER_ALLOW_BRF") = True Then frmMain.MenuList.AddItem "数据处理(D)"
        If dummy("USER_ALLOW_PS") = True Then frmMain.MenuList.AddItem "权限设置(Q)"
        If dummy("USER_ALLOW_SS") = True Then frmMain.MenuList.AddItem "系统设置(X)"
    Else
         Get_User = False
    End If
    dummy.Close
End Function



Private Sub txtPassword_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then cmdOk_Click
End Sub
Private Sub txtUserName_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then txtPassword.SetFocus
End Sub