RealICQClient/COM/RealOAMessenger/MessageSenderUnit.pas

unit MessageSenderUnit;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  ComObj, Dialogs,ActiveX, AxCtrls, Classes, RealOAMessenger_TLB, StdVcl, SysUtils,
  BlockingTCPClient, RealICQProxy, ASPTypeLibrary_TLB, MD5, EncdDecd;

type
  TMessageSender = class(TAutoObject, IConnectionPointContainer, IMessageSender)
  private
    { Private declarations }
    FConnectionPoints: TConnectionPoints;
    FConnectionPoint: TConnectionPoint;
    FEvents: IMessageSenderEvents;
    { note: FEvents maintains a *single* event sink. For access to more
      than one event sink, use FConnectionPoint.SinkList, and iterate
      through the list of sinks. }

    FBlockingTCPClient: TBlockingTCPClient;
    FServerAddress: String;
    FServerPort: SYSINT;
    FProxyType: Shortint;
    FProxyAddress: String;
    FProxyPort: SYSINT;
    FProxyPassword: String;
    FProxyUsername: String;
    FProxyDomain: String;
    FUsername: String;
    FPassword: String;

    FMessageType: Integer;
    FAutoOpenWindow: Boolean;
    FPosition,
    FLeft,
    FTop,
    FWidth,
    FHeight: Integer;
    FTitle,
    FContent,
    FUrl: String;
    FAutoCloseTime: Integer;
    FUsers: String;
    
    m_scriptContext: IScriptingContext;
    
    procedure Connect;
    procedure Login;
    procedure Send;
  public
    procedure Initialize; override;
  protected
    { Protected declarations }
    property ConnectionPoints: TConnectionPoints read FConnectionPoints
      implements IConnectionPointContainer;
    procedure EventSinkChanged(const EventSink: IUnknown); override;
    procedure OnStartPage(const unk: IUnknown); safecall;
    procedure OnEndPage; safecall;

    function Get_ServerAddress: OleVariant; safecall;
    procedure Set_ServerAddress(Value: OleVariant); safecall;
    function Get_ServerPort: OleVariant; safecall;
    procedure Set_ServerPort(Value: OleVariant); safecall;
    function Get_ProxyType: OleVariant; safecall;
    procedure Set_ProxyType(Value: OleVariant); safecall;
    function Get_ProxyAddress: OleVariant; safecall;
    procedure Set_ProxyAddress(Value: OleVariant); safecall;
    function Get_ProxyPort: OleVariant; safecall;
    procedure Set_ProxyPort(Value: OleVariant); safecall;
    function Get_ProxyPassword: OleVariant; safecall;
    function Get_ProxyUsername: OleVariant; safecall;
    procedure Set_ProxyPassword(Value: OleVariant); safecall;
    procedure Set_ProxyUsername(Value: OleVariant); safecall;
    function Get_ProxyDomain: OleVariant; safecall;
    procedure Set_ProxyDomain(Value: OleVariant); safecall;
    function Get_Username: OleVariant; safecall;
    procedure Set_Username(Value: OleVariant); safecall;
    function Get_Password: OleVariant; safecall;
    procedure Set_Password(Value: OleVariant); safecall;
    procedure SendSystemMessage(MessageType, AutoOpenWindow, Position, Left,
      Top, Width, Height, Title, Content, Url, AutoCloseTime,
      Users: OleVariant); safecall;
  end;
  
	TRealICQLoginResultType = (	rtLoginOK = 0,
		                          rtCanUpdate = 1,
		                          rtMustUpdate = 2,
		                          rtVersionError = 3,
		                          rtAuthorizationError = 4,
		                          rtOther = 5);

implementation

uses ComServ, Windows;


//------------------------------------------------------------------------------
procedure TMessageSender.OnStartPage(const unk: IUnknown);
begin
  m_scriptContext := unk as IScriptingContext;
end;

//------------------------------------------------------------------------------
procedure TMessageSender.OnEndPage;
begin
  m_scriptContext := nil; 
end;

procedure TMessageSender.EventSinkChanged(const EventSink: IUnknown);
begin
  FEvents := EventSink as IMessageSenderEvents;
end;

procedure TMessageSender.Initialize;
begin
  inherited Initialize;
  FConnectionPoints := TConnectionPoints.Create(Self);
  if AutoFactory.EventTypeInfo <> nil then
    FConnectionPoint := FConnectionPoints.CreateConnectionPoint(
      AutoFactory.EventIID, ckSingle, EventConnect)
  else FConnectionPoint := nil;

  FServerAddress := '';
  FServerPort := 0;
  FProxyType := 0;
  FProxyAddress := '';
  FProxyPort := 0;
  FProxyPassword := '';
  FProxyUsername := '';
  FProxyDomain := '';
  FUsername := '';
  FPassword := '';
