procedure ExportXls.WriteStringCell(const AValue: String);
var
L: Word;
str:AnsiString;
CXlsLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
begin
str:=AnsiString(AValue);
L := Length(str);
CXlsLabel[1] := 8 + L;
CXlsLabel[2] := FRow;
CXlsLabel[3] := FCol;
CXlsLabel[5] := L;
Stream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel));
Stream.WriteBuffer(PAnsiChar(str)^, L);
end;
//DELPHI 2010
var
sz : AnsiString;
ms : TMemoryStream;
begin
sz := AnsiString('中国人民');
ms := TMemoryStream.Create;
try
ms.WriteBuffer(sz[1], Length(sz));
ms.SaveToFile('1.txt');
finally
ms.Free;
end;
end;
var
List: TStringList;
begin
List := TStringList;
try
List.Add('你好'#9'非常好');
List.SaveToFile('1.xls');
finally
List.free;
end;
end;
procedure WriteFile(fn:string; txt:string);
var
fs : TFileStream;
begin
fs := TFileStream.Create(fn, fmCreate);
fs.Write(txt[1], Length(txt));
fs.Free;
end;
unit utExcelClass;
{
此种方法通过写磁盘文件方式导出EXCEL比较快,
但是在导出来的OPENOFFICE打开时 中文为乱码,MS、WPS中文正常,
暂时没有找到解决方法。
待用 2013-09-27
}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Controls, Forms,GridsEh, DBGridEh,
Dialogs, StdCtrls, Grids, DBGrids, DB, ADODB,ComCtrls;
var
CXlsBof: array[0..5] of Word = ($809, 8, 0, $10, 0, 0);
CXlsEof: array[0..1] of Word = ($0A, 00);
CXlsLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
CXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0);
CXlsRk: array[0..4] of Word = ($27E, 10, 0, 0, 0);
CXlsBlank: array[0..4] of Word = ($201, 6, 0, 0, $17);
type
ExportXls = class(TObject)
private
FCol: word;
FRow: word;
FDbgrid:TDBGrid;
FDbgridEh:TDBGridEh;
FStrGrid:TStringGrid;
Stream: TStream;
FWillWriteHead: boolean;
FBookMark: TBookmark;
procedure IncColRow;
procedure WriteBlankCell;
procedure WriteFloatCell(const AValue: Double);
procedure WriteIntegerCell(const AValue: Integer);
procedure WriteStringCell(const AValue: string);
procedure WritePrefix;
procedure WriteSuffix;
procedure WriteTitle;
procedure WriteDataCell;
procedure Save2Stream(aStream: TStream);
public
procedure Save2File(FileName: string; WillWriteHead: Boolean);
constructor Create(aDbgrid:TDBGrid=nil;
aDbgridEh:TDBGridEh=nil;
aStrGrid:TStringGrid=nil);
end;
function ExportToXLS( sFileName: string='';
dbGrid: TDBGrid=nil;
dbgridEh:TDBGridEh=nil;
strGrid:TStringGrid=nil): Boolean;
function ShowProgressBarForm(maxCount:Integer):TProgressBar;
var tempSaveFile:string;
implementation
function ShowProgressBarForm(maxCount:Integer):TProgressBar;
var tempProgressBar:TProgressBar;
tempForm:TForm;
templabel:TLabel;
begin
Application.CreateForm(TForm,tempForm);
tempForm.Position:=poScreenCenter;
tempForm.BorderStyle:=bsNone;
tempForm.Height:=50;
tempForm.Width:=300;
tempProgressBar:=TProgressBar.Create(tempForm);
tempProgressBar.ParentWindow:=tempForm.Handle;
tempProgressBar.Align:=alTop;
tempProgressBar.Height:=30;
tempProgressBar.Width:=300;
tempProgressBar.Visible:=True;
tempProgressBar.Smooth:=True;
tempProgressBar.Max:=maxCount;
tempProgressBar.Step:=1;
templabel:=TLabel.Create(tempForm);
templabel.Align:=alBottom;
templabel.Parent:=tempForm;
templabel.Height:=15;
templabel.Width:=300;
templabel.Visible:=True;
templabel.Caption:='正在导出,请等待.......';
templabel.Name:='Label1';
tempForm.Show;
templabel.Update;
tempProgressBar.Update;
Application.ProcessMessages;
Result:=tempProgressBar;
end;
function ExportToXLS( sFileName: string='';
dbGrid: TDBGrid=nil;
dbgridEh:TDBGridEh=nil;
strGrid:TStringGrid=nil): Boolean;
var savedialog: TSaveDialog;
strsavefile: string;
begin
tempSaveFile:='';
Result := False;
try
savedialog := TSaveDialog.Create(nil);
begin
savedialog.Filter := '*.xls|*.xls|*.ods|*.ods|*.xlsx|*.xlsx|*.et|*.et';
savedialog.FileName:=sFileName;
if not savedialog.Execute then Exit;
strsavefile:=savedialog.FileName;
end;
finally
savedialog.Free;
end;
Application.ProcessMessages;
if Length(strsavefile) = 0 then
begin
Result:=False;
Exit;
end;
if Pos('.xls', strsavefile) <= 0 then
strsavefile := strsavefile + '.xls';
tempSaveFile:=strsavefile;
with ExportXls.Create(dbGrid,dbgridEh,strGrid) do
try
Save2File(strsavefile, True);
Result := True;
finally
Free;
end;
end;
constructor ExportXls.Create(aDbgrid:TDBGrid=nil;
aDbgridEh:TDBGridEh=nil;
aStrGrid:TStringGrid=nil);
begin
inherited Create;
if aDbgrid<>nil then FDbgrid:=aDbgrid;
if aDbgridEh<>nil then FDbgridEh:=aDbgridEh;
if aStrGrid<>nil then FStrGrid:=aStrGrid;
end;
procedure ExportXls.IncColRow;
var GridFieldCount:Integer;
i:Integer;
begin
GridFieldCount:=0;
if FDbgrid<>nil then
begin
for I := 0 to FDbgrid.Columns.Count-1 do
begin
if FDbgrid.Columns[i].Visible=False then
Continue;
Inc(GridFieldCount);
end;
end;
if FDbgridEh<>nil then
begin
for I := 0 to FDbgridEh.Columns.Count-1 do
begin
if FDbgridEh.Columns[i].Visible=False then
Continue;
Inc(GridFieldCount);
end;
end;
if FStrGrid<>nil then
GridFieldCount:=FStrGrid.ColCount;
if FCol = GridFieldCount - 1 then
begin
Inc(FRow);
FCol := 0;
end
else
Inc(FCol);
end;
procedure ExportXls.WriteBlankCell;
begin
CXlsBlank[2] := FRow;
CXlsBlank[3] := FCol;
Stream.WriteBuffer(CXlsBlank, SizeOf(CXlsBlank));
IncColRow;
end;
procedure ExportXls.WriteFloatCell(const AValue: Double);
begin
CXlsNumber[2] := FRow;
CXlsNumber[3] := FCol;
Stream.WriteBuffer(CXlsNumber, SizeOf(CXlsNumber));
Stream.WriteBuffer(AValue, 8);
IncColRow;
end;
procedure ExportXls.WriteIntegerCell(const AValue: Integer);
var
V: Integer;
begin
CXlsRk[2] := FRow;
CXlsRk[3] := FCol;
Stream.WriteBuffer(CXlsRk, SizeOf(CXlsRk));
V := (AValue shl 2) or 2;
Stream.WriteBuffer(V, 4);
IncColRow;
end;
procedure ExportXls.WriteStringCell(const AValue: String);
var
L: Word;
str:AnsiString;
futf8Bytes:string;
begin
{OPENOFFICE打开中文乱码}
str:=AnsiString(AValue);
L := Length(str);
CXlsLabel[1] := 8 + L;
CXlsLabel[2] := FRow;
CXlsLabel[3] := FCol;
CXlsLabel[5] := L;
Stream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel));
Stream.WriteBuffer(PAnsiChar(str)^, L);
IncColRow;
end;
procedure ExportXls.WritePrefix;
begin
Stream.WriteBuffer(CXlsBof, SizeOf(CXlsBof));
end;
procedure ExportXls.WriteSuffix;
begin
Stream.WriteBuffer(CXlsEof, SizeOf(CXlsEof));
end;
procedure ExportXls.WriteTitle;
var
n: word;
GridFieldCount:Integer;
TitleCaption:string;
begin
GridFieldCount:=0;
if FDbgrid<>nil then GridFieldCount:=FDbgrid.Columns.Count;
if FDbgridEh<>nil then GridFieldCount:=FDbgridEh.Columns.Count;
if FStrGrid<>nil then GridFieldCount:=FStrGrid.ColCount;
for n := 0 to GridFieldCount - 1 do
begin
if FDbgrid<>nil then
begin
if FDbgrid.Columns[n].Visible=False then Continue;
TitleCaption:= FDbgrid.Columns[n].Title.Caption;
end;
if FDbgridEh<>nil then
begin
if FDbgridEh.Columns[n].Visible=False then Continue;
TitleCaption:= FDbgridEh.Columns[n].Title.Caption;
end;
if FStrGrid<>nil then TitleCaption:= FStrGrid.Cells[n,0];
WriteStringCell(TitleCaption);
end;
end;
procedure ExportXls.WriteDataCell;
var
Idx: word;
i,j:Integer;
progressBar1:TProgressBar;
begin
Screen.Cursor := crhourglass;
WritePrefix;
if FWillWriteHead then WriteTitle;
if FDbgrid<>nil then
begin
progressBar1:=ShowProgressBarForm(FDbgrid.DataSource.DataSet.RecordCount);
FDbgrid.DataSource.DataSet.DisableControls;
FBookMark := FDbgrid.DataSource.DataSet.GetBookmark;
FDbgrid.DataSource.DataSet.First;
while not FDbgrid.DataSource.DataSet.Eof do
begin
for Idx := 0 to FDbgrid.Columns.Count - 1 do
begin
if FDbgrid.Columns[Idx].Visible=False then Continue;
if FDbgrid.Columns[Idx].Field.IsNull then
WriteBlankCell
else
begin
case FDbgrid.Columns[Idx].Field.DataType of
ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:
WriteIntegerCell(FDbgrid.Columns[Idx].Field.AsInteger);
ftFloat, ftCurrency, ftBCD,ftFMTBcd:
WriteFloatCell(FDbgrid.Columns[Idx].Field.AsFloat);
else
if Assigned(FDbgrid.Columns[Idx].Field.OnGetText) then
WriteStringCell(FDbgrid.Columns[Idx].Field.Text)
else
WriteStringCell(FDbgrid.Columns[Idx].Field.AsString);
end;
end;
end;
FDbgrid.DataSource.DataSet.Next;
Application.ProcessMessages;
progressBar1.StepBy(1);
end;
WriteSuffix;
if FDbgrid.DataSource.DataSet.BookmarkValid(FBookMark) then FDbgrid.DataSource.DataSet.GotoBookmark(FBookMark);
FDbgrid.DataSource.DataSet.EnableControls;
progressBar1.Owner.Free;
end;
if FDbgridEh<>nil then
begin
progressBar1:=ShowProgressBarForm(FDbgridEh.DataSource.DataSet.RecordCount);
FDbgridEh.DataSource.DataSet.DisableControls;
FBookMark := FDbgridEh.DataSource.DataSet.GetBookmark;
FDbgridEh.DataSource.DataSet.First;
while not FDbgridEh.DataSource.DataSet.Eof do
begin
for Idx := 0 to FDbgridEh.Columns.Count - 1 do
begin
if FDbgridEh.Columns[Idx].Visible=False then Continue;
if FDbgridEh.Columns[Idx].Field.IsNull then
WriteBlankCell
else begin
case FDbgridEh.Columns[Idx].Field.DataType of
ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:
WriteIntegerCell(FDbgridEh.Columns[Idx].Field.AsInteger);
ftFloat, ftCurrency, ftBCD,ftFMTBcd:
WriteFloatCell(FDbgridEh.Columns[Idx].Field.AsFloat);
else
if Assigned(FDbgridEh.Columns[Idx].Field.OnGetText) then
WriteStringCell(FDbgridEh.Columns[Idx].Field.Text)
else
WriteStringCell(FDbgridEh.Columns[Idx].Field.AsString);
end;
end;
end;
FDbgridEh.DataSource.DataSet.Next;
Application.ProcessMessages;
progressBar1.StepBy(1);
end;
// write footers
WriteSuffix;
if FDbgridEh.DataSource.DataSet.BookmarkValid(FBookMark) then FDbgridEh.DataSource.DataSet.GotoBookmark(FBookMark);
FDbgridEh.DataSource.DataSet.EnableControls;
progressBar1.Owner.Free;
end;
if FStrGrid<>nil then
begin
progressBar1:=ShowProgressBarForm(FStrGrid.RowCount);
for i := 2 to FStrGrid.RowCount do
begin
for j := 1 to FStrGrid.ColCount do
WriteStringCell((FStrGrid.Cells[j-1,i-1]));
progressBar1.StepBy(1);
Application.ProcessMessages;
end;
WriteSuffix;
progressBar1.Owner.Free;
end;
Application.MessageBox(PWideChar('导出成功!'+(tempSaveFile)), '提示', MB_OK + MB_ICONINFORMATION);
Screen.Cursor := crDefault;
end;
procedure ExportXls.Save2Stream(aStream: TStream);
begin
FCol := 0;
FRow := 0;
Stream := aStream;
WriteDataCell;
end;
procedure ExportXls.Save2File(FileName: string; WillWriteHead: Boolean);
var
aFileStream: TFileStream;
begin
FWillWriteHead := WillWriteHead;
if FileExists(FileName) then DeleteFile(FileName);
aFileStream := TFileStream.Create(FileName, fmCreate);
try
Save2Stream(aFileStream);
finally
aFileStream.Free;
end;
end;
end.
在Delphi中，所有流对象的基类为TStream类，其中定义了所有流的共同属性和方法。 TStream类中定义的属性介绍如下： 1、Size:此属性以字节返回流中数据大小。 2、Position:此属性控制流中存取指针的位置。 ...
查找upload_5xsoft.inc文件 tStream.Charset ="gb2312" 更改为tStream.Charset ="UTF-8" 一共有两处
说明下，这个方法有好大的缺陷，XML必须要严格正确，如果有什么特殊字符，会导致出错，其次，并不能...网上找了下, 有两种方式,一个是 TXMLDocument 在 Internet 面板下, 另一个是用 IXMLDomDocument 需要用到 单元文件
使用TFileStream 保存文本文件的一些注意事项
http://www.delphibbs.com/delphibbs/dispq.asp?lid=3349991 问题：WideString 还是 AnsiString ？谈谈字符编码。 ( 积分：0, 回复：12, 阅读：242 )分类：编程手记 ( 版主：DNChen, cAkk
网络接口如下图： 浏览器演示如下：http://xxx.xxx.xxx.xxx/web/login!doLogin?data={"password":"yy123","userCode":"yyy123","terminalCode":"123"} ...","result":"1","si
delphi base64编码函数EncodeString的问题在每遇到字符长度大于75时，将在编码串中增加一个换行回车，所以在将编码串写入文件，然后在读出解码时就产生乱码， 所以在源码中将相关代码屏蔽就可以了： procedure ...
在Delphi 7开发下有强大的Indy控件，版本为9，要实现一个FTP服务器，参考自带的例子，发现还要写很多函数，而且不支持中文显示文件列表等等。于是，自己改进封装了下，形成一个TFTPServer类。
这几天学习 JSON - SuperObject, 非常幸运地得到了其作者Henri Gourvest大师的同步指点! (Henri 大师也是 DSPack 和 GDI+ 头文件的作者; 大师是法国人, 竟能用中文给我回复, 没想到!...以下例子都会出现乱码, 虽...
{ 功能：将数据集的数据导入Excel; 用法1：With ExportXls.Create(TDataSet(ADOQuery1)) do Try Save2File(SaveDialog1.FileName, True); finally Free; end; 用法2：procedure TForm1.Button4Click(Sender:...
http://www.delphibbs.com/delphibbs/dispq.asp?lid=3349991问题：WideString 还是 AnsiString ？谈谈字符编码。 ( 积分：0, 回复：12, 阅读：242 )分类：编程手记 ( 版主：DNChen, cAkk )
《版主答疑-Delphi高级编程技巧》 Delphi 教程 系列书籍 (086) 《版主答疑-Delphi高级编程技巧》 网友（邦）整理 EMail: shuaihj@163.com 下载地址： Part1 Part2 Part3 Part4 作者：岳庆生 出版社：清华大学出版社...
1.准备工作：网上下载highcharts导出的关键dll。 1）、Svg.dll：因为highcharts的格式其实就是一个xml，采用svg的方式画图； 2）、itextsharp.dll：这样主要是用于处理和提取highcharts图表内的文字以及编码问题；...
FastReport FAQ 常见问题汇总
【架构简介】*本架构以delphi作为客户端，Java作为服务端，oracle作为后台数据库数据。其中delphi客户端的封装为了保持与原来的开发方式兼容都是基于TclientDataSet实现的；*本架构选择基于阻塞模式的Indy通信套件...
内容都是写时才会, 难免稚嫩, 所以 "仅供参考" 可不是客套! 有朋友提出需要这么个目录, 所以忐忑列出; 并拜托发现问题及时通知我. 一个拼图工具的制作思路 - 回复 "AlwaysBug" 的问题 ...
这几天清理资料，把以前学Delphi时的笔记翻出来了。大概是2005年时的吧,有些资料都没有什么价值了。以后再整理吧。 ...字段：idd、namee、age、sex、city、department、position ...1、 修改操
这两天把一个使用Delphi2007成功升级到了Delphi2010。升级途中很艰辛，总结了 以下经验与大家分享。另外，D7使用的第三方组件，由于官方没有发布For Delphi2010的更新，修改的第三 方组件列表见文章尾部。...
如何设置Java 2(JDK1.2)的环境变量?...当用JDBC向数据库中插入数据或从数据库中提取数据时,为何有时中文字符会显示为乱码?当用Servlet来处理http请求并产生返回的HTML页面时,如何使HTML页面中的中文字符能够正常
举例：项目中在解压zip文件时,未对zip条目进行验证,存在路径遍历的风险,为了系统安全,应加上安全黑名单特殊字符过滤。 示例 代码如下： String name= zipEntry getName O 通过上述语句获取zip条目的名字, File ...
...摘要: 客户端每天从代理服务器获取一个有效的中间件的IP地址和端口号，客户端当天之内都连接此中间件。如果客户端连不上中间件，就重新从代理服务器获取另一个有效的中间件的IP地址和端口号。...
也许是中国第一个讲解android驱动的课程，涵盖: bootloader，内核移植，INIT进程，框架(BINDER IPC,SERVICE FRAMEWORK Activity Manager Serive,JNI,HAL等),binder驱动，logger，Ashmen，电源管理，常用驱动(如灯光系统，
Xshell破解版，亲测可用，Xshell 是一个强大的安全终端模拟软件，它支持SSH1, SSH2, 以及Microsoft Windows 平台的TELNET 协议。Xshell 通过互联网到远程主机的安全连接以及它创新性的设计和特色帮助用户在复杂的网络环境中享受他们的工作。
抢茅台的方法，里面有脚本文件和python的安装包，小白可以学习使用，大佬绕行吧，哈哈
2020年2月份美赛发布的题目ADE，是原始文件，包含有原题目给的数据等。 pdf格式全英，需要的朋友们直接下载就可以啦，里面的东西没有动过，需要翻译可以看我的博客/
本套课程仍然沿用了实战教学方式，以一个电影查询APP为实战案例，手把手从项目设
例子主要包括SocketAsyncEventArgs通讯封装、服务端实现日志查看、SCOKET列表、上传、下载、远程文件流、吞吐量协议，用于测试SocketAsyncEventArgs的性能和压力，最大连接数支持65535个长连接，最高命令交互速度达到250MB/S（使用的是127.0.0.1的方式，相当于千兆网卡1Gb=125MB/S两倍的吞吐量）。服务端用C#编写，并使用log4net作为日志模块； 同时支持65536个连接，网络吞吐量可以达到400M。
jdk1.8 64位官方正式版 jdk-8u91-windows
