connect.pas

boomerang library 5.11 internet ed

      begin
        DoBeforeOpen;
        try
          OpenConn;
        except
          CloseConn;
          raise;
        end;
        FActive:= aEnable;
        DoAfterOpen;
      end
    else
      begin
        if not (csDestroying in ComponentState) then
          DoBeforeClose;
        CloseConn;
        FActive:= aEnable;
        if not (csDestroying in ComponentState) then
          DoAfterClose;
      end;
  end;
end;

procedure TConnection.DoBeforeOpen;
begin
  if Assigned(FBeforeOpen) then
    FBeforeOpen(Self);
end;

procedure TConnection.DoBeforeClose;
begin
  if Assigned(FBeforeClose) then
    FBeforeClose(Self);
end;

procedure TConnection.DoAfterOpen;
begin
  if Assigned(FAfterOpen) then
    FAfterOpen(Self);
end;

procedure TConnection.DoAfterClose;
begin
  if Assigned(FAfterClose) then
    FAfterClose(Self);
end;

procedure TConnection.Loaded;
begin
  inherited Loaded;
  if FStreamedActive then
    Active := True;
end;

procedure TConnection.CheckInactive;
begin
  if Active then
    ComError(sActiveConnection);
end;

procedure TConnection.CheckActive;
begin
  if not Active then
    ComError(sInactiveConnection);
end;

constructor TLogger.Create(aOwner: TComponent);
begin
  inherited;
  FCriticalSection:= TCriticalSection.Create;
end;

destructor TLogger.Destroy;
begin
  FCriticalSection.Free;
  inherited;
end;

procedure TLogger.SetAutoOpen(aValue: Boolean);
begin
  CheckInactive;
  fAutoOpen:= aValue;
end;

procedure TLogger.DoOnException(E: Exception; const aName: string; aChannel: Byte; const aOriginalMessage: string);
begin
  if Assigned(fOnException) then
    fOnException(Self, E, aName, aChannel, aOriginalMessage);
end;

procedure TLogger.Log;     // multithreaded
var
  F, SaveActive: Boolean;
begin
  if (Self <> nil) and (FActive or FAutoOpen) then
  begin
    F:= True;
    if Assigned(FAcceptChannel) then
      FAcceptChannel(Self, aName, aChannel, F);
    if F then
    begin
      FCriticalSection.Enter;
      try
        if FCriticalSection2 <> nil then   // enable multilogger group (sharing the same file for example)
          FCriticalSection2.Enter;
        try
          try
            SaveActive:= fActive;
            Open;
            try
              DoLog2(aName, aChannel, aText);
            finally
              Active:= SaveActive;
            end;
          except
            on E: Exception do
              DoOnException(E, aName, aChannel, aText);
          end;
        finally
          if FCriticalSection2 <> nil then
            FCriticalSection2.Leave;
        end;
      finally
        FCriticalSection.Leave;
      end;
    end;
  end;
end;

procedure TLogger.DoLog2;
var
  S: string;
begin
  S:= PreformatText(aName, aChannel, aText);
  DoLog(S);
end;

constructor TStreamLogger.Create(aOwner: TComponent);
begin
  inherited;
  FLogFlags:= [lfInsertName, lfInsertChannel, lfDivideNames, lfDivideChannels, lfHexadecimal];
  FMaxLineLength:= 80;
end;

procedure TStreamLogger.SetLogStream;
begin
  CheckInactive;
  FLogStream:= Value;
end;

procedure TStreamLogger.DoLog;
begin
  if fLogStream <> nil then
    StringToStream(aText, fLogStream);
end;

procedure TStreamLogger.OpenConn;
begin
  if not (csDesigning in ComponentState) then
    FLogStream.Position:= FLogStream.Size;
end;

function TStreamLogger.DivideStream;
begin
  Result:= False;
  if Assigned(FOnDivideStream) then
    FOnDivideStream(Self, aName, aChannel, aText, I, Result);
end;

