TStream 写文件中文乱码

奔雷手 2013-09-26 03:19:27

delphiXE



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;

写文件其中的中文为乱码。
地点变成了 µØµã

...全文

573 15 打赏收藏转发到动态举报

写回复

用AI写文章

15 条回复

切换为时间正序

请发表友善的回复…

发表回复

奔雷手 2013-10-17

打赏
举报

引用 12 楼 HSFZXJY 的回复:

问题出在：你没有在文件头部加编码标示符。因此系统认为该文件是ANSI编码。正确做法：判断你所使用的字符编码，加上对应的文件头。（参考：BOM文件头）

这个很有可能,但OPENOFFICE编码应该是默认的吧,我用OLE方式写入OPENOFFCIE 也没有去设置编码的,是正常显示中文。不懂。。。OPENOFFICE 哪里不一样

奔雷手 2013-10-17

打赏
举报

引用 13 楼 wylton 的回复:

楼上指出了方法. Stream.WriteBuffer(PAnsiChar(str)^, L);这句有问题啊. openoffice 默认的应该是utf8吧?

怎么个问题？个人觉得MSOFFICE，WPS，OPENOFFICE应该都是一样的编码吧。 MSOFFICE，WPS没有问题的

wylton 2013-10-17

打赏
举报

楼上指出了方法. Stream.WriteBuffer(PAnsiChar(str)^, L);这句有问题啊. openoffice 默认的应该是utf8吧?

hsfzxjy 2013-10-04

打赏
举报

问题出在：你没有在文件头部加编码标示符。因此系统认为该文件是ANSI编码。正确做法：判断你所使用的字符编码，加上对应的文件头。（参考：BOM文件头）

奔雷手 2013-10-01

打赏
举报

接上


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.

奔雷手 2013-10-01

打赏
举报


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;

奔雷手 2013-10-01

打赏
举报

引用 7 楼 noelse520 的回复:

写excel还是用OLE吧，我工作这么多年，操作excel都是用OLE，没觉得怎么不好。

引用 6 楼 tcmakebest 的回复:

楼主参考一下吧：

procedure WriteFile(fn:string; txt:string);
var
    fs : TFileStream;
begin
    fs := TFileStream.Create(fn, fmCreate);
    fs.Write(txt[1], Length(txt));
    fs.Free;
end;

引用 5 楼 tcmakebest 的回复:

不知道这些代码在干嘛，莫名其妙，楼主解释一下

我把源码贴上

JohnYale 2013-10-01

打赏
举报

问题出在哪里解决了吗

noelse520 2013-09-29

打赏
举报

写excel还是用OLE吧，我工作这么多年，操作excel都是用OLE，没觉得怎么不好。

tcmakebest 2013-09-29

打赏
举报

楼主参考一下吧：

procedure WriteFile(fn:string; txt:string);
var
    fs : TFileStream;
begin
    fs := TFileStream.Create(fn, fmCreate);
    fs.Write(txt[1], Length(txt));
    fs.Free;
end;

tcmakebest 2013-09-29

打赏
举报

不知道这些代码在干嘛，莫名其妙，楼主解释一下

孤独de猫 2013-09-28

打赏
举报

用不着用OLE的方法去写，太麻烦了。可以利用TStringLis，#9可以被Excel识别的，如下面的代码。保存后，用Excel 打开即可。


var
  List: TStringList;
begin
  List := TStringList;
  try
    List.Add('你好'#9'非常好');   
    List.SaveToFile('1.xls');
  finally
    List.free;
  end;
end;

奔雷手 2013-09-28

打赏
举报

引用 3 楼 unearth 的回复:

用不着用OLE的方法去写，太麻烦了。可以利用TStringLis，#9可以被Excel识别的，如下面的代码。保存后，用Excel 打开即可。
var
  List: TStringList;
begin
  List := TStringList;
  try
    List.Add('你好'#9'非常好');   
    List.SaveToFile('1.xls');
  finally
    List.free;
  end;
end;

想过各种方法了。你所说的也实验过了。这样写的话无法导出 '0000001' 之类的，也就是无法导出文本类型的单元格

奔雷手 2013-09-27

打赏
举报

引用 1 楼 unearth 的回复:

CXlsLabel是做什么用的？将Stream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel)); 这句先注释掉，先下写进这个 Stream.WriteBuffer(PAnsiChar(str)^, L); 看看效果如果，不过，这句话，我咋感觉看上去有点复杂的，可以直接这样用。通常情况下，不推荐直接基类去操作。可以用TMemoryStream，或TFileStream，其子类来实现。
//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;

我上面的是写EXCEL的方法,OLE方式太慢. 不知道是我写的问题还是怎么，写入的中文是乱码

孤独de猫 2013-09-27

打赏
举报

CXlsLabel是做什么用的？将Stream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel)); 这句先注释掉，先下写进这个 Stream.WriteBuffer(PAnsiChar(str)^, L); 看看效果如果，不过，这句话，我咋感觉看上去有点复杂的，可以直接这样用。通常情况下，不推荐直接基类去操作。可以用TMemoryStream，或TFileStream，其子类来实现。


//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;