Refactoring and enhances

MyLog.pas

@@ -1,22 +1,33 @@
 {$I+}
 unit MyLog;
 {*******************************} interface {**********************************}
-var
-  UseAppendMode          :Boolean = true;//One file mode. OLog file opened only in writing.
-  WriteTimeToLog         :Boolean = true;
-  WriteMillisecondsToLog :Boolean = False;
-  LogElementsSeparator   :String  = ' ';
-Procedure WriteMyLog(const aStr :String);
-Procedure WriteMyLogEx(const aArgs :array of const; const aHeader :String = '');
-// WriteMyLogEx(['vMin',vMin,'vMax',vMax], 'Testing') -> Testing vMin=20 vMax=40
-{*****************************} implementation {*******************************}
 Uses
   System.SysUtils,
   System.Variants,
   System.IOUtils,
   System.SyncObjs,
-  System.Diagnostics;
+  System.Diagnostics,
+  System.Classes,
+  System.TypInfo;
+
+const
+  UseAppendMode = False;
+  // (true) Append mode: Single-file mode. The file is opened only when writing.
+  // (false) Normal mode: The file is open all the time
+var
+  WriteTimeToLog         :Boolean = True;
+  WriteMillisecondsToLog :Boolean = False;
+  WriteTreadIDToLog      :Boolean = False;
+  LogElementsSeparator   :String  = ' ';
+Procedure WriteMyLog(const aStr :String); overload;
+Procedure WriteMyLog(const aArgs :array of const; const aHeader :String = ''); overload;
+// Using: WriteMyLogEx(['vMin',vMin,'vMax',vMax], 'Testing') -> Testing vMin=20 vMax=40
 
+// Set<->String miscellaneous functions
+function SetToString(Info :PTypeInfo; const SetParam; Brackets :Boolean = true) :String;
+// Using: S:=SetToString(TypeInfo(TMySet), MSet, True);
+procedure StringToSet(Info :PTypeInfo; var SetParam; const Value :String);
+{*****************************} implementation {*******************************}
 var
   fInLog       : TCriticalSection;
   fFS          : TFormatSettings;
@@ -26,12 +37,13 @@ var
   fFileBuf     : array[1..4096] of Char;
   fLogFileName : string;
 
-procedure AddStr(var aStr :String;const aAddStr :String);inline;
+procedure AddStr(var aStr :String; const aAddStr :String); inline;
 begin
   aStr := aStr + aAddStr;
 end;
 
-Procedure WriteMyLog(const aStr :String);
+{$region 'WriteMyLog'}
+Procedure WriteMyLog(const aStr :String); overload;
 begin
   if not fLogOpened then
     Exit;
@@ -48,10 +60,14 @@ begin
     AddStr(vFullStr, ']' + aStr);
   end else
     vFullStr := aStr;
+
+  if WriteTreadIDToLog then
+    AddStr(vFullStr, '{' + TThread.CurrentThread.ToString + '_' + UIntToStr(TThread.CurrentThread.ThreadID) + '}');
+
   fInLog.Acquire;
   try
     try
-      if UseAppendMode then begin
+      if UseAppendMode then begin  // Append mode
         AssignFile(fLogFile, fLogFileName);
         if FileExists(fLogFileName) then
           Append(fLogFile)
@@ -62,46 +78,48 @@ begin
         finally
           CloseFile(fLogFile);
         end;
-      end else begin
+      end else begin // Normal mode
         Writeln(fLogFile, vFullStr);
         Flush(fLogFile);
       end;
     except
-      //Ignoring all exceptions
+      // Ignoring all exceptions
     end;{try}
   finally
     fInLog.Release;
   end;
 end;
 