function TStreamLogger.PreformatText;
const
  CR = TChar(#13);
  LF = TChar(#10);
  CRLF = CR+LF;
var
  I: Integer;
  F, NL: Boolean;
  NowS: string;
  function FormatCh(B: Byte): string;
  begin
    Result:= Format('%.2x)', [B]);
    if not (lfHexadecimal in FLogFlags) then
      Result:= Result+' ';
  end;
  procedure InsT(var S: string; const aT: string);
  begin
    S:= S+aT;
    Inc(FLineLength, Length(aT));
  end;
begin
  Result:= '';
  I:= 1;
  NowS:= DateTimemsToStr(Now)+')';
  while I <= Length(aText) do
  begin
    NL:= FLineLength = 0;
    if (FLastName <> aName) and (lfDivideNames in FLogFlags) or
       (FLastChannel <> aChannel) and (lfDivideChannels in FLogFlags) or
       (lfDivideStream in FLogFlags) and DivideStream(aName, aChannel, aText, I) then
    begin
      FLineLength:= 0;
      NL:= False;
    end;
    F:= FLineLength = 0;
    if F then
    begin
      if not NL then
        Result:= Result+CRLF;
      if lfStamp in FLogFlags then
      begin
        if (FLastName <> aName) or (FLastChannel <> aChannel) or
           not ((aText[I] = CR) and (FLastCRLF = LF) or
                (aText[I] = LF) and (FLastCRLF = CR)) then
          InsT(Result, NowS);  // if regular CRLF/LFCR, do not stamp 2nd char
      end;
    end;
    if ((FLastName <> aName) or F) and (lfInsertName in FLogFlags) then
      begin
        InsT(Result, aName+'-');
        if lfInsertChannel in FLogFlags then
          InsT(Result, FormatCh(aChannel));
      end
    else
      begin
        if ((FLastChannel <> aChannel) or F) and (lfInsertChannel in FLogFlags) then
          InsT(Result, FormatCh(aChannel));
      end;
    FLastChannel:= aChannel;
    FLastName:= aName;

    if lfHexadecimal in FLogFlags then InsT(Result, Format('%.2x ', [Byte(aText[I])]))
                                  else InsT(Result, aText[I]);
    if aText[I] in [CR, LF] then
      begin
        FLineLength:= 0;
        if (FLastName = aName) and (FLastChannel = aChannel) and
           ((aText[I] = CR) and (FLastCRLF <> LF) or
            (aText[I] = LF) and (FLastCRLF <> CR)) then
          FLastCRLF:= aText[I]
        else
          FLastCRLF:= #0;
      end
    else
      FLastCRLF:= #0;
    Inc(I);
    if (FMaxLineLength <> 0) and (FLineLength >= FMaxLineLength) then
    begin
      if I <= Length(aText) then
        Result:= Result+CRLF;
      FLineLength:= 0;    // write on next line
    end;
  end;
  if lfAutoCR in FLogFlags then
  begin
    Result:= Result+CRLF;
    FLineLength:=0;
  end;
  FLastChannel:= aChannel;
  FLastName:= aName;
end;

procedure TFileLogger.SetLogFile;
var
  SaveLogActive: Boolean;
begin
  if (csReading in ComponentState) then
  begin
    FLogFile:= aFile;
  end
else
  if aFile <> FLogFile then
  begin
    SaveLogActive:= Active;
    FActive:= False;
    FLogFile:= aFile;
    if FLogFile <> '' then
      Active:= SaveLogActive;
  end;
end;

procedure TFileLogger.OpenConn;
var
  S: string;
begin
  if not (csDesigning in ComponentState) then
  begin
    S:= GetRotateLogFile(0);
    if not FileExists(S) then
    begin
      with TFileStream.Create(S, fmCreate) do
      try
      finally
        Free;
      end;
    end;
    FLogStream:= TFileStream.Create(S, fmOpenWrite or fmShareDenyWrite);
  end;
  inherited;
end;

procedure TFileLogger.CloseConn;
begin
  FLogStream.Free;
  FLogStream:= nil;
end;

function TFileLogger.GetRotateLogFile(I: Integer): string;
begin
  Result:= Format(fLogFile, [I]);
  if (I > 0) and (fLogFile = Result) then
    Result:= Result+'.'+IntToStr(I);
end;

procedure TFileLogger.DoLog(const aText: string);
var
  I: Word;
begin
  inherited;
  if fMaxFileSize > 0 then
  begin
    if (fLogStream <> nil) and (fLogStream.Size >= fMaxFileSize) then
    begin
      CloseConn;
      try
        if fRotateCount = 0 then
          begin
            DeleteFile({$IFNDEF CLR}PChar{$ENDIF}(GetRotateLogFile(0)));
          end
        else
          begin
            for I:= fRotateCount downto 1 do
            begin
              try
                DeleteFile({$IFNDEF CLR}PChar{$ENDIF}(GetRotateLogFile(I)));
                RenameFile(GetRotateLogFile(I-1), GetRotateLogFile(I));
              except
              end;
            end;
          end;
      finally
        OpenConn;
      end;
    end;
  end;
end;

procedure TLogConnection.DoFormatLog;
begin
  if Assigned(FOnFormatLog) then
    FOnFormatLog(Self, aChannel, aText);
end;

procedure TLogConnection.Log;
begin
  DoFormatLog(aChannel, aText);
  if FLogger <> nil then
    FLogger.Log(FLogName, aChannel, aText);
end;

procedure TLogConnection.LogFromStream(aChannel: Byte; aStream: TStream);
var
  SavePos: Int64;
  S: string;
begin
  SavePos:= aStream.Position;
  aStream.Position:= 0;
  S:= StreamToString(aStream);
  aStream.Position:= SavePos;
  Log(aChannel, S);
end;

function TCommunicationConnection.Send;
{$IFDEF CLR}
var
  B: TBytes;
{$ENDIF}
begin
  Log(lchOut, S);
{$IFDEF CLR}
  B:= BytesOf(S);
  Result:= Write(B, Length(B));
{$ELSE}
  Result:= Write(S[1], Length(S));
{$ENDIF}
end;

function TCommunicationConnection.Retrieve;
{$IFDEF CLR}
var
  B: TBytes;
{$ENDIF}
begin
{$IFDEF CLR}
  SetLength(B, aCount);
  SetLength(B, Read(B, Length(B)));
  Result:= AnsiEncoding.GetString(B);
{$ELSE}
  SetLength(Result, aCount);  { alloc buffer }
  SetLength(Result, Read(Result[1], aCount));
{$ENDIF}
  Log(lchIn, Result); 
end;

procedure TCommunicationConnection.DoOnRxChar;
begin
  if Assigned(FOnRxChar) then
    FOnRxChar(Self, Count);
end;

procedure Register;
begin
  RegisterComponents('Communication', [TFileLogger]);
end;

end.