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.