Module syspwd

    Public Const STR_MASK = "MyFunction"            '加密用字串
Public Const INT_PWD_LENGTH = '預定義密碼長度
Public GintCheckPwd As Integer
'當傳入的密碼長度大於預定義密碼長度時
'將?生一個Message Box
'以下兩個常量是該Message Box中的具體提示資訊和標題欄中的文字
Public Const STR_PWD_ERROR = "The length of password can not be greater than 10 characters !"
Public Const STR_SYSTEM_NAME = "Bogart Report System" Public Const STR_INVALID_USER = "Password is not valid !"
Public Const STR_CHANGE_PASSWORD_ERROR = "User ID is not valid !" '以下的變數的定義在正式使用時去掉 '該函數的作用是將傳入的密碼字串轉換成加密的密碼字串
'傳入的字串是用戶輸入的未經過系統加密的密碼
'傳出的資料類型是字串型,?經過系統加密後的密碼 Public Function EnPwd(ByVal strIn As String) As String
Dim intCount As Integer
Dim intPwdWord() As Integer
Dim intTemp As Integer
Dim strColumn1 As String
Dim strColumn2 As String
Dim strColumn3 As String
Dim strTemp As String
Dim intDivTemp As Integer strColumn1 = ""
strColumn2 = ""
strColumn3 = ""
intTemp =
strTemp = ""
intDivTemp = If Len(strIn) > INT_PWD_LENGTH Then
MsgBox(STR_PWD_ERROR, , STR_SYSTEM_NAME)
EnPwd = ""
Exit Function
End If
ReDim intPwdWord(INT_PWD_LENGTH) For intCount = To INT_PWD_LENGTH
If Len(STR_MASK) < INT_PWD_LENGTH Then
intTemp = intTemp +
If intTemp > Len(STR_MASK) Then
intTemp =
End If
intPwdWord(intCount) = Asc(Mid(STR_MASK, intTemp, ))
Else
intPwdWord(intCount) = Asc(Mid(STR_MASK, intCount, ))
End If
Next
For intCount = To Len(strIn)
intTemp = Asc(Mid(strIn, intCount, ))
intDivTemp = intDivTemp +
If intDivTemp > Then
intDivTemp =
End If
intTemp = intTemp * intDivTemp
intPwdWord(intCount) = intPwdWord(intCount) + intTemp
Next
For intCount = To INT_PWD_LENGTH
strTemp = CStr(intPwdWord(intCount))
If Len(strTemp) < Then
strTemp = StrDup( - Len(strTemp), "") & strTemp
End If
strColumn1 = strColumn1 & Mid(strTemp, , )
strColumn2 = strColumn2 & Mid(strTemp, , )
strColumn3 = strColumn3 & Mid(strTemp, , )
Next
EnPwd = strColumn1 & strColumn2 & strColumn3 End Function '該函數的作用是將傳入的加密的密碼字串轉換成不加密的密碼字串
'傳入的字串是經過系統加密後的密碼
'傳出的資料類型是字串型,?未經過系統加密的密碼 Public Function DePwd(ByVal strIn As String) As String
Dim intCount As Integer
Dim intTemp As Integer
Dim strTemp As String
Dim strColumn1 As String
Dim strColumn2 As String
Dim strColumn3 As String
Dim intPwdWord() As Integer
Dim intDivTemp As Integer DePwd = ""
strColumn1 = ""
strColumn2 = ""
strColumn3 = ""
intTemp =
strTemp = ""
intDivTemp = strColumn1 = Mid(strIn, , INT_PWD_LENGTH)
strColumn2 = Mid(strIn, INT_PWD_LENGTH + , INT_PWD_LENGTH)
strColumn3 = Mid(strIn, INT_PWD_LENGTH * + , INT_PWD_LENGTH)
strTemp = ""
For intCount = To INT_PWD_LENGTH
strTemp = strTemp & Mid(strColumn1, intCount, )
strTemp = strTemp & Mid(strColumn2, intCount, )
strTemp = strTemp & Mid(strColumn3, intCount, )
Next
ReDim intPwdWord(INT_PWD_LENGTH)
For intCount = To INT_PWD_LENGTH intPwdWord(intCount) = Val(Mid(strTemp, intCount * - , ))
If Len(STR_MASK) < INT_PWD_LENGTH Then
intTemp = intTemp +
If intTemp > Len(STR_MASK) Then
intTemp =
End If
intPwdWord(intCount) = intPwdWord(intCount) - Asc(Mid(STR_MASK, intTemp, ))
Else
intPwdWord(intCount) = intPwdWord(intCount) - Asc(Mid(STR_MASK, intCount, ))
End If
intDivTemp = intDivTemp +
If intDivTemp > Then
intDivTemp =
End If
intPwdWord(intCount) = intPwdWord(intCount) / intDivTemp
If intPwdWord(intCount) <> Then
DePwd = DePwd & Chr(intPwdWord(intCount)) End If
Next End Function '以下函數?檢查密碼是否有效
'傳入的第一個參數?用戶名,第二個是密碼(未加密)
'如果密碼正確,則返回True
'如果密碼不正確或該用戶不存在,則出現MsgBox後返回False
Public Function CheckPwd(ByVal strUser As String, ByVal strPassword As String) As Boolean
GintCheckPwd = GintCheckPwd +
Dim Rs As New ADODB.Recordset
Dim strSQLStmt As String CheckPwd = False
On Error GoTo DBError
If adoConn.State <> ConnectionState.Open Then
adoConn.Open()
End If strSQLStmt = "SELECT Password FROM " & g.gRptdev & "g_userid WHERE UserID='" & strUser & "'" '以下的dbconn應該改寫成統一的連庫
Rs.Open(strSQLStmt, adoConn, ADODB.CursorTypeEnum.adOpenStatic, ADODB.LockTypeEnum.adLockOptimistic)
If Rs.Fields().Value <> EnPwd(strPassword.ToUpper) Then
MsgBox(STR_INVALID_USER, vbCritical, STR_SYSTEM_NAME)
'If GintCheckPwd = 3 Then
' MsgBox("您已經三次登陸失敗,系統將退出", vbExclamation, STR_SYSTEM_NAME)
'End If
Exit Function
End If CheckPwd = True Exit Function
DBError:
MsgBox(STR_INVALID_USER, vbExclamation, STR_SYSTEM_NAME)
End Function '以下函數?檢查密碼是否有效
'傳入的第一個參數?用戶名,第二個是新密碼(未加密)
'如果更改成功,則返回True
'如果更改不成功(可能因?用戶不存在等原因),則出現MsgBox後返回False
Public Function ChangePwd(ByVal strUser As String, ByVal strPassword As String) As Boolean
Dim Rs As ADODB.Recordset
Dim strSQLStmt As String ChangePwd = False
On Error GoTo DBError
adoConn.BeginTrans()
strSQLStmt = "SELECT Password FROM " & g.gRptdev & "g_userid WHERE UserID='" & strUser & "'" '以下的dbconn應該改寫成統一的連庫
Rs = adoConn.Execute(strSQLStmt)
If Rs.EOF Then
MsgBox(STR_CHANGE_PASSWORD_ERROR, , STR_SYSTEM_NAME)
Rs.Close()
adoConn.RollbackTrans()
Exit Function
End If
Rs.Close()
strSQLStmt = "UPDATE " & g.gRptdev & "g_userid SET Password = '" & EnPwd(strPassword.ToUpper) & "' WHERE UserID='" & strUser & "'" adoConn.Execute(strSQLStmt)
adoConn.CommitTrans()
ChangePwd = True
Exit Function
DBError:
MsgBox(STR_CHANGE_PASSWORD_ERROR, , STR_SYSTEM_NAME)
adoConn.RollbackTrans()
End Function
End Module

