RealICQClient/COM/RealICQCOMInterfaces/UnitCustomMessageSender.pas

unit UnitCustomMessageSender;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  ComObj,SysUtils,
  ActiveX,
  AxCtrls,
  Classes,
  RealICQCOMInterfaces_TLB,
  ASPTypeLibrary_TLB,
  StdVcl,
  Winsock2,
  RealICQSocket,
   Registry,
  Windows;

type
  TCustomMessageSender = class(TAutoObject, IConnectionPointContainer, ICustomMessageSender)
  private
    { Private declarations }
    FConnectionPoints: TConnectionPoints;
    FConnectionPoint: TConnectionPoint;
    FEvents: ICustomMessageSenderEvents;
    { 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. }

    m_scriptContext: IScriptingContext;
    FResult: Integer;
  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;
    procedure Send(ServerAddress: OleVariant; ServerPort: SYSINT; LoginName,
      Content: OleVariant; Flag: SYSINT); safecall;
    procedure OpenUMC(LoginName: OleVariant); safecall;
    function  Get_Result: SYSINT; safecall;
  end;

const
  AppKey = '\Software\Winsoft\LxTalk';
  CompanyKeyValue = '\Winsoft'; //做OEM版时，此处应该改为对应公司的网址或名称
  AppTitle = '办公助手';

  iAtom: PChar = 'Winsoft';
implementation
uses Variants, ComServ,ComConst, ShellAPI, LoggerManager;

var logger: TLogger4Delphi;


//------------------------------------------------------------------------------
procedure TCustomMessageSender.OpenUMC(LoginName: OleVariant);
var
  ExeFileName: String;
  FVar: OleVariant;
  Registry: TRegistry;
  Handle: HWND;
begin
  ExeFileName := '';

  {从注册表中读取 BaseURL}
  Registry := TRegistry.Create;
  try
    Registry.RootKey := HKEY_LOCAL_MACHINE;

    if Registry.OpenKey(AppKey + CompanyKeyValue, True) then
    begin
      ExeFileName := Registry.ReadString('ExeFileName');
    end;
  finally
    Registry.Free;
  end;

  Handle := openmutex(mutex_all_access, False, iAtom);
  try
    if Handle = 0 then
    begin
     // if MessageBox(0, PChar(AppTitle + ' 还未启动，是否启动？'), '提示', MB_ICONQUESTION or MB_YESNO) = ID_YES then
     // begin
        ShellExecute(0, 'open', PChar('"' + ExeFileName + '"'), nil, nil, SW_SHOWNORMAL);
     // end;
    //  Exit;
    end;
  finally
    closeHandle(Handle);
  end;


end;
//------------------------------------------------------------------------------
procedure TCustomMessageSender.EventSinkChanged(const EventSink: IUnknown);
begin
  FEvents := EventSink as ICustomMessageSenderEvents;
end;

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

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

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

//------------------------------------------------------------------------------
procedure TCustomMessageSender.Send(ServerAddress: OleVariant;
  ServerPort: SYSINT; LoginName, Content: OleVariant; Flag: SYSINT);
var
  FServerAddress: String;
  FServerPort: Integer;
  
  ServerSocket: TSocket;
  ServerAddr: TSockAddrIn;
  LastError: Integer;
  
  nIndex,
  ReturnValue: Integer;
  Buf: array[0..255] of Byte;

  FFlag: Byte;
  
  FContent,
  FLoginName: String;
  LoginNameLength,
  ContentLength,
  BufferLength: SmallInt;
  SendBuffer: Array of Byte;
begin
  logger.Info('start calling');
  FServerAddress := ServerAddress;
  FServerPort := ServerPort;
  FLoginName := LoginName;
  FContent := Content;
  FFlag := Flag;
  logger.Info('ServerAddress:' + FServerAddress + ' Port:' + IntToStr(FServerPort) + 'LoginName:'+FLoginName);
  logger.Info('Content:'+ FContent);
  LoginNameLength := Length(FLoginName);
  ContentLength := Length(FContent);

  logger.Info('Creating Socket');
  ServerSocket := Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
  if ServerSocket = INVALID_SOCKET then logger.Error(Format('创建套接字失败，错误代码：%d',[WSAGetLastError]));

  ServerAddr.sin_family:= AF_INET;
  ServerAddr.sin_port:= htons(FServerPort);
  ServerAddr.sin_addr.S_addr:= inet_addr(PChar(FServerAddress));

  logger.Info('Connect to Server');
  connect(ServerSocket, @ServerAddr, SizeOf(ServerAddr));
  LastError := WSAGetLastError();
  if LastError <> 0 then
  begin
    closesocket(ServerSocket);
    logger.Error(Format('无法建立与服务器的连接，错误代码：%d', [LastError]));
  end;

  BufferLength := 7 + LoginNameLength + ContentLength;
  logger.Info('Packing Data');
  SetLength(SendBuffer, BufferLength);
  nIndex := 0;

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

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

  //填充 (3)接收人用户名长度            1byte
  SendBuffer[nIndex] := Byte(LoginNameLength);    
  Inc(nIndex, 1);

  //填充 (4)接收人用户名                动态长度
  CopyMemory(@SendBuffer[nIndex], PChar(FLoginName), LoginNameLength);
  Inc(nIndex, LoginNameLength);
  
  //填充 (5)消息发送方式                1byte
  SendBuffer[nIndex] := FFlag;
  Inc(nIndex, 1);

  //填充 (6)消息内容长度                2byte
  CopyMemory(@SendBuffer[nIndex], @ContentLength, 2);
  Inc(nIndex, 2);

  //填充 (7)消息内容                    动态长度
  CopyMemory(@SendBuffer[nIndex], PChar(FContent), ContentLength);
  //Inc(nIndex, ContentLength);
  logger.Info('Sending Data');
  try
    ReturnValue := Winsock2.Send(ServerSocket, SendBuffer[0], BufferLength, 0);
    if ReturnValue <= 0 then
    begin
      FResult :=$FF;
      closesocket(ServerSocket);
      logger.Error('往服务器发送数据失败');
    end;

//    FillChar(Buf, 256, #0);
//    ReturnValue := Recv(ServerSocket, Buf, 1, 0);
//    if ReturnValue <> 1 then
//    begin
//      closesocket(ServerSocket);
//      logger.Error('服务器上返回了错误的数据');
//    end;

    closesocket(ServerSocket);
    //FResult := Buf[0];
    //if FResult = $FF then logger.Error('数据发送失败');
  except
    on E: Exception do
      logger.Info('异常类名称:' + E.ClassName
        + #13#10 + '异常信息:' + E.Message);
  end;
  logger.Info('OK');
end;

//------------------------------------------------------------------------------
function TCustomMessageSender.Get_Result: SYSINT;
begin
  Result := FResult;
end;

//------------------------------------------------------------------------------
initialization
  TAutoObjectFactory.Create(ComServer, TCustomMessageSender, Class_CustomMessageSender,
    ciMultiInstance, tmApartment);
  logger := TLogger4Delphi.Create;
finalization
  logger.Free;
end.