下面的代码可以把adoquery查询出的记录导出到指定的*.txt中procedure TForm1.Button1Click(Sender: TObject);
var
f:Textfile;
str:string;
i,j:integer;
begin
assignfile(f, ExtractFilePath(Application.ExeName)+ 'demo.txt');
rewrite(f);
for j:= 0 to Adoquery.recordcount-1 do
begin
str:='';
for i:= 0 to Adoquery.fieldcount-1 do
begin
str:=str+Adoquery.fields[i].asstring+',';
end;
writeln(f,str);
Adoquery.next;
end;
closefile(f);
end;
var
f:Textfile;
str:string;
i,j:integer;
begin
assignfile(f, ExtractFilePath(Application.ExeName)+ 'demo.txt');
rewrite(f);
for j:= 0 to Adoquery.recordcount-1 do
begin
str:='';
for i:= 0 to Adoquery.fieldcount-1 do
begin
str:=str+Adoquery.fields[i].asstring+',';
end;
writeln(f,str);
Adoquery.next;
end;
closefile(f);
end;
解决方案 »
- 长字符串处理
- 郁闷了一整天的一个问题。
- ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Excel 8.0;DATABASE=c:\a.xls' 无法连接Excel2000以上版本。
- 怎么样用installshield8.0把安装文件做成一个EXE啊?
- 在quickreport中动态创建QRExpr
- 我在DLL入口函数中这样创建一个对象不可以么?为什么总是出错?呼唤高手!!在线等待~~~
- 如何读出打印机支持的纸张大小信息
- datetimepicker日期格式!
- 怎样不让DBGRID显示水平滚动栏?
- 有关于DELPHI调用word的问题!请赐教!谢谢!
- 如何将数字如8转换为字符串001?
- 有关字符串处理
首先是几个通用函数:
//将其它字符转换成空格
function TurntoSpace(overall,special:string):string;
var
i,h:integer;
sumstr,temstr:string;
begin
h:=length(overall);
for i:=1 to h do
begin
temstr:=copy(overall,i,1);
if temstr=special then
begin
temstr:=' ';
sumstr:=sumstr+temstr;
end
else
sumstr:=sumstr+temstr;
TurntoSpace:=sumstr;
end;
end;//去除多余的指定字符:**** -> *
function Delspecial(overall,special:string):string;
var
i,h:integer;
flag:boolean;
sumstr,temstr:string;
begin
flag:=false;
h:=length(overall);
for i:=1 to h do
begin
temstr:=copy(overall,i,1);
if temstr<>special then
begin
sumstr:=sumstr+temstr;
flag:=true;
end
else
if flag=true then
begin
sumstr:=sumstr+temstr;
flag:=false;
end;
end;
if sumstr[length(sumstr)]<>special then
sumstr:=sumstr+special;
Delspecial:=sumstr;
end;//去除指定字符:**** ->
function SDelspecial(overall,special:string):string;
var
i,h:integer;
sumstr,temstr:string;
begin
h:=length(overall);
for i:=1 to h do
begin
temstr:=copy(overall,i,1);
if temstr<>special then
begin
sumstr:=sumstr+temstr;
end;
end;
SDelspecial:=sumstr;
end;function Substring(var overall:string;special:string):string;
var
sumstr:string;
subpos:integer;
begin
subpos:=pos(special,overall);
sumstr:=copy(overall,1,subpos-1);
delete(overall,1,subpos);
Substring:=sumstr;
end;function TForm1.FenGe(overall,special:string):Integer;var
i:Integer;
h:Integer;
num:Integer;
begin
h:=Length(overall);
num:=0;
for i:=1 to h do
begin
if copy(overall,i,1)=special then //改为是否为处理字符
num:=num+1;
end;
FenGe:=num;
end;procedure TForm1.BtnTabClick(Sender: TObject);
const
space=#009;
var
i:integer;
myline:string;
begin
for i:=0 to memo1.lines.count-1 do
begin
myline:=TurnToSpace(memo1.lines[i],space);
memo1.Lines [i]:=myline;
end;
end;
procedure TForm1.BtnvfClick(Sender: TObject);
const
space=' ';
var
i,j:integer;
myline:string;
begin
Btnvf.Enabled:=false;
with Tblvf do
begin
TableName:='c:\leberty\ToVFP.dbf';
open;
for i:=0 to memo1.Lines.Count-1 do
begin
myline:=Delspecial(memo1.Lines[i],space);
append;
for j:=1 to FenGe(myline,space) do
begin
fields[j].Value:=substring(myline,space);
end;
post;
end;
end;
end;procedure TForm1.BtnaccessClick(Sender: TObject);
const
space=' ';
var
i,j:integer;
myline:string;
Aconnection,ARecordSet:variant;
begin
Btnaccess.Enabled:=false;
Aconnection:=CreateOleObject('adodb.connection');
Aconnection.open('Driver={Microsoft Access Driver (*.mdb)};DBQ=c:\leberty\Toacc');
ARecordSet:=CreateOleObject('adodb.RecordSet');
ARecordSet.open('acc',Aconnection,3,3,0002);
for i:=0 to memo1.Lines.Count-1 do
begin
myline:=Delspecial(memo1.Lines[i],space);
ARecordSet.AddNew;
for j:=1 to FenGe(myline,space) do
begin
ARecordSet.fields[j].Value:=substring(myline,space);
end;
ARecordSet.Update;
ARecordSet.MoveNext;
end;
end;
deletedb;
table1.DatabaseName:='XXX';
table1.TableName:='XXX';
table1.Active:=true;
table1.Edit;
lines:=Tstringlist.Create;
lines.LoadFromFile('filename');
for i:=0 to pred(lines.Count-1) do begin
table1.Append;
s:=lines[i];
s2:=copy(s,10,16);
table1.FieldByName('xx').Value:=s2;
s2:=copy(s,29,6);
table1.FieldByName('xx').Value:=s2;
s2:=copy(s,72,14);
table1.FieldByName('xx').Value:=s2;
s2:=copy(s,97,8);
table1.FieldByName('xx').Value:=s2;
try
table1.Post;
except
on EDBEngineError do begin
messagebox(handle,'写数据库失败.','失败',0);
table1.Cancel;
table1.Edit;
continue;
end;
end;
用Delphi实现将纯文本资料转入数据库
p> 在我们日常工作中,常会碰到这样一个难题:一大堆收集好的纯文本格式,比较规整的资料怎样才能将它们分离,转到自己已经建好的数据库中进行管理呢?
例如,有一段人事档案资料archive.txt,内容如下:
小许 男 21 工程师
小吴 女 23 助理工程师
小蔡 男 22 助理工程师
小牟 女 22 工程师
要将它转入数据库archive.dbf中,archive.dbf结构如下:
姓名,性别,年龄,职称
怎么办呢?现在通过使用delphi编程,很好地解决了这个难题。Delphi提供了许多功能强大,丰富的字符处理函数和过程,常用的有:
(1)function Length(S:String):Integer返回串的长度
(2)function Copy(S:String;Index,Count:Integer):String 给出一个字符串中串的拷贝
(3)function Pos(Substr:String;S:String);Integer 查找子串在字符串中的位置
(4)Procedure Delete(VarS:String;Index,Count:Integer);从一个字符串中去除子串
利用Delphi提供的已有函数和过程基础上编制自己的三个函数,实现了纯文本格式资料转入数据库功能。只要Delphi支持的数据库都可以支持。
archive.txt中每行数据为一个字符串,字符串中每个被分割的数据为一个字段,分割每个字段的字符为分割符,这里是空格,也可以是,、;、#等符号。具体思想是:先将字符串进行调整,然后把串中每个字符同分割符比较,将不是分割符的字符追加到MyStr串中,最后得到一个字段的内容。通过一个循环,就可以将一个字符串分成几个字段。
Function Regulate(aString,Sepchar:string):string 去掉多余的分割符,规范字符串
Function GetSubStr(varsSt g:string;SepChar:String):String;得到字符串中一个子串,因要改变参数aString的值,所以将它用var定义。
FunctionGetSubStrNum(aString,SepChar:String):Integer;计算一个字符串要被分割成几个字段。
参数:aString是所需分割的一个字符串,SepChar是分割符。 Function RegulateStr(aString:String;Sepchar:String):String;
var
i,Num:Integer;
Flag:Boolean;
MyStr,TempStr:String;
begin
Flag:=False;进行标志,去除多余的分割符
Num:=Length(aString); 计算aString串的长度
for i:=1 to Num do
begin
TempStr:=Copy(aString,i,1);取aString串中的一字符
if TempStr SepChar then
begin
MyStr:=MyStr+TempStr;
Flag:=True;
end
else
if(Flag = True)then
begin
Mystr:=Mystr+TempSrt;
Flag:=False;
end;
end;
if MyStr[Length(MyStr)] SepChar then
MyStr:=MyStr+SepChar;
RegulateSrt:=MyStr;
end; Function GetSubStr(var aString:String,SepChar:Strign):String;
var
Mysrt:String;
StrLen:Integer;
SepCharPso:Integer;
begin
StrLen:=Length(aString);
SepCharPos:=Pos(SepChar,aString);计算分割符在子串中的位置
MyStr:=Copy(aString,1,SepCharPos-1); 将分割符前所有字符放到mystr串中
Delete(aString,1,SepCharPos);除去分割符和分割符前的子串
GetSubStr:=MyStr;返回一个字段
end; FunctionTforml.GetSubStrNum(aString:String;SepChar:String):Integer;
var
i:Integer;
StrLen:Integer;
Num:Integer;
begin
StrLen:=Length(aString);
Num:=0;
for i:=1 to StrLen do
if Copy(aString,i,1) = SepCharthen
Num:=Num+1;
GetSubSrtNum:=Num;
end; 有了上面三个函数,现在介绍一下具体的应用:
1.首先建立一个窗体Forml,加入一个RichEditl(或Menol),一个按钮Buttonl和一个Tablel,设置Tablel的属性:
Tablell.DataBase = c:\Archivs
Tablell.TableName =Archive.dbf 2.分别加入以下程序:
Const Space=
ProcedureTForml.FormCreate(Sender:Tobject);
begin
RichRditl.Lines.LoadFromFile(Archive.txt);
end; ProcedureTForml.Button1Click(Sender:Tobject);
var
i,j:Integer;
MyLine:String;
begin
with Tablel do
begin
Open;
for i:=0 to RichEditl.Lines.Count-1 do
begin
MyLine:=RegulateStr(Richeditl.Lines[i],Space);
for j:=1 to Num do
begin
Append;
fileds[j-1].aString:=GetSubSrt(MyLine,Space));
post;
end;
end;
end;
end;