Bogart SysPwd.vb的更多相关文章

  1. Bogart BogartPublic.vb

    Imports System.Data.SqlClient Imports System.Data #Region "IBogartToolbar,請勿隨便更改" Interfac ...

  2. Bogart gSub.vb

    '--------------Job No 0900408 -------------- '--DIM PART ONE ONLINE Update Order Qty '''主要新加過程名 Refr ...

  3. Bogart gData.vb

    Imports System Imports System.Data Imports System.Data.OleDb Imports Microsoft.VisualBasic Imports S ...

  4. Bogart BogartAutoCode.vb

    Imports System.Data.SqlClient Imports System.Data Public Class BogartAutoCodeDataBase Private Conn A ...

  5. Bogart gFunction.vb

    Module gFunction '其它不是常用的方法及函數 #Region " 將指定的數據格式轉換為英文格式" Public Function EnglishFormat(By ...

  6. Bogart gGrid.vb

    Namespace BogartMis.Cls Public Class gGrid '設定表格控的列標題的別名 '說明:strItem字符串的格式為"01,02,03,04,05" ...

  7. [转载]C#中MessageBox.Show用法以及VB.NET中MsgBox用法

    一.C#中MessageBox.Show用法 MessageBox.Show (String) 显示具有指定文本的消息框. 由 .NET Compact Framework 支持. MessageBo ...

  8. VB.NET设置控件和窗体的显示级别

    前言:在用VB.NET开发射频检测系统ADS时,当激活已存在的目标MDI子窗体时,被其他子窗体遮住了,导致目标MDI子窗体不能显示. 这个问题怎么解决呢?网上看到一篇帖子VB.NET设置控件和窗体的显 ...

  9. 用VB脚本批到导入字段到PowerDesigner

    在PowerDesigner使用脚本批量导入excel中记录的表结构信息,由于需要通过powerdesigner逆向工程创建一些sybase IQ的表,由于是接口数据,只有excel表,手动导入太耗时 ...

随机推荐

  1. SQL 基础--> NEW_VALUE 的使用

    --=============================== -- SQL 基础--> NEW_VALUE 的使用 --=============================== 通常 ...

  2. CentOS下设置MySQL的root各种密码 总结

    一.更改mysql密码常用的三种方法 大部分情况下,一般用户没有权限更改密码,只有申请了权限或root用户才可以更改密码: 1.方法1:用mysqladmin mysqladmin -u root p ...

  3. 位操作Bit Operation算法题

    一道让你拍案叫绝的算法题   这是一道看完答案会觉得很简单,但做之前很难想到答案的题目!!! 不信? Let us go ! 题目描述 给定一个非空整数数组,除了某个元素只出现一次以外,其余每个元素均 ...

  4. Transformer-view java实体 转换视图 Lists.transform

    自: https://blog.csdn.net/mnmlist/article/details/53870520 meta_ws 连接: https://github.com/kse-music/d ...

  5. windows下配置redis

    1.首先去GitHub上下载所需文件,这里我们下载的是zip文件 https://github.com/MicrosoftArchive/redis/releases 2.解压后文件目录如下 3.启动 ...

  6. 【Quartz】Quartz将Job保存在数据库中所需表的说明

    QRTZ_CALENDARS 以 Blob 类型存储 Quartz 的 Calendar 信息 QRTZ_CRON_TRIGGERS 存储 Cron Trigger,包括 Cron表达式和时区信息  ...

  7. 利用GPU改善程序性能的一点心得

    1.     硬件方面 a. 流处理器个数    Gpu内部的计算单元个数,决定分析模块实时性的关键因素.    实测效果: gtx760  1152个 Gtx960  1024个 单路1080p运动 ...

  8. MySQL--忘记MYSQL管理员密码

    如root用户密码,可以按照以下方式来修改: STEP1: 停止MySQL服务 ps -ef | grep -v 'grep' | grep 'mysqld' | awk '{print $2}' | ...

  9. NTLM 了解

    NTLM是NT LAN Manager的缩写,这也说明了协议的来源.NTLM 是 Windows NT 早期版本的标准安全协议,Windows 2000 支持 NTLM 是为了保持向后兼容.Windo ...

  10. GridView实现数据编辑和删除

    <asp:GridView ID="gv_Emplogin" runat="server" AutoGenerateColumns="False ...