end;

function TMessageSender.Get_ServerAddress: OleVariant;
begin
  Result := FServerAddress;
end;

procedure TMessageSender.Set_ServerAddress(Value: OleVariant);
begin
  FServerAddress := Value;
end;

function TMessageSender.Get_ServerPort: OleVariant;
begin
  Result := FServerPort;
end;

procedure TMessageSender.Set_ServerPort(Value: OleVariant);
begin
  FServerPort := Value;
end;

function TMessageSender.Get_ProxyType: OleVariant;
begin
  Result := FProxyType;
end;

procedure TMessageSender.Set_ProxyType(Value: OleVariant);
begin
  FProxyType := Value;
end;

function TMessageSender.Get_ProxyAddress: OleVariant;
begin
  Result := FProxyAddress;
end;

procedure TMessageSender.Set_ProxyAddress(Value: OleVariant);
begin
  FProxyAddress := Value;
end;

function TMessageSender.Get_ProxyPort: OleVariant;
begin
  Result := FProxyPort;
end;

procedure TMessageSender.Set_ProxyPort(Value: OleVariant);
begin
  FProxyPort := Value;
end;

function TMessageSender.Get_ProxyPassword: OleVariant;
begin
  Result := FProxyPassword;
end;

function TMessageSender.Get_ProxyUsername: OleVariant;
begin
  Result := FProxyUsername;
end;

procedure TMessageSender.Set_ProxyPassword(Value: OleVariant);
begin
  FProxyPassword := Value;
end;

procedure TMessageSender.Set_ProxyUsername(Value: OleVariant);
begin
  FProxyUsername := Value;
end;

function TMessageSender.Get_ProxyDomain: OleVariant;
begin
  Result := FProxyDomain;
end;

procedure TMessageSender.Set_ProxyDomain(Value: OleVariant);
begin
  FProxyDomain := Value;
end;

function TMessageSender.Get_Username: OleVariant;
begin
  Result := FUsername;
end;

procedure TMessageSender.Set_Username(Value: OleVariant);
begin
  FUsername := Value;
end;

function TMessageSender.Get_Password: OleVariant;
begin
  Result := FPassword;
end;

procedure TMessageSender.Set_Password(Value: OleVariant);
begin
  FPassword := Value;
end;

procedure TMessageSender.Connect;
begin
  if FBlockingTCPClient <> nil then FreeAndNil(FBlockingTCPClient);
  
  FBlockingTCPClient := TBlockingTCPClient.Create;
  FBlockingTCPClient.NoDelay := True;
  FBlockingTCPClient.RemoteAddress := FServerAddress;
  FBlockingTCPClient.RemotePort := FServerPort;
  FBlockingTCPClient.Proxy.ProxyType := TProxyType(FProxyType);
  FBlockingTCPClient.Proxy.Address := FProxyAddress;
  FBlockingTCPClient.Proxy.Port := FProxyPort;
  FBlockingTCPClient.Proxy.Username := FProxyUsername;
  FBlockingTCPClient.Proxy.Password := FProxyPassword;
  FBlockingTCPClient.Proxy.Domain := FProxyDomain;
  FBlockingTCPClient.Connect;
end;

procedure TMessageSender.Login;
var
  EncryptedPassword: String;
  nIndex,
  UsernameLength,
  PasswordLength,
  BufferLength: SmallInt;
  InternalVersion: Word;
  SendBuffer: Array of Byte;
begin
  UsernameLength := Length(FUsername);
  EncryptedPassword := UpperCase(MD5Print(MD5String(FPassword)));
  PasswordLength := Length(EncryptedPassword);

  BufferLength := 7 + UsernameLength + PasswordLength;

  SetLength(SendBuffer, BufferLength);
  nIndex := 0;

  //填充 (1)协议类型（0x01）            1byte
  SendBuffer[nIndex] := $01;
  Inc(nIndex, 1);

  //填充 (2)消息总长度                  2byte
  CopyMemory(@SendBuffer[nIndex], @BufferLength, 2);
  Inc(nIndex, 2);

  //填充 (3)当前客户端的内部版本号      2byte
  InternalVersion := $01;
  CopyMemory(@SendBuffer[nIndex], @InternalVersion, 2);
  Inc(nIndex, 2);

  //填充 (4)用户名长度                  1byte
  SendBuffer[nIndex] := Byte(UsernameLength);    
  Inc(nIndex, 1);

  //填充 (5)用户名                      动态长度，由(4)指定
  CopyMemory(@SendBuffer[nIndex], PChar(FUsername), UsernameLength);
  Inc(nIndex, UsernameLength);

  //填充 (6)密码长度                    1byte
  SendBuffer[nIndex] := Byte(PasswordLength);    
  Inc(nIndex, 1);

  //填充 (7)密码                        动态长度，由(6)指定
  CopyMemory(@SendBuffer[nIndex], PChar(EncryptedPassword), PasswordLength);
  //Inc(nIndex, PasswordLength);

  FBlockingTCPClient.SendBuffer(SendBuffer[0], BufferLength);
  
