msgcombase.pas

Delphi MsgCommunicator 2-10 component.I ve used, really good job. can be Server-Client message appl

// LoadContactInfoFromStream 
//------------------------------------------------------------------------------ 
procedure TMsgComponent.LoadContactInfoFromStream(var ContactInfo: TMsgContactInfo; Stream: TStream); 
begin 
  LoadUserInfoFromStream(ContactInfo.UserInfo,Stream); 
  LoadDataFromStream(ContactInfo.ContactNameSource,SizeOf(ContactInfo.ContactNameSource),Stream,11460);
  LoadShortStringFromStream(ContactInfo.ContactCustomName,Stream,11461);
end; // LoadContactInfoFromStream 
	
	
//------------------------------------------------------------------------------
// SaveContactInfoToStream 
//------------------------------------------------------------------------------ 
procedure TMsgComponent.SaveContactInfoToStream(var ContactInfo: TMsgContactInfo; Stream: TStream);
begin 
  SaveUserInfoToStream(ContactInfo.UserInfo,Stream); 
  SaveDataToStream(ContactInfo.ContactNameSource,SizeOf(ContactInfo.ContactNameSource),Stream,11458); 
  SaveShortStringToStream(ContactInfo.ContactCustomName,Stream,11459);
end; // SaveContactInfoToStream
 
 
//------------------------------------------------------------------------------ 
// LoadBaseContactInfoFromStream 
//------------------------------------------------------------------------------ 
procedure TMsgComponent.LoadBaseContactInfoFromStream(var ContactInfo: TMsgContactInfo; Stream: TStream); 
begin
  LoadDataFromStream(ContactInfo.UserInfo.UserID,SizeOf(ContactInfo.UserInfo.UserID),Stream,11496); 
  LoadDataFromStream(ContactInfo.ContactNameSource,SizeOf(ContactInfo.ContactNameSource),Stream,11497); 
  LoadShortStringFromStream(ContactInfo.ContactCustomName,Stream,11498); 
end; // LoadBaseContactInfoFromStream 
 
 
//------------------------------------------------------------------------------ 
// SaveBaseContactInfoToStream 
//------------------------------------------------------------------------------ 
procedure TMsgComponent.SaveBaseContactInfoToStream(var ContactInfo: TMsgContactInfo; Stream: TStream);
begin
  SaveDataToStream(ContactInfo.UserInfo.UserID,SizeOf(ContactInfo.UserInfo.UserID),Stream,11499);
  SaveDataToStream(ContactInfo.ContactNameSource,SizeOf(ContactInfo.ContactNameSource),Stream,11500);
  SaveShortStringToStream(ContactInfo.ContactCustomName,Stream,11501); 
end; // SaveBaseContactInfoToStream
	
 
//------------------------------------------------------------------------------
// load contacts
//------------------------------------------------------------------------------ 
procedure TMsgComponent.LoadContactsFromStream(var Contacts: TMsgContactInfoArray; Stream: TStream); 
var 
    ContactCount,i: Integer; 
begin 
 LoadDataFromStream(ContactCount, SizeOf(ContactCount), Stream, 11376); 
 SetLength(Contacts,ContactCount); 
 for i := 0 to ContactCount-1 do
   LoadContactInfoFromStream(Contacts[i],Stream);
end; // LoadContactsFromStream 
	
 
//------------------------------------------------------------------------------ 
// save contacts
//------------------------------------------------------------------------------ 
procedure TMsgComponent.SaveContactsToStream(var Contacts: TMsgContactInfoArray; Stream: TStream);
var 
    ContactCount,i: Integer; 
begin
 ContactCount := Length(Contacts);
 SaveDataToStream(ContactCount, SizeOf(ContactCount), Stream, 11470);
 for i := 0 to ContactCount-1 do
   SaveContactInfoToStream(Contacts[i],Stream);
end; // SaveContactsToStream


//------------------------------------------------------------------------------
// save message to database and return MessageID
//------------------------------------------------------------------------------
function TMsgComponent.SaveMessageToDatabase(
                                    Database:     TComponent;
                                    SenderID:     Cardinal;
                                    RecipientID:  Cardinal;
                                    MessageType:  TMsgMessageType;
                                    SendingDate:  TDateTime;
                                    Delivered:    Boolean;
                                    DeliveryDate: TDateTime;
                                    Stream:       TMsgMemoryStream
                                   ): Integer;
var MessageText:          String;
    MessageUnicodeText:   WideString;
    MessageData:          PChar;
    MessageDataSize, len: Integer;
    Pos:                  Int64;
    Command:              Cardinal;
begin
  Pos := Stream.Position;
  try
    MessageUnicodeText := '';
    MessageText := '';
    MessageData := nil;
    MessageDataSize := 0;
    if (MessageType = aamtText) then
     begin
      try
        LoadDataFromStream(len,SizeOf(len),Stream,11377);
        SetLength(MessageText,len);
        if (len > 0) then
         LoadDataFromStream(PChar(@MessageText[1])^,len,Stream,11378);
      except
      end;
     end
    else
    if (MessageType >= MsgLowestType) then
     begin
      Command := 0;
      try
        LoadDataFromStream(len,SizeOf(len),Stream,10270);
        if (len > 0) then
         begin
          case MessageType of
            MsgCustomCommand:
             begin
              LoadDataFromStream(Command, SizeOf(Command), Stream, 40061);
              MessageData := PChar(Stream.Buffer + Stream.Position);
              MessageDataSize := len - SizeOf(Command);
             end;
            else
             begin
              MessageData := PChar(Stream.Buffer + Stream.Position);
              MessageDataSize := len;
             end;
          end;
         end;
      except
      end;
     end // Command
    else
     begin
      MessageDataSize := Stream.Size - Stream.Position;
      if (MessageDataSize > 0) then
       MessageData := PChar(Stream.Buffer + Stream.Position);
     end; // binary or stream message
   if (MessageDataSize = 0) then
    MessageData := nil;
   try
    if (Assigned(FOnSaveMessage)) then
     FOnSaveMessage(SenderID,RecipientID,MessageType,
                    SendingDate,
                    DeliveryDate,
                    MessageData,MessageDataSize,
                    MessageText,MessageUnicodeText,Command);
   except
   end;
   Result := TMsgDatabase(Database).SaveMessage(Delivered,DeliveryDate,SenderID,RecipientID,MessageType,
                    SendingDate,
                    MessageData,MessageDataSize,
                    MessageText,MessageUnicodeText,Command);
  finally
    Stream.Position := Pos;
  end;
