Option Explicit
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpbuffer As String, nSize As Long) As Long
Public OK As Boolean
Dim m_Password As String
Dim userpwd As String
Dim usercd As String
Dim useremail As String
Dim usernm As String

Private Sub cmdforgetpassword_Click()
    Dim cSql As String
    Dim Rs As New ADODB.Recordset

    If txtUserName.Text = "" Then
        MsgBox "Please Enter UserName", vbOKOnly, "ProjPRS"
        txtUserName.SetFocus
        txtUserName.SelStart = 0
        txtUserName.SelLength = Len(txtUserName.Text)
        Exit Sub
    End If

    cSql = "SELECT USERMAST.*,DEPTMAST.DEPTNM FROM USERMAST,DEPTMAST WHERE (USERMAST.DEPTCD*=DEPTMAST.DEPTCD) AND (USERMAST.USERCD='" & Trim(txtUserName.Text) & "')"
    Set Rs = ReturnRecSet(CnnGlobal, adCmdText, cSql)
    If (Rs Is Nothing) Then GoTo ErrProc

    If (Rs.EOF) Then
        MsgBox "User code not found in master. Please enter valid user code.", vbCritical, "Invalid Entry!"
        txtUserName.SelStart = 0
        txtUserName.SelLength = Len(txtUserName.Text)
        Exit Sub
    End If

    Dim StrHtml As String
    Dim Sendto As String
    Dim objrs As New ADODB.Recordset
    Dim iCount As Integer
    Dim MylistItem As ListItem

    On Error GoTo ErrProc

    Dim myout As Outlook.Application
    Dim myNS As NameSpace
    Dim myInbox As MAPIFolder

    Set myout = New Outlook.Application
    Set myNS = myout.GetNamespace("MAPI")
    Set myInbox = myNS.GetDefaultFolder(olFolderInbox)
    Dim msReply As MailItem

    Sendto = ""

    cSql = " Select usernm,userpwd,useremail from usermast where usercd = '" & Trim(txtUserName) & "' "
    objrs.Open cSql, CnnGlobal, adOpenStatic, adLockReadOnly
    Do While Not objrs.EOF
        Sendto = Sendto & "; " & Trim(objrs.Fields("USEREMAIL").Value & "")
        objrs.MoveNext
    Loop
    objrs.Close
    Set objrs = Nothing

    StrHtml = ""
    StrHtml = "<Table align=left cellpadding=10 border=1 width=100%><Caption align=Center><b>Your Permasoft Password :</b></Caption>"
    StrHtml = StrHtml + "<td align = center colspan=0 Bgcolor = RGB(102,179,230)><B> User Code </B></td>"
    StrHtml = StrHtml + "<td align = center Bgcolor = RGB(102,179,230)><B> Password </B></td>"

    usercd = Trim(Rs.Fields("usercd").Value)
    userpwd = Trim(Rs.Fields("userpwd").Value)
    usernm = Trim(Rs.Fields("usernm").Value)

    StrHtml = StrHtml + "<tr>"
    StrHtml = StrHtml + "<td align = center bgcolor = RGB(180,236,243)> " & Trim(usercd) & " </td>"
    StrHtml = StrHtml + "<td align = center bgcolor = RGB(180,236,243)> " & Trim(userpwd) & " </td>"


''    Csql = "select userpwd,useremail from usermast where usercd='" & Trim(txtUserName.Text) & "'"
''    Rs.Open Csql, CnnGlobal, adOpenStatic, adLockReadOnly

''    userpwd = Trim(Rs.Fields("userpwd").Value)
''    useremail = Trim(Rs.Fields("useremail").Value)


''            StrHtml = StrHtml + "<tr>"
''            StrHtml = StrHtml + "<td align = center bgcolor = RGB(180,236,243)> " & Trim("userpwd") & " </td>"

    StrHtml = StrHtml + "</table>"

    Set msReply = myInbox.Items.Add

'   SendTo = "iterp@prs-permacel.com" 'Remove   For Testing
    msReply.To = Sendto
'   msReply.CC = CClist
'   msReply.Subject = Trim(Rs.Fields("usernm").Value)
    msReply.Subject = "Your Permasoft Password"
    msReply.HTMLBody = StrHtml
    msReply.Send

    Set myInbox = Nothing
    Set myNS = Nothing
    Set myout = Nothing

    MsgBox "Please check your Inbox", vbOKOnly

    Exit Sub
ErrProc:
    MsgBox "Error in forgetPassword Function : " & Err.Description & " No: " & Err.Number
End Sub

Private Sub Form_Load()
    Dim sBuffer As String
    Dim lSize As Long
    If (CheckSingleMode = 0) Then End
    OK = False
    sBuffer = Space$(255)
    lSize = Len(sBuffer)
    Call GetUserName(sBuffer, lSize)
    If lSize > 0 Then
        txtUserName.Text = Left$(sBuffer, lSize)
    Else
        txtUserName.Text = vbNullString
    End If
    m_Password = ""


    'by shailesh 06\07\07

    txtUserName.Text = Left$(sBuffer, lSize)
    txtPassword.Text = ""
    m_Password = ""
    txtUserName.Text = "ITTECH"
    txtPassword.Text = "ITTECH"
End Sub

Private Sub CmdCancel_Click()
    OK = False
    Me.Hide
End Sub

