SQL Server SQL语句导入导出大全

SQL Server SQL语句导入导出大全

/******* 导出到excel
EXEC master..xp_cmdshell 'bcp SettleDB.dbo.shanghu out c:/temp1.xls -c -q -S"GNETDATA/GNETDATA" -U"sa" -P""'

/*********** 导入Excel
SELECT *
FROM OpenDataSource( 'Microsoft.Jet.OLEDB.4.0',
'Data Source="c:/test.xls";User ID=Admin;Password=;Extended properties=Excel 5.0')...xactions

/*动态文件名
declare @fn varchar(20),@s varchar(1000)
set @fn = 'c:/test.xls'
set @s ='''Microsoft.Jet.OLEDB.4.0'',
''Data Source="'+@fn+'";User ID=Admin;Password=;Extended properties=Excel 5.0'''
set @s = 'SELECT * FROM OpenDataSource ('+@s+')...sheet1$'
exec(@s)
*/

SELECT cast(cast(科目编号 as numeric(10,2)) as nvarchar(255))+'　' 转换后的别名
FROM OpenDataSource( 'Microsoft.Jet.OLEDB.4.0',
'Data Source="c:/test.xls";User ID=Admin;Password=;Extended properties=Excel 5.0')...xactions

/********************** EXCEL导到远程SQL
insert OPENDATASOURCE(
'SQLOLEDB',
'Data Source=远程ip;User ID=sa;Password=密码'
).库名.dbo.表名 (列名1,列名2)
SELECT 列名1,列名2
FROM OpenDataSource( 'Microsoft.Jet.OLEDB.4.0',
'Data Source="c:/test.xls";User ID=Admin;Password=;Extended properties=Excel 5.0')...xactions

不知道那些写这个语句的强人是怎么做出来，总是提示xactions这个表不存在，I服了u，

下面这个才是可以使用的：

insert OPENDATASOURCE(
'SQLOLEDB',
'Data Source=172.18.136.151;User ID=sa;Password='
).rsxx.dbo.gjj_tgjjip (ZUNIT,ZAP,ZN,ZSFZ,ZTYP,ZRS,ZZJR,ZOAD,ZFLAG,ZZQ)


select 单位账号,个人账号,姓名,身份证号,月缴交额,余额,最后缴交日期+'-01',开户日期,状态,支取金额 from
OPENROWSET('MICROSOFT.JET.OLEDB.4.0'
,'Excel 5.0;HDR=YES;DATABASE=E:/workspace/nuaars/Datacw/new format/New Folder/住房公积金.xls',sheet1$)

/** 导入文本文件
EXEC master..xp_cmdshell 'bcp dbname..tablename in c:/DT.txt -c -Sservername -Usa -Ppassword'

/** 导出文本文件
EXEC master..xp_cmdshell 'bcp dbname..tablename out c:/DT.txt -c -Sservername -Usa -Ppassword'
或
EXEC master..xp_cmdshell 'bcp "Select * from dbname..tablename" queryout c:/DT.txt -c -Sservername -Usa -Ppassword'

导出到TXT文本，用逗号分开
exec master..xp_cmdshell 'bcp "库名..表名" out "d:/tt.txt" -c -t ,-U sa -P password'

导入txt
BULK INSERT 库名..表名
FROM 'c:/test.txt'
WITH (
FIELDTERMINATOR = ';',
ROWTERMINATOR = '/n'
)

--/* dBase IV文件
select * from
OPENROWSET('MICROSOFT.JET.OLEDB.4.0'
,'dBase IV;HDR=NO;IMEX=2;DATABASE=C:/','select * from [客户资料4.dbf]')
--*/

--/* dBase III文件
select * from
OPENROWSET('MICROSOFT.JET.OLEDB.4.0'
,'dBase III;HDR=NO;IMEX=2;DATABASE=C:/','select * from [客户资料3.dbf]')
--*/

--/* FoxPro 数据库
select * from openrowset('MSDASQL',
'Driver=Microsoft Visual FoxPro Driver;SourceType=DBF;SourceDB=c:/',
'select * from [aa.DBF]')
--*/

/**************导入DBF文件****************/
select * from openrowset('MSDASQL',
'Driver=Microsoft Visual FoxPro Driver;
SourceDB=e:/VFP98/data;
SourceType=DBF',
'select * from customer where country != "USA" order by country')
go
/***************** 导出到DBF ***************/
如果要导出数据到已经生成结构(即现存的)FOXPRO表中,可以直接用下面的SQL语句

insert into openrowset('MSDASQL',
'Driver=Microsoft Visual FoxPro Driver;SourceType=DBF;SourceDB=c:/',
'select * from [aa.DBF]')
select * from 表

说明:
SourceDB=c:/ 指定foxpro表所在的文件夹
aa.DBF 指定foxpro表的文件名.

/*************导出到Access********************/
insert into openrowset('Microsoft.Jet.OLEDB.4.0',
'x:/A.mdb';'admin';'',A表) select * from 数据库名..B表

/*************导入Access********************/
insert into B表 selet * from openrowset('Microsoft.Jet.OLEDB.4.0',
'x:/A.mdb';'admin';'',A表)

