frmpass.frm

用VB调用SSH控件

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