⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 dmparam.pas

📁 使用delphi编写的cmpp接口程序源代码
💻 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 + -