mORMot Open Source

Delphi10.3.3+mormot2
(mormot\SynLog is ok)

////////// 1.1-dll Project1.dpr
library Project1;

uses
  uSynLog2, System.SysUtils, System.Classes;

{$R *.res}

function Test(AoMsg : PAnsiChar) : Integer; StdCall; export;
var
  sMsg : String;
begin
  Result := -1;
  sMsg := FormatDatetime('yyyy-MM-dd hh:nn:ss.ZZZ', Now);
  Log(sMsg);
  StrPCopy(AoMsg, sMsg );
  Result := 0;
end;

exports
  Test;

begin
  ReportMemoryLeaksOnShutdown := True;
  InitLog(16);
end.

////////// 1.2-dll uSynLog2.pas
unit uSynLog2;

interface

uses
  System.SysUtils, mormot.core.base, mormot.core.os, mormot.core.log, mormot.core.zip;

Type
  //提示性信息,警告,一般错误,严重错误
  TLogLevel = (llHint, llWarning, llError, llException);

procedure InitLog(ARotateFileCount : Integer = 16);
procedure Log(AMsg : String; ALevel : TLogLevel = llHint);

implementation

procedure InitLog(ARotateFileCount : Integer);
begin
  try
    with TSynLog.Family do
    begin
      Level := LOG_VERBOSE;
      NoEnvironmentVariable := True;
      CustomFileName := ExeVersion.ProgramName;
      DestinationPath := ExeVersion.ProgramFilePath + 'Log';
      if not DirectoryExists(DestinationPath) then
        ForceDirectories(DestinationPath);
      AutoFlushTimeOut := 10;
      OnArchive := EventArchiveZip;
      LocalTimestamp := True;
      RotateFileCount := ARotateFileCount;
      RotateFileSizeKB := 10240;
      RotateFileDailyAtHour := 0;
      FileExistsAction := acAppend;
    end;
  except
  end;
end;

procedure Log(AMsg : String; ALevel : TLogLevel);
var
  Level : TSynLogInfo;
begin
  case ALevel of
    llWarning : Level := sllCustom2; //警告
    llError : Level := sllCustom3; //一般错误
    llException : Level := sllCustom4; //警告
    else Level := sllCustom1; //提示性信息
  end;
  TSynLog.Add.Log(Level, AMsg);
end;

end.

////////// 2.1-exe unit1.pas
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

function Test(AoMsg : PAnsiChar) : Integer; StdCall; external 'Project1.dll';

{$R *.dfm}

function Test_(out AoMsg : String) : Integer;
var
  Msg : Array[0..1023] of AnsiChar;
begin
  Result := Test(Msg);
  AoMsg := StrPas(Msg);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.Clear;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  iRet : Integer;
  sMsg : String;
begin
  iRet := Test_(sMsg);
  Memo1.Lines.Add( Format('%d> %s', [iRet, sMsg]) );
end;

end.

////////// 3.1-run
Button1Click
Button1Click   (!important)
close......