mandysoft.vcl.connect.pas

boomerang library 5.11 internet ed

destructor TConnection.Destroy;
begin
  Destroying;
  Close;
  inherited;
end;

procedure TConnection.Open;
begin
  Active:= True;
end;

procedure TConnection.Close;
begin
  Active:= False;
end;

procedure TConnection.SetActive;
begin
  if (csReading in ComponentState) then
  begin
    if aEnable then
      FStreamedActive := True;
  end
else
  if FActive <> aEnable then
  begin
    if aEnable then
      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.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
        SaveActive:= fActive;
        Open;
        try
          DoLog(PreformatText(aName, aChannel, aText));
        finally
          Active:= SaveActive;
        end;
      finally
        FCriticalSection.Leave;
      end;
    end;
  end;
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
  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;
  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;
  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
        InsT(Result, DateTimeToStr(Now)+')');
    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]);
    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;
begin
  if not (csDesigning in ComponentState) then
  begin
    if not FileExists(LogFile) then
    begin
      with TFileStream.Create(LogFile, fmCreate) do
      try
      finally
        Free;
      end;
    end;
    FLogStream:= TFileStream.Create(LogFile, fmOpenWrite or fmShareDenyWrite);
  end;
  inherited;
end;

procedure TFileLogger.CloseConn;
begin
  FLogStream.Free;
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.