档案馆模型库系统的VB实现

概述公共变量： Public cnn As ADODB.ConnectionPublic rs As ADODB.Recordset   Form1： Private Sub Form_load() '建立与模型库的连接 Set cnn = New ADODB.Connection With cnn .Provider = "microsoft.jet.ol

公共变量：

Public cnn As ADODB.ConnectionPublic rs As ADODB.Recordset

Form1：

Private Sub Form_load()    '建立与模型库的连接    Set cnn = New ADODB.Connection    With cnn        .ProvIDer = "microsoft.jet.oledb.4.0"  '数据库驱动程序        .Open "D:\档案模型系统.mdb"    End With    '查找模型库中的模型，并设置给“模型清单”列表框    Call 获取模型清单End SubPublic Sub 获取模型清单()    '获取模型库中的表    Set rs = cnn.OpenSchema(adSchematables)    With 模型清单        .Clear        Do Until rs.EOF            If left(rs!table_name,4) <> "MSys" Then  '系统表不显示                模型清单.AddItem rs!table_name            End If            rs.MoveNext        Loop    End WithEnd SubPrivate Sub 查找模型_Click()    '指定要查找模型的名称    myNewname = inputBox("请输入要查找的模型名称：","输入模型名称")    If Len(Trim(myNewname)) = 0 Then 'Trim(str)，去掉str两边的空格        MsgBox "没有输入有效的模型名！",vbCritical        Exit Sub    End If    '检查模型库中是否有同名模型    Set rs = cnn.OpenSchema(adSchematables) '语法：Set 记录集对象名= connection.OpenSchema(queryType,Criteria,SchemaID)，参数：queryType 所要运行的模式查询类型可以是一系列常量，比如adSchemaColumns    Do Until rs.EOF        If LCase(rs!table_name) = LCase(myNewname) Then            模型清单.Text = rs!table_name            MsgBox "找到模型：" & myNewname            Exit Sub        End If        rs.MoveNext    Loop    If rs.EOF = True Then        MsgBox "没有找到模型：" & myNewname & " ！",vbCritical,"警告"    End IfEnd Sub    Private Sub 创建模型_Click()        Form2.Show   '打开“创建模型窗体”子窗体        Call 获取模型清单    '刷新“模型清单”列表框    End Sub    Private Sub 打开模型_Click()        '判断是否选择了要打开的模型        If 模型清单.ListIndex = -1 Then            MsgBox "没有选择要打开的模型！","警告"            Exit Sub        End If        '打开选择的模型        Dim myAccess As Object  'Object 数据类型保存引用对象的 32 位（4 字节）地址。可以为 Object 的变量分配任何引用类型（字符串、数组、类或接口）。Object 变量还可以引用任何值类型（数值、Boolean、Char、Date、结构或枚举）的数据。        Set myAccess = CreateObject("D:\档案模型系统.mdb")        With myAccess            .Visible = True            .DoCmd.Opentable 模型清单.Text  'DoCmd 对象方法的任务是打开和关闭Access对象            .DoCmd.Maximize        End With        '释放变量        Set myAccess = nothing    End Sub    Private Sub 复制模型_Click()        Dim sql As String,myNewname As String        '判断是否选择了要复制的模型        If 模型清单.ListIndex = -1 Then            MsgBox "没有选择要复制的模型！","警告"            Exit Sub        End If        '确认是否复制选择的模型        If MsgBox("是否要复制模型<" & 模型清单.Text & ">？",_            vbQuestion + vbYesNo) = vbNo Then Exit Subbegin:        '指定模型的新名称        myNewname = inputBox("请输入模型新名称：","输入模型名称")        If Len(Trim(myNewname)) = 0 Then            MsgBox "没有输入有效的模型名！",vbCritical            Exit Sub        End If        '检查模型库中是否有同名模型        Set rs = cnn.OpenSchema(adSchematables)        Do Until rs.EOF            If LCase(rs!table_name) = LCase(myNewname) Then                MsgBox "模型<" & myNewname & ">已经存在！请重新输入模型名！",_                    vbCritical,"警告"                GoTo begin                Exit Sub            End If            rs.MoveNext        Loop        '生成一个查询表        sql = "select * into " & myNewname & " from " & 模型清单.Text        Set rs = cnn.Execute(sql)        MsgBox "将模型<" & 模型清单.Text & ">复制了一份。名称为<" _            & myNewname & ">",vbinformation + vbOKOnly,"复制模型"        '刷新“模型清单”列表框        Call 获取模型清单        '删除“字段清单”列表框中的项目        字段清单.Clear    End Sub    Private Sub 改变字段长度_Click()        Dim sql As String,myFIEldType As String        '判断是否选择了要改变字段长度的字段        If 字段清单.ListIndex = -1 Then            MsgBox "没有选择要改变字段长度的字段！","警告"            Exit Sub        End If        '确认是否改变选择字段的长度        If MsgBox("是否改变字段<" & 字段清单.Text & ">的长度？",_            vbQuestion + vbYesNo) = vbNo Then Exit Subbegin:        '指定字段新类型        myFIEldType = inputBox("请输入字段类型及长度：","输入字段类型及长度")        If Len(Trim(myFIEldType)) = 0 Then            MsgBox "没有输入有效的字段类型和长度！",vbCritical            Exit Sub        End If        '改变选择字段的模型类型        sql = "alter table " & 模型清单.Text & " alter " _            & 字段清单.Text & Space(1) & myFIEldType        Set rs = New ADODB.Recordset        rs.Open sql,cnn,adOpenDynamic,adLockOptimistic  '游标类型，加锁类型  ADOPENDYNAMIC(=2) 可读写,当前数据记录可自由移动   ADLOCKOPTIMISTIC(=3) 乐观锁定 ，直到用Update方法提交更新记录时才锁定记录。        MsgBox "模型<" & 模型清单.Text & ">中的字段<" _            & 字段清单.Text & ">的长度被改变！",_            vbinformation + vbOKOnly,"改变字段长度"    End Sub    Private Sub 改变字段类型_Click()        Dim sql As String,myFIEldType As String        '判断是否选择了要改变模型类型的字段        If 字段清单.ListIndex = -1 Then            MsgBox "没有选择要改变模型类型的字段！","警告"            Exit Sub        End If        '确认是否改变选择字段的模型类型        If MsgBox("是否改变字段<" & 字段清单.Text & ">的模型类型？",_            vbQuestion + vbYesNo) = vbNo Then Exit Subbegin:        '指定字段新类型        myFIEldType = inputBox("请输入字段新类型：","输入字段新类型")        If Len(Trim(myFIEldType)) = 0 Then            MsgBox "没有输入有效的字段类型！",adLockOptimistic        MsgBox "模型<" & 模型清单.Text & ">中的字段<" _            & 字段清单.Text & ">的类型被改变！","改变字段类型"    End Sub    Private Sub 删除模型_Click()        Dim sql As String        '判断是否选择了要删除的模型        If 模型清单.ListIndex = -1 Then            MsgBox "没有选择要删除的模型！","警告"            Exit Sub        End If        '确认是否删除选择的模型        If MsgBox("是否要删除模型<" & 模型清单.Text & ">？",_            vbQuestion + vbYesNo) = vbNo Then Exit Sub        '删除选定的模型        sql = "drop table " & 模型清单.Text        Set rs = cnn.Execute(sql)        MsgBox "模型<" & 模型清单.Text & ">被成功删除！","删除模型"        '刷新“模型清单”列表框        Call 获取模型清单        '删除“字段清单”列表框中的项目        字段清单.Clear    End Sub    Private Sub 删除字段_Click()        Dim sql As String        '判断是否选择了要删除的字段        If 字段清单.ListIndex = -1 Then            MsgBox "没有选择要删除的字段！","警告"            Exit Sub        End If        '确认是否删除选择的字段        If MsgBox("是否要删除字段<" & 字段清单.Text & ">？",_            vbQuestion + vbYesNo) = vbNo Then Exit Sub        '删除选定的字段        sql = "alter table " & 模型清单.Text & " drop " & 字段清单.Text        Set rs = New ADODB.Recordset        rs.Open sql,adLockOptimistic        MsgBox "模型<" & 模型清单.Text & ">中的字段<" _            & 字段清单.Text & ">被成功删除！","删除模型"        '刷新“字段清单”列表框        Call 获取字段清单    End SubPrivate Sub 模型清单_Click()        Call 获取字段清单End SubPublic Sub 获取字段清单()        On Error Resume Next        Dim sql As String,i As Integer        '查询选择的模型，将字段名清单设置给“字段清单”列表框        sql = "select * from " & 模型清单.Text        Set rs = cnn.Execute(sql)        With 字段清单            .Clear            For i = 0 To rs.FIElds.Count - 1                .AddItem rs.FIElds(i).name            Next i        End With        rs.CloseEnd SubPrivate Sub 刷新_Click()    Call 获取模型清单End Sub    Private Sub 添加字段_Click()        Dim sql As String,myNewFIEld As String        '判断是否选择了要添加字段的模型        If 模型清单.ListIndex = -1 Then            MsgBox "没有选择要添加字段的模型！","警告"            Exit Sub        End Ifbegin:        '指定新字段名称        myNewFIEld = inputBox("请输入新字段名称和类型：","输入新字段名称类型")        If Len(Trim(myNewFIEld)) = 0 Then            MsgBox "没有输入有效的字段名！",vbCritical            Exit Sub        End If        '确认是否添加字段        If MsgBox("是否要向模型<" & 模型清单.Text _            & ">中添加字段<" & myNewFIEld & ">？",_            vbQuestion + vbYesNo) = vbNo Then Exit Sub        '检查模型中是否有同名的字段        Set rs = cnn.OpenSchema(adSchemaColumns)        Do Until rs.EOF            If LCase(rs!column_name) = LCase(myNewFIEld) Then               MsgBox "在模型<" & 模型清单 & ">中已经存在字段< " _                & myNewFIEld & ">！","警告"                GoTo begin                Exit Sub            End If            rs.MoveNext        Loop        '添加字段        sql = "alter table " & 模型清单.Text & " add " & myNewFIEld        Set rs = New ADODB.Recordset        rs.Open sql,adLockOptimistic        MsgBox "在模型<" & 模型清单.Text & ">中成功添加了字段<" _            & myNewFIEld,"删除模型"        '刷新“字段清单”列表框        Call 获取字段清单    End Sub    Private Sub 退出系统_Click()        cnn.Close        Set rs = nothing        Set myCat = nothing        Set cnn = nothing        Unload Form1    End SubPrivate Sub 重命名模型_Click()    Dim sql As String,myNewname As String    '判断是否选择了要重命名的模型    If 模型清单.ListIndex = -1 Then        MsgBox "没有选择要重命名的模型！","警告"        Exit Sub    End If    '确认是否删除选择的模型    If MsgBox("是否要重命名模型<" & 模型清单.Text & ">？",_        vbQuestion + vbYesNo) = vbNo Then Exit Subbegin:    '指定模型的新名称    myNewname = inputBox("请输入模型新名称：","输入模型名称")    If Len(Trim(myNewname)) = 0 Then        MsgBox "没有输入有效的模型名！",vbCritical        Exit Sub    End If    '检查模型库中是否有同名模型    Set rs = cnn.OpenSchema(adSchematables)    Do Until rs.EOF        If LCase(rs!table_name) = LCase(myNewname) Then            MsgBox "模型<" & myNewname & ">已经存在！请重新输入模型名！",_                vbCritical,"警告"            GoTo begin            Exit Sub        End If        rs.MoveNext    Loop    '生成一个查询表    sql = "select * into " & myNewname & " from " & 模型清单.Text    Set rs = cnn.Execute(sql)    '删除原来的模型    sql = "drop table " & 模型清单.Text    Set rs = cnn.Execute(sql)    MsgBox "成功将模型<" & 模型清单.Text & ">名称改为<" _        & myNewname & ">","模型重命名"    '刷新“模型清单”列表框    Call 获取模型清单    '删除“字段清单”列表框中的项目    字段清单.ClearEnd SubPrivate Sub 字段清单_Click()        Call 获取字段信息End SubPublic Sub 获取字段信息()        Dim sql As String,i As Integer        '查询选择的模型        sql = "select * from " & 模型清单.Text        Set rs = New ADODB.Recordset        rs.Open sql,adOpenKeyset,adLockOptimistic        '将字段名称、类型和大小输出到有关文字框        字段名称.Text = rs.FIElds(字段清单.Text).name        字段类型 = getType(rs.FIElds(字段清单.Text).Type)        字段长度 = rs.FIElds(字段清单.Text).definedSizeEnd SubFunction getType(num)   getType = num   Select Case num     Case "202":       getType = "文本"  'nvarchar(255) 可以  nvarchar 数据类型用作变长的统一编码字符型数据。此数据类型能存储4000种字符，使用的字节空间增加了一倍     Case "203":       getType = "备注"  'ntext(536870910) 可以  ntext 数据类型用来存储大量的统一编码字符型数据。这种数据类型能存储230 -1或将近10亿个字符，且使用的字节空间增加了一倍     Case "3":       getType = "长整型"  'int(4) 不可以  int 数据类型可以存储从- 231(-2147483648)到231 (2147483 647)之间的整数。存储到数据库的几乎所有数值型的数据都可以用这种数据类型。这种数据类型在数据库里占用4个字节     Case "2":       getType = "整型"    'smallint(2)  不可以 smallint 数据类型可以存储从- 215(-32768)到215(32767)之间的整数。这种数据类型对存储一些常限定在特定范围内的数值型数据非常有用。这种数据类型在数据库里占用2 字节空间     Case "17":       getType = "字节"    'tinyint(1)  不可以  tinyint 数据类型能存储从0到255 之间的整数。它在你只打算存储有限数目的数值时很有用。 这种数据类型在数据库中占用1 个字节     Case "4":       getType = "单精浮点"    'real(4)   不可以   real 数据类型像浮点数一样，是近似数值类型。它可以表示数值在-3.40E+38到3.40E+38之间的浮点数     Case "5":       getType = "双精浮点"    'float(8)   不可以  float 数据类型是一种近似数值类型，供浮点数使用。说浮点数是近似的，是因为在其范围内不是所有的数都能精确表示。浮点数可以是从-1.79E+308到1.79E+308 之间的任意数     Case "7":       getType = "日期/时间"   'datetime(8)   不可以 datetime数据类型用来表示日期和时间。这种数据类型存储从1753年1月1日到9999年12月3 1日间所有的日期和时间数据， 精确到三百分之一秒或3.33毫秒     Case "6":       getType = "货币"    'money(8)  不可以  money 数据类型用来表示钱和货币值。这种数据类型能存储从-9220亿到9220 亿之间的数据，精确到货币单位的万分之一     Case "11":       getType = "是/否"    'bit(2)  不可以   bit 数据类型是整型，其值只能是0、1或空值。这种数据类型用于存储只有两种可能值的数据，如Yes 或No、True 或Fa lse 、On 或Off   End SelectEnd Function

