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

📄 frmnewweb.frm

📁 OA编程 源代码
💻 FRM
📖 第 1 页 / 共 2 页
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmNewWeb 
   Caption         =   "新建WEB站点"
   ClientHeight    =   5085
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6705
   Icon            =   "frmNewWeb.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5085
   ScaleWidth      =   6705
   StartUpPosition =   2  '屏幕中心
   Begin VB.PictureBox Picture1 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   1020
      Left            =   5400
      Picture         =   "frmNewWeb.frx":030A
      ScaleHeight     =   1020
      ScaleWidth      =   1020
      TabIndex        =   18
      Top             =   120
      Width           =   1020
   End
   Begin VB.CommandButton cmdPath 
      Caption         =   "浏览"
      Height          =   375
      Left            =   5640
      TabIndex        =   6
      Top             =   4560
      Width           =   855
   End
   Begin VB.TextBox txtFilePath 
      Height          =   375
      Left            =   1440
      Locked          =   -1  'True
      TabIndex        =   5
      Top             =   4560
      Width           =   4215
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   5520
      Top             =   2640
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Frame Frame1 
      Caption         =   "数据库信息"
      ForeColor       =   &H00FF0000&
      Height          =   2175
      Left            =   120
      TabIndex        =   12
      Top             =   480
      Width           =   4935
      Begin VB.OptionButton Opt7 
         Caption         =   "SQL Server7.0"
         Height          =   255
         Left            =   2880
         TabIndex        =   20
         Top             =   1680
         Width           =   1815
      End
      Begin VB.OptionButton Opt65 
         Caption         =   "SQL Server6.5"
         Height          =   255
         Left            =   240
         TabIndex        =   19
         Top             =   1680
         Width           =   1695
      End
      Begin VB.TextBox txtDB 
         Height          =   375
         Left            =   1320
         TabIndex        =   2
         Text            =   "bkbtinfo"
         Top             =   1080
         Width           =   3375
      End
      Begin VB.TextBox txtPWD 
         Height          =   375
         Left            =   3120
         TabIndex        =   1
         Top             =   480
         Width           =   1575
      End
      Begin VB.TextBox txtUID 
         Height          =   390
         Left            =   720
         TabIndex        =   0
         Text            =   "sa"
         Top             =   480
         Width           =   1575
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "数据库名称:"
         Height          =   180
         Index           =   1
         Left            =   240
         TabIndex        =   15
         Top             =   1200
         Width           =   990
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "口令:"
         Height          =   180
         Index           =   0
         Left            =   2640
         TabIndex        =   14
         Top             =   600
         Width           =   450
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "姓名:"
         Height          =   180
         Left            =   240
         TabIndex        =   13
         Top             =   600
         Width           =   450
      End
   End
   Begin VB.Frame aaa 
      Caption         =   "WEB站点信息"
      ForeColor       =   &H00FF0000&
      Height          =   1575
      Left            =   120
      TabIndex        =   9
      Top             =   2760
      Width           =   4935
      Begin VB.TextBox txtDomain 
         Height          =   375
         Left            =   1320
         TabIndex        =   3
         Top             =   480
         Width           =   3375
      End
      Begin VB.TextBox txtWebName 
         Height          =   375
         Left            =   1320
         TabIndex        =   4
         Text            =   "bk2000"
         Top             =   960
         Width           =   3375
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "域    名:"
         Height          =   180
         Index           =   1
         Left            =   360
         TabIndex        =   11
         Top             =   600
         Width           =   900
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "WEB站点名称:"
         Height          =   180
         Index           =   0
         Left            =   120
         TabIndex        =   10
         Top             =   1080
         Width           =   1170
      End
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "退出"
      Height          =   495
      Left            =   5400
      TabIndex        =   8
      Top             =   3240
      Width           =   1095
   End
   Begin VB.CommandButton cmdOk 
      Caption         =   "确认"
      Height          =   495
      Left            =   5400
      TabIndex        =   7
      Top             =   2040
      Width           =   1095
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "程序安装路径:"
      Height          =   180
      Left            =   120
      TabIndex        =   17
      Top             =   4680
      Width           =   1260
   End
   Begin VB.Label LabSysInfo 
      BackStyle       =   0  'Transparent
      ForeColor       =   &H00FF0000&
      Height          =   375
      Left            =   840
      TabIndex        =   16
      Top             =   120
      Width           =   5535
   End
End
Attribute VB_Name = "frmNewWeb"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub CmdExit_Click()
    Unload Me
    
End Sub

Private Sub CmdOk_Click()
Dim MyConn As New adodb.Connection
Dim rs As New adodb.Recordset

Dim j, DbSize As Integer
Dim dbName, dbpath, tempPath As String
Dim exitUser As Integer
            
Screen.MousePointer = vbHourglass
If Trim(txtDB) = "" Then
    MsgBox "数据库名不能为空!", 64, "提示"
    txtDB.SetFocus
    Screen.MousePointer = vbDefault
    Exit Sub
End If

j = Asc(Left(Trim(txtDB), 1))
If Not ((j >= 65 And j <= 90) Or (j >= 97 And j <= 122)) Then
    MsgBox "数据库名必须是英文字母或数字,并以英文字母开始。", vbDefaultButton1 + vbInformation
    txtDB.SetFocus
    Screen.MousePointer = vbDefault
    Exit Sub
End If

If CheckInput(Trim(txtDB)) = False Then
    MsgBox "数据库名必须是英文字母或数字,并以英文字母开始。", vbDefaultButton1 + vbInformation
    txtDB.SetFocus
    Screen.MousePointer = vbDefault
    Exit Sub
End If

If Len(txtDB) > 15 Then
    MsgBox "数据库名超长 !", 64, "提示"
    txtDB.SetFocus
    Screen.MousePointer = vbDefault
    Exit Sub
End If

If IsNumeric(Left(txtDB, 1)) = True Then
    MsgBox "数据库名必须是英文字母或数字,并以英文字母开始。", 64, "提示"
    txtDB.SetFocus
    Screen.MousePointer = vbDefault
    Exit Sub
End If

If Trim(txtDomain.Text) = "" Then
    MsgBox "必须输入系统的域名!", 48, "系统提示"
    txtDomain.SetFocus
    Exit Sub
End If

If Trim(txtUID.Text) = "" Then
    MsgBox "必须输入数据库管理员的用户名和口令!", 48, "系统提示"
    txtUID.SetFocus
    Exit Sub
End If
If Trim(txtWebName) = "" Then
    MsgBox "WEB站点名称不能为空!", 48, "系统提示"
    txtWebName.SetFocus
    Exit Sub
End If
WebName = Trim(txtWebName)

If Trim(txtFilePath) = "" Then
    MsgBox "程序的安装路径不能为空!", 48, "系统提示"
    txtFilePath.SetFocus
    Screen.MousePointer = vbDefault
    Exit Sub
    
End If

dbName = Trim(txtDB)
'DbSize = 100
Screen.MousePointer = vbDefault
    
    If WebExist(txtWebName) = 1 Then
        Exit Sub
        

⌨️ 快捷键说明

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