文件名为参数
declare @fname varchar(20)
set @fname = 'd:/test.mdb'
exec('SELECT a.* FROM opendatasource(''Microsoft.Jet.OLEDB.4.0'',
'''+@fname+''';''admin'';'''', topics) as a ')

SELECT *
FROM OpenDataSource( 'Microsoft.Jet.OLEDB.4.0',
'Data Source="f:/northwind.mdb";Jet OLEDB:Database Password=123;User ID=Admin;Password=;')...产品

********************* 导入 xml　文件

DECLARE @idoc int
DECLARE @doc varchar(1000)
--sample XML document
SET @doc ='
<root>
<Customer cid= "C1" name="Janine" city="Issaquah">
<Order oid="O1" date="1/20/1996" amount="3.5" />
<Order oid="O2" date="4/30/1997" amount="13.4">Customer was very satisfied
</Order>
</Customer>
<Customer cid="C2" name="Ursula" city="Oelde" >
<Order oid="O3" date="7/14/1999" amount="100" note="Wrap it blue
white red">
<Urgency>Important</Urgency>
Happy Customer.
</Order>
<Order oid="O4" date="1/20/1996" amount="10000"/>
</Customer>
</root>
'
-- Create an internal representation of the XML document.
EXEC sp_xml_preparedocument @idoc OUTPUT, @doc

-- Execute a SELECT statement using OPENXML rowset provider.
SELECT *
FROM OPENXML (@idoc, '/root/Customer/Order', 1)
WITH (oid char(5),
amount float,
comment ntext 'text()')
EXEC sp_xml_removedocument @idoc

???????

/**********************Excel导到Txt****************************************/
想用
select * into opendatasource(...) from opendatasource(...)
实现将一个Excel文件内容导入到一个文本文件

假设Excel中有两列，第一列为姓名，第二列为很行帐号(16位)
且银行帐号导出到文本文件后分两部分，前8位和后8位分开。

邹健：
如果要用你上面的语句插入的话,文本文件必须存在,而且有一行:姓名,银行账号1,银行账号2
然后就可以用下面的语句进行插入
注意文件名和目录根据你的实际情况进行修改.

insert into
opendatasource('MICROSOFT.JET.OLEDB.4.0'
,'Text;HDR=Yes;DATABASE=C:/'
)...[aa#txt]
--,aa#txt)
--*/
select 姓名,银行账号1=left(银行账号,8),银行账号2=right(银行账号,8)
from
opendatasource('MICROSOFT.JET.OLEDB.4.0'
,'Excel 5.0;HDR=YES;IMEX=2;DATABASE=c:/a.xls'
--,Sheet1$)
)...[Sheet1$]

如果你想直接插入并生成文本文件,就要用bcp

declare @sql varchar(8000),@tbname varchar(50)

--首先将excel表内容导入到一个全局临时表
select @tbname='[##temp'+cast(newid() as varchar(40))+']'
,@sql='select 姓名,银行账号1=left(银行账号,8),银行账号2=right(银行账号,8)
into '+@tbname+' from
opendatasource(''MICROSOFT.JET.OLEDB.4.0''
,''Excel 5.0;HDR=YES;IMEX=2;DATABASE=c:/a.xls''
)...[Sheet1$]'
exec(@sql)

--然后用bcp从全局临时表导出到文本文件
set @sql='bcp "'+@tbname+'" out "c:/aa.txt" /S"(local)" /P"" /c'
exec master..xp_cmdshell @sql

--删除临时表
exec('drop table '+@tbname)

/********************导整个数据库*********************************************/

用bcp实现的存储过程

/*
实现数据导入/导出的存储过程
根据不同的参数,可以实现导入/导出整个数据库/单个表
调用示例:
--导出调用示例
----导出单个表
exec file2table 'zj','','','xzkh_sa..地区资料','c:/zj.txt',1
----导出整个数据库
exec file2table 'zj','','','xzkh_sa','C:/docman',1

--导入调用示例
----导入单个表
exec file2table 'zj','','','xzkh_sa..地区资料','c:/zj.txt',0
----导入整个数据库
exec file2table 'zj','','','xzkh_sa','C:/docman',0

*/
if exists(select 1 from sysobjects where name='File2Table' and objectproperty(id,'IsProcedure')=1)
drop procedure File2Table
go
create procedure File2Table
@servername varchar(200) --服务器名
,@username varchar(200) --用户名,如果用NT验证方式,则为空''
,@password varchar(200) --密码
,@tbname varchar(500) --数据库.dbo.表名,如果不指定:.dbo.表名,则导出数据库的所有用户表
,@filename varchar(1000) --导入/导出路径/文件名,如果@tbname参数指明是导出整个数据库,则这个参数是文件存放路径,文件名自动用表名.txt
,@isout bit --1为导出,0为导入
as
declare @sql varchar(8000)

if @tbname like '%.%.%' --如果指定了表名,则直接导出单个表
begin
set @sql='bcp '+@tbname
+case when @isout=1 then ' out ' else ' in ' end
+' "'+@filename+'" /w'
+' /S '+@servername
+case when isnull(@username,'')='' then '' else ' /U '+@username end
+' /P '+isnull(@password,'')
exec master..xp_cmdshell @sql
end
else
begin --导出整个数据库,定义游标,取出所有的用户表
declare @m_tbname varchar(250)
if right(@filename,1)<>'/' set @filename=@filename+'/'

set @m_tbname='declare #tb cursor for select name from '+@tbname+'..sysobjects where xtype=''U'''
exec(@m_tbname)
open #tb
fetch next from #tb into @m_tbname
while @@fetch_status=0
begin
set @sql='bcp '+@tbname+'..'+@m_tbname
+case when @isout=1 then ' out ' else ' in ' end
+' "'+@filename+@m_tbname+'.txt " /w'
+' /S '+@servername
+case when isnull(@username,'')='' then '' else ' /U '+@username end
+' /P '+isnull(@password,'')
exec master..xp_cmdshell @sql
fetch next from #tb into @m_tbname
end
close #tb
deallocate #tb
end
go

/************* Oracle **************/
EXEC sp_addlinkedserver 'OracleSvr',
'Oracle 7.3',
'MSDAORA',
'ORCLDB'
GO

delete from openquery(mailser,'select * from yulin')

select * from openquery(mailser,'select * from yulin')

update openquery(mailser,'select * from yulin where id=15')set disorder=555,catago=888

insert into openquery(mailser,'select disorder,catago from yulin')values(333,777)

补充：

对于用bcp导出,是没有字段名的.

用openrowset导出,需要事先建好表.

用openrowset导入,除ACCESS及EXCEL外,均不支持非本机数据导入

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~



简介：微软SQL Server数据库SQL语句导入导出大全，包括与其他数据库和文件的数据的导入导出。
/******* 导出到excel
EXEC master..xp_cmdshell ’bcp SettleDB.dbo.shanghu out c:/temp1.xls -c -q -S"GNETDATA/GNETDATA" -U"sa" -P""’
/*********** 导入Excel
SELECT *
FROM OpenDataSource( ’Microsoft.Jet.OLEDB.4.0’,
’Data Source="c:/test.xls";User ID=Admin;Password=;Extended properties=Excel 5.0’)...xactions
SELECT cast(cast(科目编号 as numeric(10,2)) as nvarchar(255))+’　’ 转换后的别名
FROM OpenDataSource( ’Microsoft.Jet.OLEDB.4.0’,
’Data Source="c:/test.xls";User ID=Admin;Password=;Extended properties=Excel 5.0’)...xactions
/** 导入文本文件
EXEC master..xp_cmdshell ’bcp "dbname..tablename" in c:/DT.txt -c -Sservername -Usa -Ppassword’
/** 导出文本文件
EXEC master..xp_cmdshell ’bcp "dbname..tablename" out c:/DT.txt -c -Sservername -Usa -Ppassword’
或
EXEC master..xp_cmdshell ’bcp "Select * from dbname..tablename" queryout c:/DT.txt -c -Sservername -Usa -Ppassword’
导出到TXT文本，用逗号分开
exec master..xp_cmdshell ’bcp "库名..表名" out "d:/tt.txt" -c -t ,-U sa -P password’
BULK INSERT 库名..表名
FROM ’c:/test.txt’
WITH (
FIELDTERMINATOR = ’;’,
ROWTERMINATOR = ’/n’
)
--/* dBase IV文件
select * from
OPENROWSET(’MICROSOFT.JET.OLEDB.4.0’
,’dBase IV;HDR=NO;IMEX=2;DATABASE=C:/’,’select * from [客户资料4.dbf]’)
--*/
--/* dBase III文件
select * from
OPENROWSET(’MICROSOFT.JET.OLEDB.4.0’
,’dBase III;HDR=NO;IMEX=2;DATABASE=C:/’,’select * from [客户资料3.dbf]’)
--*/
--/* FoxPro 数据库
select * from openrowset(’MSDASQL’,
’Driver=Microsoft Visual FoxPro Driver;SourceType=DBF;SourceDB=c:/’,
’select * from [aa.DBF]’)
--*/
/**************导入DBF文件****************/
select * from openrowset(’MSDASQL’,
’Driver=Microsoft Visual FoxPro Driver;
SourceDB=e:/VFP98/data;
SourceType=DBF’,
’select * from customer where country != "USA" order by country’)
go
/***************** 导出到DBF ***************/
如果要导出数据到已经生成结构(即现存的)FOXPRO表中,可以直接用下面的SQL语句
insert into openrowset(’MSDASQL’,
’Driver=Microsoft Visual FoxPro Driver;SourceType=DBF;SourceDB=c:/’,
’select * from [aa.DBF]’)
select * from 表
说明:
SourceDB=c:/ 指定foxpro表所在的文件夹
aa.DBF 指定foxpro表的文件名.
/*************导出到Access********************/
insert into openrowset(’Microsoft.Jet.OLEDB.4.0’,
’x:/A.mdb’;’admin’;’’,A表) select * from 数据库名..B表
/*************导入Access********************/
insert into B表 selet * from openrowset(’Microsoft.Jet.OLEDB.4.0’,
’x:/A.mdb’;’admin’;’’,A表)
********************* 导入 xml　文件
DECLARE @idoc int
DECLARE @doc varchar(1000)
--sample XML document
SET @doc =’
<root>
<Customer cid= "C1" name="Janine" city="Issaquah">
<Order oid="O1" date="1/20/1996" amount="3.5" />
<Order oid="O2" date="4/30/1997" amount="13.4">Customer was very satisfied
</Order>
</Customer>
<Customer cid="C2" name="Ursula" city="Oelde" >
<Order oid="O3" date="7/14/1999" amount="100" note="Wrap it blue
white red">
<Urgency>Important</Urgency>
Happy Customer.
</Order>
<Order oid="O4" date="1/20/1996" amount="10000"/>
</Customer>
</root>
’
-- Create an internal representation of the XML document.
EXEC sp_xml_preparedocument @idoc OUTPUT, @doc
-- Execute a SELECT statement using OPENXML rowset provider.
SELECT *
FROM OPENXML (@idoc, ’/root/Customer/Order’, 1)
WITH (oid char(5),
amount float,
comment ntext ’text()’)
EXEC sp_xml_removedocument @idoc
/********************导整个数据库*********************************************/
用bcp实现的存储过程
/*
实现数据导入/导出的存储过程
根据不同的参数,可以实现导入/导出整个数据库/单个表
调用示例:
--导出调用示例
----导出单个表
exec file2table ’zj’,’’,’’,’xzkh_sa..地区资料’,’c:/zj.txt’,1
----导出整个数据库
exec file2table ’zj’,’’,’’,’xzkh_sa’,’C:/docman’,1
--导入调用示例
----导入单个表
exec file2table ’zj’,’’,’’,’xzkh_sa..地区资料’,’c:/zj.txt’,0
----导入整个数据库
exec file2table ’zj’,’’,’’,’xzkh_sa’,’C:/docman’,0
*/
if exists(select 1 from sysobjects where name=’File2Table’ and objectproperty(id,’IsProcedure’)=1)
drop procedure File2Table
go
create procedure File2Table
@servername varchar(200) --服务器名
,@username varchar(200) --用户名,如果用NT验证方式,则为空’’
,@password varchar(200) --密码
,@tbname varchar(500) --数据库.dbo.表名,如果不指定:.dbo.表名,则导出数据库的所有用户表
,@filename varchar(1000) --导入/导出路径/文件名,如果@tbname参数指明是导出整个数据库,则这个参数是文件存放路径,文件名自动用表名.txt
,@isout bit --1为导出,0为导入
as
declare @sql varchar(8000)
if @tbname like ’%.%.%’ --如果指定了表名,则直接导出单个表
begin
set @sql=’bcp ’+@tbname
+case when @isout=1 then ’ out ’ else ’ in ’ end
+’ "’+@filename+’" /w’
+’ /S ’+@servername
+case when isnull(@username,’’)=’’ then ’’ else ’ /U ’+@username end
+’ /P ’+isnull(@password,’’)
exec master..xp_cmdshell @sql
end
else
begin --导出整个数据库,定义游标,取出所有的用户表
declare @m_tbname varchar(250)
if right(@filename,1)<>’/’ set @filename=@filename+’/’
set @m_tbname=’declare #tb cursor for select name from ’+@tbname+’..sysobjects where xtype=’’U’’’
exec(@m_tbname)
open #tb
fetch next from #tb into @m_tbname
while @@fetch_status=0
begin
set @sql=’bcp ’+@tbname+’..’+@m_tbname
+case when @isout=1 then ’ out ’ else ’ in ’ end
+’ "’+@filename+@m_tbname+’.txt " /w’
+’ /S ’+@servername
+case when isnull(@username,’’)=’’ then ’’ else ’ /U ’+@username end
+’ /P ’+isnull(@password,’’)
exec master..xp_cmdshell @sql
fetch next from #tb into @m_tbname
end
close #tb
deallocate #tb
end
go

/**********************Excel导到Txt****************************************/
想用
select * into opendatasource(...) from opendatasource(...)
实现将一个Excel文件内容导入到一个文本文件
假设Excel中有两列，第一列为姓名，第二列为很行帐号(16位)
且银行帐号导出到文本文件后分两部分，前8位和后8位分开。
如果要用你上面的语句插入的话,文本文件必须存在,而且有一行:姓名,银行账号1,银行账号2
然后就可以用下面的语句进行插入
注意文件名和目录根据你的实际情况进行修改.
insert into
opendatasource(’MICROSOFT.JET.OLEDB.4.0’
,’Text;HDR=Yes;DATABASE=C:/’
)...[aa#txt]
--,aa#txt)
--*/
select 姓名,银行账号1=left(银行账号,8),银行账号2=right(银行账号,8)
from
opendatasource(’MICROSOFT.JET.OLEDB.4.0’
,’Excel 5.0;HDR=YES;IMEX=2;DATABASE=c:/a.xls’
--,Sheet1$)
)...[Sheet1$]
如果你想直接插入并生成文本文件,就要用bcp
declare @sql varchar(8000),@tbname varchar(50)
--首先将excel表内容导入到一个全局临时表
select @tbname=’[##temp’+cast(newid() as varchar(40))+’]’
,@sql=’select 姓名,银行账号1=left(银行账号,8),银行账号2=right(银行账号,8)
into ’+@tbname+’ from
opendatasource(’’MICROSOFT.JET.OLEDB.4.0’’
,’’Excel 5.0;HDR=YES;IMEX=2;DATABASE=c:/a.xls’’
)...[Sheet1$]’
exec(@sql)
--然后用bcp从全局临时表导出到文本文件
set @sql=’bcp "’+@tbname+’" out "c:/aa.txt" /S"(local)" /P"" /c’
exec master..xp_cmdshell @sql
--删除临时表
exec(’drop table ’+@tbname)
用bcp将文件导入导出到数据库的存储过程:
/*--bcp-二进制文件的导入导出
支持image,text,ntext字段的导入/导出
image适合于二进制文件;text,ntext适合于文本数据文件
注意:导入时,将覆盖满足条件的所有行
导出时,将把所有满足条件的行也出到指定文件中
此存储过程仅用bcp实现
邹建 2003.08-----------------*/
/*--调用示例
--数据导出
exec p_binaryIO ’zj’,’’,’’,’acc_演示数据..tb’,’img’,’c:/zj1.dat’
--数据导出
exec p_binaryIO ’zj’,’’,’’,’acc_演示数据..tb’,’img’,’c:/zj1.dat’,’’,0
--*/
if exists (select * from dbo.sysobjects where id = object_id(N’[dbo].[p_binaryIO]’) and OBJECTPROPERTY(id, N’IsProcedure’) = 1)
drop procedure [dbo].[p_binaryIO]
GO
Create proc p_binaryIO
@servename varchar (30),--服务器名称
@username varchar (30), --用户名
@password varchar (30), --密码
@tbname varchar (500), --数据库..表名
@fdname varchar (30), --字段名
@fname varchar (1000), --目录+文件名,处理过程中要使用/覆盖:@filename+.bak
@tj varchar (1000)=’’, --处理条件.对于数据导入,如果条件中包含@fdname,请指定表名前缀
@isout bit=1 --1导出((默认),0导入
AS
declare @fname_in varchar(1000) --bcp处理应答文件名
,@fsize varchar(20) --要处理的文件的大小
,@m_tbname varchar(50) --临时表名
,@sql varchar(8000)
--则取得导入文件的大小
if @isout=1
set @fsize=’0’
else
begin
create table #tb(可选名 varchar(20),大小 int
,创建日期 varchar(10),创建时间 varchar(20)
,上次写操作日期 varchar(10),上次写操作时间 varchar(20)
,上次访问日期 varchar(10),上次访问时间 varchar(20),特性 int)
insert into #tb
exec master..xp_getfiledetails @fname
select @fsize=大小 from #tb
drop table #tb
if @fsize is null
begin
print ’文件未找到’
return
end
end

--生成数据处理应答文件
set @m_tbname=’[##temp’+cast(newid() as varchar(40))+’]’
set @sql=’select * into ’+@m_tbname+’ from(
select null as 类型
union all select 0 as 前缀
union all select ’+@fsize+’ as 长度
union all select null as 结束
union all select null as 格式
) a’
exec(@sql)
select @fname_in=@fname+’_temp’
,@sql=’bcp "’+@m_tbname+’" out "’+@fname_in
+’" /S"’+@servename
+case when isnull(@username,’’)=’’ then ’’
else ’" /U"’+@username end
+’" /P"’+isnull(@password,’’)+’" /c’
exec master..xp_cmdshell @sql
--删除临时表
set @sql=’drop table ’+@m_tbname
exec(@sql)
if @isout=1
begin
set @sql=’bcp "select top 1 ’+@fdname+’ from ’
+@tbname+case isnull(@tj,’’) when ’’ then ’’
else ’ where ’+@tj end
+’" queryout "’+@fname
+’" /S"’+@servename
+case when isnull(@username,’’)=’’ then ’’
else ’" /U"’+@username end
+’" /P"’+isnull(@password,’’)
+’" /i"’+@fname_in+’"’
exec master..xp_cmdshell @sql
end
else
begin
--为数据导入准备临时表
set @sql=’select top 0 ’+@fdname+’ into ’
+@m_tbname+’ from ’ +@tbname
exec(@sql)
--将数据导入到临时表
set @sql=’bcp "’+@m_tbname+’" in "’+@fname
+’" /S"’+@servename
+case when isnull(@username,’’)=’’ then ’’
else ’" /U"’+@username end
+’" /P"’+isnull(@password,’’)
+’" /i"’+@fname_in+’"’
exec master..xp_cmdshell @sql

--将数据导入到正式表中
set @sql=’update ’+@tbname
+’ set ’+@fdname+’=b.’+@fdname
+’ from ’+@tbname+’ a,’
+@m_tbname+’ b’
+case isnull(@tj,’’) when ’’ then ’’
else ’ where ’+@tj end
exec(@sql)
--删除数据处理临时表
set @sql=’drop table ’+@m_tbname
end
--删除数据处理应答文件
set @sql=’del ’+@fname_in
exec master..xp_cmdshell @sql
go

/** 导入文本文件
EXEC master..xp_cmdshell ’bcp "dbname..tablename" in c:/DT.txt -c -Sservername -Usa -Ppassword’
改为如下，不需引号
EXEC master..xp_cmdshell ’bcp dbname..tablename in c:/DT.txt -c -Sservername -Usa -Ppassword’
/** 导出文本文件
EXEC master..xp_cmdshell ’bcp "dbname..tablename" out c:/DT.txt -c -Sservername -Usa -Ppassword’
此句需加引号
posted on 2005-03-26 17:10 xiaoyucn 阅读(4462)
5:09添加评论固定链接引用通告 (0)记录它
9月6日
后台调用外部程序的完美实现

后台调用外部程序的完美实现

最近在做的一个软件，其中有一部分功能需要调用其它的软件来完成，而那个软件只有可执行文件，根本没有源代码，幸好，我要做的事不难，只需要在我的程序启动后，将那个软件打开，在需要的时候，对其中的一个文本矿设置一些文字，再点击一个按钮就可以了。

说到这里，相信你也有了对该功能的一些初步设想了，没错，其基本思路就是：
1）调用CreateProcess（）打开目标程序。
2）用FindWindow（）找到目标程序的窗口Handle。
3）找到文本框的Handle，以及按钮的MessageID，用SendMessage（）方法设置文字，并触发事件。

好了，这样确实很简单吧，但是当我实现它后，却发现这样做的结果则是：当我的程序启动并打开目标程序时，它的Splash窗口，以及主窗口都将显示出来，即使当我用FindWindow（）找到主窗口Handle后，调用SendMessage（WindowHandle， SW_HIDE）来隐藏该窗口，还是会有一瞬主窗口被显示出来的，这样的效果实在是最求完美的我不忍心看到的。

那么怎么解决这个问题呢，首先我当然在CreateProcess（）上面寻找方法，可惜，它只有一个参数可以设置窗口的默认显示方式，但是一旦这个窗口自己重设了显示方式，它就没有任何作用了。。。。继续查找文档，这时我看到CreateProcess（）的一个参数TStartupInfo中有 lpDesktop这么一个属性，按照MSDN的说法，如果该指针为NULL，那么新建的Process将在当前Desktop上启动，而如果对其赋了一个Desktop的名称后，Process将在指定的Desktop上启动，恩，看来不错，就从它入手了：

1）首先，建立一个虚拟的Desktop，
const
DesktopName = ''MYDESK'';

FDesktop:=CreateDesktop(DesktopName,nil,nil,0,GENERIC_ALL,nil);
Windows中可以建立多个Desktop，可以使用SwitchDesktop（）来切换哪个Desktop被显示出来，以前有过将Windows模拟成Linux的形式，可以在多个虚拟Desktop中切换的程序，其实那种程序也是用的Windows本身的虚拟Desktop功能来实现的，另外 Windows的启动画面，以及屏保画面也都是用虚拟Desktop实现的，好了，关于这方面不多介绍了，感兴趣的话，可以到MSDN中查看更详细资料：
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dllproc/base/enumdesktops.asp

2）在CreateProcess的时候，指定程序在我新生成的Desktop上运行：
var
StartInfo:TStartupInfo;

FillChar(StartInfo, sizeof(StartInfo), 0);
StartInfo.cb:=sizeof(StartInfo);
StartInfo.lpDesktop:=PChar(DesktopName); //指定Desktop的名称即可
StartInfo.wShowWindow:=SW_HIDE;
StartInfo.dwFlags:=STARTF_USESHOWWINDOW;
StartInfo.hStdError:=0;
StartInfo.hStdInput:=0;
StartInfo.hStdOutput:=0;
if not CreateProcess(PChar(FileName),nil,nil,nil,true,CREATE_NEW_CONSOLE+HIGH_PRIORITY_CLASS,nil,PChar(ExtractFilePath(FilePath)),StartInfo,FProceInfo) then begin
MessageBox(Application.Handle,''Error when init voice (5).'',PChar(Application.Title),MB_ICONWARNING);
exit;
end;

3）用FindWindow去找程序的主窗口
开始我直接写下了这样的代码：
for I:=0 to 60 do begin //wait 30 seconds for open the main window
WindowHandle:=FindWindow(nil,''WindowCaption'');
if WindowHandle<>0 then begin
break;
end;
Sleep(500);
end;
但是，实践证明，这样是找不到不在当前Desktop中的Window的，那怎么办呢：
答案是，可以用SetThreadDesktop（）函数，这个函数可以设置当前Thread工作所在的Desktop，于是我在以上代码前又加了一句：
if not SetThreadDesktop(FDesktop) then begin
exit;
end;
但是，程序运行后，该函数却返回了false，说明方法调用失败了，再仔细看MSDN，发现有这么一句话：

The SetThreadDesktop function will fail if the calling thread has any windows or hooks on its current desktop (unless the hDesktop parameter is a handle to the current desktop).

哦，原来需要切换Desktop的线程中不能有任何UI方面的东西，而我是在程序的主线程中调用该方法的，当然会失败拉，知道了这点就好办了，我只需要用一个“干净”的线程，让它绑定到新的Desktop上，再让它用FindWindow（）方法找到我要找的WindowHandle，不就可以了吗，于是，这一步就需要借助一个线程了，线程的代码如下：

TFindWindowThread = class(TThread)
private
FDesktop:THandle;
FWindowHandle:THandle;
protected
procedure Execute();override;
public
constructor Create(ACreateSuspended:Boolean;const ADesktop:THandle);reintroduce;
property WindowHandle:THandle read FWindowHandle;
end;

{ TFindWindowThread }

procedure TFindWindowThread.Execute();
var
I:Integer;
begin
//make the current thread find window on the new desktop!
if not SetThreadDesktop(FDesktop) then begin
exit;
end;
for I:=0 to 60 do begin //wait 30 seconds for open the main window
FWindowHandle:=FindWindow(nil,PChar(''WindowCaption''));
if FWindowHandle<>0 then begin
break;
end;
Sleep(500);
end;
end;

constructor TFindWindowThread.Create(ACreateSuspended:Boolean;const ADesktop:THandle);
begin
inherited Create(ACreateSuspended);
FDesktop:=ADesktop;
end;

而主程序中的代码变成这样：
FindWindowThread:=TFindWindowThread.Create(false,FDesktop);
try
FindWindowThread.WaitFor;
FMainWindowHandle:=FindWindowThread.WindowHandle;
finally
FindWindowThread.Free;
end;
if FMainWindowHandle=0 then begin
MessageBox(Application.Handle,''Error when init voice (6).'',PChar(Application.Title),MB_ICONWARNING);
exit;
end;

呵呵，成功，这样果然可以顺利的找到窗口Handle了。

4）最后，再用这个主窗口Handle，找出里面的EditBox的Handle，如这样：
FEditWindow:=FindWindowEx(FMainWindowHandle,0,PChar(''Edit''),nil);
我在这里指定了这个文本框的ClassName，这个名称可以用Spy＋＋得到。

初始化的工作就到此结束了，如果顺利，程序就真正在后台被运行了起来。那么功能调用呢，还是和一般的做法一样：

if (FMainWindowHandle=0) or (FEditWindow=0) then begin
exit;
end;
SendMessage(FEditWindow,WM_SETTEXT,0,LongInt(@AText[1]));
SendMessage(FMainWindowHandle,WM_COMMAND,$8012,$0);
其中$8012这个数字，也是用Spy＋＋来得到的资源ID。

最后，别忘了关闭程序，以及释放虚拟Desktop：
if FProceInfo.hProcess<>0 then begin
TerminateProcess(FProceInfo.hProcess,0);
end;
if FDesktop<>0 then begin
CloseDesktop(FDesktop);
end;

好了，这样就几乎完美的实现了一个后台调用程序的功能，它对最终客户来说将是完全透明的，客户根本感觉不到后台还有另一个程序在工作。是不是很爽啊，这样别人的很多程序我们都可以直接拿来用了（当然了，得在遵守版权的基础上才行拉）。

18:01添加评论固定链接阅读评论 (3)引用通告 (0)记录它
Delphi的“动态窗体”技术实际应用

Delphi的“动态窗体”技术实际应用

在Delphi可视化设计环境中，允许程序员在代码编辑器中以文本的方式浏览和修改DFM文件内容。当用File/Open命令直接打开DFM文件或者选择窗体设计窗口的弹出式菜单上的View as Text命令时，就会在编辑器中出现文本形式的信息。在一些资料中将这种文本形式称之为窗体设计脚本。Delphi提供的这种脚本编辑功能是对Delphi可视化设计的一大补充。当然这个脚本编辑能力是有限制的，比方说不能在脚本任意地添加和删除部件，因为代码和DFM脚本是紧密相连的，任意添加和修改会导致不一致性。但在动态生成的DFM文件中，就不存在这一限制。
　　实际上，DFM文件内容是二进制数据，它的脚本是经过Delphi开发环境自动转化的，而且Delphi VCL中的Classes库单元提供了在二进制流中的文件DFM和它的脚本之相互转化的过程。它们是ObjectBinaryToText和ObjectTextToBinary、ObjectResourceToText和ObjectTextToResource。
　　ObjectBinaryToText过程将二进制流中存储的部件转化为基于文本的表现形式，这样就可以用文本处理函数进行处理，还可以用文本编辑器进行查找和替代操作，最后可以将文本再转化成二进制流中的部件。
　　ObjectTextToBinary过程执行的功能与ObjectBinaryToText相反，将TXT文件转换为二进制流中的部件，而且只要TXT文件内容的书写符合DFM脚本语法，ObjectTextToBinary可将任何程序生成的TXT文件转换为部件，这一功能也为DFM文件的动态生成和编辑奠定了基础。

如何在运行过程中将本窗体保存成一个文本格式的.dfm文件？
zswang(伴水)　(2001-11-21 9:52:59) 得0分
function ComponentToString(Component: TComponent): string;
var
BinStream: TMemoryStream;
StrStream: TStringStream;
s: string;
begin
BinStream := TMemoryStream.Create;
try
StrStream := TStringStream.Create(s);
try
BinStream.WriteComponent(Component);
BinStream.Seek(0, soFromBeginning);
ObjectBinaryToText(BinStream, StrStream);
StrStream.Seek(0, soFromBeginning);
Result := StrStream.DataString;
finally
StrStream.Free;
end;
finally
BinStream.Free
end;
end; { ComponentToString }
function StringToComponent(Value: string; Instance: TComponent): TComponent;
var
StrStream: TStringStream;
BinStream: TMemoryStream;
begin
StrStream := TStringStream.Create(Value);
try
BinStream := TMemoryStream.Create;
try
ObjectTextToBinary(StrStream, BinStream);
BinStream.Seek(0, soFromBeginning);
Result := BinStream.ReadComponent(Instance);
finally
BinStream.Free;
end;
finally
StrStream.Free;
end;
end; { StringToComponent }
　
回复人：　zswang(伴水)　(2001-11-21 9:54:28) 得0分
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Text := ComponentToString(Self);
end;
　
回复人：　zswang(伴水)　(2001-11-21 9:58:13) 得0分
procedure TForm1.Button2Click(Sender: TObject);
begin
StringToComponent(
''object Label1: TLabel''#13#10 +
'' Left = 232''#13#10 +
'' Top = 56''#13#10 +
'' Width = 26''#13#10 +
'' Height = 13''#13#10 +
'' Caption = #20320#22909''#13#10 +
'' Font.Charset = GB2312_CHARSET''#13#10 +
'' Font.Color = clRed''#13#10 +
'' Font.Height = -13''#13#10 +
'' Font.Name = #23435#20307''#13#10 +
'' Font.Style = []''#13#10 +
'' ParentFont = False''#13#10 +
''end''#13#10, Label1);
end;
//要注册类
＝＝end＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
好了，理解了上面的这段文字，一些朋友就会自然想到，利用这几个函数应该可以弄出点有用的东西出来，我就弄出了一点应用，并全面应用到了项目中，现在我来给大家完整描述出来：

首先我要求我的程序有如下能力：
1. 我的程序的窗体是可以动态替换的，不用编译Exe，只要替换一个DFM窗体设计脚本就可以了（当然，你可以重新包装一下这个DFM文件，比如换成txt后缀名等）。
2. 我可以预览所有的DFM文件，让它变成实际的Form察看。
不要小看这两点，在很多情况下，这意义非常重大，举几个例子①开发阶段，可以把界面设计和程序设计完全分开，分工进行②现场维护时，有些界面的调整和功能设置不需要再找源代码到Delphi下去编译一遍了，老出差做Mis类的朋友应该能从这点体会出好处③某些功能界面的升级简单了不少，只要让用户下载一个DFM文件覆盖原来的就可以了。
好，不费话了，下面详细说明怎么达到以上两点要求。
显然我们要让一段文本变成一个Form，那么就用这个函数：
function StringToComponent(Value: string; Instance:TComponent): TComponent;
var
StrStream:TStringStream;
BinStream: TMemoryStream;
begin
StrStream := TStringStream.Create(Value);
try
BinStream := TMemoryStream.Create;
try
ObjectTextToBinary(StrStream, BinStream);
BinStream.Seek(0, soFromBeginning);
Result := BinStream.ReadComponent(Instance);
finally
BinStream.Free;
end;
finally
StrStream.Free;
end;
end;
但是，所有的Class必须是注册过的，例如，如下的Form1FRM.DFM文件
object Form1: TForm1
Left = 222
Top = 168
Width = 485
Height = 290
Caption = ''Form1''
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = ''MS Sans Serif''
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 0
Top = 0
Width = 477
Height = 33
Align = alTop
TabOrder = 0
object BitBtn1: TBitBtn
Left = 4
Top = 4
Width = 75
Height = 25
Caption = ''OK''
TabOrder = 0
end
end
object Memo1: TMemo
Left = 0
Top = 33
Width = 477
Height = 230
Align = alClient
TabOrder = 1
end
end
你应该这么使用，
var list:TstringList;form:TForm
…
list.Lines.LoadFromFile(‘Form1FRM.DFM’);
RegisterClass(TForm1);
RegisterClass(TPanel);
RegisterClass(TBitBtn);
RegisterClass(TMemo);
form := StringToComponent(list.Lines.Text,nil);
form.ShowModal();
…
这样就能显示出一个窗体了。
但是这有个问题，Delphi自带的VCL控件是固定的，用RegisterClass（…）注册一遍没有问题，可TForm1不是，如果连TForm1都要注册的话，就无法达成第2点要求。我们可以变通一下，因为所有的Form都是从Tform继承的，所以，应该都可以用注册Tform来取代，因此，有了下面这样一个函数：
function LoadTextForm(FileName:String):TForm;
var
list:TStrings;
FirstLine:String;
iPos : Integer;
Form : TForm;
begin
Result := nil;
if FileExists(FileName)=False then
Exit;
Form := TForm.Create(Application);
list := TStringList.Create;
try
list.LoadFromFile(FileName);
if list.Count=0 then
Exit;
FirstLine := list[0];
iPos := Pos('': '',FirstLine);
if iPos = 0 then //找不到'': ''，格式不对
Exit;
list[0]:=Copy(FirstLine,1,iPos)+'' TForm'';
DeleteErrorLines(list);
StringToComponent(list.Text,Form);
Result := Form;
except
Form.Free;
Result := nil;
end;
list.Free;
end;
原理就是读入DFM文件后把窗体的类别偷换成Tform。其中还有一个函数：
procedure DeleteErrorLines(list:TStrings);
var
i:Integer;
line:String;
begin
if list.Count=0 then
Exit;

i:=0;
while i<list.Count do
begin
line := Trim(list[i]);
if Copy(line,1,2)=''On'' then
list.Delete(i)
else
Inc(i);
end;
end;
这个函数是把凡是含有“On”开头的行删除，应为在Delphi中，所有控件的事件都是以“On”开头，删除了这样的行，就能保证StringToComponent(list.Text,Form);不出错，用以上的两个函数就可以写一个DFM窗体察看器了，到目前为止，我还没有搜到哪个人发布了DFM窗体察看器。这样我们就完成了第2个要求。

实际应用中，一个窗体几乎肯定会有事件处理函数，所以我们要达成第1个要求。我这儿提供了两个方案，各有优缺点：
方案一：
程序员在开发时，在窗体的FormCreate（…）中，用LoadTextForm（…）生成窗体文件，然后把窗体上的控件全部移到本窗体上，最后查找窗体上的控件，动态设置事件处理函数。这个方法要求有一套好的控件命名规则，而且开发比较烦琐，享受不到Delphi的IDE所见即所得，自动生成事件关联代码的好处了。不过对Form文件的制作人员限制很小，他们可以直接用Delphi来制作窗体。
方案二：
用这个函数
procedure ReadForm(aFrom : TComponent;aFileName :string='''');
var
FrmStrings : TStrings;
begin
RegisterClass(TPersistentClass(aFrom.ClassType));
FrmStrings:=TStringlist.Create ;
try
if trim(aFileName)='''' then FrmStrings.LoadFromFile( gsPathInfo+''/''+aFrom.Name+''.txt'')
else FrmStrings.LoadFromFile(aFileName);
while aFrom.ComponentCount>0 do aFrom.Components[0].Destroy ;
aFrom:=StringToComponent(FrmStrings.Text,aFrom)
finally
FrmStrings.Free;
end;
UnRegisterClass(TPersistentClass(aFrom.ClassType));
end;
在FormCreate中调用ReadForm（self，…）。
这个方案没有第一个方案的限制，但是要求开发人员必须先完成一个完整的Form文件交给Form文件制作人员， Form文件的制作人员不能修改控件的name，不能添加或删除控件，而且必须保留开发人员给定所有事件处理函数，不能修改函数名。不过很多问题可以写一个Form编辑器来保证不出问题。
具体代码就不写了。
我想，肯定还有跟好的方案来解决动态窗体的问题，希望大家讨论。
（以上代码使用Delphi6编写）
最后，我给出一个我实际项目中的有关动态窗体的函数的Unit
{*****************************************
模块编号：J001DfmFunc
模块名称：Dfm窗体函数集单元
作者：刘爱军
建立日期：2002年12月2日
最后修改日期：
说明：本Unit包含了一些函数，用于根据Delphi窗体文件格式的文件动态创建窗体
*******************************************}

unit J001DfmFunc;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, DBCtrls, Grids, DBGrids, Buttons, StdCtrls,
ComCtrls,dbcgrids, buttonComps,Tabs,QryGlobal;

type
TAllComponentClass = Array of TPersistentClass;

procedure InitClassType(ClassArray:TAllComponentClass);

function ComponentToString(Component: TComponent): string;
function StringToComponent(Value: string; Instance:TComponent): TComponent;
procedure RegisterAllClasses(aAllCmpClass:TAllComponentClass);
procedure UnRegisterAllClasses(aAllCmpClass:TAllComponentClass);
function GetObjectString(list:TStrings;BegLine:Integer=0;TypeString:string=''''):string;
function LoadTextForm(FileName:String):TForm;
function LoadTextForm2(FileName:String;out ErrMsg:string):TForm;
procedure DeleteErrorLines(list:TStrings);
procedure ReadForm(aFrom : TComponent;aFileName :string='''');
const
RegisteredCompoentClassCount = 32;//数组大小

var
AllCmpClass : TAllComponentClass; //存放控件类

implementation

//初始化可以解析的类，可随需要增加
procedure InitClassType(ClassArray:TAllComponentClass);
begin
SetLength(AllCmpClass,RegisteredCompoentClassCount);
AllCmpClass[0] := TForm;
AllCmpClass[1] := TGroupBox;
AllCmpClass[2] := TPanel;
AllCmpClass[3] := TScrollBox;
AllCmpClass[4] := TLabel;
AllCmpClass[5] := TButton;
AllCmpClass[6] := TBitBtn;
AllCmpClass[7] := TSpeedButton;
AllCmpClass[8] := TStringGrid;
AllCmpClass[9] := TImage;
AllCmpClass[10] := TBevel;
AllCmpClass[11] := TStaticText;
AllCmpClass[12] := TTabControl;
AllCmpClass[13] := TPageControl;
AllCmpClass[14] := TTabSheet;
AllCmpClass[15] := TDBNavigator;
AllCmpClass[16] := TDBText;
AllCmpClass[17] := TDBEdit;
AllCmpClass[18] := TDBMemo;
AllCmpClass[19] := TDBGrid;
AllCmpClass[20] := TDBCtrlGrid;
AllCmpClass[21] := TMemo;
AllCmpClass[22] := TSplitter;
AllCmpClass[23] := TCheckBox;
AllCmpClass[24] := TEdit;
AllCmpClass[25] := TListBox;
AllCmpClass[26] := TComboBox;
AllCmpClass[27] := TDateTimePicker;
AllCmpClass[28] := TImageButton;
AllCmpClass[29] := TTabSet;
AllCmpClass[30] := TTreeView;
AllCmpClass[31] := TListView;

end;

procedure RegisterAllClasses(aAllCmpClass:TAllComponentClass);
var
i:Integer;
begin
for i:=0 to RegisteredCompoentClassCount-1 do
RegisterClass(aAllCmpClass[i]);
end;

procedure UnRegisterAllClasses(aAllCmpClass:TAllComponentClass);
var
i:Integer;
begin
for i:=0 to RegisteredCompoentClassCount-1 do
UnRegisterClass(aAllCmpClass[i]);
end;

function ComponentToString(Component: TComponent): string;
var
BinStream:TMemoryStream;
StrStream: TStringStream;
s: string;
begin
BinStream := TMemoryStream.Create;
try
StrStream := TStringStream.Create(s);
try
BinStream.WriteComponent(Component);
BinStream.Seek(0, soFromBeginning);
ObjectBinaryToText(BinStream, StrStream);
StrStream.Seek(0, soFromBeginning);
Result:= StrStream.DataString;
finally
StrStream.Free;

end;
finally
BinStream.Free
end;
end;

function StringToComponent(Value: string; Instance:TComponent): TComponent;
var
StrStream:TStringStream;
BinStream: TMemoryStream;
begin
StrStream := TStringStream.Create(Value);
try
BinStream := TMemoryStream.Create;
try
ObjectTextToBinary(StrStream, BinStream);
BinStream.Seek(0, soFromBeginning);
Result := BinStream.ReadComponent(Instance);

finally
BinStream.Free;
end;
finally
StrStream.Free;
end;
end;

function GetObjectString(list:TStrings;BegLine:Integer=0;TypeString:string=''''):string;
var
i,iBegCount,iEndCount:Integer;
ObjString,Line,ClassStr:String;
begin
iBegCount:=0;
iEndCount:=0;
ClassStr := Trim(UpperCase(TypeString));
for i:=BegLine to list.Count-1 do
begin
line := UpperCase(list[i]);
if Pos(''OBJECT'',line)>0 then
begin
if (TypeString='''') or (Pos('': ''+ClassStr,line)>0) then
Inc(iBegCount);
end
else if (iBegCount>iEndCount) and (trim(line)=''END'') then
Inc(iEndCount);

if iBegCount>0 then
Result := Result + list[i] + #13#10;

if (iBegCount>0) and (iBegCount=iEndCount) then
Exit;
end;
end;

procedure DeleteErrorLines(list:TStrings);
var
i:Integer;
line:String;
begin
if list.Count=0 then
Exit;

i:=0;
while i<list.Count do
begin
line := Trim(list[i]);
if Copy(line,1,2)=''On'' then
list.Delete(i)
else
Inc(i);
end;
end;
procedure ReadForm(aFrom : TComponent;aFileName :string='''');
var
FrmStrings : TStrings;
begin
RegisterClass(TPersistentClass(aFrom.ClassType));
FrmStrings:=TStringlist.Create ;
try
if trim(aFileName)='''' then FrmStrings.LoadFromFile( gsPathInfo+''/''+aFrom.Name+''.txt'')
else FrmStrings.LoadFromFile(aFileName);
while aFrom.ComponentCount>0 do aFrom.Components[0].Destroy ;
aFrom:=StringToComponent(FrmStrings.Text,aFrom)
finally
FrmStrings.Free;
end;
UnRegisterClass(TPersistentClass(aFrom.ClassType));
end;
function LoadTextForm(FileName:String):TForm;
var
list:TStrings;
FirstLine:String;
iPos : Integer;
Form : TForm;
begin
Result := nil;

if FileExists(FileName)=False then
Exit;

Form := TForm.Create(Application);
list := TStringList.Create;
try
list.LoadFromFile(FileName);
if list.Count=0 then
Exit;

FirstLine := list[0];
iPos := Pos('': '',FirstLine);
if iPos = 0 then //找不到'': ''，格式不对
Exit;

list[0]:=Copy(FirstLine,1,iPos)+'' TForm'';

DeleteErrorLines(list);

StringToComponent(list.Text,Form);
Result := Form;
except
Form.Free;
Result := nil;
end;
list.Free;
end;
function LoadTextForm2(FileName:String;out ErrMsg:string):TForm;
var
list:TStrings;
FirstLine:String;
iPos : Integer;
Form : TForm;
begin
Result := nil;

if FileExists(FileName)=False then
begin
ErrMsg := ''无效的文件名！'';
Exit;
end;

Form := TForm.Create(Application);
list := TStringList.Create;
try
list.LoadFromFile(FileName);
if list.Count=0 then
Exit;

FirstLine := list[0];
iPos := Pos('': '',FirstLine);
if iPos = 0 then //找不到'': ''，格式不对
begin
ErrMsg := ''找不到'''': ''''，文件格式不对'';
Exit;
end;

list[0]:=Copy(FirstLine,1,iPos)+'' TForm'';

DeleteErrorLines(list);

StringToComponent(list.Text,Form);
Result := Form;
except
on e:exception do
begin
Form.Free;
Result := nil;
ErrMsg := ''读入文件错误:''+e.Message;
end;
end;
list.Free;
end;

initialization
begin
InitClassType(AllCmpClass);
RegisterAllClasses(AllCmpClass);
end;

finalization
UnRegisterAllClasses(AllCmpClass);

end.

17:37添加评论固定链接阅读评论 (2)引用通告 (0)记录它
9月4日
IIS_Manager（vbs代码）
IIS_Manager（vbs代码）
'BrcIIS (Backup,Restore,Change Site IP) v1.0
'本代码参考了源码之家的《用ASP编程控制IIS建立WEB站点》和Adsutil.vbs的代码
'还要感谢Envymask和LuoLuo的帮助，谢谢
'小生对ADSI也不是很熟悉，所以代码中有什么错误的，还请大家批评指教，谢谢
'Codz by BlackFox,My QQ:6858849 E-mail:[email protected] WebSite:fox.he100.com
'Base On Adsutil.vbs

Option Explicit
'On Error Resume Next

Dim objArg,objInStream,objOutStream,intSiteIndex,objW3svc,ObjChildObject,strChildObjectName
Dim objIIs,objIIsWeb,objFso,objBackupFile,arrServerBindings,strServerComment,strMaxConnections
Dim strPath,strBackupFile,strFileLine,arrSiteInfo,intCreateWebStatus,strOldIP,strNewIP,intSiteCount
Dim intBindsIndex,intBindsArrID,intChoice,strSearchMode,strSearchedSite,strSaveToBackup,strResult
Dim strSaveFileName,strOverWrite,objResultFile,strIpString,intSearched,strDomainString,strPathString

Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8

Set objOutStream = Wscript.StdOut
Set objInStream = Wscript.StdIn

Set objArg = Wscript.Arguments
If objArg.Count <= 0 Then
HELP()
Wscript.Quit
End If

Select Case UCase(objArg(0))
Case "BACKUP"
HELP()
BackupSite()
Case "RESTORE"
HELP()
RestoreSite()
Case "CHANGEIP"
HELP()
ChangeSiteIP()
Case "CHANGE_APP"
HELP()
Change_AppIsolated()
Case "SEARCH"
HELP()
Search()
End Select

Function BackupSite() '备份站点模块
objOutStream.Write "请输入用来备份站点信息的文件名:"
strBackupFile = objInStream.ReadLine
intSiteIndex = 1 '站点ID的索引
Wscript.Echo vbCrLf & "开始备份站点信息……" & vbCrLf
'*********************************************
Set objW3svc = GetObject("IIS://localhost/w3svc") '建立IIS对象
For Each objChildObject In objW3svc
If (Err.Number <> 0) Then Exit For
If IsNumeric(objChildObject.Name) = True Then '判断ObjChildObject.Name是不是数字
Set objIIs = objW3svc.GetObject("IIsWebServer", objChildObject.Name)
If Err.Number <> 0 Then
Exit For
Wscript.Echo "Error # " & CStr(Err.Number) & " " & Err.Description
Err.Clear()
Wscript.Quit
End If
arrServerBindings = objIIs.ServerBindings '把IIS虚拟站点绑定的IP、端口、域名的值放入数组ServerBindings
strServerComment = objIIs.ServerComment '把IIS虚拟站点的名称赋值给变量ServerComment
strMaxConnections = objIIs.MaxConnections '把IIS虚拟站点的最大连接数赋值给变量MaxConnections
Set objIIsWeb = objIIs.GetObject("IIsWebVirtualDir","Root")
strPath = objIIsWeb.Path
Set objFso = CreateObject("Scripting.FileSystemObject")
If (objFso.fileexists(strBackupFile)) Then
Set objBackupFile = objFso.OpenTextFile(strBackupFile,ForAppending,True)
objBackupFile.WriteLine(strServerComment &vbTab & Join(arrServerBindings,",") & vbTab & strMaxConnections & vbTab & strPath)
objBackupFile.Close
Wscript.Echo "正在备份站点 " & strServerComment & "!"
Else
Set objBackupFile = objFso.CreateTextFile(strBackupFile,True)
objBackupFile.WriteLine(strServerComment & vbTab & Join(arrServerBindings,",") & vbTab & strMaxConnections & vbTab & strPath)
objBackupFile.Close
Wscript.Echo "正在备份站点 " & strServerComment & "!"
End If
intSiteIndex = intSiteIndex + 1
End If
Next
Wscript.Echo vbCrLf & "一共备份了 " & intSiteIndex - 1 & "个站点信息!" & vbCrLf
Set objW3svc = Nothing
Set objChildObject = Nothing
Set objIIs = Nothing
Set objIIsWeb = Nothing
Set objFso = Nothing
Set objBackupFile = Nothing
End Function

Function RestoreSite() '恢复站点模块
objOutStream.Write "请输入用来恢复站点信息的文件名:"
strBackupFile = objInStream.ReadLine
Wscript.Echo vbCrLf & "开始恢复站点信息……" & vbCrLf
Set objFso = CreateObject("Scripting.FileSystemObject")
If Not (objFso.fileexists(strBackupFile)) Then
Wscrip.Echo "没有找到文件 "&strBackupFile&"!"&vbCrLf&"请确定文件的位置!"
Wscript.Quit
End If
Set objBackupFile = objFso.OpenTextFile(strBackupFile,1)
intSiteCount = 1
Do While objBackupFile.AtEndOfStream <> True
strFileLine = objBackupFile.ReadLine
arrSiteInfo = split(strFileLine,vbTab)
intCreateWebStatus = CreateWebServer(arrSiteInfo(0),split(arrSiteInfo(1),","),arrSiteInfo(2),arrSiteInfo(3))
If intCreateWebStatus = 1 Then
Wscript.Echo "建立站点 " & arrSiteInfo(0) & " 成功"
intSiteCount = intSiteCount + 1
Else
Wscript.Echo "建立站点 " & arrSiteInfo(0) & " 失败"
End If
Loop
objBackupFile.Close
Wscript.Echo vbCrLf & "一共恢复了 " & intSiteCount - 1 & " 个站点信息!" & vbCrLf
Set objBackupFile = Nothing
Set objFso = Nothing
End Function

Function ChangeSiteIP() '修改站点IP模块
'*********************************************
'获取两个IP，一个是原来的，是个是新的
'*********************************************
objOutStream.Write "请输入站点原IP："
strOldIP = objInStream.ReadLine
objOutStream.Write "请输入站点新IP："
strNewIP = objInStream.ReadLine
'*********************************************
Wscript.Echo vbCrLf & "开始修改……" & vbCrLf
Set objW3svc = GetObject("IIS://localhost/w3svc") '建立IIS对象
For Each objChildObject In objW3svc
If (Err.Number <> 0) Then Exit For
If IsNumeric(objChildObject.Name) = True Then '判断objChildObject.Name是不是数字
Set objIIs = objW3svc.GetObject("IIsWebServer", objChildObject.Name) '建立IIS虚拟站点对像
If Err.Number <> 0 Then
Exit For
Wscript.Echo "Error # " & CStr(Err.Number) & " " & Err.Description
Err.Clear()
Wscript.Quit
End If
arrServerBindings = objIIs.ServerBindings '把IIS虚拟站点绑定的IP、端口、域名的值放入数组ServerBindings
strServerComment = objIIs.ServerComment '把IIS虚拟站点的名称赋值给变量ServerComment
Wscript.Echo "正在修改站点 " & strServerComment & " 的IP" '在命令行打印正在修改IP的站点名称
intBindsIndex = UBound(arrServerBindings) + 1 '由于站点可以绑定多个域名、端口和IP，所以需要判断一共绑定了多少IP
For intBindsArrID = 1 To intBindsIndex
If instr(arrServerBindings(intBindsArrID - 1) , strOldIP) Then
arrServerBindings(intBindsArrID - 1) = Replace(arrServerBindings(intBindsArrID - 1) , strOldIP , strNewIP) '把数组内包含oldip的字符串替换成newip的字符串
End If
Next
objIIs.ServerBindings = arrServerBindings '把iis对象的ServerBindings属性修改为替换过IP的数组
objIIs.setinfo '使替换过的设置生效
End If
Next
'*********************************************
Set objW3svc = Nothing
Set objChildObject = Nothing
Set objIIs = Nothing
Set objIIsWeb = Nothing
Wscript.Echo vbCrLf & "修改完成!"
End Function

Function Change_AppIsolated() '修改应用程序保护模块
objOutStream.Write "选择你需要设置的(0,低_IIS进程 2,中_共用的 3,高_独立的,默认设置为2):"
intChoice = objInStream.ReadLine
If Not IsNumeric(intChoice) Then
Wscript.Echo "错误，你输入的不是数字!"
Wscript.Quit
End If
intSiteIndex = 1 '站点ID的索引
Wscript.Echo vbCrLf & "开始修改……" & vbCrLf
'*********************************************
Set objW3svc = GetObject("IIS://localhost/w3svc") '建立IIS对象
For Each objChildObject In objW3svc
If (Err.Number <> 0) Then Exit For
If IsNumeric(objChildObject.Name) = True Then '判断取出的objChildObject.Name是不是数字
Set objIIs = objW3svc.GetObject("IIsWebServer" , objChildObject.Name)
If Err.Number <> 0 Then
Exit For
Wscript.Echo "Error # " & CStr(Err.Number) & " " & Err.Description
Err.Clear()
Wscript.Quit
End If
strServerComment = objIIs.ServerComment
set objIIsWeb = objIIs.GetObject("IIsWebVirtualDir","Root")
objIIsWeb.AppIsolated = int(intChoice)
objIIsWeb.SetInfo
Wscript.Echo "设置站点 " & strServerComment & " 完成!"
End If
Next
Set objW3svc = Nothing
Set objChildObject = Nothing
Set objIIs = Nothing
Set objIIsWeb = Nothing
Wscript.Echo vbCrLf & "设置完成!"
End Function

Function Search() '搜索模块
Wscript.Echo "请选择搜索方式：" & vbCrLf
Wscript.Echo "1.根据IP查询站点信息"
Wscript.Echo "2.根据域名查询站点信息"
Wscript.Echo "3.根据站点绝对路径查询站点信息" & vbCrLf
objOutStream.Write "请选择你需要的查询方式（1 2 3）："
strSearchMode = objInStream.ReadLine

Select Case strSearchMode
Case "1"
Use_IP_Search()
Case "2"
Use_Domain_Search()
Case "3"
Use_Path_Search()
End Select

End Function

Function Use_IP_Search() '根据IP搜索站点信息
objOutStream.Write "请输入你要搜索的IP："
strIpString = objInStream.ReadLine
Wscript.Echo "开始搜索……" & vbCrLf
intSiteIndex = 1
'*********************************************
Set objW3svc = GetObject("IIS://localhost/w3svc") '建立IIS对象
For Each objChildObject In objW3svc
If (Err.Number <> 0) Then Exit For
If IsNumeric(objChildObject.Name) = True Then '判断objChildObject.Name是不是数字
Set objIIs = objW3svc.GetObject("IIsWebServer", objChildObject.Name) '建立IIS虚拟站点对像
If Err.Number <> 0 Then
Exit For
Wscript.Echo "Error # " & CStr(Err.Number) & " " & Err.Description
Err.Clear()
Wscript.Quit
End If
arrServerBindings = objIIs.ServerBindings '把IIS虚拟站点绑定的IP、端口、域名的值放入数组ServerBindings
intBindsIndex = UBound(arrServerBindings) + 1 '由于站点可以绑定多个域名、端口和IP，所以需要判断一共绑定了多少IP
intSearched=0
For intBindsArrID = 1 To intBindsIndex
If InStr(arrServerBindings(intBindsArrID - 1) , strIpString) Then
intSearched=1
Exit For
End If
Next
If intSearched=1 Then
strServerComment = objIIs.ServerComment '把IIS虚拟站点的名称赋值给变量ServerComment
strMaxConnections = objIIs.MaxConnections
Wscript.Echo "站点描述：" & strServerComment
Set objIIsWeb=objIIs.GetObject("IIsWebVirtualDir","Root")
strPath=objIIsWeb.Path
strSearchedSite = strSearchedSite & strServerComment & vbTab & Join(arrServerBindings,",") & vbTab & strMaxConnections & vbTab & strPath & vbCrLf
intSiteIndex = intSiteIndex + 1
End If
End If
Next
'Wscript.Echo strSearchedSite '打印出搜索到的站点信息
If intSiteIndex = 1 Then
Wscript.Echo vbCrLf & "未查找到站点信息!"
Else
Wscript.Echo vbCrLf & "共查找到" & intSiteIndex - 1 & "个站点!"
Wscript.Echo "默认只显示出站点描述，如果您需要详细信息，请把搜索结果存为文件!"
objOutStream.Write "是否将站点信息存为备份文件？（YES，NO）："
strSaveToBackup=objInStream.ReadLine
If UCase(strSaveToBackup)="YES" Then
SaveToFile(strSearchedSite)
End If
End If
'*********************************************
Set objW3svc = Nothing
Set objChildObject = Nothing
Set objIIs = Nothing
Set objIIsWeb = Nothing
End Function

Function Use_Domain_Search() '域名搜索模块
objOutStream.Write "请输入你要搜索的域名："
strDomainString = objInStream.ReadLine
Set objW3svc = GetObject("IIS://LocalHost/W3svc")
Wscript.Echo "开始搜索……" & vbCrLf
intSiteIndex = 1
For Each objChildObject In objW3svc
If (Err.Number <> 0) Then Exit For
If IsNumeric(objChildObject.Name) = True Then '判断objChildObject.Name是不是数字
Set objIIs = objW3svc.GetObject("IIsWebServer", objChildObject.Name) '建立IIS虚拟站点对像
If Err.Number <> 0 Then
Exit For
Wscript.Echo "Error # " & CStr(Err.Number) & " " & Err.Description
Err.Clear()
Wscript.Quit
End If
arrServerBindings = objIIs.ServerBindings '把IIS虚拟站点绑定的IP、端口、域名的值放入数组ServerBindings
intBindsIndex = UBound(arrServerBindings) + 1 '由于站点可以绑定多个域名、端口和IP，所以需要判断一共绑定了多少IP
intSearched=0
For intBindsArrID = 1 To intBindsIndex
If InStr(arrServerBindings(intBindsArrID - 1) , strDomainString) Then
intSearched=1
Exit For
End If
Next
If intSearched=1 Then
strServerComment = objIIs.ServerComment '把IIS虚拟站点的名称赋值给变量ServerComment
strMaxConnections = objIIs.MaxConnections
Wscript.Echo "站点描述：" & strServerComment
Set objIIsWeb=objIIs.GetObject("IIsWebVirtualDir","Root")
strPath=objIIsWeb.Path
strSearchedSite = strSearchedSite & strServerComment & vbTab & Join(arrServerBindings,",") & vbTab & strMaxConnections & vbTab & strPath & vbCrLf
intSiteIndex = intSiteIndex + 1
End If
End If
Next
'Wscript.Echo strSearchedSite '打印出搜索到的站点信息
If intSiteIndex = 1 Then
Wscript.Echo vbCrLf & "未查找到站点信息!"
Else
Wscript.Echo vbCrLf & "共查找到" & intSiteIndex - 1 & "个站点!"
Wscript.Echo "默认只显示出站点描述，如果您需要详细信息，请把搜索结果存为文件!"
objOutStream.Write "是否将站点信息存为备份文件？（YES，NO）："
strSaveToBackup=objInStream.ReadLine
If UCase(strSaveToBackup)="YES" Then
SaveToFile(strSearchedSite)
End If
End If
'*********************************************
Set objW3svc = Nothing
Set objChildObject = Nothing
Set objIIs = Nothing
Set objIIsWeb = Nothing

End Function

Function Use_Path_Search() '域名搜索模块
objOutStream.Write "请输入你要搜索的绝对路径："
strPathString = objInStream.ReadLine
Set objW3svc = GetObject("IIS://LocalHost/W3svc")
Wscript.Echo "开始搜索……" & vbCrLf
intSiteIndex = 1
For Each objChildObject In objW3svc
If (Err.Number <> 0) Then Exit For
If IsNumeric(objChildObject.Name) = True Then '判断objChildObject.Name是不是数字
Set objIIs = objW3svc.GetObject("IIsWebServer", objChildObject.Name) '建立IIS虚拟站点对像
If Err.Number <> 0 Then
Exit For
Wscript.Echo "Error # " & CStr(Err.Number) & " " & Err.Description
Err.Clear()
Wscript.Quit
End If
Set objIIsWeb=objIIs.GetObject("IIsWebVirtualDir","Root")
If instr(objIIsWeb.Path , strPathString) Then
strServerComment = objIIs.ServerComment '把IIS虚拟站点的名称赋值给变量ServerComment
arrServerBindings = objIIs.ServerBindings '把IIS虚拟站点绑定的IP、端口、域名的值放入数组ServerBindings
strMaxConnections = objIIs.MaxConnections
strPath=objIIsWeb.Path
Wscript.Echo "站点描述：" & strServerComment
strSearchedSite = strSearchedSite & strServerComment & vbTab & Join(arrServerBindings,",") & vbTab & strMaxConnections & vbTab & strPath & vbCrLf
intSiteIndex = intSiteIndex + 1
End If
End If
Next
'Wscript.Echo strSearchedSite '打印出搜索到的站点信息
If intSiteIndex = 1 Then
Wscript.Echo vbCrLf & "未查找到站点信息!"
Else
Wscript.Echo vbCrLf & "共查找到" & intSiteIndex - 1 & "个站点!"
Wscript.Echo "默认只显示出站点描述，如果您需要详细信息，请把搜索结果存为文件!"
objOutStream.Write "是否将站点信息存为备份文件？（YES，NO）："
strSaveToBackup=objInStream.ReadLine
If UCase(strSaveToBackup)="YES" Then
SaveToFile(strSearchedSite)
End If
End If

'*********************************************
Set objW3svc = Nothing
Set objChildObject = Nothing
Set objIIs = Nothing
Set objIIsWeb = Nothing
End Function

Function SaveToFile(strResult) '保存文件
objOutStream.Write "请输入保存的文件名："
strSaveFileName=objInStream.ReadLine
Set objFso=CreateObject("Scripting.FileSystemObject")
If objFso.FileExists(strSaveFileName) Then
Wscript.Echo "文件" & strSaveFileName & "已经存在!"
objOutStream.Write "是否追加写入文件？(Yes,No)"
strOverWrite = objInStream.ReadLine
If UCase(strOverWrite) = "YES" Then
Set objResultFile=objFso.OpenTextFile(strSaveFileName , ForAppending , True)
objResultFile.Write strResult
objResultFile.Close
Wscript.Echo "写入文件" & strSaveFileName & "完成!"
End If

If UCase(strOverWrite) = "NO" Then
objOutStream.Write "请重命名文件："
strSaveFileName = objInStream.ReadLine
Set objResultFile = objFso.CreateTextFile(strSaveFileName,True)
objResultFile.Write strResult
objResultFile.Close
Wscript.Echo "保存文件 " & strSaveFileNmae & " 完成!"
End If
Else
Set objResultFile = objFso.CreateTextFile(strSaveFileName , True)
objResultFile.Write strResult
objResultFile.Close
Wscript.Echo "保存文件 " & strSaveFileName & " 完成!"
End If
Set objFso = Nothing
End Function

Function CreateWebServer(strServerComment,arrServerBindings,strMaxConnections,strPath)'建立站点
On Error Resume Next
Set objW3svc = GetObject("IIS://LocalHost/W3svc")
intSiteIndex = 999

Do While IsObject(objW3svc.GetObject("IIsWebServer",intSiteIndex))
If Err.Number <> 0 Then
'Wscript.Echo Err.Description
Err.Clear()
Exit Do
End If
intSiteIndex = intSiteIndex - 1
Loop

Set objIIs = objW3svc.Create("IIsWebServer",intSiteIndex)
If Err.Number <> 0 Then
Wscript.Echo "Error # " & CStr(Err.Number) & " " & Err.Description
Err.Clear()
CreateWebServer = 0
Exit Function
End If

objIIs.ServerSize = 1
objIIs.ServerComment = strServerComment
objIIs.ServerBindings = arrServerBindings
objIIs.MaxConnections = strMaxConnections
objIIs.EnableDefaultDoc = True
objIIs.SetInfo
Set objIIsWeb = objIIs.Create("IIsWebVirtualDir", "Root")
If Err.Number <> 0 Then
Wscript.Echo "Error # " & CStr(Err.Number) & " " & Err.Description
Err.Clear()
CreateWebServer = 0
Exit Function
End If
objIIsWeb.Path = strPath
objIIsWeb.AccessRead = True
objIIsWeb.AccessWrite = False
objIIsWeb.EnableDirBrowsing = False
objIIsWeb.EnableDefaultDoc = True
objIIsWeb.AccessScript = True
objIIsWeb.AppIsolated = 2
objIIsWeb.AppFriendlyName = "默认应用程序"
objIIsWeb.SetInfo
Set objW3svc = Nothing
Set objIIs = Nothing
Set objIIsWeb = Nothing
CreateWebServer = 1
End Function

Function HELP()
Wscript.Echo " IIS总管 V1.5 By BlackFox"
Wscript.Echo " http://fox.he100.com"&vbCrLf
Wscript.Echo "Cscript IIS_Manager-1.5.vbs Backup （备份IIS站点信息到一个文本文件！）"
Wscript.Echo "Cscript IIS_Manager-1.5.vbs Restroe （从一个文本文件恢复IIS站点信息！）"
Wscript.Echo "Cscript IIS_Manager-1.5.vbs ChangeIP （修改所有IIS站点IP！）"
Wscript.Echo "Cscript IIS_Manager-1.5.vbs Change_App （修改所有IIS站点应用程序级别！）"
Wscript.Echo "Cscript IIS_Manager-1.5.vbs Search （根据条件查找站点信息！）"&vbCrLf
End Function

'想到的新功能
'备份功能增加一个备份站点数据的功能，通过RAR自动打包，默认打包到站点的上级目录，可选择打包的指定的目录
'增加建立隐藏虚拟目录的功能
'批量删除绑定的指定IP
'程序运行时判断IIS是否启动
</pre>