📄 dmparam.pas
字号:
unit dmParam;
interface
uses
SysUtils, Classes, SyncObjs;
const
CONFFILE = 'SMSCfg.ini';
Param_LogEnable = 'Log\Enable';
Param_LogShow = 'Log\Show';
Param_Version = 'CMPP\Version';
Param_ICPId = 'CMPP\ICPId';
Param_ICPShareKey = 'CMPP\ICPShareKey';
Param_ServiceIP = 'CMPP\ServiceIP';
Param_ServicePort = 'CMPP\ServicePort';
Param_SubmitRetry = 'CMPP\SubmitRetry';
Param_RequestTimeOut = 'CMPP\RequestTimeOut';
Param_RequestWindow = 'CMPP\RequestWindow';
type
TdmParamConf = class
private
{ Private declarations }
FstrConfFile: string;
public
{ Public declarations }
constructor Create;
function GetVaule(ParamPath: string; DftVaule: string = ''): string; overload;
function GetVaule(ParamPath: string; DftVaule: Integer = 0): Integer; overload;
function GetVaule(ParamPath: string; DftVaule: boolean = False): boolean; overload;
procedure SetVaule(ParamPath: string; Vaule: string = ''); overload;
procedure SetVaule(ParamPath: string; Vaule: Integer = 0); overload;
procedure SetVaule(ParamPath: string; Vaule: boolean = False); overload;
end;
TOnLog = procedure(Info: string) of object;
//日志文件类型,可以重复轮换
TLogInfo = class
private
FOrgFileName: string;
FCurFileDate: TDateTime;
FLogFile: TFileStream;
FMaxLineNum: Integer;
FCurLineNum: Integer;
FCurFileIndex: Integer;
FWriteLock: TCriticalSection;
FOnLog: TOnLog;
FEnable: boolean;
procedure CheckChgFile;
procedure SetEnable(const Value: boolean);
public
constructor Create(FileName: string; MaxLineNum: Integer = 65535);
destructor Destroy;
procedure LogInfo(Info: string; NeedTime: Boolean = True); overload;
procedure LogInfo(Info: Pointer; Len: integer); overload;
property Enable: boolean read FEnable write SetEnable;
property OnLog: TOnLog read FOnLog write FOnLog;
end;
var
Param : TdmParamConf;
SysLog : TLogInfo;
implementation
uses
Forms, IniFiles, StrUtils;
constructor TdmParamConf.Create;
begin
inherited Create;
FstrConfFile := ExtractFilePath(Application.ExeName) + CONFFILE;
if not FileExists(FstrConfFile) then
begin
FstrConfFile := ExtractFilePath(Application.ExeName) + CONFFILE;
end;
end;
function TdmParamConf.GetVaule(ParamPath: string; DftVaule: string): string;
var
Confs : TIniFile;
SectName : string;
ParamName : string;
begin
Result := DftVaule;
SectName := LeftStr(ParamPath, Pos('\', ParamPath) - 1);
ParamName := RightStr(ParamPath, length(ParamPath) - Pos('\', ParamPath));
if (ParamPath = '') or (SectName = '') or (ParamName = '') then
begin
exit;
end;
Confs := TIniFile.Create(FstrConfFile);
try
if Confs.ValueExists(SectName, ParamName) then
begin
Result := Confs.ReadString(SectName, ParamName, DftVaule);
end
else
begin
Confs.WriteString(SectName, ParamName, DftVaule)
end; // end if
finally
Confs.Free;
end;
end;
function TdmParamConf.GetVaule(ParamPath: string;
DftVaule: Integer): Integer;
var
Confs : TIniFile;
SectName : string;
ParamName : string;
begin
Result := DftVaule;
SectName := LeftStr(ParamPath, Pos('\', ParamPath) - 1);
ParamName := RightStr(ParamPath, length(ParamPath) - Pos('\', ParamPath));
if (ParamPath = '') or (SectName = '') or (ParamName = '') then
begin
exit;
end;
Confs := TIniFile.Create(FstrConfFile);
try
if Confs.ValueExists(SectName, ParamName) then
begin
Result := Confs.ReadInteger(SectName, ParamName, DftVaule);
end
else
begin
Confs.WriteInteger(SectName, ParamName, DftVaule)
end; // end if
finally
Confs.Free;
end;
end;
function TdmParamConf.GetVaule(ParamPath: string;
DftVaule: boolean): boolean;
var
Confs : TIniFile;
SectName : string;
ParamName : string;
begin
Result := DftVaule;
SectName := LeftStr(ParamPath, Pos('\', ParamPath) - 1);
ParamName := RightStr(ParamPath, length(ParamPath) - Pos('\', ParamPath));
if (ParamPath = '') or (SectName = '') or (ParamName = '') then
begin
exit;
end;
Confs := TIniFile.Create(FstrConfFile);
try
if Confs.ValueExists(SectName, ParamName) then
begin
Result := Confs.ReadBool(SectName, ParamName, DftVaule);
end
else
begin
Confs.WriteBool(SectName, ParamName, DftVaule)
end; // end if
finally
Confs.Free;
end;
end;
{ TLogInfo }
procedure TLogInfo.CheckChgFile;
var
CurFileName : string;
begin
if FCurFileDate <> Date then
begin
//新日期,日志更换,从序号0开始
FLogFile.Free;
FCurFileDate := Date;
FCurLineNum := 0;
FCurFileIndex := 0;
CurFileName := FOrgFileName + DateToStr(FCurFileDate) + '_' + IntToStr(FCurFileIndex) + '.txt';
if FileExists(curFileName) then
begin
FLogFile := TFileStream.Create(CurFileName, fmOpenReadWrite or fmShareDenyNone);
end
else
begin
FLogFile := TFileStream.Create(CurFileName, fmOpenReadWrite or fmCreate or fmShareDenyNone);
end; // end if
FLogFile.Seek(0, soFromEnd);
end
else if FCurLineNum >= FMaxLineNum then
begin
//日志行数到最大,日志更换,从序号增加
FLogFile.Free;
FCurLineNum := 0;
Inc(FCurFileIndex);
CurFileName := FOrgFileName + DateToStr(FCurFileDate) + '_' + IntToStr(FCurFileIndex) + '.txt';
if FileExists(curFileName) then
begin
FLogFile := TFileStream.Create(CurFileName, fmOpenReadWrite or fmShareDenyNone);
end
else
begin
FLogFile := TFileStream.Create(CurFileName, fmCreate or fmShareDenyNone);
end; // end if
FLogFile.Seek(0, soFromEnd);
end; // end if
end;
constructor TLogInfo.Create(FileName: string; MaxLineNum: Integer);
var
CurFileName : string;
begin
FOnLog := nil;
FEnable := Param.GetVaule(Param_LogEnable, False);
FWriteLock := TCriticalSection.Create;
if not DirectoryExists('.\Log') then
ForceDirectories('.\Log');
FOrgFileName := '.\Log\' + FileName;
FCurFileDate := Date;
FMaxLineNum := MaxLineNum;
FCurLineNum := 0;
FCurFileIndex := 0;
CurFileName := FOrgFileName + DateToStr(FCurFileDate) + '_' + IntToStr(FCurFileIndex) + '.txt';
if FileExists(curFileName) then
begin
FLogFile := TFileStream.Create(CurFileName, fmOpenReadWrite or fmShareDenyNone);
end
else
begin
FLogFile := TFileStream.Create(CurFileName, fmOpenReadWrite or fmCreate or fmShareDenyNone);
end; // end if
FLogFile.Seek(0, soFromEnd);
end;
destructor TLogInfo.Destroy;
begin
FLogFile.Free;
FWriteLock.Free;
end;
procedure TLogInfo.LogInfo(Info: string; NeedTime: Boolean = True);
begin
FWriteLock.Enter;
CheckChgFile;
if NeedTime then
Info := DateTimeToStr(now) + ' ' + Info;
if assigned(FOnLog) then
FOnLog(Info);
try
if Enable then
begin
FLogFile.WriteBuffer(PChar(Info + #13#10)^, Length(Info + #13#10));
Inc(FCurLineNum);
end;
except
end;
FWriteLock.Leave;
end;
procedure TLogInfo.LogInfo(Info: Pointer; Len: integer);
var
I : integer;
tmp : PByteArray;
LogStr : string;
const
Digits : array[0..15] of char =
('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
begin
tmp := PByteArray(Info);
LogStr := '';
if Len > 0 then
for I := 0 to Len - 1 do
begin
LogStr := LogStr + Digits[(tmp[I] shr 4) and $0F] + Digits[tmp[I] and
$0F] + ' ';
if (i + 1) mod 21 = 0 then
begin
LogInfo(LogStr, False);
LogStr := '';
end
end;
if LogStr <> '' then
LogInfo(LogStr, False);
end;
procedure TLogInfo.SetEnable(const Value: boolean);
begin
FEnable := Value;
end;
procedure TdmParamConf.SetVaule(ParamPath, Vaule: string);
var
Confs : TIniFile;
SectName : string;
ParamName : string;
begin
SectName := LeftStr(ParamPath, Pos('\', ParamPath) - 1);
ParamName := RightStr(ParamPath, length(ParamPath) - Pos('\', ParamPath));
if (ParamPath = '') or (SectName = '') or (ParamName = '') then
begin
exit;
end;
Confs := TIniFile.Create(FstrConfFile);
try
Confs.WriteString(SectName, ParamName, Vaule)
finally
Confs.Free;
end;
end;
procedure TdmParamConf.SetVaule(ParamPath: string; Vaule: Integer);
var
Confs : TIniFile;
SectName : string;
ParamName : string;
begin
SectName := LeftStr(ParamPath, Pos('\', ParamPath) - 1);
ParamName := RightStr(ParamPath, length(ParamPath) - Pos('\', ParamPath));
if (ParamPath = '') or (SectName = '') or (ParamName = '') then
begin
exit;
end;
Confs := TIniFile.Create(FstrConfFile);
try
Confs.WriteInteger(SectName, ParamName, Vaule)
finally
Confs.Free;
end;
end;
procedure TdmParamConf.SetVaule(ParamPath: string; Vaule: boolean);
var
Confs : TIniFile;
SectName : string;
ParamName : string;
begin
SectName := LeftStr(ParamPath, Pos('\', ParamPath) - 1);
ParamName := RightStr(ParamPath, length(ParamPath) - Pos('\', ParamPath));
if (ParamPath = '') or (SectName = '') or (ParamName = '') then
begin
exit;
end;
Confs := TIniFile.Create(FstrConfFile);
try
Confs.WriteBool(SectName, ParamName, Vaule)
finally
Confs.Free;
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -