SQL Server SQL语句导入导出大全

来源:互联网 发布:mac抹掉移动硬盘失败 编辑:程序博客网 时间:2024/05/17 08:07

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:ym2236@163.com 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>