Initial commit - Delphi MES client project
This commit is contained in:
Developer
@@ -0,0 +1,830 @@
|
||||
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.
|
||||
Reference in New Issue
Block a user