Private Sub cmdok_Click()
Dim d As String
    If (OK = True) Then
        Me.Hide
        Dim de As String
        'If g_usercd = "" Then

        Dim ado As New ADODB.Connection
        de = "update usermast set logedin=1 where usercd='" & g_usercd & "'"
        CnnGlobal.Execute de
'        Else
'        MsgBox "you are already in login", vbInformation, "Alert"
'        End If
    End If
End Sub
Private Sub txtPassword_GotFocus()
    SendKeys "{End}"
    SendKeys "+{Home}"
End Sub

Private Sub txtpassword_Validate(Cancel As Boolean)
    Static iLoginTry As Integer
    If (Trim(UCase(txtPassword.Text)) = Trim(UCase(m_Password))) Then
        OK = True
        Cancel = False
        g_usercd = Trim(txtUserName.Text)
    Else
        If (iLoginTry < 2) Then
            MsgBox "Invalid Password, try again!", , "Login"
            OK = False
            txtPassword.SetFocus
            txtPassword.SelStart = 0
            txtPassword.SelLength = Len(txtPassword.Text)
            Cancel = True
            iLoginTry = iLoginTry + 1
        ElseIf (iLoginTry >= 2) Then
            MsgBox "Login failed 3 times. Please try again.", vbCritical, "Access Denied!"
            Me.Hide
            Exit Sub
        End If
    End If
End Sub

Private Sub txtUserName_GotFocus()
    SendKeys "{End}"
    SendKeys "+{Home}"
End Sub

Private Sub txtUserName_Validate(Cancel As Boolean)
    If (Len(Trim(txtUserName.Text)) < 1) Then
        MsgBox "User name must be entered.", vbInformation, "Null Entry!"
        Cancel = True
        Exit Sub
    End If

    Dim objrs As New ADODB.Recordset
    Dim cSql As String

    cSql = "SELECT USERMAST.*,DEPTMAST.DEPTNM FROM USERMAST,DEPTMAST WHERE (USERMAST.DEPTCD*=DEPTMAST.DEPTCD) AND (USERMAST.USERCD='" & Trim(txtUserName.Text) & "')"
    Set objrs = ReturnRecSet(CnnGlobal, adCmdText, cSql)
    If (objrs Is Nothing) Then GoTo ErrProc

    If (objrs.EOF) Then
        MsgBox "User code not found in master. Please enter valid user code.", vbCritical, "Invalid Entry!"
        txtUserName.SelStart = 0
        txtUserName.SelLength = Len(txtUserName.Text)
        Cancel = True
        Exit Sub
    End If
    If (Not objrs.EOF) Then
        m_Password = ""
        m_Password = Trim(objrs.Fields("UserPwd").Value & "")
        With g_User
            .location = Trim(objrs.Fields("LOCATIONCD").Value & "")
            .USERCODE = Trim(objrs.Fields("UserCd").Value & "")
            .UserName = Trim(objrs.Fields("UserNM").Value & "")
            .UserType = Trim(objrs.Fields("UserType").Value & "")
            .deptcd = Trim(objrs.Fields("deptcd").Value & "")
            .deptnm = Trim(objrs.Fields("deptNM").Value & "")
            g_UserDeptcd = Trim(objrs.Fields("deptcd").Value & "")
            g_UserLocation = Trim(objrs.Fields("LOCATIONCD").Value & "")
            g_UserDeptHead = Trim(objrs.Fields("deptHEAD").Value & "")

            If (FillUserMenuAccess = 0) Then
                MsgBox "Cant login into system.", vbCritical, "Unexpected Eror!"
                Cancel = True
                Exit Sub
            End If
        End With
    End If
    Exit Sub

ErrProc:
    Cancel = True
    MsgBox "Error in txtUserName_Validate procedure." & Trim(Err.Number) & " Desc:  " & Trim(Err.Description)
End Sub


Private Function FillUserMenuAccess() As Integer
    Dim objrs As New ADODB.Recordset
    Dim cSql As String
    Dim iCount As Integer

    cSql = "SELECT * FROM USER_MENUMAST WHERE (USERCD='" & Trim(txtUserName.Text) & "') AND (GRANTED=1) ORDER BY MENUCD"
    Set objrs = ReturnRecSet(CnnGlobal, adCmdText, cSql)
    If (objrs Is Nothing) Then GoTo ErrProc
    If (objrs.EOF) Then
        MsgBox "No profile set for the specified user. Contact Administrator for details.", vbCritical, "Invalid Entry!"
        txtUserName.SelStart = 0
        txtUserName.SelLength = Len(txtUserName.Text)
        If txtUserName.Enabled Then txtUserName.SetFocus
        FillUserMenuAccess = 0
        Exit Function
    End If

    iCount = 0
    objrs.MoveFirst
    Do While Not (objrs.EOF)
        With g_User
            .MenuAccess(iCount) = Trim(objrs.Fields("MENUCD").Value & "")
        End With
        iCount = iCount + 1
        objrs.MoveNext
    Loop

    FillUserMenuAccess = 1
    Exit Function
ErrProc:
    FillUserMenuAccess = 0
    MsgBox "Error in txtUserName_Validate procedure." & Trim(Err.Number) & " Desc:  " & Trim(Err.Description)
End Function

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If Not (Me.ActiveControl Is Nothing) Then
        ControlNavigate Me.ActiveControl, KeyCode
    End If
    If (KeyCode = vbKeyEscape) Then
        Call CmdCancel_Click
    End If
End Sub