end;

procedure TMessageSender.Send;
var
  nIndex,
  BufferLength: SmallInt;
  UsersLength,
  SystemMessageStrLength: Word;
  SendBuffer: Array of Byte;

  SystemMessageStr,
  DisplayMode,
  Rectangle: String;
begin
  BufferLength := 6;

  UsersLength := Length(FUsers);
  if UsersLength > 0 then
  begin
    Inc(BufferLength, 2);
    Inc(BufferLength, UsersLength);
  end;

  if FAutoOpenWindow then
    DisplayMode := '0'
  else
    DisplayMode := '1';

  if FPosition = 2 then
    Rectangle := '{' + IntToStr(FLeft) + ',' + IntToStr(FTop) + ',' + IntToStr(FWidth) + ',' + IntToStr(FHeight) + '}'
  else
    Rectangle := '{' + IntToStr(FWidth) + ',' + IntToStr(FHeight) + '}';
    
  SystemMessageStr := IntToStr(FMessageType) + Chr(9) + 
                      DisplayMode + Chr(9) +
                      EncodeString(FUrl) + Chr(9) +
                      IntToStr(FPosition) + Chr(9) +
                      Rectangle + Chr(9) +
                      EncodeString(FTitle) + Chr(9) +
                      IntToStr(FAutoCloseTime) + Chr(9) +
                      EncodeString(FContent);
  SystemMessageStrLength := Length(SystemMessageStr);
  Inc(BufferLength, SystemMessageStrLength);

  SetLength(SendBuffer, BufferLength);
  nIndex := 0;

  //填充 (1)协议类型（0x41）            1byte
  SendBuffer[nIndex] := $41;
  Inc(nIndex, 1);

  //填充 (2)消息总长度                  2byte
  CopyMemory(@SendBuffer[nIndex], @BufferLength, 2);
  Inc(nIndex, 2);

  //填充 (3)用户类型                    1byte
  if UsersLength > 0 then
    SendBuffer[nIndex] := $0
  else
    SendBuffer[nIndex] := $1;
  Inc(nIndex, 1);

  if UsersLength > 0 then
  begin
    //填充 (4)用户名长度                  1byte
    CopyMemory(@SendBuffer[nIndex], @UsersLength, 2);
    Inc(nIndex, 2);

    //填充 (5)用户名                      动态长度，由(4)指定
    CopyMemory(@SendBuffer[nIndex], PChar(FUsers), UsersLength);
    Inc(nIndex, UsersLength);
  end;

  //填充 (6)系统消息长度                  2byte
  CopyMemory(@SendBuffer[nIndex], @SystemMessageStrLength, 2);
  Inc(nIndex, 2);

  //填充 (7)系统消息                    动态长度
  CopyMemory(@SendBuffer[nIndex], PChar(SystemMessageStr), SystemMessageStrLength);
  //Inc(nIndex, SystemMessageStrLength);
  
  FBlockingTCPClient.SendBuffer(SendBuffer[0], BufferLength);
end;

procedure TMessageSender.SendSystemMessage(MessageType, AutoOpenWindow,
  Position, Left, Top, Width, Height, Title, Content, Url, AutoCloseTime,
  Users: OleVariant);
begin
  FMessageType := MessageType;
  FAutoOpenWindow := AutoOpenWindow;
  FPosition := Position;
  FLeft := Left;
  FTop := Top;
  FWidth := Width;
  FHeight := Height;
  FTitle := Title;
  FContent := Content;
  FUrl := Url;
  FAutoCloseTime := AutoCloseTime;
  FUsers := Users;

  try
    Connect;
    Login;
    Sleep(200);
    
    Send;
    Sleep(500);
  finally
    if FBlockingTCPClient <> nil then FreeAndNil(FBlockingTCPClient);
  end;
end;

initialization
  TAutoObjectFactory.Create(ComServer, TMessageSender, Class_MessageSender,
    ciMultiInstance, tmApartment);
end.