-function PointerToStr(aPtr : Pointer):String;
-begin
-  if aPtr=nil then
-    Exit('nil')
-  else
-    Exit(IntToHex(UIntPtr(aPtr)));
-end;
-
-function ObjectToStr(aObj : TObject):String;
-begin
-  if aObj=nil then
-    Exit('[]nil')
-  else
-    Exit('['+aObj.ClassName+']'+PointerToStr(aObj));
-end;
 
-
-Procedure WriteMyLogEx(const aArgs :array of const; const aHeader :String = '');
+Procedure WriteMyLog(const aArgs :array of const; const aHeader :String = ''); overload;
 var
   vArgument :Boolean;
-  vStr :String;
-  procedure IncStr(const aAddStr :String);
+  vStr      :String;
+
+  procedure locIncStr(const aAddStr :String);
   begin
     if vArgument then
       AddStr(vStr, aAddStr)
     else
       AddStr(vStr, '=' + aAddStr + LogElementsSeparator);
   end;
+
+  function locPointerToStr(aPtr :Pointer) :String;
+  begin
+    if aPtr = nil then
+      Exit('nil')
+    else
+      Exit(IntToHex(UIntPtr(aPtr)));
+  end;
+
+  function locObjectToStr(aObj :TObject) :String;
+  begin
+    if aObj=nil then
+      Exit('[]nil')
+    else
+      Exit('[' + aObj.ClassName + ']' + locPointerToStr(aObj));
+  end;
+
 begin
   if not fLogOpened then
     Exit;
@@ -112,42 +130,42 @@ begin
   for var I := Low(aArgs) to High(aArgs) do begin
     with aArgs[I] do begin
       case VType of
-          vtUnicodeString : IncStr(String(UnicodeString(VUnicodeString)));
-          vtAnsiString    : IncStr(String(AnsiString(VAnsiString)));
-          vtWideString    : IncStr(String(WideString(VWideString)));
-          vtString        : IncStr(String(VString^));
-
-          vtInteger       : IncStr(IntToStr(VInteger));
-          vtInt64         : IncStr(IntToStr(VInt64^));
-          vtExtended      : IncStr(FloatToStr(VExtended^, fFS));
-          vtBoolean       : IncStr(BoolToStr(VBoolean, true));
-          vtCurrency      : IncStr(CurrToStr(VCurrency^, fFS));
-          vtObject        : IncStr(ObjectToStr(VObject));
-          vtClass         : IncStr(VClass.ClassName);
-          vtPointer       : IncStr(PointerToStr(vPointer));
-          vtVariant       : IncStr(VarToStr(VVariant^));
-          vtInterface     : IncStr(PointerToStr(vInterface));
-(*
-          vtChar
-          vtPChar
-          vtWideChar
-          vtPWideChar
-*)
+          vtUnicodeString : locIncStr(String(UnicodeString(VUnicodeString)));
+          vtAnsiString    : locIncStr(String(AnsiString(VAnsiString)));
+          vtWideString    : locIncStr(String(WideString(VWideString)));
+          vtString        : locIncStr(String(VString^));
+
+          vtInteger       : locIncStr(IntToStr(VInteger));
+          vtInt64         : locIncStr(IntToStr(VInt64^));
+          vtExtended      : locIncStr(FloatToStr(VExtended^, fFS));
+          vtBoolean       : locIncStr(BoolToStr(VBoolean, true));
+          vtCurrency      : locIncStr(CurrToStr(VCurrency^, fFS));
+          vtObject        : locIncStr(locObjectToStr(VObject));
+          vtClass         : locIncStr(VClass.ClassName);
+          vtPointer       : locIncStr(locPointerToStr(vPointer));
+          vtVariant       : locIncStr(VarToStr(VVariant^));
+          vtInterface     : locIncStr(locPointerToStr(vInterface));
+
+          vtChar          : locIncStr(String(AnsiString(VChar)));
+          vtPChar         : locIncStr(String(AnsiString(VPChar^)));
+          vtWideChar      : locIncStr(String(WideString(VWideChar)));
+          vtPWideChar     : locIncStr(String(WideString(VPWideChar^)));
       end;{case}
     end;{with}
     vArgument := not vArgument;
   end;{for i}
   WriteMyLog(vStr);
 end;
