frmupgrade.frm

本系统可用于医院和专业体检中心的健康体检管理

VERSION 5.00
Object = "{0B81E4A9-BE4E-4AEF-9272-33AB5B51C6FC}#1.0#0"; "XPControls.ocx"
Begin VB.Form frmUpgrade 
   BackColor       =   &H80000018&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "FTP服务器参数"
   ClientHeight    =   4035
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   5985
   Icon            =   "frmUpgrade.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4035
   ScaleWidth      =   5985
   StartUpPosition =   2  'CenterScreen
   Begin VB.Frame fraContainer 
      BackColor       =   &H80000018&
      Height          =   2340
      Left            =   195
      TabIndex        =   3
      Top             =   885
      Width           =   5595
      Begin VB.TextBox txtPassword 
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   315
         IMEMode         =   3  'DISABLE
         Left            =   1695
         PasswordChar    =   "*"
         TabIndex        =   17
         Top             =   1365
         Width           =   2430
      End
      Begin VB.TextBox txtUserName 
         Height          =   285
         Left            =   1695
         TabIndex        =   16
         Top             =   990
         Width           =   2430
      End
      Begin VB.TextBox txtFtpAddress 
         Alignment       =   2  'Center
         Height          =   285
         Index           =   3
         Left            =   4860
         TabIndex        =   11
         Top             =   240
         Width           =   495
      End
      Begin VB.TextBox txtFtpAddress 
         Alignment       =   2  'Center
         Height          =   285
         Index           =   2
         Left            =   4285
         TabIndex        =   10
         Top             =   240
         Width           =   495
      End
      Begin VB.TextBox txtFtpAddress 
         Alignment       =   2  'Center
         Height          =   285
         Index           =   1
         Left            =   3710
         TabIndex        =   9
         Top             =   240
         Width           =   495
      End
      Begin VB.TextBox txtFtpAddress 
         Alignment       =   2  'Center
         Height          =   270
         Index           =   0
         Left            =   3135
         TabIndex        =   8
         Top             =   240
         Width           =   495
      End
      Begin VB.CheckBox chkNoFtp 
         BackColor       =   &H80000018&
         Caption         =   "我不在局域网内部，或者本机就是服务器"
         Height          =   240
         Left            =   225
         TabIndex        =   7
         Top             =   1920
         Width           =   3600
      End
      Begin VB.Label Label6 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "密   码："
         Height          =   195
         Left            =   870
         TabIndex        =   15
         Top             =   1410
         Width           =   675
      End
      Begin VB.Label Label4 
         BackStyle       =   0  'Transparent
         Caption         =   "."
         Height          =   255
         Index           =   2
         Left            =   4800
         TabIndex        =   14
         Top             =   225
         Width           =   75
      End
      Begin VB.Label Label4 
         BackStyle       =   0  'Transparent
         Caption         =   "."
         Height          =   255
         Index           =   1
         Left            =   4215
         TabIndex        =   13
         Top             =   225
         Width           =   75
      End
      Begin VB.Label Label4 
         BackStyle       =   0  'Transparent
         Caption         =   "."
         Height          =   255
         Index           =   0
         Left            =   3645
         TabIndex        =   12
         Top             =   225
         Width           =   75
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "用户名："
         Height          =   195
         Left            =   870
         TabIndex        =   6
         Top             =   1035
         Width           =   720
      End
      Begin VB.Label Label2 
         BackStyle       =   0  'Transparent
         Caption         =   "2、请输入用于登录FTP服务器的用户名和密码："
         Height          =   285
         Left            =   225
         TabIndex        =   5
         Top             =   645
         Width           =   4260
      End
      Begin VB.Label Label1 
         BackStyle       =   0  'Transparent
         Caption         =   "1、请输入服务器上的FTP地址："
         Height          =   270
         Left            =   225
         TabIndex        =   4
         Top             =   300
         Width           =   2715
      End
   End
   Begin XPControls.XPCommandButton cmdCancel 
      Height          =   375
      Left            =   3495
      TabIndex        =   1
      Top             =   3495
      Width           =   975
      _ExtentX        =   1720
      _ExtentY        =   661
      Caption         =   "取消(&C)"
      Font            =   "frmUpgrade.frx":0CCA
   End
   Begin XPControls.XPCommandButton cmdOK 
      Height          =   375
      Left            =   1935
      TabIndex        =   2
      Top             =   3495
      Width           =   975
      _ExtentX        =   1720
      _ExtentY        =   661
      Caption         =   "确定(&O)"
      Font            =   "frmUpgrade.frx":0CED
   End
   Begin VB.Label Label5 
      Caption         =   $"frmUpgrade.frx":0D10
      Height          =   645
      Left            =   210
      TabIndex        =   0
      Top             =   165
      Width           =   5565
   End
End
Attribute VB_Name = "frmUpgrade"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mblnOK As Boolean

