form2.frm

一个OA办公自动化管理系统

VERSION 5.00
Begin VB.Form frmNewAccount 
   Caption         =   "新建帐套"
   ClientHeight    =   2970
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5325
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2970
   ScaleWidth      =   5325
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   435
      Left            =   2940
      TabIndex        =   7
      Top             =   1860
      Width           =   1935
   End
   Begin VB.TextBox txtAccountName 
      Height          =   330
      Left            =   1800
      TabIndex        =   2
      Top             =   1200
      Width           =   2595
   End
   Begin VB.TextBox txtAdminPassWord 
      Height          =   330
      Left            =   1800
      TabIndex        =   1
      Top             =   780
      Width           =   2595
   End
   Begin VB.TextBox txtServerName 
      Height          =   345
      Left            =   1800
      TabIndex        =   0
      Top             =   360
      Width           =   2595
   End
   Begin VB.CommandButton cmdNewAccount 
      Caption         =   "新建"
      Height          =   495
      Left            =   120
      TabIndex        =   3
      Top             =   1860
      Width           =   2295
   End
   Begin VB.Label Label3 
      Caption         =   "帐套名称:"
      Height          =   195
      Left            =   540
      TabIndex        =   6
      Top             =   1260
      Width           =   1215
   End
   Begin VB.Label Label2 
      Caption         =   "管理员密码:"
      Height          =   195
      Left            =   540
      TabIndex        =   5
      Top             =   840
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "服务器名称:"
      Height          =   195
      Left            =   540
      TabIndex        =   4
      Top             =   420
      Width           =   1215
   End
End
Attribute VB_Name = "frmNewAccount"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public linkString1 As String, cn As New Connection

'Function ShowFileAccessInfo(filespec)
'  var fso, f, s;
'  fso = new ActiveXObject("Scripting.FileSystemObject");
'  f = fso.GetFile(filespec);
'  s = f.Path.toUpperCase() + "<br>";
'  s += "Created: " + f.DateCreated + "<br>";
'  s += "Last Accessed: " + f.DateLastAccessed + "<br>";
'  s += "Last Modified: " + f.DateLastModified
'  return(s);


 Function GetSQlScript(txtFileName As String) As String

    Dim NextLine As String
    
    Close 1
    GetSQlScript = ""
    Open txtFileName For Input As 1
    
    Do Until EOF(1)
        Line Input #1, NextLine
        GetSQlScript = GetSQlScript + NextLine + Chr(13) + Chr(10)
    Loop

End Function

Private Sub Command2_Click()
'MsgBox strFile
End Sub
Private Function CreateDBString() As String
    Dim strLink As String
    strLink = "Provider=SQLOLEDB.1;"
    If Trim(Me.txtAdminPassWord.Text) <> "" Then
        strLink = strLink & "Password=" & Trim(Me.txtAdminPassWord.Text) & ""
    End If
    strLink = strLink & ";Persist Security Info=False;User ID=sa;Data Source=" & Trim(Me.txtServerName.Text) & ""
    CreateDBString = strLink
End Function

Private Function CreateCNString() As String
    Dim strLink As String
    strLink = "Provider=SQLOLEDB.1;"
    If Trim(Me.txtAdminPassWord.Text) <> "" Then
        strLink = strLink & "Password=" & Trim(Me.txtAdminPassWord.Text) & ""
    End If
    strLink = strLink & ";Persist Security Info=False;User ID=sa;Initial Catalog=" & Trim(Me.txtAccountName.Text) & ";Data Source=" & Trim(Me.txtServerName.Text) & ""
    CreateCNString = strLink

End Function


Private Sub cmdNewAccount_Click()
    Me.MousePointer = 11
    If dbcn(CreateDBString) = 0 Then
    
        On Error GoTo Err_CreateBD
    
        cn.Execute "Create Database " & Trim(Me.txtAccountName.Text)
        If dbcn(CreateCNString) = 0 Then
            cn.Execute GetSQlScript(App.Path & "\luo.txt")
        End If
        Me.MousePointer = 0
        MsgBox "帐套建立成功！", vbExclamation, "新建帐套"
    End If
Exit_cmdNewAccount_Click:
    Exit Sub
Err_CreateBD:
    MsgBox Trim(Me.txtAccountName.Text) & "  已存在，请输入新帐套！", vbExclamation, "新建帐套"
    
    
Me.MousePointer = 0
End Sub

Public Function dbcn(cnString As String) As Integer
    On Error GoTo Err_CnString
    If cn.State = 0 Then
    Else
        cn.Close
    End If
    cn.ConnectionString = cnString
    
    'cn.ConnectionTimeout = 300
    cn.CursorLocation = adUseServer
    cn.Open
    dbcn = 0
    Me.MousePointer = 0

Exit_dbcn:
    Exit Function

Err_CnString:
    MsgBox Trim(Me.txtServerName.Text) & "  连接失败，请检查！", vbExclamation, "连接数据库"
    dbcn = 1
    Me.MousePointer = 0

End Function

Private Sub Command1_Click()

GetConnect.Execute "xp_sendmail 'luo','luo Send '"
End Sub