Developer
830 lines
24 KiB
ObjectPascal
830 lines
24 KiB
ObjectPascal
unit uSafeLog;
|
||
|
||
interface
|
||
|
||
uses Windows,SysUtils,ComObj,Messages,System.DateUtils,System.Classes,System.IOUtils,
|
||
System.StrUtils, FMX.Grid, FMX.Dialogs, FMX.Forms, uExceptionHandler, uLogManager, uConfigManager;
|
||
|
||
const
|
||
WRITE_LOG_DIR = 'log\'; // 记录日志默认目录
|
||
LOG_TIME_FORMAT = 'yyyy/mm/dd hh:nn:ss.zzz'; // 日志显示添加时间的格式
|
||
SHOW_LOG_CLEAR_COUNT = 1000; // 日志显示容器最大显示条数
|
||
|
||
type
|
||
TLogLevel=(lgvHint, lgvError, lgvWarning, lgvMessage, lgvDebug);
|
||
TLogLevels = set of TLogLevel;
|
||
|
||
const
|
||
TLogLevelCaption: array [TLogLevel] of string = ('[Hint]:','[Error]:','[Warning]:','[Info]:','[Debug]:');
|
||
|
||
type
|
||
TSafeLog = class
|
||
private
|
||
FFileStream: TFileStream; // 文件流
|
||
FLogShower: TComponent; // 日志显示容器
|
||
FLogDay: TDateTime; // 日志当天天数
|
||
FEnabled: Boolean;
|
||
FPrefixFile:string; //日志文件前缀
|
||
|
||
FLogFileDir: string; // 日志目录
|
||
FUtf8Ready: Boolean;
|
||
procedure SetEnabled(const Value: Boolean);
|
||
procedure SetLogFileDir(const Value: string);
|
||
function EnsureUtf8FileReady(const AFileName: string): Boolean;
|
||
protected
|
||
|
||
public
|
||
FileName:string;
|
||
procedure WriteLog(Log: String; const LogLevel: TLogLevel = lgvHint); overload;
|
||
procedure WriteLog(Log: String; const Args: array of const;const LogLevel: TLogLevel = lgvHint); overload;
|
||
procedure WriteLog(AException: Exception;const LogLevel: TLogLevel = lgvError); overload;
|
||
procedure Error(const AMessage: string);overload;
|
||
procedure Error(const AMessage: string;const Args: array of const);overload;
|
||
procedure Hint(const AMessage: string);overload;
|
||
procedure Hint(const AMessage: string;const Args: array of const);overload;
|
||
procedure Warn(const AMessage: string);overload;
|
||
procedure Warn(const AMessage: string;const Args: array of const);overload;
|
||
procedure Debug(const AMessage: string);overload;
|
||
procedure Debug(const AMessage: string;const Args: array of const);overload;
|
||
procedure MessageInfo(const AMessage: string);overload;
|
||
procedure MessageInfo(const AMessage: string;const Args: array of const);overload;
|
||
procedure MessageError(const AMessage: string;const Args: array of const);overload;
|
||
|
||
constructor Create(PrefixFile:string);
|
||
destructor Destroy; override;
|
||
// 是否允许记录日志
|
||
property Enabled: Boolean read FEnabled write SetEnabled;
|
||
// 日志文件目录,默认当前目录的Log目录
|
||
property LogFileDir: string read FLogFileDir write SetLogFileDir;
|
||
end;
|
||
|
||
TDataSavaLog = class
|
||
private
|
||
FFileStream: TFileStream; // 文件流
|
||
FLogShower: TComponent; // 日志显示容器
|
||
FLogDay: TDateTime; // 日志当天天数
|
||
FEnabled: Boolean;
|
||
fFileName:string; //文件名
|
||
FPrefixFile:string; //日志文件前缀
|
||
FLogFileDir: string; // 日志目录
|
||
FUtf8Ready: Boolean;
|
||
procedure SetEnabled(const Value: Boolean);
|
||
procedure SetLogFileDir(const Value: string);
|
||
function EnsureUtf8FileReady(const AFileName: string): Boolean;
|
||
protected
|
||
|
||
public
|
||
FileName:string;
|
||
procedure WriteLog(Log: String; const LogLevel: TLogLevel = lgvHint); overload;
|
||
procedure DelFile(const sFname:string); overload;
|
||
function OpenLog(sFileLog: String;var f: TStrings):Boolean; overload;
|
||
procedure MessageInfo(const sFname:string;const AMessage: string);overload;
|
||
|
||
constructor Create(PrefixFile:string;Const WRITE_LOG_SaveDIR:string='DataSava\');
|
||
destructor Destroy; override;
|
||
// 是否允许记录日志
|
||
property Enabled: Boolean read FEnabled write SetEnabled;
|
||
// 日志文件目录,默认当前目录的Log目录
|
||
property LogFileDir: string read FLogFileDir write SetLogFileDir;
|
||
end;
|
||
|
||
function WorkLog():TSafeLog;
|
||
function DbApiLog():TSafeLog;
|
||
function RfidLog():TSafeLog;
|
||
function DataLog():TSafeLog;
|
||
function DataSavaLog(sFName: string):TDataSavaLog;
|
||
procedure LogDebug(msg:string);inline;overload; //用于代码测试输出
|
||
procedure LogDebug(Log: String; const Args: array of const);overload;
|
||
procedure CopyLogFile(DestPath:string);
|
||
procedure ExportToExcel(FName: String;RzStrGrid: TStringGrid);//导出到Excel
|
||
|
||
var
|
||
FWorkLog:TSafeLog;
|
||
FDbApiLog,FRfidLog,FDataLog:TSafeLog;
|
||
FDataSavaLog:TDataSavaLog;
|
||
|
||
implementation
|
||
|
||
uses uShowInfo;
|
||
function IsValidUtf8(const bytes: TBytes): Boolean;
|
||
var
|
||
i, extra: Integer;
|
||
b: Byte;
|
||
begin
|
||
Result := True;
|
||
i := 0;
|
||
while i < Length(bytes) do
|
||
begin
|
||
b := bytes[i];
|
||
if (b and $80) = 0 then
|
||
begin
|
||
Inc(i);
|
||
Continue;
|
||
end
|
||
else if (b and $E0) = $C0 then
|
||
extra := 1
|
||
else if (b and $F0) = $E0 then
|
||
extra := 2
|
||
else if (b and $F8) = $F0 then
|
||
extra := 3
|
||
else
|
||
Exit(False);
|
||
|
||
if i + extra >= Length(bytes) then
|
||
Exit(False);
|
||
Inc(i);
|
||
while (extra > 0) do
|
||
begin
|
||
if (bytes[i] and $C0) <> $80 then
|
||
Exit(False);
|
||
Inc(i);
|
||
Dec(extra);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function TSafeLog.EnsureUtf8FileReady(const AFileName: string): Boolean;
|
||
var
|
||
hdr: array[0..2] of Byte;
|
||
fsCheck: TFileStream;
|
||
needConvert: Boolean;
|
||
legacyText: string;
|
||
data: TBytes;
|
||
begin
|
||
Result := True;
|
||
if (AFileName = '') then Exit;
|
||
try
|
||
if FileExists(AFileName) then
|
||
begin
|
||
needConvert := False;
|
||
fsCheck := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
|
||
try
|
||
if fsCheck.Size > 0 then
|
||
begin
|
||
FillChar(hdr, SizeOf(hdr), 0);
|
||
fsCheck.Read(hdr, SizeOf(hdr));
|
||
if (hdr[0]=$EF) and (hdr[1]=$BB) and (hdr[2]=$BF) then
|
||
needConvert := False
|
||
else
|
||
begin
|
||
// 无BOM：读取全部检测是否为有效UTF-8
|
||
fsCheck.Position := 0;
|
||
SetLength(data, fsCheck.Size);
|
||
if fsCheck.Size > 0 then
|
||
fsCheck.ReadBuffer(data[0], fsCheck.Size);
|
||
needConvert := not IsValidUtf8(data);
|
||
end;
|
||
end;
|
||
finally
|
||
fsCheck.Free;
|
||
end;
|
||
if needConvert then
|
||
begin
|
||
legacyText := TFile.ReadAllText(AFileName, TEncoding.ANSI);
|
||
TFile.WriteAllText(AFileName, legacyText, TEncoding.UTF8);
|
||
end;
|
||
end;
|
||
except
|
||
on E: Exception do
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
function TDataSavaLog.EnsureUtf8FileReady(const AFileName: string): Boolean;
|
||
var
|
||
hdr: array[0..2] of Byte;
|
||
fsCheck: TFileStream;
|
||
needConvert: Boolean;
|
||
legacyText: string;
|
||
data: TBytes;
|
||
begin
|
||
Result := True;
|
||
if (AFileName = '') then Exit;
|
||
try
|
||
if FileExists(AFileName) then
|
||
begin
|
||
needConvert := False;
|
||
fsCheck := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
|
||
try
|
||
if fsCheck.Size > 0 then
|
||
begin
|
||
FillChar(hdr, SizeOf(hdr), 0);
|
||
fsCheck.Read(hdr, SizeOf(hdr));
|
||
if (hdr[0]=$EF) and (hdr[1]=$BB) and (hdr[2]=$BF) then
|
||
needConvert := False
|
||
else
|
||
begin
|
||
fsCheck.Position := 0;
|
||
SetLength(data, fsCheck.Size);
|
||
if fsCheck.Size > 0 then
|
||
fsCheck.ReadBuffer(data[0], fsCheck.Size);
|
||
needConvert := not IsValidUtf8(data);
|
||
end;
|
||
end;
|
||
finally
|
||
fsCheck.Free;
|
||
end;
|
||
if needConvert then
|
||
begin
|
||
legacyText := TFile.ReadAllText(AFileName, TEncoding.ANSI);
|
||
TFile.WriteAllText(AFileName, legacyText, TEncoding.UTF8);
|
||
end;
|
||
end;
|
||
except
|
||
on E: Exception do
|
||
Result := False;
|
||
end;
|
||
end;
|
||
|
||
|
||
function WorkLog():TSafeLog;
|
||
begin
|
||
if FWorkLog = nil then
|
||
begin
|
||
FWorkLog := TSafeLog.Create('work');
|
||
FWorkLog.Enabled:=true;
|
||
end;
|
||
Result := FWorkLog;
|
||
end;
|
||
|
||
function DbApiLog():TSafeLog;
|
||
begin
|
||
if FDbApiLog = nil then
|
||
begin
|
||
FDbApiLog := TSafeLog.Create('Api');
|
||
FDbApiLog.Enabled:=true;
|
||
end;
|
||
Result := FDbApiLog;
|
||
end;
|
||
|
||
function RfidLog():TSafeLog;
|
||
begin
|
||
if FRfidLog = nil then
|
||
begin
|
||
FRfidLog := TSafeLog.Create('Rfid');
|
||
FRfidLog.Enabled:=true;
|
||
end;
|
||
Result := FRfidLog;
|
||
end;
|
||
|
||
function DataLog():TSafeLog;
|
||
begin
|
||
if FDataLog = nil then
|
||
begin
|
||
FDataLog := TSafeLog.Create('Data');
|
||
FDataLog.Enabled:=true;
|
||
end;
|
||
Result := FDataLog;
|
||
end;
|
||
|
||
function DataSavaLog(sFName: string):TDataSavaLog;
|
||
begin
|
||
if FDataSavaLog = nil then
|
||
begin
|
||
FDataSavaLog := TDataSavaLog.Create(sFName); //'D301909600'+'-'+'1688187-A01-0F'
|
||
FDataSavaLog.Enabled:=true;
|
||
end;
|
||
Result := FDataSavaLog;
|
||
end;
|
||
|
||
procedure LogDebug(msg:string);overload;
|
||
begin
|
||
outputdebugstring(pchar(msg));
|
||
end;
|
||
|
||
procedure LogDebug(Log: String; const Args: array of const);overload;
|
||
begin
|
||
outputdebugstring(pchar(Format(Log, Args)));
|
||
end;
|
||
|
||
procedure TSafeLog.Error(const AMessage: string);
|
||
begin
|
||
WriteLog(AMessage,lgvError);
|
||
LogManager.ErrorCategory(lcSystem, AMessage);
|
||
end;
|
||
|
||
procedure TSafeLog.Error(const AMessage: string;const Args: array of const);
|
||
begin
|
||
WriteLog(Format(AMessage, Args),lgvError);
|
||
LogManager.ErrorCategory(lcSystem, AMessage, Args);
|
||
end;
|
||
|
||
procedure TSafeLog.Hint(const AMessage: string);
|
||
begin
|
||
WriteLog(AMessage,lgvHint);
|
||
LogManager.TraceCategory(lcSystem, AMessage);
|
||
end;
|
||
|
||
procedure TSafeLog.Hint(const AMessage: string;const Args: array of const);
|
||
begin
|
||
WriteLog(Format(AMessage, Args),lgvHint);
|
||
LogManager.TraceCategory(lcSystem, AMessage, Args);
|
||
end;
|
||
|
||
procedure TSafeLog.Warn(const AMessage: string);
|
||
begin
|
||
WriteLog(AMessage,lgvWarning);
|
||
LogManager.WarnCategory(lcSystem, AMessage);
|
||
end;
|
||
|
||
procedure TSafeLog.Warn(const AMessage: string;const Args: array of const);
|
||
begin
|
||
WriteLog(Format(AMessage, Args),lgvWarning);
|
||
LogManager.WarnCategory(lcSystem, AMessage, Args);
|
||
end;
|
||
|
||
procedure TSafeLog.Debug(const AMessage: string);
|
||
begin
|
||
WriteLog(AMessage,lgvDebug);
|
||
LogManager.DebugCategory(lcSystem, AMessage);
|
||
end;
|
||
|
||
procedure TSafeLog.Debug(const AMessage: string;const Args: array of const);
|
||
begin
|
||
WriteLog(Format(AMessage, Args),lgvDebug);
|
||
LogManager.DebugCategory(lcSystem, AMessage, Args);
|
||
end;
|
||
|
||
procedure TSafeLog.MessageInfo(const AMessage: string);
|
||
begin
|
||
WriteLog(AMessage,lgvMessage);
|
||
LogManager.InfoCategory(lcSystem, AMessage);
|
||
end;
|
||
|
||
procedure TSafeLog.MessageInfo(const AMessage: string;const Args: array of const);
|
||
begin
|
||
WriteLog(Format(AMessage, Args),lgvMessage);
|
||
LogManager.InfoCategory(lcSystem, AMessage, Args);
|
||
end;
|
||
|
||
procedure TSafeLog.MessageError(const AMessage: string;const Args: array of const);
|
||
begin
|
||
WriteLog(Format(AMessage, Args),lgvMessage);
|
||
LogManager.ErrorCategory(lcSystem, AMessage, Args);
|
||
end;
|
||
|
||
procedure TSafeLog.WriteLog(Log: String; const Args: array of const;const LogLevel: TLogLevel = lgvHint);
|
||
begin
|
||
WriteLog(Format(Log, Args), LogLevel);
|
||
end;
|
||
|
||
procedure TSafeLog.WriteLog(AException: Exception;const LogLevel: TLogLevel = lgvError);
|
||
begin
|
||
WriteLog(AException.Message,lgvError);
|
||
end;
|
||
|
||
procedure TSafeLog.SetEnabled(const Value: Boolean);
|
||
begin
|
||
FEnabled := Value;
|
||
end;
|
||
|
||
procedure TSafeLog.SetLogFileDir(const Value: string);
|
||
begin
|
||
FLogFileDir := Value;
|
||
if not DirectoryExists(FLogFileDir) then
|
||
if not ForceDirectories(FLogFileDir) then //创建目录
|
||
begin
|
||
RaiseDataException('日志路径错误，日志类对象不能被创建', 2001);
|
||
end;
|
||
end;
|
||
|
||
constructor TSafeLog.Create(PrefixFile:string);
|
||
begin
|
||
FLogShower := nil;
|
||
FLogDay:=-1;
|
||
FPrefixFile:=PrefixFile;
|
||
LogFileDir := ExtractFilePath(ParamStr(0)) + WRITE_LOG_DIR;
|
||
end;
|
||
|
||
destructor TSafeLog.Destroy;
|
||
begin
|
||
if Assigned(FFileStream) then
|
||
FreeAndNil(FFileStream);
|
||
end;
|
||
|
||
procedure TSafeLog.WriteLog(Log: String; const LogLevel: TLogLevel = lgvHint);
|
||
var
|
||
logName: String;
|
||
fMode: Word;
|
||
bytes: TBytes;
|
||
begin
|
||
System.TMonitor.Enter(self);
|
||
try
|
||
if FLogDay<>Date then
|
||
begin
|
||
logName := FPrefixFile+FormatDateTime('yyyymmdd', Now) + '.log'; //
|
||
FLogDay:=Date;
|
||
FileName:=FLogFileDir + logName;
|
||
if FileExists(FileName) then // 如果当天的日志文件存在
|
||
fMode := fmOpenWrite or fmShareDenyNone
|
||
else
|
||
fMode := fmCreate or fmShareDenyNone;
|
||
|
||
if Assigned(FFileStream) then
|
||
FreeAndNil(FFileStream);
|
||
FFileStream := TFileStream.Create(FLogFileDir + logName, fMode);
|
||
end;
|
||
FFileStream.Seek(0,soEnd); // 追加到最后
|
||
if Log='' then
|
||
Log:=#13#10
|
||
else
|
||
begin
|
||
Log:=TLogLevelCaption[LogLevel]+#9+Log;
|
||
Log := FormatDateTime(LOG_TIME_FORMAT, Now) + #9 + Log + #13#10;
|
||
end;
|
||
|
||
// 修复乱码问题：添加UTF-8 BOM并使用正确的编码
|
||
if (FFileStream.Size = 0) then
|
||
begin
|
||
// 添加UTF-8 BOM以避免乱码
|
||
bytes := [$EF, $BB, $BF]; // UTF-8 BOM
|
||
FFileStream.Write(bytes, Length(bytes));
|
||
end;
|
||
|
||
bytes := TEncoding.UTF8.GetBytes(Log);
|
||
FFileStream.Write(bytes, Length(bytes));
|
||
finally
|
||
System.TMonitor.Exit(self);
|
||
end;
|
||
end;
|
||
|
||
function CombinePath(QPathA: string; QPathB: string): string;
|
||
var
|
||
lSeparatorChar: string;
|
||
lReplaceChar: string;
|
||
begin
|
||
lSeparatorChar := TPath.DirectorySeparatorChar;
|
||
lReplaceChar := '/';
|
||
if lSeparatorChar = '/' then
|
||
begin
|
||
lReplaceChar := '\';
|
||
end;
|
||
QPathA := QPathA.Replace(lReplaceChar, lSeparatorChar);
|
||
QPathB := QPathB.Replace(lReplaceChar, lSeparatorChar);
|
||
if RightStr(QPathA,1)<>lSeparatorChar then
|
||
QPathA:=QPathA+lSeparatorChar;
|
||
|
||
if QPathB.Length > 0 then
|
||
begin
|
||
if QPathA.Length > 0 then
|
||
begin
|
||
// 判断第一个是不是 lSeparatorChar,是的话去除
|
||
if leftStr(QPathB, 1) = lSeparatorChar then
|
||
begin
|
||
QPathB := QPathB.Substring(1, QPathB.Length - 1);
|
||
end;
|
||
end;
|
||
end;
|
||
result := TPath.Combine(QPathA, QPathB);
|
||
end;
|
||
|
||
procedure CopyLogFile(DestPath:string);
|
||
begin
|
||
TThread.CreateAnonymousThread( // 创建一个匿名线程，
|
||
procedure
|
||
var
|
||
FileName:string;
|
||
begin
|
||
try
|
||
FileName:=CombinePath(DestPath,TPath.GetDirectoryName(FWorkLog.FileName));
|
||
Copyfile(Pchar(FWorkLog.FileName),Pchar(FileName),false);
|
||
FileName:=CombinePath(DestPath,TPath.GetDirectoryName(FDbApiLog.FileName));
|
||
Copyfile(Pchar(FDbApiLog.FileName),Pchar(FileName),false);
|
||
FileName:=CombinePath(DestPath,TPath.GetDirectoryName(FRfidLog.FileName));
|
||
Copyfile(Pchar(FRfidLog.FileName),Pchar(FileName),false);
|
||
except
|
||
on e:Exception do
|
||
begin
|
||
workLog.Error('上传日志出错:%s',[e.Message]);
|
||
end;
|
||
end;
|
||
end).Start;
|
||
end;
|
||
|
||
procedure Stringgridtoexcel(atitle: string;Astringgrid: TStringGrid; Afontsize: integer);
|
||
var
|
||
xlapp, xlsheet: variant;
|
||
row, CCC, nnn, jjj: integer;
|
||
begin
|
||
try
|
||
xlapp := createoleobject('excel.application');
|
||
except
|
||
// showmessage('not found excel in your system, so can not create file!');
|
||
exit;
|
||
end;
|
||
try
|
||
ccc := AstringGrid.ColumnCount;
|
||
xlapp.workbooks.add; //添加新工作簿
|
||
xlapp.visible := false;
|
||
xlsheet := xlapp.activesheet;
|
||
xlapp.activewindow.windowstate := 2;
|
||
xlapp.range[xlsheet.cells[1, 1], xlsheet.cells[1, ccc]];//.MERGE;
|
||
xlsheet.cells[1, 1] := Atitle; //页头第一行；
|
||
// xlsheet.cells[1, 1].HorizontalAlignment := -4108;
|
||
row := 2;
|
||
for jjj := 0 to Astringgrid.RowCount - 1 do
|
||
begin
|
||
for nnn := 1 to ccc do
|
||
xlsheet.cells[row, nnn] := trim(Astringgrid.Cells[nnn - 1, row - 2]);
|
||
// xlsheet.rows[row].RowHeight := 18;
|
||
inc(row);
|
||
end;
|
||
xlapp.visible := true;
|
||
//格式调整
|
||
// xlapp.range[xlsheet.cells[row, 1], xlsheet.cells[row, 13]].WrapText := True;
|
||
// xlapp.range[xlsheet.cells[row, 1], xlsheet.cells[row, 13]].HorizontalAlignment := -4108;
|
||
xlsheet.pagesetup.headerMargin := 1 / 0.035; //页眉到顶端边距1cm
|
||
xlsheet.pagesetup.footerMargin := 0.6 / 0.035; //页脚到底端边距1cm
|
||
xlsheet.pagesetup.topMargin := 1 / 0.035; //顶边距1cm
|
||
XLSHEET.pagesetup.bottomMargin := 1.3 / 0.035; //底边距1cm
|
||
xlsheet.pagesetup.leftMargin := 0.5 / 0.035; //左边距1cm
|
||
xlsheet.pagesetup.rightMargin := 0.5 / 0.035; //右边距1cm
|
||
// xlsheet.pagesetup.leftfooter := '制表: ' + Puboptername;
|
||
xlsheet.pagesetup.centerfooter := ''; //页脚
|
||
xlsheet.pagesetup.rightfooter := '第&P页/共&N页';
|
||
xlsheet.pagesetup.leftHeader := '';
|
||
xlsheet.pagesetup.orientation := 1; //横向
|
||
xlsheet.pagesetup.printtitlerows := '$1:$1';
|
||
// xlsheet.rows[1].font.name := '宋体'; //设置第一行字体属性
|
||
// xlsheet.rows[1].font.bold := true;
|
||
// xlsheet.rows[1].font.size := 20;
|
||
// xlsheet.rows[1].RowHeight := 28;
|
||
// for nnn := 1 to ccc do
|
||
// begin
|
||
// xlsheet.columns[nnn].columnwidth := Astringgrid.ColWidths[nnn - 1] * 0.1188;
|
||
// end;
|
||
// for nnn := 1 to 4 do begin
|
||
// xlapp.range[xlsheet.cells[2, 1], xlsheet.cells[row - 1, CCC]].borders[nnn].linestyle := 1;
|
||
// xlapp.range[xlsheet.cells[2, 1], xlsheet.cells[row - 1, CCC]].borders[nnn].weight := 1;
|
||
// end;
|
||
// xlapp.range[xlsheet.cells[2, 1], xlsheet.cells[row - 1, CCC]].font.size := Afontsize;
|
||
// xlapp.range[xlsheet.cells[2, 1], xlsheet.cells[row - 1, ccc]].WrapText := True;
|
||
varclear(xlsheet);
|
||
varclear(xlapp);
|
||
except
|
||
on E: Exception do
|
||
begin
|
||
xlapp.quit;
|
||
// showMSG('出现错误' + E.message, '错误', 1);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
//把他写成了一个过程，这样其他用到这个StringGrid的控件都可以刁永红这个来导出了
|
||
procedure ExportToExcel(FName: String;RzStrGrid: TStringGrid);
|
||
const
|
||
xlNormal = -4143;
|
||
var
|
||
i, j, k, l: integer;
|
||
filename: string;
|
||
excel, Vrange: OleVariant;
|
||
savedialog: TSaveDialog;
|
||
begin
|
||
filename := ExtractFilePath(Paramstr(0))+'log\'+FName;
|
||
if RzStrGrid.RowCount > 65536 then
|
||
begin
|
||
// if application.messagebox('需要导出的数据过大，Excel最大只能容纳65536行,是否还要继续？', '询问', mb_yesno + mb_iconquestion) = idno then
|
||
exit;
|
||
end;
|
||
// screen.Cursor := crHourGlass;
|
||
|
||
try
|
||
excel := CreateOleObject('Excel.Application');
|
||
excel.workbooks.add;
|
||
except
|
||
// screen.cursor := crDefault;
|
||
showmessage('无法调用Excel！');
|
||
exit;
|
||
end;
|
||
// savedialog := TSaveDialog.Create(nil);
|
||
// savedialog.Filter := 'Excel文件(*.xls)|*.xls';
|
||
// if savedialog.Execute then
|
||
// begin
|
||
// if FileExists(savedialog.FileName) then
|
||
// try
|
||
// if ShowInfoOKCancel('该文件已经存在，要覆盖吗？') then
|
||
// DeleteFile(PChar(savedialog.FileName))
|
||
// else
|
||
// begin
|
||
// excel.Quit;
|
||
// savedialog.free;
|
||
// // screen.cursor := crDefault;
|
||
// Exit;
|
||
// end;
|
||
// except
|
||
// excel.Quit;
|
||
// savedialog.free;
|
||
// // screen.cursor := crDefault;
|
||
// Exit;
|
||
// end;
|
||
// filename := savedialog.FileName;
|
||
// end;
|
||
// savedialog.free;
|
||
if filename = '' then
|
||
begin
|
||
excel.Quit;
|
||
// screen.cursor := crDefault;
|
||
exit;
|
||
end;
|
||
//设置字体
|
||
excel.Cells.Font.Size := 10;
|
||
//导出数据到Excel
|
||
for i := 0 to RzStrGrid.RowCount - 1 do
|
||
begin
|
||
for j := 0 to RzStrGrid.ColumnCount - 1 do
|
||
begin
|
||
excel.Cells[i + 1, j + 1] := RzStrGrid.Cells[j, i];
|
||
end;
|
||
end;
|
||
//设置列宽
|
||
// excel.ActiveSheet.Columns[3].ColumnWidth := 15;
|
||
//需要合并的单元格
|
||
Vrange := excel.range[excel.cells[RzStrGrid.RowCount + 1, 1], excel.cells[RzStrGrid.RowCount + 1, RzStrGrid.ColumnCount]];
|
||
Vrange.Select;
|
||
//合并单元格
|
||
Vrange.Merge(True);
|
||
//合并后单元格内容的字体大小
|
||
Vrange.Font.Size := 15;
|
||
Vrange.Font.Bold := True;
|
||
//合并单元格后的背景色
|
||
Vrange.Interior.ColorIndex := 6;
|
||
////最后一行加一个注解
|
||
//excel.cells[RzStrGrid.RowCount + 1, 1] := '注意：导出Excel和上一篇文章导出的Excel模板一样，可以进行导入导出';
|
||
//整页的文本全都居中
|
||
excel.columns.HorizontalAlignment := 3;
|
||
try
|
||
//判断文件名后缀是不是.xls
|
||
if copy(filename, length(filename) - 3, 4) <> '.xls' then
|
||
filename := filename + '.xls';
|
||
//保存Excel
|
||
excel.ActiveWorkbook.SaveAs(filename, xlNormal, '', '', False, False);
|
||
except
|
||
excel.Quit;
|
||
// screen.cursor := crDefault;
|
||
exit;
|
||
end;
|
||
// excel.Visible := true; //打开文件
|
||
// screen.cursor := crDefault;
|
||
end;
|
||
|
||
{ TDataSavaLog }
|
||
|
||
constructor TDataSavaLog.Create(PrefixFile: string;Const WRITE_LOG_SaveDIR:string='DataSava\');
|
||
begin
|
||
FLogShower := nil;
|
||
FLogDay:=-1;
|
||
FPrefixFile:=PrefixFile;
|
||
LogFileDir := ExtractFilePath(ParamStr(0)) + WRITE_LOG_SaveDIR;
|
||
end;
|
||
|
||
destructor TDataSavaLog.Destroy;
|
||
begin
|
||
if Assigned(FFileStream) then
|
||
FreeAndNil(FFileStream);
|
||
end;
|
||
|
||
procedure TDataSavaLog.WriteLog(Log: String; const LogLevel: TLogLevel = lgvHint);
|
||
var
|
||
logName: String;
|
||
fMode: Word;
|
||
bytes: TBytes;
|
||
hdr: array[0..2] of Byte;
|
||
fsCheck: TFileStream;
|
||
needConvert: Boolean;
|
||
legacyText: string;
|
||
begin
|
||
System.TMonitor.Enter(self);
|
||
try
|
||
if fFileName<>FPrefixFile then
|
||
begin
|
||
FPrefixFile:= fFileName;
|
||
|
||
logName := FPrefixFile + '.log'; //+FormatDateTime('yyyymmdd', Now)
|
||
FLogDay:=Date;
|
||
FileName:=FLogFileDir + logName;
|
||
FUtf8Ready := EnsureUtf8FileReady(FileName);
|
||
if FileExists(FileName) then // 如果当天的日志文件存在
|
||
begin
|
||
// 若历史文件不是UTF-8 BOM，转为UTF-8 BOM
|
||
needConvert := False;
|
||
fsCheck := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
|
||
try
|
||
if fsCheck.Size > 0 then
|
||
begin
|
||
FillChar(hdr, SizeOf(hdr), 0);
|
||
fsCheck.Read(hdr, SizeOf(hdr));
|
||
needConvert := not ((hdr[0]=$EF) and (hdr[1]=$BB) and (hdr[2]=$BF));
|
||
end;
|
||
finally
|
||
fsCheck.Free;
|
||
end;
|
||
if needConvert then
|
||
begin
|
||
legacyText := TFile.ReadAllText(FileName, TEncoding.ANSI);
|
||
TFile.WriteAllText(FileName, legacyText, TEncoding.UTF8);
|
||
end;
|
||
fMode := fmOpenWrite or fmShareDenyNone
|
||
end
|
||
else
|
||
fMode := fmCreate or fmShareDenyNone;
|
||
|
||
if Assigned(FFileStream) then
|
||
FreeAndNil(FFileStream);
|
||
FFileStream := TFileStream.Create(FLogFileDir + logName, fMode);
|
||
end;
|
||
// 非跨文件写入时，也确保为UTF-8
|
||
if (not FUtf8Ready) and (FileName <> '') then
|
||
begin
|
||
FUtf8Ready := EnsureUtf8FileReady(FileName);
|
||
end;
|
||
FFileStream.Seek(0,soEnd); // 追加到最后
|
||
if Log='' then
|
||
Log:=#13#10
|
||
else
|
||
begin
|
||
Log:=Log+#13#10;
|
||
// Log:=TLogLevelCaption[LogLevel]+#9+Log;
|
||
// Log := FormatDateTime(LOG_TIME_FORMAT, Now) + #9 + Log + #13#10;
|
||
end;
|
||
|
||
// 使用UTF-8编码，并在新文件写入BOM
|
||
if (FFileStream.Size = 0) then
|
||
begin
|
||
bytes := [$EF, $BB, $BF];
|
||
FFileStream.Write(bytes, Length(bytes));
|
||
end;
|
||
bytes := TEncoding.UTF8.GetBytes(Log);
|
||
FFileStream.Write(bytes, Length(bytes));
|
||
finally
|
||
System.TMonitor.Exit(self);
|
||
end;
|
||
end;
|
||
|
||
procedure TDataSavaLog.MessageInfo(const sFname: string; const AMessage: string);
|
||
begin
|
||
try
|
||
fFileName := sFname;
|
||
WriteLog(AMessage, lgvMessage);
|
||
except
|
||
on E: Exception do
|
||
begin
|
||
// 静默处理日志记录异常
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
// 添加繁简转换函数
|
||
function TraditionalToSimplified(const str: string): string;
|
||
begin
|
||
// 在实际应用中，这里应该实现繁体到简体的转换逻辑
|
||
// 目前只是返回原字符串，需要根据实际需求实现转换算法或使用转换库
|
||
Result := str;
|
||
end;
|
||
|
||
function TDataSavaLog.OpenLog(sFileLog: String; var f: TStrings): Boolean;
|
||
var
|
||
sloadLog: String;
|
||
begin
|
||
Result := False;
|
||
try
|
||
// ExtractFilePath(ParamStr(0)) +
|
||
sloadLog := (ExtractFilePath(ParamStr(0)) + 'DataSava\' + sFileLog);
|
||
DbApiLog.MessageInfo('文件sloadLog:' + sloadLog);
|
||
// True，若拷贝过去的文件路径下已存在相同文件，那么不替换文件。// False，若拷贝过去的文件路径下已存在相同文件，那么会替换掉文件。//-----------------------------
|
||
CopyFile(PWideChar(Config.GetFileServerPath + '\' + sFileLog), PWideChar(sLoadLog), True);
|
||
f.LoadFromFile(sLoadLog);
|
||
Result := True;
|
||
except
|
||
on E: Exception do
|
||
begin
|
||
// 静默处理文件打开异常
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TDataSavaLog.DelFile(const sFname:string);
|
||
begin
|
||
try
|
||
// DeleteFile('\\192.168.0.250\DataSava\'+sFname);
|
||
WINEXEC(PAnsiCHAR('CMD /C DEL /Q/F ' + Config.GetFileServerPath + '\' + sFname), SW_HIDE); Sleep(1000);
|
||
except
|
||
|
||
end;
|
||
end;
|
||
|
||
procedure TDataSavaLog.SetEnabled(const Value: Boolean);
|
||
begin
|
||
FEnabled := Value;
|
||
end;
|
||
|
||
procedure TDataSavaLog.SetLogFileDir(const Value: string);
|
||
begin
|
||
FLogFileDir := Value;
|
||
if not DirectoryExists(FLogFileDir) then
|
||
if not ForceDirectories(FLogFileDir) then //创建目录
|
||
begin
|
||
RaiseDataException('日志路径错误，日志类对象不能被创建', 2001);
|
||
end;
|
||
end;
|
||
|
||
end. |