end; // SaveMessageToDatabase


//------------------------------------------------------------------------------
// do on error
//------------------------------------------------------------------------------
procedure TMsgComponent.DoOnError(
                       const ErrorCode:    Integer;
                       const NativeError:  Integer = -1;
                       const ErrorMessage: String = ''
                                 );
begin
{$IFDEF DEBUG_ONERROR}
aaWriteToLog('==================================================================');
if (Self is TMsgClient) then
  aaWriteToLog('Error on client !')
else
  aaWriteToLog('Error on server !');
aaWriteToLog('------------------------------------------------------------------');
aaWriteToLog('ErrorCode='+IntToStr(Integer(ErrorCode)));
aaWriteToLog('NativeError='+IntToStr(Integer(NativeError)));
aaWriteToLog('ErrorMessage: "'+ErrorMessage+'"');
aaWriteToLog('GetTickCount = '+IntToStr(aaGetTickCount));
aaWriteToLog('==================================================================');
{$ENDIF}
  if (Assigned(FOnError)) then
   FOnError(Self,ErrorCode,NativeError,ErrorMessage);
end; // DoOnError


//------------------------------------------------------------------------------
// return current version
//------------------------------------------------------------------------------
function TMsgComponent.GetCurrentVersion: String;
var c : char;
begin
 c := DecimalSeparator;
 DecimalSeparator := '.';
 Result := FloatToStrF(MsgVersion,ffFixed,3,2) + ' ' + MsgVersionText;
 DecimalSeparator := c;
end; // GetCurrentVersion


//------------------------------------------------------------------------------
// dummy for Object Inspector
//------------------------------------------------------------------------------
procedure TMsgComponent.SetCurrentVersion(value: String);
begin
end; // SetCurrentVersion


//------------------------------------------------------------------------------
// return contact display name
//------------------------------------------------------------------------------
function TMsgComponent.GetContactDisplayName(const ContactInfo: TMsgContactInfo): String;
begin
 case (ContactInfo.ContactNameSource) of
  mcnsUserName: Result := ContactInfo.UserInfo.UserName;
  mcnsFirstName: Result := ContactInfo.UserInfo.FirstName;
  mcnsLastName: Result := ContactInfo.UserInfo.LastName;
  mcnsFullName: Result := ContactInfo.UserInfo.FirstName + ' ' +ContactInfo.UserInfo.LastName;
  mcnsCustom: Result := ContactInfo.ContactCustomName
 else
  Result := '';
 end;
end; // GetContactDisplayName


////////////////////////////////////////////////////////////////////////////////
//
// TMsgComBaseSession
//
////////////////////////////////////////////////////////////////////////////////


//------------------------------------------------------------------------------
// Create
//------------------------------------------------------------------------------
constructor TMsgComBaseSession.Create;
begin
  inherited;
  FSessionID := INVALID_SESSION_ID;
  FUserID := MSG_INVALID_USER_ID;
end; // Create


//------------------------------------------------------------------------------
// Destroy
//------------------------------------------------------------------------------
destructor TMsgComBaseSession.Destroy;
begin
//  SetConnected(False);
  inherited;
end; // Destroy


//------------------------------------------------------------------------------
// save command header
//------------------------------------------------------------------------------
procedure TMsgComBaseSession.SaveCommandHeader(
                                Stream:         TStream;
                                CommandCode:    Integer;
                                CommandResult:  Integer = 0;
                                NativeError:    Integer = 0
                                );
var CommandHeader: TMsgCommandHeader;
begin
  FillChar(CommandHeader,SizeOf(CommandHeader),$00);
  MsgGenerateRandomBuffer(@CommandHeader.RandomData,SizeOf(CommandHeader.RandomData));
  CommandHeader.CommandCode := CommandCode;
  CommandHeader.CommandResult := CommandResult;
  CommandHeader.NativeError := NativeError;
  SaveDataToStream(CommandHeader,SizeOf(CommandHeader),Stream,11462);
end; // SaveCommandHeader


////////////////////////////////////////////////////////////////////////////////
//
// TMsgNetworkSession
//
////////////////////////////////////////////////////////////////////////////////


//------------------------------------------------------------------------------
// Create
//------------------------------------------------------------------------------
constructor TMsgNetworkSession.Create;
begin
  FConnected := False;
  inherited Create;
end; // Create


//------------------------------------------------------------------------------
// Destroy
//------------------------------------------------------------------------------
destructor TMsgNetworkSession.Destroy;
begin
  inherited Destroy;
end; // Destroy

// TMsgNetworkSession


initialization

{$IFDEF DEBUG_LOG_INIT}
aaWriteToLog('MsgComBase> initialized');
{$ENDIF}

end.