Initial commit - Delphi MES client project

This commit is contained in:
Developer
2026-05-07 20:25:34 +08:00
commit 819b4824f6
466 changed files with 1176403 additions and 0 deletions
+629
View File
@@ -0,0 +1,629 @@
unit uSafeLog;
interface
uses Windows,SysUtils,ComObj,Messages,System.DateUtils,System.Classes,System.IOUtils,
System.StrUtils, FMX.Grid, FMX.Dialogs, FMX.Forms;
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; // 日志目录
procedure SetEnabled(const Value: Boolean);
procedure SetLogFileDir(const Value: string);
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; // 日志目录
procedure SetEnabled(const Value: Boolean);
procedure SetLogFileDir(const Value: string);
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 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);
end;
procedure TSafeLog.Error(const AMessage: string;const Args: array of const);
begin
WriteLog(Format(AMessage, Args),lgvError);
end;
procedure TSafeLog.Hint(const AMessage: string);
begin
WriteLog(AMessage,lgvHint);
end;
procedure TSafeLog.Hint(const AMessage: string;const Args: array of const);
begin
WriteLog(Format(AMessage, Args),lgvHint);
end;
procedure TSafeLog.Warn(const AMessage: string);
begin
WriteLog(AMessage,lgvWarning);
end;
procedure TSafeLog.Warn(const AMessage: string;const Args: array of const);
begin
WriteLog(Format(AMessage, Args),lgvWarning);
end;
procedure TSafeLog.Debug(const AMessage: string);
begin
WriteLog(AMessage,lgvDebug);
end;
procedure TSafeLog.Debug(const AMessage: string;const Args: array of const);
begin
WriteLog(Format(AMessage, Args),lgvDebug);
end;
procedure TSafeLog.MessageInfo(const AMessage: string);
begin
WriteLog(AMessage,lgvMessage);
end;
procedure TSafeLog.MessageInfo(const AMessage: string;const Args: array of const);
begin
WriteLog(Format(AMessage, Args),lgvMessage);
end;
procedure TSafeLog.MessageError(const AMessage: string;const Args: array of const);
begin
WriteLog(Format(AMessage, Args),lgvMessage);
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
raise Exception.Create('日志路径错误,日志类对象不能被创建');
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;
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;
begin
System.TMonitor.Enter(self);
try
if fFileName<>FPrefixFile then
begin
FPrefixFile:= fFileName;
logName := FPrefixFile + '.log'; //+FormatDateTime('yyyymmdd', Now)
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:=Log+#13#10;
// Log:=TLogLevelCaption[LogLevel]+#9+Log;
// Log := FormatDateTime(LOG_TIME_FORMAT, Now) + #9 + Log + #13#10;
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
fFileName:= sFname;
WriteLog(AMessage,lgvMessage);
end;
function TDataSavaLog.OpenLog(sFileLog: String;var f: TStrings):Boolean;
var
sloadLog: String;
begin
try
//ExtractFilePath(ParamStr(0)) +
sloadLog:= (ExtractFilePath(ParamStr(0)) +'DataSava\'+ sFileLog);
DbApiLog.MessageInfo('文件sloadLog:'+sloadLog);
//True,若拷贝过去的文件路径下已存在相同文件,那么不替换文件。//False,若拷贝过去的文件路径下已存在相同文件,那么会替换掉文件。//-----------------------------
CopyFile(PWideChar('\\192.168.0.250\DataSava\'+sFileLog),PWideChar(sLoadLog),True);
f.LoadFromFile(sLoadLog);
except
end;
end;
procedure TDataSavaLog.DelFile(const sFname:string);
begin
try
// DeleteFile('\\192.168.0.250\DataSava\'+sFname);
WINEXEC(PAnsiCHAR('CMD /C DEL /Q/F \\192.168.0.250\DataSava\'+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
raise Exception.Create('日志路径错误,日志类对象不能被创建');
end;
end;
end.