?? frmpass.frm
字號:
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form FrmPass
BorderStyle = 1 'Fixed Single
Caption = "Password"
ClientHeight = 1020
ClientLeft = 45
ClientTop = 330
ClientWidth = 4875
ControlBox = 0 'False
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1020
ScaleWidth = 4875
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command2
Caption = "返回"
Height = 375
Left = 3840
TabIndex = 6
Top = 600
Width = 975
End
Begin VB.CommandButton Command1
Caption = "確定"
Height = 375
Left = 3840
TabIndex = 5
Top = 120
Width = 975
End
Begin VB.TextBox Text3
Height = 270
Left = 1800
TabIndex = 4
Top = 1560
Width = 1335
End
Begin VB.TextBox Text2
Height = 270
Left = 240
TabIndex = 3
Top = 1560
Width = 1455
End
Begin VB.Timer Timer1
Interval = 1000
Left = 2880
Top = 600
End
Begin MSWinsockLib.Winsock Winsock1
Left = 2400
Top = 600
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.TextBox Text1
Height = 270
IMEMode = 3 'DISABLE
Left = 1200
PasswordChar = "*"
TabIndex = 1
Top = 120
Width = 2535
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Height = 255
Left = 0
TabIndex = 2
Top = 480
Width = 1815
End
Begin VB.Label Label1
Caption = "登陸驗證口令："
Height = 255
Left = 0
TabIndex = 0
Top = 120
Width = 1335
End
End
Attribute VB_Name = "FrmPass"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim strCharB, strCharA
Dim strSectionTemp As String
Dim strNameTemp As String
Dim strReturn As String
Dim strip As String
Dim strpost As String
Dim strname As String
Dim itwms As ListItem
Dim conent As Integer
'遞歸遠程資源目錄
Dim SendData As String
Dim ScanRun As Boolean
Dim WaitForInfo As Boolean
Dim StoredData(0 To 10) As String
Function setProfile(strFileName As String, strSection As String, strname As String, strSave As String) As Boolean
'這個函數是用來對INI文件進行寫操作的
'函數說明:
'strFileName 是所要存儲的文件名
'strSection 是這個文件中的一個節點名
'strName 是所要查找的字段名
'strSave 是所要替換字段值
'薛向華 1998/05/13
Dim strtemp As String
Dim strfileback As String
Dim strReturn As String
strfileback = App.Path & "\系統文件\System.tmp" '臨時文件是用來存放中轉信息的
Open strFileName For Input As #1
Open strfileback For Output As #2
Do While Not EOF(1)
Line Input #1, strtemp
strReturn = strtemp
Print #2, strReturn
If InStr(1, Trim(strtemp), "[") <> 0 Then
If InStr(1, Trim(strtemp), Trim(strSection)) <> 0 Then
Do While Not EOF(1)
Line Input #1, strtemp
If InStr(1, Trim(strtemp), Trim(strname)) <> 0 Then Exit Do '找到所要修改的字段值
strReturn = strtemp
Print #2, strReturn '拷貝不需要的字段值
Loop
strReturn = strname & "=" & strSave '修改
Print #2, strReturn
End If
End If
Loop
Close #1
Close #2
Open strfileback For Input As #1
Open strFileName For Output As #2
Do While Not EOF(1) And EOF(2)
Line Input #1, strReturn
Print #2, strReturn
Loop
Close #1
Close #2
End Function
Function setProfile2(strFileName As String, strSection As String, strname As String, strSave As String) As Boolean
'這個函數是用來對INI文件進行寫操作的
'函數說明:
'strFileName 是所要存儲的文件名
'strSection 是這個文件中的一個節點名
'strName 是所要查找的字段名
'strSave 是所要替換字段值
'薛向華 1998/05/13
Dim strtemp As String
Dim strfileback As String
Dim strReturn As String
strfileback = App.Path & "\系統文件\err.tmp" '臨時文件是用來存放中轉信息的
Open strFileName For Input As #1
Open strfileback For Output As #2
Do While Not EOF(1)
Line Input #1, strtemp
strReturn = strtemp
Print #2, strReturn
If InStr(1, Trim(strtemp), "[") <> 0 Then
If InStr(1, Trim(strtemp), Trim(strSection)) <> 0 Then
Do While Not EOF(1)
Line Input #1, strtemp
If InStr(1, Trim(strtemp), Trim(strname)) <> 0 Then Exit Do '找到所要修改的字段值
strReturn = strtemp
Print #2, strReturn '拷貝不需要的字段值
Loop
strReturn = strname & "=" & strSave '修改
Print #2, strReturn
End If
End If
Loop
Close #1
Close #2
Open strfileback For Input As #1
Open strFileName For Output As #2
Do While Not EOF(1) And EOF(2)
Line Input #1, strReturn
Print #2, strReturn
Loop
Close #1
Close #2
End Function
Function GetProfile2(strFileName As String, strSection As String, strname As String) As String
'這個函數是用來對INI文件進行讀操作的
'函數說明:
'strFileName 是所要讀取的文件名
'strSection 是這個文件中的一個節點名
'strName 是所要查找的字段名
'返回值：
'薛向華 1998/05/13
strSectionTemp = ""
strNameTemp = ""
strReturn2 = ""
On Error GoTo ErrSrchSection
Open strFileName For Input As #1
' 下面這段程序是用來查找節點的
Do While Not EOF(1)
strCharA = Input(1, #1)
If strCharA = "[" Then
Do While Not EOF(1)
strCharB = Input(1, #1)
If strCharB = "]" Then Exit Do
strSectionTemp = strSectionTemp & strCharB
Loop
End If
If strSectionTemp = strSection Then
strCharA = Input(2, #1)
Exit Do
Else
strSectionTemp = ""
End If
Loop
On Error GoTo ErrReadFile
AA:
'下面這段程序是用來查找所要查找的字段的
strNameTemp = ""
Do While Not EOF(1)
strCharA = Input(1, #1)
If strCharA <> "=" Then
strNameTemp = strNameTemp & strCharA '得到名稱
Else
Exit Do
End If
Loop
If strNameTemp = strname Then
Line Input #1, strReturn2 '如果找到與它匹配的字段名，就返回得到的值
Else
Line Input #1, strReturn2 '如果未找到與它匹配的字段名，就繼續找
GoTo AA
End If
Close #1
GetProfile2 = strReturn2
Exit Function
ErrReadFile:
Exit Function
ErrSrchSection:
MsgBox "節點未找到", vbOKOnly
GetProfile2 = ""
Close #1
End Function
Function GetProfile(strFileName As String, strSection As String, strname As String) As String
'這個函數是用來對INI文件進行讀操作的
'函數說明:
'strFileName 是所要讀取的文件名
'strSection 是這個文件中的一個節點名
'strName 是所要查找的字段名
'返回值：
'薛向華 1998/05/13
strSectionTemp = ""
strNameTemp = ""
strReturn = ""
On Error GoTo ErrSrchSection
Open strFileName For Input As #1
' 下面這段程序是用來查找節點的
Do While Not EOF(1)
strCharA = Input(1, #1)
If strCharA = "[" Then
Do While Not EOF(1)
strCharB = Input(1, #1)
If strCharB = "]" Then Exit Do
strSectionTemp = strSectionTemp & strCharB
Loop
End If
If strSectionTemp = strSection Then
strCharA = Input(2, #1)
Exit Do
Else
strSectionTemp = ""
End If
Loop
On Error GoTo ErrReadFile
AA:
'下面這段程序是用來查找所要查找的字段的
strNameTemp = ""
Do While Not EOF(1)
strCharA = Input(1, #1)
If strCharA <> "=" Then
strNameTemp = strNameTemp & strCharA '得到名稱
Else
Exit Do
End If
Loop
If strNameTemp = strname Then
Line Input #1, strReturn '如果找到與它匹配的字段名，就返回得到的值
Else
Line Input #1, strReturn '如果未找到與它匹配的字段名，就繼續找
GoTo AA
End If
Close #1
GetProfile = strReturn
Exit Function
ErrReadFile:
Exit Function
ErrSrchSection:
MsgBox "節點未找到", vbOKOnly
GetProfile = ""
Close #1
End Function
Private Sub Command1_Click()
Dim strpass As String
On Error GoTo FinaliseError
Me.Hide
frmClient.Enabled = True
'WinSockCtl.Connect strip, strpost
'一次加密
'strpass = Crypt(Text1.text, "msd6d5aaber2-6")
strpass = Text1.text
strpass = strname & strpass
Winsock1.SendData strpass
FinaliseError:
'MsgBox "無法連接遠程主機", vbInformation, "連接"
' Exit Sub
End Sub
Private Sub Command2_Click()
Unload Me
frmClient.Enabled = True
End Sub
Private Sub Form_Load()
On Error Resume Next
barHigh.Width = 0
Dim strPath As String
Dim xc As String
strPath = App.Path & "\系統文件\err.ini"
xc = GetProfile2(strPath, "database", "delName")
'
Dim strPatht As String
strPatht = App.Path & "\系統文件\System.ini"
If strPatht <> "" Then
strip = GetProfile(strPatht, "database", "remIP")
strname = GetProfile(strPatht, "database", "remName")
strpost = GetProfile(strPatht, "database", "RemPort")
Text2.text = strip
Text3.text = strpost
ConnectPort.text = strpost '端口設置值
Winsock1.Connect strip, 502
Else
Unload Me
frmClient.Enabled = True
End If
If xc = strip Then
MsgBox "您使用的登陸驗證已經被停用，請注銷該帳號。", vbCritical + vbOKOnly, "錯誤提示"
End
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
FrmPass.Winsock1.Close
Unload Me
End Sub
Private Sub Label2_Click()
Unload Me
frmClient.Enabled = True
End Sub
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
Dim strpass As String
On Error GoTo FinaliseError
If KeyCode = 13 Then
Me.Hide
frmClient.Enabled = True
'WinSockCtl.Connect strip, strpost
'一次加密
'strpass = Crypt(Text1.text, "msd6d5aaber2-6")
strpass = Text1.text
strpass = strname & strpass
Winsock1.SendData strpass
End If
FinaliseError:
'MsgBox "無法連接遠程主機", vbInformation, "連接"
' Exit Sub
End Sub
Private Sub Timer1_Timer()
If conent <> 0 Then
Label2.Caption = "輸入密碼錯誤" & Str(conent) & " 次"
End If
End Sub
Private Sub Winsock1_Close()
On Error Resume Next
If Winsock1.State <> sckClosed Then
Winsock1.Close
Winsock1.Connect strip, 502
Else
Winsock1.Connect strip, 502
End If
End Sub
Private Sub Winsock1_Connect()
'frmClient.txtOutput.Text
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
Dim strPath As String
Dim strpass As String
Winsock1.GetData strpass
If strpass = "ok" Then
frmClient.Client.Connect strip, strpost
Winsock1.Close
Unload Me
End If
If strpass = "no" Then
frmClient.Enabled = False
Me.Show
'MsgBox "請確認輸入的密碼", vbExclamation + vbOKOnly, "系統提示"
conent = conent + 1
Label2.Caption = "輸入密碼錯誤" & Str(conent) & " 次"
FrmPass.Text1.text = ""
End If
If strpass = "err" Then
MsgBox "您使用的登陸驗證已經超過使用次數，現已停用。", vbCritical + vbOKOnly, "錯誤提示"
strPath = App.Path & "\系統文件\err.ini"
setProfile strPath, "[database]", "delName", strip
End
End If
End Sub
Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
'MsgBox "" & Winsock1.State
On Error Resume Next
If Winsock1.State <> sckClosed Then
Winsock1.Close
Winsock1.Connect strip, 502
ElseIf Winsock1.State = 9 Then
Winsock1.Close
Winsock1.Connect strip, 502
End If
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -