frmconnection.frm

用VB调用SSH控件

VERSION 5.00
Begin VB.Form FrmConnection 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Connection"
   ClientHeight    =   2565
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4950
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2565
   ScaleWidth      =   4950
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame1 
      Height          =   2535
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   4935
      Begin VB.TextBox Text1 
         Height          =   270
         Left            =   1320
         TabIndex        =   8
         Top             =   840
         Width           =   2175
      End
      Begin VB.CommandButton CmdExit 
         Caption         =   "取消"
         Height          =   375
         Left            =   3720
         TabIndex        =   6
         Top             =   1920
         Width           =   975
      End
      Begin VB.CommandButton CmdOk 
         Caption         =   "确定"
         Height          =   375
         Left            =   2640
         TabIndex        =   5
         Top             =   1920
         Width           =   975
      End
      Begin VB.TextBox TxtPost 
         Height          =   270
         Left            =   1320
         TabIndex        =   4
         Top             =   1320
         Width           =   2175
      End
      Begin VB.TextBox TxtIP 
         Height          =   270
         Left            =   1320
         TabIndex        =   2
         Top             =   360
         Width           =   2175
      End
      Begin VB.Label Label3 
         Caption         =   "登陆用户名："
         Height          =   255
         Left            =   120
         TabIndex        =   7
         Top             =   840
         Width           =   1095
      End
      Begin VB.Label Label2 
         Caption         =   "远程端口："
         Height          =   255
         Left            =   120
         TabIndex        =   3
         Top             =   1320
         Width           =   1215
      End
      Begin VB.Label Label1 
         Caption         =   "远程主机IP："
         Height          =   255
         Left            =   120
         TabIndex        =   1
         Top             =   360
         Width           =   1215
      End
   End
End
Attribute VB_Name = "FrmConnection"
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
Sub Item_clear()
     TxtIP = ""
     TxtPost = ""
End Sub

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 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 CmdExit_Click()
Unload Me
frmClient.Enabled = True
End Sub

Private Sub CmdOk_Click()
On Error Resume Next
Dim strPath As String
If TxtIP.text = Empty Or TxtPost.text = Empty Or Text1.text = Empty Then
MsgBox "地址内容不能是空值！", vbExclamation + vbOKOnly, "系统提示"
Exit Sub
Else

If Text1.MaxLength > 4 Then
 Text1.text = Left(Text1.text, 4)
 End If
If Text1.MaxLength = 1 Then
 Text1.text = Text1.text & "@@@"
 ElseIf Text1.MaxLength = 2 Then
 Text1.text = Text1.text & "@@"
 ElseIf Text1.MaxLength = 3 Then
 Text1.text = Text1.text & "@"
 End If
 strPath = App.Path & "\系统文件\System.ini"
 setProfile strPath, "[database]", "remName", Text1.text
     
 setProfile strPath, "[database]", "remIP", TxtIP
 
 setProfile strPath, "[database]", "RemPort", TxtPost
 
 Me.Hide

 FrmPass.Show
 End If
 
End Sub

Private Sub Form_Load()
On Error Resume Next
Dim strPath As String
If Dir(App.Path & "\系统文件\System.ini") = Empty Then
 Open App.Path & "\系统文件\System.ini" For Output As #1
 Print #1, "[database]" & vbCrLf & "remName=" & vbCrLf & "remIP=" & "remPORT=" & vbCrLf & "dbparm=" & vbCrLf & "RemPort=" & vbCrLf
 Close #1
 End If
 
 
 On Error Resume Next
barHigh.Width = 0

Dim strPatht As String
 strPatht = App.Path & "\系统文件\System.ini"
 
 If strPatht <> "" Then

TxtIP.text = GetProfile(strPatht, "database", "remIP")
TxtPost.text = GetProfile(strPatht, "database", "RemPort")
Text1.text = GetProfile(strPatht, "database", "remName")

End If
End Sub