Private Sub chkNoFtp_Click()
On Error Resume Next
    Dim objControl As Object
    Dim blnEnable As Boolean
    
    If chkNoFtp.Value = 1 Then
        blnEnable = False
    Else
        blnEnable = True
    End If
        
    For Each objControl In Me.Controls
        If objControl.Name <> fraContainer.Name Then
            If objControl.Container.Name = fraContainer.Name Then
                If objControl.Name <> "chkNoFtp" Then
                    objControl.Enabled = blnEnable
                End If
            End If
        End If
    Next
End Sub

Private Sub cmdCancel_Click()
    mblnOK = False
    Unload Me
End Sub

'被调函数
Public Function ShowFtpPara() As Boolean
    mblnOK = False
    Me.Show vbModal
    ShowFtpPara = mblnOK
End Function

Private Sub cmdOK_Click()
    Dim i As Integer
    Dim strFTPServer As String
    Dim strPassword As String
    
    Me.MousePointer = 13
    
    If chkNoFtp.Value = 1 Then
        If MsgBox("您的选择将使本机不参与智能升级，确认要继续吗？", _
                vbQuestion + vbYesNo + vbDefaultButton2, "提示") = vbNo Then
            GoTo ExitLab
        Else
            Call WriteINI(gstrCurrPath & DSNINIFile, "Upgrade", "Upgrade", "NO")
            Me.MousePointer = 0
            Unload Me
        End If
    Else
        '检查ip地址
        For i = txtFtpAddress.LBound To txtFtpAddress.UBound
            txtFtpAddress(i).Text = CInt(Val(txtFtpAddress(i).Text))
            If (Val(txtFtpAddress(i).Text) > 255) Or (Val(txtFtpAddress(i).Text) < 0) Then
                MsgBox "您输入的ftp地址不是合法地址！请重新输入(0到255之间)！", vbInformation, "提示"
                txtFtpAddress(i).SetFocus
                GoTo ExitLab
            End If
        Next
        For i = txtFtpAddress.LBound To txtFtpAddress.UBound
            strFTPServer = strFTPServer & txtFtpAddress(i).Text & "."
        Next
        '去掉最后多余的点
        strFTPServer = Left(strFTPServer, Len(strFTPServer) - 1)
        
        txtUserName.Text = Trim(txtUserName.Text)
        
        If FTPGET.FtpConnect(strFTPServer, txtUserName.Text, txtPassword.Text) = False Then
            If MsgBox("无法连接到指定的FTP服务器。可能的原因：" & _
                    vbCrLf & "*ftp服务器尚未运行" & _
                    vbCrLf & "*找不到ftp地址" & _
                    vbCrLf & "*用户名或密码不正确" & _
                    vbCrLf & vbCrLf & "如果要重新设置参数，请单击“是”；如果继续使用这些参数，请单击“否”！", _
                    vbExclamation + vbYesNo + vbDefaultButton1, "提示") = vbYes Then GoTo ExitLab
            GoSub Set_Para
        Else
            GoSub Set_Para
        End If
        
        mblnOK = True
        Unload Me
    End If
    Exit Sub
    
Set_Para:
    Call WriteINI(gstrCurrPath & DSNINIFile, "Upgrade", "FTPServer", strFTPServer)
    Call WriteINI(gstrCurrPath & DSNINIFile, "Upgrade", "FTPUser", txtUserName.Text)
    Call WriteINI(gstrCurrPath & DSNINIFile, "Upgrade", "FTPPassword", FTPGET.Encrypt(txtPassword.Text))
    
    Call WriteINI(gstrCurrPath & DSNINIFile, "Upgrade", "Upgrade", "YES")
    Return
ExitLab:
    Me.MousePointer = 0
End Sub

Private Sub Form_Load()
On Error Resume Next
    Dim strUserName As String
    Dim strPassword As String
    Dim strFTPServer As String
    Dim arrServer
    Dim i As Integer
    
    strUserName = GetINI(gstrCurrPath & DSNINIFile, "Upgrade", "FTPUser", "?")
    strPassword = GetINI(gstrCurrPath & DSNINIFile, "Upgrade", "FTPPassword", "?")
    strFTPServer = GetINI(gstrCurrPath & DSNINIFile, "Upgrade", "FTPServer", "?")
    If strFTPServer <> "?" Then
        arrServer = Split(strFTPServer, ".")
        For i = LBound(arrServer) To UBound(arrServer)
            txtFtpAddress(i).Text = arrServer(i)
        Next
    End If
    
    If strUserName <> "?" Then
        txtUserName.Text = strUserName
    End If
    If strPassword <> "?" Then
        txtPassword.TabIndex = FTPGET.Decrypt(strPassword)
    End If
End Sub

Private Sub txtFtpAddress_GotFocus(Index As Integer)
    txtFtpAddress(Index).SelStart = 0
    txtFtpAddress(Index).SelLength = Len(txtFtpAddress(Index).Text)
End Sub