frmpass.frm

用VB调用SSH控件

    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
FrmMain.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
FrmMain.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 '端口设置值
WinSockCtl.Close

Winsock1.Connect strip, 502

Else
Unload Me
FrmMain.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
FrmPass.WinSockCtl.Close
Unload Me

End Sub

Private Sub Label2_Click()
Unload Me
FrmMain.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
FrmMain.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()

FrmMain.List1.AddItem ("验证用户口令模式连接成功  " & "                 " & Date & "      " & Time & "")
Set itwms = FrmMain.ListView4.ListItems.Add(, , "验证用户口令模式连接成功")
itwms.SubItems(1) = Date
itwms.SubItems(2) = Time
itwms.SubItems(3) = "验证口令"
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
WinSockCtl.Connect strip, strpost
Winsock1.Close
FrmMain.List1.AddItem ("验证用户口令正确          " & "                 " & Date & "      " & Time & "")
Set itwms = FrmMain.ListView4.ListItems.Add(, , "验证用户口令正确")
itwms.SubItems(1) = Date
itwms.SubItems(2) = Time
itwms.SubItems(3) = "验证口令"
End If
If strpass = "no" Then
FrmMain.List1.AddItem ("验证用户口令错误          " & "                 " & Date & "      " & Time & "")
Set itwms = FrmMain.ListView4.ListItems.Add(, , "验证用户口令错误")
itwms.SubItems(1) = Date
itwms.SubItems(2) = Time
itwms.SubItems(3) = "验证口令"
FrmMain.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, "错误提示"
FrmMain.List1.AddItem ("验证用户口令被锁          " & "                 " & Date & "      " & Time & "")
Set itwms = FrmMain.ListView4.ListItems.Add(, , "验证用户口令被锁")
itwms.SubItems(1) = Date
itwms.SubItems(2) = Time
itwms.SubItems(3) = "验证口令"
 
 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

Private Sub WinSockCtl_Close()
FrmMain.Caption = "SSH demo "
End Sub

Private Sub WinSockCtl_Connect()
 If WinSockCtl.State <> 7 Then
      MsgBox "无法连接到远程主机", vbCritical + vbOKOnly, "错误提示"
        WinSockCtl.Close
        
        Exit Sub
    End If
    FrmMain.Caption = "SSH demo " & "连接到[" & WinSockCtl.RemoteHost & "]" & "远程端口：" & WinSockCtl.RemotePort
     FrmMain.List1.AddItem ("成功连接远程主机          " & "                 " & Date & "      " & Time & "")
     
     Set itwms = FrmMain.ListView4.ListItems.Add(, , "成功连接远程主机" & WinSockCtl.RemoteHost)
     itwms.SubItems(1) = Date
     itwms.SubItems(2) = Time
     itwms.SubItems(3) = "成功连接"
     
     WinSockCtl.SendData "[LOAD DRIVE DATA]"
    'FrmMain.ListView2.ListItems.Clear
        
    WaitTime = 0
    Do Until WaitTime = 10000
        WaitTime = WaitTime + 1: DoEvents
        Loop

    WinSockCtl.SendData "[LOAD FOLDER DATA]" & FrmMain.TextDirectory.Text
    
    WaitTime = 0
    Do Until WaitTime = 10000
        WaitTime = WaitTime + 1: DoEvents
        Loop
    
    WinSockCtl.SendData "[LOAD FOLDER NAME]" & FrmMain.TextDirectory.Text
    WaitTime = 0
    Do Until WaitTime = 10000
        WaitTime = WaitTime + 1: DoEvents
        Loop
    
    WinSockCtl.SendData "[FILE SIZE DATA]" & FrmMain.TextDirectory.Text
    
    FrmMain.Combo2.Text = FrmMain.TextDirectory.Text
    FrmMain.ListView1.BackColor = &H80000009 '白色
    FrmMain.ListView2.BackColor = &H80000009 '白色
    FrmMain.ListView2.Enabled = True
    Me.Visible = False
End Sub

Private Sub WinSockCtl_DataArrival(ByVal bytesTotal As Long)
 On Error GoTo FinaliseError
    Dim MyText As String
    Dim Data As String
    Dim Myinput As String
    Dim GetLine As Long
    Dim LastLine As Long
    Dim ChrState As String
    Dim ProcessFileCount As Integer
    Dim DriveListCount As Long
    ''''''''''''''''''''''''''''''
    Dim Pirinure As Long
    ''''''''''''''''''''''''''''
    ' WinSockCtl.GetData MyText
    
    'WinSockCtl.GetData Pirinure = FrmPicture.Picture1.Picture
    
    WinSockCtl.GetData Data
    'If Left(Data, 7) = "loadme" Then
            'FrmText.Show
            'FrmText.Text1 = Myinput
       ' End If
    'MsgBox "传过来的数据" & vbCrLf & MyText, vbExclamation + vbOKOnly, "消息"
    '接收到文件路径与文件名
    If Data = "passerr" Then
    WinSockCtl.Close
    End If
    
    If Left(Data, 6) = "sorry1" Then
    
    Set itwms = FrmMain.ListView4.ListItems.Add(, , "你的权限不够无法删除" & FrmMain.TextDirectory.Text & FrmMain.ListView2.SelectedItem.Text)
     itwms.SubItems(1) = Date
     itwms.SubItems(2) = Time
     itwms.SubItems(3) = "权限不够"