Form2：

Private Sub Form_load()        字段字符串.Text = "示例：  字段1 nvarchar(10) primary key,字段2 datetime,字段3 float"End Sub    Private Sub 字段字符串_Enter()        字段字符串.Text = ""    End Sub    Private Sub 取消_Click()        Unload Form2    End Sub    Private Sub 确定_Click()        Dim sql As String        '检查模型库中是否有同名模型        Set rs = cnn.OpenSchema(adSchematables)        Do Until rs.EOF            If LCase(rs!table_name) = LCase(模型名.Text) Then                MsgBox "模型<" & mytable & ">已经存在！请重新输入模型名！"                模型名.Text = ""                模型名.SetFocus                Exit Sub            End If            rs.MoveNext        Loop        '创建模型        sql = "create table " & 模型名.Text & Space(1) & "(" & 字段字符串.Text & ")"        Set rs = cnn.Execute(sql)        MsgBox "模型创建成功！",vbinformation,"创建模型"        Unload Form2    End Sub

Form4：

总结

以上是内存溢出为你收集整理的档案馆模型库系统的VB实现全部内容，希望文章能够帮你解决档案馆模型库系统的VB实现所遇到的程序开发问题。

如果觉得内存溢出网站内容还不错，欢迎将内存溢出网站推荐给程序员好友。