+{$endregion 'WriteMyLog'}
 
-
+{$region 'Init/Done'}
 procedure InitLogSubSystem;
 begin
   fLogOpened := True;
   try
     var vTmpPath := TPath.GetTempPath + PathDelim + 'MyLog';
     CreateDir(vTmpPath);
-    AddStr(vTmpPath, PathDelim + ExtractFileName(ParamStr(0)));
+    AddStr(vTmpPath, PathDelim + ExtractFileName(GetModuleName(HInstance)));
     if UseAppendMode then
       fLogFileName := vTmpPath + '.log'
     else begin
@@ -192,7 +210,93 @@ begin
     {Ignoring}
   end;
 end;
+{$endregion 'Init/Done'}
+
+
+{$region 'Set<->String conversion'}
+function GetOrdValue(Info: PTypeInfo; const SetParam): Integer;
+begin
+  Result := 0;
+
+  case GetTypeData(Info)^.OrdType of
+    otSByte, otUByte:
+      Result := Byte(SetParam);
+    otSWord, otUWord:
+      Result := Word(SetParam);
+    otSLong, otULong:
+      Result := Integer(SetParam);
+  end;
+end;
 
+procedure SetOrdValue(Info: PTypeInfo; var SetParam; Value: Integer);
+begin
+  case GetTypeData(Info)^.OrdType of
+    otSByte, otUByte:
+      Byte(SetParam) := Value;
+    otSWord, otUWord:
+      Word(SetParam) := Value;
+    otSLong, otULong:
+      Integer(SetParam) := Value;
+  end;
+end;
+
+function SetToString(Info :PTypeInfo; const SetParam; Brackets :Boolean = true): String;
+begin
+  Result := '';
+  var S :TIntegerSet;
+  Integer(S) := GetOrdValue(Info, SetParam);
+  var TypeInfo := GetTypeData(Info)^.CompType^;
+  for var I := 0 to SizeOf(Integer) * 8 - 1 do
+    if I in S then begin
+      if Result <> '' then
+        Result := Result + ',';
+      Result := Result + GetEnumName(TypeInfo, I);
+    end;
+  if Brackets then
+    Result := '[' + Result + ']';
+end;
+
+procedure StringToSet(Info: PTypeInfo; var SetParam; const Value: String);
+var
+  P :PChar;
+
+  function locNextWord(var aP :PChar): String;
+  begin
+    var I := 0;
+    // scan til whitespace
+    while not CharInSet(aP[I],[',', ' ', #0,']']) do
+      Inc(I);
+    SetString(Result, aP, I);
+    // skip whitespace
+    while CharInSet(aP[I],[',', ' ',']']) do
+      Inc(I);
+    Inc(aP, I);
+  end;
+
+begin
+  SetOrdValue(Info, SetParam, 0);
+  if Value = '' then
+    Exit;
+
+  P := PChar(Value);
+  // skip leading bracket and whitespace
+  while CharInSet(P^,['[',' ']) do
+    Inc(P);
+  var EnumInfo :PTypeInfo := GetTypeData(Info)^.CompType^;
+  var SetValue :Longint := 0;
+  var EnumName := locNextWord(P);
+  while EnumName <> '' do begin
+    var EnumValue :Longint := GetEnumValue(EnumInfo, EnumName);
+    if EnumValue < 0 then begin
+      SetOrdValue(Info, SetParam, 0);
+      Exit;
+    end;
+    Include(TIntegerSet(SetValue), EnumValue);
+    EnumName := locNextWord(P);
+  end;
+  SetOrdValue(Info, SetParam, SetValue);
+end;
+{$endregion 'Set<->String conversion'}
 
 initialization
   InitLogSubSystem;