unit SMSFrm; interface uses Windows, Messages, md5,SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, DSPack, Menus, ExtDlgs, AppEvnts, ActnPopup, ExtCtrls, ImgList, ActiveX, StdActns, ActnList, XPStyleActnCtrls, ActnMan, ToolWin, ActnCtrls, ActnMenus, OleCtrls, SHDocVw, StdCtrls, Buttons, RealICQButton, RxRichEd, XMLDoc, XMLIntf, MSHTML, RealICQRichEdit, RealICQSpeedButton, RealICQSkinFrm, StrUtils, RealICQColors, RealICQRoundBorderPanel, MyUtils, RealICQClient, UserCardDetailView, AddUserFrm, MultiSendSMSFrm,SelUserFrm, RealICQContacterListView, TalkingFrm, RealICQUtils, DateUtils, Types, ComCtrls,ShellAPI, RealICQModel, pngimage; const MaxSMSLength: Integer =900; type TSMSForm = class(TRealICQSkinForm) pnlClient: TPanel; pnlTalkingArea: TPanel; Splitter1: TSplitter; pnlInputer: TPanel; ImgInputerBottomMiddle: TImage; ImgInputerTopLeft: TImage; ImgInputerTopRight: TImage; ImgInputerTopMiddle: TImage; ShpInputerClient: TShape; ImgInputerBottomLeft: TImage; ImgInputerBottomRight: TImage; lblState: TLabel; pnlInputeBack: TPanel; pnlSendButtonBack: TPanel; btSend: TRealICQButton; pnlDisplayer: TPanel; ShpDisplayerTopMiddle: TShape; ShpDisplayerClient: TShape; ImgDisplayerTopLeft: TImage; ImgDisplayerTopRight: TImage; lblDest: TLabel; pnlForWebBrowser: TPanel; WebBrowser: TWebBrowser; pnlHint: TPanel; ShpHint: TShape; Image1: TImage; LblHint: TLabel; pnlForHideWebBrowser: TPanel; pnlToolBar: TPanel; Shape1: TShape; pnlForActionToolBar: TPanel; imgToolbarBack: TImage; spbMultiSend: TRealICQSpeedButton; pnlUsers: TPanel; pnlMenu: TPanel; shpMenuBottomLine: TShape; Panel3: TPanel; pnlForActionMainMenuBar: TPanel; ActionMainMenuBar: TActionMainMenuBar; ActionManager1: TActionManager; actShowHistory: TAction; actSaveAsHTMLFile: TAction; actSaveAsTextFile: TAction; EditCut: TEditCut; EditCopy: TEditCopy; EditPaste: TEditPaste; EditSelectAll: TEditSelectAll; EditUndo: TEditUndo; EditDelete: TEditDelete; actAlwayOnTop: TAction; actPageSet: TAction; actPrint: TAction; actPreview: TAction; actClose: TAction; actEnter: TAction; actCtrlEnter: TAction; actStopVideo: TAction; TimerForGetUserInformation: TTimer; ppForWebBrowser: TPopupActionBar; miCopyFromIE: TMenuItem; miSelAllFromIE: TMenuItem; ppForInputer: TPopupActionBar; U1: TMenuItem; N14: TMenuItem; C1: TMenuItem; C2: TMenuItem; P1: TMenuItem; T1: TMenuItem; N15: TMenuItem; A1: TMenuItem; N16: TMenuItem; EnterE1: TMenuItem; CtrlEnterT1: TMenuItem; ApplicationEvents: TApplicationEvents; MainMenu1: TMainMenu; pnlTeamMembers: TPanel; rndTeamMembers: TRealICQRoundBorderPanel; lblTeamMemberCount: TLabel; rndTeamMemberContainer: TRealICQRoundBorderPanel; pnlTeamMemberContainer: TPanel; pnlMobile: TPanel; Label1: TLabel; edMobiles: TEdit; spMobileBorder: TShape; lblSMSState: TLabel; SaveDialog: TSaveDialog; ppUserItemRightMenu: TPopupActionBar; miSendMessage: TMenuItem; miSeeUserInformation: TMenuItem; RichEdInputer: TRealICQRichEdit; cbCustomSendDateTime: TCheckBox; DatePickerStart: TDateTimePicker; TimePickerStart: TDateTimePicker; spbSMSManage: TRealICQSpeedButton; N1: TMenuItem; lblSmsLimitInfo: TLabel; TimerForGetHasSendSmsCount: TTimer; procedure N1Click(Sender: TObject); procedure spbSMSManageClick(Sender: TObject); procedure edMobilesChange(Sender: TObject); procedure cbCustomSendDateTimeClick(Sender: TObject); procedure ppForInputerGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass); procedure ppForWebBrowserGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass); procedure edMobilesKeyPress(Sender: TObject; var Key: Char); procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormDestroy(Sender: TObject); procedure pnlDisplayerResize(Sender: TObject); procedure lblDestClick(Sender: TObject); procedure lblDestMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure lblDestMouseEnter(Sender: TObject); procedure lblDestMouseLeave(Sender: TObject); procedure lblDestMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure TimerForGetUserInformationTimer(Sender: TObject); procedure WebBrowserDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant); procedure WebBrowserBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool); procedure ApplicationEventsMessage(var Msg: tagMSG; var Handled: Boolean); procedure btSendClick(Sender: TObject); procedure RichEdInputerChange(Sender: TObject); procedure RichEdInputerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure actEnterExecute(Sender: TObject); procedure actCtrlEnterExecute(Sender: TObject); procedure actShowHistoryExecute(Sender: TObject); procedure actSaveAsHTMLFileExecute(Sender: TObject); procedure actSaveAsTextFileExecute(Sender: TObject); procedure actPageSetExecute(Sender: TObject); procedure actPrintExecute(Sender: TObject); procedure actPreviewExecute(Sender: TObject); procedure actCloseExecute(Sender: TObject); procedure spbMultiSendClick(Sender: TObject); procedure ppUserItemRightMenuGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass); procedure ppUserItemRightMenuPopup(Sender: TObject); procedure miSendMessageClick(Sender: TObject); procedure miSeeUserInformationClick(Sender: TObject); procedure FormShow(Sender: TObject); procedure miCopyFromIEClick(Sender: TObject); procedure miSelAllFromIEClick(Sender: TObject); procedure TimerForGetHasSendSmsCountTimer(Sender: TObject); private FSMSReveivers: TStringList; FLastSendMsgTicket: Cardinal; FLVTeamMembers: TRealICQContacterListView; FReceiver: String; FTeamID:String; FIsMultiSend: Boolean; procedure CalculateSMSCount; procedure UpdateListItemSendState(ALoginName: String); procedure AddLVTeamMembers; procedure AddUserToListView(RealICQUser: TRealICQUser); procedure SetReceiver(Value: String); procedure SetTeamID(Value: String); procedure SetDOMStyle(Doc:IHTMLDocument2); procedure UpdateSMSMember(ARealICQUser: TRealICQUser); function GetWaitSendSMSCount(SMSContent:String;RecevierCount:Integer):Integer; procedure AddMessageToWebBrowser(SenderID: String; SenderName, ReceiverName, MessageStr: String; SendDateTime: TDateTime; SMSMessageID: Cardinal; IsReceivedSMS: Boolean = False; IsHistory: Boolean = False); function GetCanWriteMessage: Boolean; procedure InvokeCMD(InvokeIE: Boolean; Value1, Value2: Integer; var vaIn, vaOut: OleVariant); function CheckCount(ACount: Integer; AContent: string): Boolean; protected procedure CreateParams(var Params: TCreateParams); override; procedure CMWininichange(var Message: TWMWinIniChange); message CM_WININICHANGE; public procedure ChangeUIColor(AColor: TColor); override; procedure ShowSMSMessageResult(AMessageID: Cardinal; AResult: Integer); procedure LoadNotReadSMSMessages; property Receiver: String read FReceiver write SetReceiver; property TeamID:String read FTeamID write SetTeamID; property CanWriteMessage: Boolean read GetCanWriteMessage; end; TSMSMessage = class private FSenderID, FReceiverID, FSenderName, FReceiverName, FMessageStr: String; FSendDateTime: TDateTime; FSMSMessageID: Cardinal; FSMSForm: TSMSForm; FSended: Boolean; FMuiltySend: Boolean; public constructor Create(ASMSForm: TSMSForm); property SenderID: String read FSenderID; property ReceiverID: String read FReceiverID; property SenderName: String read FSenderName; property ReceiverName: String read FReceiverName; property MessageStr: String read FMessageStr; property SendDateTime: TDateTime read FSendDateTime; property SMSMessageID: Cardinal read FSMSMessageID; property SMSForm: TSMSForm read FSMSForm; property Sended: Boolean read FSended write FSended; end; function OpenSMSForm(AReceiver: String; AShowActive: Boolean = True): TSMSForm; function OpenTeamSMSForm(ATeamID: String): TSMSForm; function GetSMSForm(AReceiver: String): TSMSForm; procedure ChangeSMSFormColor(AColor: TColor); procedure ChangeSMSFormSkin(ASkinName: String); procedure CloseAllSMSForm; procedure UpdateSMSForm(ARealICQUser: TRealICQUser); procedure SetAllSMSFormEnabledState(AEnableValue: Boolean); procedure UpdateCanSendSMSCount; var SMSForms: TList; SMSMessages: TStringList; {$I LXTalk.inc} implementation uses MainFrm, MessagesManagerFrm, NotReadMessageBoxFrm, TeamsAdapter, UsersService, ConditionConfig, Math; {$R *.dfm} //------------------------------------------------------------------------------ //显示可发短信数量和已经发送的短信数量 //------------------------------------------------------------------------------ procedure UpdateCanSendSMSCount; var iLoop: Integer; HintStr:String; AForm: TSMSForm; begin for iLoop := SMSForms.Count - 1 downto 0 do begin AForm := SMSForms[iLoop]; if not AForm.lblSmsLimitInfo.Visible then AForm.lblSmsLimitInfo.Visible:=True; if MainForm.RealICQClient.UserPermission.SMSLimitRole=smsBranchRole then HintStr:='您处于部门模式下,本%s贵部门尚可发送%d条短信,' +'您个人已发送%d条短信' else if MainForm.RealICQClient.UserPermission.SMSLimitRole=smsUserRole then HintStr:='您处于个人模式下,本%s您尚可发送%d条短信,' +'您个人已发送%d条短信' else HintStr:=''; if MainForm.RealICQClient.UserPermission.SMSLimitMode=smsMonthLimit then AForm.lblSmsLimitInfo.Caption:=Format(HintStr,['月', MainForm.RealICQClient.UserPermission.CanSendSmsCount, MainForm.RealICQClient.UserPermission.HasBeenSentSmsCount]) else AForm.lblSmsLimitInfo.Caption:=Format(HintStr,['日', MainForm.RealICQClient.UserPermission.CanSendSmsCount, MainForm.RealICQClient.UserPermission.HasBeenSentSmsCount]); AForm.TimerForGetHasSendSmsCount.Interval:=AForm.TimerForGetHasSendSmsCount.Interval+1000; end; end; procedure SetAllSMSFormEnabledState(AEnableValue: Boolean); var iLoop: Integer; AForm: TSMSForm; begin for iLoop := SMSForms.Count - 1 downto 0 do begin AForm := SMSForms[iLoop]; AForm.pnlClient.Enabled := AEnableValue; PostMessage(AForm.pnlDisplayer.Handle, WM_SIZE, 0, 0); end; end; //------------------------------------------------------------------------------ procedure SetSMSFormPosition(APrevForm, ASMSForm: TSMSForm; AShowActive: Boolean); begin if APrevForm <> nil then begin ASMSForm.Left := APrevForm.Left + 20; ASMSForm.Top := APrevForm.Top + 20; if (ASMSForm.Left + ASMSForm.Width > Screen.WorkAreaWidth) or (ASMSForm.Top + ASMSForm.Height > Screen.WorkAreaHeight) then begin ASMSForm.Left := 0; ASMSForm.Top := 0; end; end else begin //TalkingForm.Left := (Screen.WorkAreaWidth - TalkingForm.Width) div 2; //TalkingForm.Top := (Screen.WorkAreaHeight - TalkingForm.Height) div 2; end; if AShowActive then ASMSForm.WindowState := wsNormal else ASMSForm.WindowState := wsMinimized; ASMSForm.Show; if AShowActive then begin ShowWindow(ASMSForm.Handle, SW_SHOW); ForceForeGroundWindow(ASMSForm.Handle); end; end; function OpenSMSFormByWeb(Mobile:String): TSMSForm; var // iLoop: Integer; SMSForm: TSMSForm; begin SMSForm := TSMSForm.Create(MainForm); SMSForm.edMobiles.Text:=Mobile; SMSForm.Show; SetSMSFormPosition(nil, SMSForm, True); Result := SMSForm; MainForm.HideMainForm; end; //------------------------------------------------------------------------------ function OpenTeamSMSForm(ATeamID: String): TSMSForm; var iLoop: Integer; AForm, SMSForm: TSMSForm; begin AForm := nil; for iLoop := 0 to SMSForms.Count - 1 do begin AForm := SMSForms[iLoop]; if AForm.FIsMultiSend then continue; if AnsiSameText(AForm.TeamID, ATeamID) then begin ForceForeGroundWindow(AForm.Handle); Result := AForm; Exit; end; end; SMSForm := TSMSForm.Create(MainForm); SMSForm.TeamID := ATeamID; SMSForm.Show; SetSMSFormPosition(AForm, SMSForm,True); Result := SMSForm; MainForm.HideMainForm; end; //------------------------------------------------------------------------------ function OpenSMSForm(AReceiver: String; AShowActive: Boolean = True): TSMSForm; var iLoop: Integer; AForm, SMSForm: TSMSForm; begin AForm := nil; for iLoop := 0 to SMSForms.Count - 1 do begin AForm := SMSForms[iLoop]; if AForm.FIsMultiSend then continue; if AnsiSameText(AForm.Receiver, AReceiver) then begin if AShowActive then ForceForeGroundWindow(AForm.Handle); Result := AForm; Exit; end; end; SMSForm := TSMSForm.Create(MainForm); SMSForm.Receiver := AReceiver; SMSForm.Show; SetSMSFormPosition(AForm, SMSForm, AShowActive); Result := SMSForm; MainForm.HideMainForm; end; //------------------------------------------------------------------------------ function GetSMSForm(AReceiver: String): TSMSForm; var iLoop: Integer; AForm: TSMSForm; begin Result := nil; for iLoop := 0 to SMSForms.Count - 1 do begin AForm := SMSForms[iLoop]; if AForm.FIsMultiSend then continue; if AnsiSameText(AForm.Receiver, AReceiver) then begin Result := AForm; Exit; end; end; end; //------------------------------------------------------------------------------ procedure CloseAllSMSForm; var AForm: TSMSForm; begin while SMSForms.Count > 0 do begin AForm := SMSForms[0]; FreeAndNil(AForm); end; end; //------------------------------------------------------------------------------ procedure UpdateSMSForm(ARealICQUser: TRealICQUser); var iLoop: Integer; AForm: TSMSForm; begin for iLoop := SMSForms.Count - 1 downto 0 do begin AForm := SMSForms[iLoop]; if AForm.FIsMultiSend then begin AForm.UpdateSMSMember(ARealICQUser); end else if (AForm.FReceiver = ARealICQUser.LoginName) then begin AForm.SetReceiver(ARealICQUser.LoginName); end; end; end; //------------------------------------------------------------------------------ procedure ChangeSMSFormColor(AColor: TColor); var iLoop: Integer; AForm: TSMSForm; begin for iLoop := 0 to SMSForms.Count - 1 do begin AForm := SMSForms[iLoop]; AForm.ChangeUIColor(AColor); end; end; //------------------------------------------------------------------------------ procedure ChangeSMSFormSkin(ASkinName: String); var iLoop: Integer; AForm: TSMSForm; OldSkin: String; begin ASkinName := AnsiReplaceText(ASkinName, 'MainForm', ''); for iLoop := 0 to SMSForms.Count - 1 do begin AForm := SMSForms[iLoop]; OldSkin := AForm.SkinName; try AForm.SkinName := ASkinName; except AForm.SkinName := OldSkin; end; AForm.ChangeUIColor(MainForm.UIMainColor) end; end; //------------------------------------------------------------------------------ constructor TSMSMessage.Create(ASMSForm: TSMSForm); begin FSMSForm := ASMSForm; end; //------------------------------------------------------------------------------ function TSMSForm.GetCanWriteMessage: Boolean; begin Result := not pnlForHideWebBrowser.Visible; end; function TSMSForm.GetWaitSendSMSCount(SMSContent: String; RecevierCount: Integer): Integer; begin Result:=Length(SMSContent) div 140; if (Length(SMSContent) mod 140)<> 0 then Inc(Result,1); Result:=Result*RecevierCount; end; //------------------------------------------------------------------------------ procedure TSMSForm.CreateParams(var Params: TCreateParams); begin inherited; with Params do begin Params.WndParent := 0; end; end; procedure TSMSForm.edMobilesChange(Sender: TObject); var SelStart, iCount, iLength, iLoop: Integer; begin iCount := 0; iLength := Length(edMobiles.Text); if edMobiles.SelStart < iLength then Exit; for iLoop := iLength - 1 downto 0 do begin if edMobiles.Text[iLoop] in ['0'..'9'] then begin Inc(iCount); if iCount = 10 then begin SelStart := edMobiles.SelStart; edMobiles.OnChange := nil; edMobiles.Text := edMobiles.Text + ','; edMobiles.OnChange := edMobilesChange; edMobiles.SelStart := SelStart + 1; iCount := 0; Exit; end; end else begin iCount := 0; Exit; end; end; end; procedure TSMSForm.edMobilesKeyPress(Sender: TObject; var Key: Char); begin if not (key in ['0'..'9',',',#8]) then begin key:=#0; Messagebeep(0); end; end; //------------------------------------------------------------------------------ procedure TSMSForm.SetReceiver(Value: String); var FRealICQUser: TRealICQUser; begin FReceiver := Value; if Length(Trim(FReceiver)) > 0 then begin pnlMobile.Visible := False; FRealICQUser:= TUsersService.GetUsersService.GetUser(Receiver); if not Assigned(FRealICQUser) then Exit; if FRealICQUser.DisplayName = '' then TimerForGetUserInformation.Enabled := True; end else begin pnlMobile.Visible := True; lblDest.OnClick := nil; end; PostMessage(pnlDisplayer.Handle, WM_SIZE, 0, 0); PostMessage(Handle, WM_SIZE, 0, 0); end; //------------------------------------------------------------------------------ procedure TSMSForm.AddLVTeamMembers; var ItemIndex:Integer; begin {$region '生成显示群发列表的ListView'} ItemIndex := MainForm.AddContacterListView(pnlTeamMemberContainer, ''); FLVTeamMembers := MainForm.ContacterListViews.Objects[ItemIndex] as TRealICQContacterListView; MainForm.ContacterListViews.Delete(ItemIndex); FLVTeamMembers.OnItemOnline := nil; FLVTeamMembers.OnItemOffline := nil; FLVTeamMembers.PopupMenu := ppUserItemRightMenu; FLVTeamMembers.Style := lsSmallHeadImage; FLVTeamMembers.CaptionStyle := csDisplayName; FLVTeamMembers.OnItemMouseEnter := nil; FLVTeamMembers.OnItemMouseLeave := nil; FLVTeamMembers.OnItemIconButtonClick := nil; //FLVTeamMembers.OnItemIconButtonDblClick := nil; FLVTeamMembers.ShowHeadImageButton := False; FLVTeamMembers.AdjustPosition := False; FLVTeamMembers.ShowTelButton := False; FLVTeamMembers.ShowMobileButton := False; FLVTeamMembers.ShowEmailButton := False; FLVTeamMembers.ShowCameraButton := False; FLVTeamMembers.ChangeUIColor(MainForm.UIMainColor); {$endregion} end; //------------------------------------------------------------------------------ procedure TSMSForm.SetTeamID(Value: String); var iLoop,ItemIndex: Integer; ATeam: TRealICQTeam; MemberList: TStringList; LoginName:String; RealICQUser: TRealICQUser; AListItem: TRealICQContacterListItem; begin FTeamID:=Value; ATeam := TTeamsAdapter.GetTeam(FTeamID); if ATeam = nil then Exit; if FLVTeamMembers = nil then AddLVTeamMembers; pnlUsers.Width := 228; pnlMobile.Visible := False; FIsMultiSend := True; MemberList := SplitString(ATeam.TeamMembers, Chr(10)); try for iLoop := 0 to MemberList.Count - 1 do begin LoginName := MemberList[iLoop]; if Length(Trim(LoginName)) = 0 then continue; RealICQUser:= TUsersService.GetUsersService.GetOrRequestUser(LoginName); AddUserToListView(RealICQUser); end; lblTeamMemberCount.Caption := Format('接收者(%d/%d)', [FLVTeamMembers.OnlineNumeric, FLVTeamMembers.Items.Count]); finally MemberList.Free; pnlDisplayerResize(pnlDisplayer); PostMessage(Handle, WM_SIZE, 0, 0); end; {FTeamID:=Value; ItemIndex := MainForm.RealICQClient.Teams.IndexOf(FTeamID); if ItemIndex<0 then Exit; ATeam := MainForm.RealICQClient.Teams.Objects[ItemIndex] as TRealICQTeam; if FLVTeamMembers = nil then AddLVTeamMembers; pnlUsers.Width := 228; pnlMobile.Visible := False; FIsMultiSend := True; MemberList := SplitString(ATeam.TeamMembers, Chr(10)); try for iLoop := 0 to MemberList.Count - 1 do begin LoginName := MemberList[iLoop]; if Length(Trim(LoginName)) = 0 then continue; RealICQUser :=MainForm.RealICQClient.GetRealICQUserObject(LoginName); AddUserToListView(RealICQUser); end; lblTeamMemberCount.Caption := Format('接收者(%d/%d)', [FLVTeamMembers.OnlineNumeric, FLVTeamMembers.Items.Count]); finally MemberList.Free; pnlDisplayerResize(pnlDisplayer); PostMessage(Handle, WM_SIZE, 0, 0); end; } end; procedure TSMSForm.AddUserToListView(RealICQUser: TRealICQUser); var AListItem: TRealICQContacterListItem; ItemIndex:Integer; begin if not Assigned(RealICQUser) then Exit; if Length(Trim(RealICQUser.Mobile)) = 0 then Exit; FSMSReveivers.AddObject(RealICQUser.LoginName, TStringList.Create); ItemIndex := FLVTeamMembers.Items.IndexOf(RealICQUser.LoginName); if ItemIndex = -1 then ItemIndex := FLVTeamMembers.Items.Add(RealICQUser.LoginName); AListItem := FLVTeamMembers.Items.Objects[ItemIndex] as TRealICQContacterListItem; MainForm.BindUserDataToItem(AListItem, RealICQUser); end; procedure TSMSForm.spbMultiSendClick(Sender: TObject); var AddUserForm: TMultiSendSMSForm; iIndex: Integer; iLoop: Integer; LoginName: String; RealICQUser: TRealICQUser; AddedUsers: TStringList; SendedSMSMessages: TStringList; AListItem: TRealICQContacterListItem; begin if (not MainForm.RealICQClient.UserPermission.EnableMultiSendSms) then begin ShowMessage('您没有群发手机短信的权限!'); Exit; end; if FLVTeamMembers = nil then AddLVTeamMembers; AddUserForm := TMultiSendSMSForm.Create(Self); //将上次选择发送的对象加入到已选择列表中。 for iLoop := 0 to FLVTeamMembers.Items.Count - 1 do begin RealICQUser:=(FLVTeamMembers.Items.Objects[iLoop] as TRealICQContacterListItem).data; AddUserForm.AddedUsers.AddObject(RealICQUser.Mobile,RealICQUser); end; try if AddUserForm.ShowModal = mrOk then begin AddedUsers := AddUserForm.AddedUsers; try if AddedUsers.Count = 0 then begin pnlUsers.Width := 0; FIsMultiSend := False; FReceiver := ''; FLVTeamMembers.Items.Clear; SetReceiver(FReceiver); Exit; end; pnlUsers.Width := 228; pnlMobile.Visible := False; FIsMultiSend := True; Application.ProcessMessages; while FSMSReveivers.Count > 0 do begin SendedSMSMessages := FSMSReveivers.Objects[0] as TStringList; FSMSReveivers.Delete(0); try FreeAndNil(SendedSMSMessages); except end; end; FSMSReveivers.Clear; for iLoop := 0 to AddedUsers.Count - 1 do begin AddUserToListView(AddedUsers.Objects[iLoop] as TRealICQUser); end; for iLoop := FLVTeamMembers.Items.Count - 1 downto 0 do begin AListItem := FLVTeamMembers.Items.Objects[iLoop] as TRealICQContacterListItem; if AddedUsers.IndexOf(AListItem.Mobile) = -1 then begin FLVTeamMembers.Items.Delete(iLoop); end; end; lblTeamMemberCount.Caption := Format('接收者(%d/%d)', [FLVTeamMembers.OnlineNumeric, FLVTeamMembers.Items.Count]); finally FreeAndNil(AddedUsers); end; end; finally pnlDisplayerResize(pnlDisplayer); PostMessage(Handle, WM_SIZE, 0, 0); try FreeAndNil(AddUserForm); except end; end; end; //------------------------------------------------------------------------------ procedure TSMSForm.TimerForGetHasSendSmsCountTimer(Sender: TObject); begin MainForm.RealICQClient.SendGetCanSendSMSCount; end; procedure TSMSForm.TimerForGetUserInformationTimer(Sender: TObject); var FRealICQUser: TRealICQUser; begin if Length(Trim(Receiver)) = 0 then Exit; FRealICQUser:= TUsersService.GetUsersService.GetUser(Receiver); if not Assigned(FRealICQUser) then Exit; TimerForGetUserInformation.Enabled := False; if FRealICQUser.DisplayName = '' then TUsersService.GetUsersService.GetOrRequestUser(FRealICQUser.LoginName, MainForm.RealICQClient); end; //------------------------------------------------------------------------------ procedure TSMSForm.WebBrowserBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool); const BaseURL = 'about:blank'; BaseURL1 = 'about:'; var NewURL: String; function GetBaseIDFromUrl(SrcUrl:String):String; begin result := Copy(SrcUrl, AnsiPos('_',SrcUrl) + 1, Length(SrcUrl)); end; begin NewUrl := Trim(AnsiReplaceText(String(URL), BaseURL, '')); NewUrl := Trim(AnsiReplaceText(String(NewUrl), BaseURL1, '')); {$region '复制,全选菜单'} if AnsiSameText(NewUrl , 'PopMenu') then begin Cancel := True; ppForWebBrowser.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y); Exit; end; {$endregion} Cancel := True; end; //------------------------------------------------------------------------------ procedure TSMSForm.WebBrowserDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant); begin try WebBrowser.OnDocumentComplete := nil; try SetDomStyle(WebBrowser.Document as IHtmlDocument2); finally pnlForHideWebBrowser.Visible := False; end; except end; end; //------------------------------------------------------------------------------ procedure TSMSForm.SetDOMStyle(Doc:IHTMLDocument2); var v: Variant; CurrentColor, CssColor: String; begin if pnlForHideWebBrowser.Visible then begin v := VarArrayCreate([0, 0], varVariant); v[0] := '' + '' + '' + '' + '' + ''; doc.write(PSafeArray(TVarData(v).VArray)); end; try CurrentColor := IntToHex(ConvertColorToColor($00CDCDCD, MainForm.UIMainColor), 6); CssColor := '#' + Copy(CurrentColor,5,2) + Copy(CurrentColor,3,2) + Copy(CurrentColor,1,2); except end; Doc.body.language := 'gb2312'; Doc.body.style.cssText:='SCROLLBAR-FACE-COLOR:' + CssColor + ';' + 'SCROLLBAR-HIGHLIGHT-COLOR: ButtonHighLight;' + 'SCROLLBAR-SHADOW-COLOR: ButtonShadow;' + 'SCROLLBAR-ARROW-COLOR: #333333;' + 'SCROLLBAR-3DLIGHT-COLOR:' + CssColor + ';' + 'SCROLLBAR-TRACK-COLOR:' + CssColor + ';' + 'SCROLLBAR-DARKSHADOW-COLOR:' + CssColor + ';' + 'word-break: break-all;' + 'background-attachment: fixed;' + 'background-repeat: no-repeat;' + 'background-position: left top;'; Doc.body.style.overflow:='auto'; Doc.body.style.border:='0px solid'; Doc.body.style.margin:='2px'; Doc.body.style.fontFamily:='宋体'; Doc.body.style.fontSize:='9pt'; end; //------------------------------------------------------------------------------ procedure TSMSForm.actCloseExecute(Sender: TObject); begin Close; end; //------------------------------------------------------------------------------ procedure TSMSForm.actCtrlEnterExecute(Sender: TObject); begin actCtrlEnter.Checked := True; MainForm.CtrlEnterSendMessage := True; end; //------------------------------------------------------------------------------ procedure TSMSForm.actEnterExecute(Sender: TObject); begin actEnter.Checked := True; MainForm.CtrlEnterSendMessage := False; end; //------------------------------------------------------------------------------ procedure TSMSForm.actPageSetExecute(Sender: TObject); begin WebBrowser.ExecWB(OLECMDID_PAGESETUP, OLECMDEXECOPT_DODEFAULT, EmptyParam, EmptyParam); end; //------------------------------------------------------------------------------ procedure TSMSForm.actPreviewExecute(Sender: TObject); begin if WebBrowser.QueryStatusWB(OLECMDID_PRINTPREVIEW) = 3 then WebBrowser.ExecWB(OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DODEFAULT, EmptyParam, EmptyParam); end; //------------------------------------------------------------------------------ procedure TSMSForm.actPrintExecute(Sender: TObject); begin WebBrowser.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DODEFAULT, EmptyParam, EmptyParam); end; //------------------------------------------------------------------------------ procedure TSMSForm.actSaveAsHTMLFileExecute(Sender: TObject); var StringList: TStringList; begin SaveDialog.FileName := Caption + '_' + FormatDateTime('yyyy-mm-dd',Now()) + '.Html'; if SaveDialog.Execute then begin StringList := TStringList.Create; try StringList.Add(IHtmlDocument2(WebBrowser.Document).Body.innerHTML); StringList.SaveToFile(SaveDialog.FileName); finally StringList.Free; end; end; end; //------------------------------------------------------------------------------ procedure TSMSForm.actSaveAsTextFileExecute(Sender: TObject); var StringList: TStringList; begin SaveDialog.FileName := Caption + '_' + FormatDateTime('yyyy-mm-dd',Now())+ '.TXT'; if SaveDialog.Execute then begin StringList := TStringList.Create; try StringList.Add(IHtmlDocument2(WebBrowser.Document).Body.OuterText); StringList.SaveToFile(SaveDialog.FileName); finally StringList.Free; end; end; end; //------------------------------------------------------------------------------ procedure TSMSForm.actShowHistoryExecute(Sender: TObject); begin MainForm.OpenMessagesManagerForm; Application.ProcessMessages; if (not pnlMobile.Visible) and (FIsMultiSend = False) then MessagesManagerForm.ShowUsersMessages(FReceiver) else begin MessagesManagerForm.ShowUsersMessages(''); end; end; //------------------------------------------------------------------------------ procedure TSMSForm.ApplicationEventsMessage(var Msg: tagMSG; var Handled: Boolean); begin if IsChild(Webbrowser.Handle, Msg.hwnd) then begin if (Msg.Message = WM_KEYDOWN) or (Msg.Message = WM_SYSKEYDOWN) then begin if msg.wParam = VK_F5 then begin Handled := True; end; end; end; if RichEdInputer.Handle = Msg.hwnd then begin if (Msg.Message = WM_KEYDOWN) or (Msg.Message = WM_SYSKEYDOWN) then begin if (msg.wParam = 13) then begin if (not MainForm.CtrlEnterSendMessage) and (GetKeyState(VK_CONTROL) < 0) then Exit; if (MainForm.CtrlEnterSendMessage) and (GetKeyState(VK_CONTROL) >= 0) then Exit; btSendClick(nil); Handled := True; end; end; end; end; //------------------------------------------------------------------------------ procedure TSMSForm.CMWininichange(var Message: TWMWinIniChange); begin ChangeUIColor(MainForm.UIMainColor); DisableAlign; try PostMessage(Handle, WM_SIZE, 0, 0); finally EnableAlign; end; end; //------------------------------------------------------------------------------ procedure TSMSForm.LoadNotReadSMSMessages; var iLoop, iIndex: Integer; SMSSender, SenderName, ReceiverName, MessageID: String; NotReadSMSMessage: TNotReadSMSMessage; FRealICQUser: TRealICQUser; AMessageType: Integer; MessageList: TList; begin if FIsMultiSend then Exit; if Length(Trim(MainForm.RealICQClient.Me.DisplayName)) = 0 then ReceiverName := MainForm.RealICQClient.Me.LoginName else ReceiverName := MainForm.RealICQClient.Me.DisplayName; iIndex := MainForm.NotReadMessages.IndexOf(SMSMessageID + FReceiver); if iIndex < 0 then Exit; MessageList := MainForm.NotReadMessages.Objects[iIndex] as TList; MessageID := MainForm.NotReadMessages.Strings[iIndex]; MainForm.NotReadMessages.Delete(iIndex); try NotReadMessageBoxForm.ShowNotReadMessage; NotReadMessageBoxForm.Height := 0; NotReadMessageBoxForm.Top := Screen.WorkAreaHeight - NotReadMessageBoxForm.Height; except end; for iLoop := 0 to MessageList.Count - 1 do begin SMSSender := Copy(MessageID, Length(SMSMessageID) + 1, Length(MessageID) - Length(SMSMessageID)); NotReadSMSMessage := MessageList[iLoop]; AMessageType := -2; if Length(Trim(SMSSender)) <= 0 then begin SMSSender := NotReadSMSMessage.SMSSender; AMessageType := -3; end; FRealICQUser := TUsersService.GetUsersService.GetUser(SMSSender); MainForm.DBHistory.SetReadFlag('-2',SMSSender); if Assigned(FRealICQUser) then begin if Length(Trim(FRealICQUser.DisplayName)) = 0 then SenderName := FRealICQUser.LoginName else SenderName := FRealICQUser.DisplayName; end else SenderName := SMSSender; AddMessageToWebBrowser(SMSSender, SenderName, ReceiverName, NotReadSMSMessage.SMSContent, NotReadSMSMessage.SMSDateTime, 0, True); MainForm.DBHistory.SaveSMSMessage(SMSSender, MainForm.RealICQClient.LoginName, NotReadSMSMessage.SMSDateTime, NotReadSMSMessage.SMSContent, AMessageType); FreeAndNil(NotReadSMSMessage); end; MessageList.Free; end; //------------------------------------------------------------------------------ procedure TSMSForm.ShowSMSMessageResult(AMessageID: Cardinal; AResult: Integer); var E: IHTMLElement; iIndex, iLoop, AMessageType: Integer; SMSMessage: TSMSMessage; TimeStamp1, TimeStamp2: TTimeStamp; FStartDateTime: TDateTime; ErrorStr: String; ARealICQUser: TRealICQUser; begin TimeStamp1 := DateTimeToTimeStamp(DatePickerStart.Date); TimeStamp2 := DateTimeToTimeStamp(TimePickerStart.Time); TimeStamp1.Time := TimeStamp2.Time; FStartDateTime := TimeStampToDateTime(TimeStamp1); iIndex := SMSMessages.IndexOf(IntToStr(AMessageID)); if iIndex >= 0 then begin SMSMessage := SMSMessages.Objects[iIndex] as TSMSMessage; if Self.pnlMobile.Visible then AMessageType := -3 else AMessageType := -2; if SMSMessage.FMuiltySend then begin UpdateListItemSendState(SMSMessage.FReceiverID); if AResult <> 0 then begin if AResult = -9999 then ErrorStr := '(' + IntToStr(AResult) + ':号码有误)' else if(AResult = -1002) then ErrorStr := '(您已经超出今天允许发送的短信条数,请明天再发)' else ErrorStr := '(' + IntToStr(AResult) + ')'; ShowMessageInWebBrowser(WebBrowser, '无法将短信发送给:' + SMSMessage.FReceiverName + ErrorStr); end; Exit; end; end; E := (WebBrowser.Document as IHTMLDocument2).all.item('SMSIMG_' + IntToStr(AMessageID), 0) as IHTMLElement; if AResult = 0 then begin E.setAttribute('src', ExtractFilePath(Application.ExeName) + SMSSendOK, 0); E := (WebBrowser.Document as IHTMLDocument2).all.item('SMSState_' + IntToStr(AMessageID), 0) as IHTMLElement; //if cbCustomSendDateTime.Checked then // E.innerHTML := '(将于 ' + DateTimeToStr(FStartDateTime) + ' 发送)'; if iIndex >= 0 then begin ARealICQUser := TUsersService.GetUsersService.GetUser(SMSMessage.FReceiverID); if (MainForm.RealICQClient.MoreUsers.IndexOf(SMSMessage.FReceiverID) < 0) then begin if (ARealICQUser <> nil) and (trim(ARealICQUser.Mobile)<>'') then SMSMessage.FReceiverID := ARealICQUser.Mobile; AMessageType := -3; end else if ARealICQUser <> nil then SMSMessage.FReceiverID := ARealICQUser.LoginName; MainForm.DBHistory.SaveSMSMessage(SMSMessage.SenderID, SMSMessage.FReceiverID, SMSMessage.FSendDateTime, SMSMessage.FMessageStr, AMessageType); MainForm.RealICQClient.SendGetCanSendSMSCount; TimerForGetHasSendSmsCount.Interval:=5000; end; end else begin E.setAttribute('src', ExtractFilePath(Application.ExeName) + SMSSendError, 0); E := (WebBrowser.Document as IHTMLDocument2).all.item('SMSState_' + IntToStr(AMessageID), 0) as IHTMLElement; if AResult = -9999 then E.innerHTML := '(' + IntToStr(AResult) + ':号码有误)' else if(AResult = -1002) then E.innerHTML := '(您已经超出今天允许发送的短信条数,请明天再发)' else E.innerHTML := '(' + IntToStr(AResult) + ')'; end; end; {将消息内容显示在WebBrowser中} //------------------------------------------------------------------------------ procedure TSMSForm.AddMessageToWebBrowser(SenderID: String; SenderName, ReceiverName, MessageStr: String; SendDateTime: TDateTime; SMSMessageID: Cardinal; IsReceivedSMS: Boolean = False; IsHistory: Boolean = False); var MsgContent, HTML, SenderColor: String; TimeStamp1, TimeStamp2: TTimeStamp; FStartDateTime: TDateTime; begin TimeStamp1 := DateTimeToTimeStamp(DatePickerStart.Date); TimeStamp2 := DateTimeToTimeStamp(TimePickerStart.Time); TimeStamp1.Time := TimeStamp2.Time; FStartDateTime := TimeStampToDateTime(TimeStamp1); MsgContent := ''; if CompareDate(Now, SendDateTime) = EqualsValue then MsgContent := SenderName + ' -> ' + ReceiverName + ' ' + TimeToStr(SendDateTime) + ':' else MsgContent := SenderName + ' -> ' + ReceiverName + ' ' + DateTimeToStr(SendDateTime) + ':'; MsgContent := FilterHTMLCode(MsgContent, MainForm.AllowURL); //过滤HTML代码 if not IsHistory then begin if AnsiSameText(SenderID, MainForm.RealICQClient.LoginName) then SenderColor := '#0000FF' else SenderColor := '#009900'; end else SenderColor := '#686868'; HTML := '
' + MsgContent; if AnsiSameText(SenderID, MainForm.RealICQClient.LoginName) and (not IsReceivedSMS) then begin if (not FIsMultiSend) then HTML := HTML + ''; HTML := HTML + ''; end; HTML := HTML + '
'; HTML := HTML + '
' + MsgContent + '
'; if cbCustomSendDateTime.Checked and (not IsHistory) and (not IsReceivedSMS) then HTML := HTML + '
' + Format('(本条信息将于%s发送)', [FormatDateTime('yyyy年MM月dd日 hh点nn分ss秒',FStartDateTime)]) + '
'; InsertHTML(WebBrowser, HTML); end; procedure TSMSForm.UpdateListItemSendState(ALoginName: String); var iIndex, iLoop, iSended: Integer; AListItem: TRealICQContacterListItem; SendedSMSMessages: TStringList; SMSMessage: TSMSMessage; begin iIndex := FLVTeamMembers.Items.IndexOf(ALoginName); if iIndex < 0 then Exit; AListItem := FLVTeamMembers.Items.Objects[iIndex] as TRealICQContacterListItem; iIndex := FSMSReveivers.IndexOf(ALoginName); if iIndex < 0 then Exit; SendedSMSMessages := FSMSReveivers.Objects[iIndex] as TStringList; iSended := 0; for iLoop := 0 to SendedSMSMessages.Count - 1 do begin SMSMessage := SendedSMSMessages.Objects[iLoop] as TSMSMessage; if SMSMessage.Sended then Inc(iSended); end; //AListItem.Watchword := Format('(%d/%d条)', [iSended, SendedSMSMessages.Count]); AListItem.Watchword := Format('(成功:%d/%d条)', [iSended, SendedSMSMessages.Count]); //AListItem.Watchword := Format('(×:%d,√:%d)', [SendedSMSMessages.Count - iSended, iSended]); AListItem.ReDrawItem; MainForm.RealICQClient.SendGetCanSendSMSCount; TimerForGetHasSendSmsCount.Interval:=5000; end; //------------------------------------------------------------------------------ procedure TSMSForm.btSendClick(Sender: TObject); var SenderName, UnderWrite, ReceiverName, MessageStr, OneMessageStr: String; FRealICQUser: TRealICQUser; iLoop, jLoop, OnSMSLength, iIndex, HZCount,ItemIndex: Integer; SMSMessage: TSMSMessage; Mobiles: TStringList; StartChr: Char; TimeStamp1, TimeStamp2: TTimeStamp; FStartDateTime: TDateTime; SendedSMSMessages: TStringList; AListItem: TRealICQContacterListItem; begin TimeStamp1 := DateTimeToTimeStamp(DatePickerStart.Date); TimeStamp2 := DateTimeToTimeStamp(TimePickerStart.Time); TimeStamp1.Time := TimeStamp2.Time; FStartDateTime := TimeStampToDateTime(TimeStamp1); if cbCustomSendDateTime.Checked then begin if FStartDateTime < Now then begin ShowMessage('定时发送时间不能小于当前时间!'); Exit; end; end; if not MainForm.RealICQClient.UserPermission.EnableSendSms then begin ShowMessage('您没有发送手机短信的权限!'); Exit; end; if Length(Trim(RichEdInputer.Text)) > MaxSmsLength then begin MessageBox(Handle, '对不起,您输入消息太长', '提示', MB_ICONINFORMATION); RichEdInputer.SetFocus; Exit; end; if (GetTickCount - FLastSendMsgTicket) < 1000 then begin ShowSendMessageTooQuickly(WebBrowser); Exit; end; if pnlMobile.Visible then //手输号码 begin if Length(Trim(edMobiles.Text)) = 0 then begin MessageBox(Handle, '请输入手机号码!', '提示', MB_ICONINFORMATION); RichEdInputer.SetFocus; Exit; end; edMobiles.Text := Trim(edMobiles.Text); end; MessageStr := ''; RichEdInputer.OnChange := nil; RichEdInputer.Visible := False; try MessageStr := Trim(RichEdInputer.Text); if Length(MessageStr) = 0 then begin MessageBox(Handle, '对不起,不能发送空消息', '提示', MB_ICONINFORMATION); Exit; end; finally RichEdInputer.MaxLength := MaxSMSLength; RichEdInputer.OnChange := RichEdInputerChange; RichEdInputer.Lines.Clear; RichEdInputerChange(RichEdInputer); RichEdInputer.Visible := True; RichEdInputer.SetFocus; end; if Length(Trim(MainForm.RealICQClient.Me.DisplayName)) = 0 then SenderName := MainForm.RealICQClient.Me.LoginName else SenderName := MainForm.RealICQClient.Me.DisplayName; //UnderWrite := ' -- ' + SenderName + '(可直接回复)'; //OnSMSLength := 120 - Length(UnderWrite); //iIndex := 1; //while iIndex <= Length(MessageStr) do //begin //OneMessageStr := Copy(MessageStr, iIndex, OnSMSLength); //HZCount := 0; //for jLoop := 1 to length(OneMessageStr) do //begin //if WORD(OneMessageStr[jLoop]) > 126 then Inc(HZCount); //end; //if HZCount mod 2 <> 0 then //begin //OneMessageStr := Copy(MessageStr, iIndex, OnSMSLength - 1); //Inc(iIndex, OnSMSLength - 1); //end //else //begin //Inc(iIndex, OnSMSLength); //end; OneMessageStr := MessageStr + ' -- ' + SenderName + ''; //消息内容(可直接回复) if pnlMobile.Visible then //手输号码 begin {$region '手输号码'} if Length(Trim(edMobiles.Text)) = 0 then begin MessageBox(Handle, '请输入手机号码!', '提示', MB_ICONINFORMATION); Exit; end; Mobiles := SplitString(edMobiles.Text, ','); if (Mobiles.Count>2) and (not MainForm.RealICQClient.UserPermission.EnableMultiSendSms) then begin ShowMessage('您没有群发手机短信的权限!'); Exit; end; if not CheckCount(Mobiles.Count - 1, OneMessageStr) then begin Exit; end; try for jLoop := 0 to Mobiles.Count - 1 do begin ReceiverName := Mobiles.Strings[jLoop]; if Length(Trim(ReceiverName)) = 0 then continue; //验证手机号码 if not CheckMobile(trim(ReceiverName)) then begin MessageBox(Handle, '手机号码不正确!', '提示', MB_ICONINFORMATION); edMobiles.SetFocus; Exit; end; SMSMessage := TSMSMessage.Create(Self); SMSMessage.FSenderID := MainForm.RealICQClient.LoginName; SMSMessage.FReceiverID := ReceiverName; SMSMessage.FSenderName := SenderName; SMSMessage.FReceiverName := ReceiverName; SMSMessage.FMessageStr := OneMessageStr; SMSMessage.FSendDateTime := Now; SMSMessage.FSended := False; SMSMessage.FMuiltySend := False; SMSMessage.FSMSMessageID := GetTickCount + SMSMessages.Count; SMSMessages.AddObject(IntToStr(SMSMessage.FSMSMessageID), SMSMessage); MainForm.RealICQClient.SendSMSMessage(SMSMessage.ReceiverName, SMSMessage.MessageStr, SMSMessage.SMSMessageID, cbCustomSendDateTime.Checked, FStartDateTime); AddMessageToWebBrowser(SMSMessage.SenderID, SMSMessage.SenderName, SMSMessage.ReceiverName, SMSMessage.MessageStr, SMSMessage.SendDateTime, SMSMessage.SMSMessageID); Sleep(200); Application.ProcessMessages; end; finally FreeAndNil(Mobiles); end; {$endregion} end else if FIsMultiSend then //群发 begin {$region '群发'} if FLVTeamMembers.Items.Count < 1 then begin MessageBox(Handle, '请选择用户!', '提示', MB_ICONINFORMATION); Exit; end; if not CheckCount(FLVTeamMembers.Items.Count, OneMessageStr) then begin Exit; end; AddMessageToWebBrowser(MainForm.RealICQClient.LoginName, SenderName, '群发', OneMessageStr, Now, 10000); for jLoop := 0 to FLVTeamMembers.Items.Count - 1 do begin ReceiverName := FLVTeamMembers.Items[jLoop]; AListItem := FLVTeamMembers.Items.Objects[jLoop] as TRealICQContacterListItem; {ItemIndex:=MainForm.RealICQClient.AddrBookUsers.IndexOf(ReceiverName); if ItemIndex>=0 then begin FRealICQUser := MainForm.RealICQClient.AddrBookUsers.Objects[ItemIndex] as TRealICQUser; end else begin ItemIndex:=MainForm.RealICQClient.Friends.IndexOf(ReceiverName); if ItemIndex<0 then continue; FRealICQUser := MainForm.RealICQClient.Friends.Objects[ItemIndex] as TRealICQUser; end;} ItemIndex:=MainForm.RealICQClient.AddrBookUsers.IndexOf(ReceiverName); if ItemIndex>=0 then begin FRealICQUser := MainForm.RealICQClient.AddrBookUsers.Objects[ItemIndex] as TRealICQUser; end else if(ItemIndex<0) then begin FRealICQUser:= TUsersService.GetUsersService.GetUser(ReceiverName); if FRealICQUser = nil then begin ItemIndex:=MainForm.RealICQClient.MoreUsers.IndexOf(ReceiverName); if ItemIndex<0 then continue; FRealICQUser := MainForm.RealICQClient.MoreUsers.Objects[ItemIndex] as TRealICQUser ; end; end; if not Assigned(FRealICQUser) then Exit; if Length(Trim(FRealICQUser.Mobile)) = 0 then continue; if Length(Trim(FRealICQUser.DisplayName)) = 0 then ReceiverName := FRealICQUser.LoginName else ReceiverName := FRealICQUser.DisplayName; SMSMessage := TSMSMessage.Create(Self); SMSMessage.FSenderID := MainForm.RealICQClient.LoginName; SMSMessage.FReceiverID := FRealICQUser.LoginName; SMSMessage.FSenderName := SenderName; SMSMessage.FReceiverName := ReceiverName; SMSMessage.FMessageStr := OneMessageStr; SMSMessage.FSendDateTime := Now; SMSMessage.FSended := False; SMSMessage.FMuiltySend := True; SMSMessage.FSMSMessageID := GetTickCount + SMSMessages.Count; SMSMessages.AddObject(IntToStr(SMSMessage.FSMSMessageID), SMSMessage); iIndex := FSMSReveivers.IndexOf(FRealICQUser.LoginName); if iIndex < 0 then Continue; SendedSMSMessages := FSMSReveivers.Objects[iIndex] as TStringList; SendedSMSMessages.AddObject(IntToStr(SMSMessage.FSMSMessageID), SMSMessage); //UpdateListItemSendState(FRealICQUser.LoginName); MainForm.RealICQClient.SendSMSMessage(FRealICQUser.Mobile, SMSMessage.MessageStr, SMSMessage.SMSMessageID, cbCustomSendDateTime.Checked, FStartDateTime); Application.ProcessMessages; end; {$endregion} end else begin {$region '单发'} FRealICQUser := TUsersService.GetUsersService.GetUser(Receiver); if not Assigned(FRealICQUser) then Exit; if Length(Trim(FRealICQUser.DisplayName)) = 0 then ReceiverName := FRealICQUser.LoginName else ReceiverName := FRealICQUser.DisplayName; SMSMessage := TSMSMessage.Create(Self); SMSMessage.FSenderID := MainForm.RealICQClient.LoginName; SMSMessage.FReceiverID := FRealICQUser.LoginName; SMSMessage.FSenderName := SenderName; SMSMessage.FReceiverName := ReceiverName; SMSMessage.FMessageStr := OneMessageStr; SMSMessage.FSendDateTime := Now; SMSMessage.FSended := False; SMSMessage.FMuiltySend := False; SMSMessage.FSMSMessageID := GetTickCount + SMSMessages.Count; SMSMessages.AddObject(IntToStr(SMSMessage.FSMSMessageID), SMSMessage); MainForm.RealICQClient.SendSMSMessage(FRealICQUser.Mobile, SMSMessage.MessageStr, SMSMessage.SMSMessageID, cbCustomSendDateTime.Checked, FStartDateTime); AddMessageToWebBrowser(SMSMessage.SenderID, SMSMessage.SenderName, SMSMessage.ReceiverName, SMSMessage.MessageStr, SMSMessage.SendDateTime, SMSMessage.SMSMessageID); {$endregion} end; //end; FLastSendMsgTicket := GetTickCount; end; function TSMSForm.CheckCount(ACount: Integer; AContent: string): Boolean; var ALen: Integer; begin ALen := Length(AContent) + Length(TConditionConfig.GetConfig.SMSName); Result := MainForm.RealICQClient.UserPermission.CanSendSmsCount > Ceil(ALen / 70) * ACount; if not Result then ShowMessage(Format('您这次要发送%d条,已超出可发送条数。',[Ceil(ALen / 70) * ACount])); end; procedure TSMSForm.CalculateSMSCount; begin lblSMSState.Caption := '已输入 ' + IntToStr(Length(RichEdInputer.Text)) + ' 个字符;' +'每条短信上限140个字符(70个汉字);本次产生'+IntToStr(GetWaitSendSMSCount(RichEdInputer.Text,1)); if self.FIsMultiSend then lblSMSState.Caption :=lblSMSState.Caption+'×('+IntToStr(FLVTeamMembers.Items.Count)+')' else if (pnlMobile.Visible) and (Trim(edMobiles.Text)<>'') then begin lblSMSState.Caption :=lblSMSState.Caption+'×('+IntToStr(SplitString(edMobiles.Text, ',').Count-1)+')'; end; lblSMSState.Caption :=lblSMSState.Caption+'条短信'; end; procedure TSMSForm.cbCustomSendDateTimeClick(Sender: TObject); begin DatePickerStart.Enabled := cbCustomSendDateTime.Checked; TimePickerStart.Enabled := cbCustomSendDateTime.Checked; end; //------------------------------------------------------------------------------ procedure TSMSForm.ChangeUIColor(AColor: TColor); begin inherited ChangeUIColor(AColor); pnlClient.Color := FormColor; pnlMenu.Color := FormColor; pnlUsers.Color := FormColor; pnlTalkingArea.Color := FormColor; pnlForActionMainMenuBar.Color := FormColor; pnlForActionToolBar.Color := FormColor; ActionMainMenuBar.ColorMap.Color := FormColor; ActionMainMenuBar.ColorMap.SelectedColor := ConvertColorToColor(ActionMainMenuBar.ColorMap.SelectedColor, AColor); ActionMainMenuBar.ColorMap.BtnFrameColor := ConvertColorToColor(ActionMainMenuBar.ColorMap.BtnFrameColor, AColor); ActionMainMenuBar.Font.Name := '宋体'; ActionMainMenuBar.Font.Size := 9; rndTeamMembers.ChangeUIColor(AColor); rndTeamMemberContainer.ChangeUIColor(AColor); spbSMSManage.ChangeUIColor(AColor); spbMultiSend.ChangeUIColor(AColor); spMobileBorder.Pen.Color := ConvertColorToColor(spMobileBorder.Pen.Color, AColor); ConvertBitmapToColor(imgToolbarBack.Picture.Bitmap, AColor); imgToolbarBack.Invalidate; ConvertBitmapToColor(ImgDisplayerTopLeft.Picture.Bitmap, AColor); ImgDisplayerTopLeft.Invalidate; ConvertBitmapToColor(ImgDisplayerTopRight.Picture.Bitmap, AColor); ImgDisplayerTopRight.Invalidate; ShpDisplayerTopMiddle.Pen.Color := ConvertColorToColor(ShpDisplayerTopMiddle.Pen.Color, AColor); ShpDisplayerTopMiddle.Brush.Color := ConvertColorToColor(ShpDisplayerTopMiddle.Brush.Color, AColor); ShpDisplayerClient.Pen.Color := ConvertColorToColor(ShpDisplayerClient.Pen.Color, AColor); ConvertBitmapToColor(ImgInputerTopLeft.Picture.Bitmap, AColor); ImgInputerTopLeft.Invalidate; ConvertBitmapToColor(ImgInputerTopMiddle.Picture.Bitmap, AColor); ImgInputerTopMiddle.Invalidate; ConvertBitmapToColor(ImgInputerTopRight.Picture.Bitmap, AColor); ImgInputerTopRight.Invalidate; ConvertBitmapToColor(ImgInputerBottomLeft.Picture.Bitmap, AColor); ImgInputerBottomLeft.Invalidate; ConvertBitmapToColor(ImgInputerBottomMiddle.Picture.Bitmap, AColor); ImgInputerBottomMiddle.Invalidate; ConvertBitmapToColor(ImgInputerBottomRight.Picture.Bitmap, AColor); ImgInputerBottomRight.Invalidate; ShpInputerClient.Pen.Color := ConvertColorToColor(ShpInputerClient.Pen.Color, AColor); if FLVTeamMembers <> nil then FLVTeamMembers.ChangeUIColor(AColor); ShpHint.Pen.Color := ConvertColorToColor(ShpHint.Pen.Color, AColor); btSend.ChangeUIColor(AColor); try if (not WebBrowser.Busy) and (WebBrowser.Document <> nil) then SetDomStyle(WebBrowser.Document as IHtmlDocument2); except end; end; //------------------------------------------------------------------------------ procedure TSMSForm.UpdateSMSMember(ARealICQUser: TRealICQUser); var ItemIndex: Integer; AListItem: TRealICQContacterListItem; begin if FLVTeamMembers <> nil then begin ItemIndex := FLVTeamMembers.Items.IndexOf(ARealICQUser.LoginName); if ItemIndex = -1 then Exit; AListItem := FLVTeamMembers.Items.Objects[ItemIndex] as TRealICQContacterListItem; MainForm.BindUserDataToItem(AListItem, ARealICQUser); lblTeamMemberCount.Caption := Format('接收者(%d/%d)', [FLVTeamMembers.OnlineNumeric, FLVTeamMembers.Items.Count]); end; end; //------------------------------------------------------------------------------ procedure TSMSForm.FormClose(Sender: TObject; var Action: TCloseAction); begin Action := caFree; end; //------------------------------------------------------------------------------ procedure TSMSForm.FormCreate(Sender: TObject); var iLoop: Integer; begin SMSForms.Add(Self); DoubleBuffered := True; pnlClient.DoubleBuffered := True; pnlToolBar.DoubleBuffered := True; pnlMenu.DoubleBuffered := True; pnlUsers.DoubleBuffered := True; pnlTalkingArea.DoubleBuffered := True; pnlInputer.DoubleBuffered := True; pnlDisplayer.DoubleBuffered := True; pnlHint.DoubleBuffered := True; pnlForWebBrowser.DoubleBuffered := True; btSend.DoubleBuffered := True; WebBrowser.DoubleBuffered := False; pnlForActionToolBar.DoubleBuffered := True; pnlInputeBack.DoubleBuffered := True; RichEdInputer.DoubleBuffered := True; for iLoop := 0 to RichEdInputer.ControlCount - 1 do begin if RichEdInputer.Controls[iLoop] is TWinControl then TWinControl(RichEdInputer.Controls[iLoop]).DoubleBuffered := True; end; RichEdInputer.Parent.DoubleBuffered := True; pnlSendButtonBack.DoubleBuffered := True; pnlMobile.DoubleBuffered := True; FSMSReveivers := TStringList.Create; pnlUsers.Width := 0; FIsMultiSend := False; FLastSendMsgTicket := 0; Left := MainForm.SMSFormLeft; Top := MainForm.SMSFormTop; Width := MainForm.SMSFormWidth; Height := MainForm.SMSFormHeight; if Left < 0 then Left := 0; if Left + Width > Screen.WorkAreaWidth then Left := Screen.WorkAreaWidth - Width; if Top < 0 then Top := 0; if Top + Height > Screen.WorkAreaHeight then Top := Screen.WorkAreaHeight - Height; actAlwayOnTop.Checked := MainForm.TalkingFormAlwaysOnTop; if actAlwayOnTop.Checked then FormStyle := fsStayOnTop else FormStyle := fsNormal; actCtrlEnter.Checked := MainForm.CtrlEnterSendMessage; actEnter.Checked := not MainForm.CtrlEnterSendMessage; RichEdInputer.MaxLength :=0; RichEdInputer.DoubleBuffered := False; RichEdInputer.Color := clWhite; RichEdInputer.Font := MainForm.InputFont; SkinName := AnsiReplaceText(MainForm.SkinName, 'MainForm', ''); ChangeUIColor(MainForm.UIMainColor); DatePickerStart.Date := Now; TimePickerStart.Time := Now; WebBrowser.OnBeforeNavigate2 := nil; WebBrowser.Navigate('about:blank'); WebBrowser.OnBeforeNavigate2 := WebBrowserBeforeNavigate2; MainForm.RealICQClient.SendGetCanSendSMSCount; TimerForGetHasSendSmsCount.Enabled:=True; end; //------------------------------------------------------------------------------ procedure TSMSForm.FormDestroy(Sender: TObject); begin SMSForms.Remove(Self); if WindowState <> wsMaximized then begin MainForm.SMSFormLeft := Left; MainForm.SMSFormTop := Top; MainForm.SMSFormWidth := Width; MainForm.SMSFormHeight := Height; MainForm.SaveDefaultConfigs; end; if FLVTeamMembers <> nil then FreeAndNil(FLVTeamMembers); FreeAndNil(FSMSReveivers); end; procedure TSMSForm.FormShow(Sender: TObject); var iWaitTimes: Integer; begin {$IFDEF NXQST} spbSMSManage.Visible := False; // AppCentreFrm.chrm1.Options.ApplicationCache := STATE_DISABLED; {$ENDIF} Application.ProcessMessages; iWaitTimes := 0; while not CanWriteMessage do begin Application.ProcessMessages; Inc(iWaitTimes); if iWaitTimes > 1000 then break; Sleep(10); end; try LoadNotReadSMSMessages; except end; OnShow := nil; end; //------------------------------------------------------------------------------ procedure TSMSForm.pnlDisplayerResize(Sender: TObject); var UserName, AStateMsg, HIntMsg, HDestIntMsg: WideString; FRealICQUser: TRealICQUser; begin if pnlMobile.Visible then begin HDestIntMsg := '请输入接收短信的手机号码,多个号码之间以逗号隔开'; Caption := '手机短信'; end else if FIsMultiSend then begin HDestIntMsg := '短信群发模式'; Caption := '群发 - 手机短信'; end else begin FRealICQUser := TUsersService.GetUsersService.GetUser(FReceiver); if Assigned(FRealICQUser) then begin if FRealICQUser.DisplayName = '' then UserName := FRealICQUser.LoginName else UserName := FRealICQUser.DisplayName; if (FRealICQUser.LoginState = stLeave) or (FRealICQUser.LoginState = stBusy) then AStateMsg := FRealICQUser.LeaveMessage else AStateMsg := StateValues[Integer(FRealICQUser.LoginState) mod 5]; if FRealICQUser.Watchword = '' then HDestIntMsg := '发送至: ' + UserName + '(' + AStateMsg + ')' else HDestIntMsg := '发送至: ' + UserName + '(' + AStateMsg + ') - ' + FRealICQUser.Watchword; Caption := UserName + ' - 手机短信'; end else //这种情况是与服务器的连接已断开了 begin HDestIntMsg := LblDest.Hint; end; end; if (MainForm.RealICQClient.Me = nil) then begin AStateMsg := StateValues[Integer(stOffline)]; HIntMsg := '您不能发送任何消息,因为您当前的状态为“' + AStateMsg + '”'; LblHint.Height := LblHint.Canvas.TextHeight(HIntMsg) * (LblHint.Canvas.TextWidth(HIntMsg) div LblHint.Width + 1); pnlHint.Visible := True; LblHint.Caption := HIntMsg; pnlClient.Enabled := False; btSend.Enabled := False; end else begin pnlHint.Visible := False; LblHint.Caption := ''; pnlClient.Enabled := True; btSend.Enabled := True; end; {$region '信息显示'} LblDest.Hint := HDestIntMsg; LblDest.ShowHint := False; //字符串长度过长时,截短字符串并在后面显示“...” while LblDest.Canvas.TextWidth(HDestIntMsg) > LblDest.Width do begin if Length(HDestIntMsg) > 3 then begin if Copy(HDestIntMsg, Length(HDestIntMsg) - 2, Length(HDestIntMsg)) = '...' then HDestIntMsg := Copy(HDestIntMsg, 1, Length(HDestIntMsg) - 3); HDestIntMsg := Copy(HDestIntMsg, 1, Length(HDestIntMsg) - 1) + '...'; end else break; LblDest.ShowHint := True; end; LblDest.Caption := HDestIntMsg; {$endregion} end; //------------------------------------------------------------------------------ procedure TSMSForm.ppForInputerGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass); begin MainForm.ChangePPMenuColorMap(ppForInputer.PopupMenu); end; procedure TSMSForm.ppForWebBrowserGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass); begin MainForm.ChangePPMenuColorMap(ppForWebBrowser.PopupMenu); end; procedure TSMSForm.ppUserItemRightMenuGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass); begin MainForm.ChangePPMenuColorMap(ppUserItemRightMenu.PopupMenu); end; //------------------------------------------------------------------------------ procedure TSMSForm.ppUserItemRightMenuPopup(Sender: TObject); begin miSendMessage.Visible := FLVTeamMembers.SelCount = 1; miSeeUserInformation.Visible := FLVTeamMembers.SelCount = 1; end; //------------------------------------------------------------------------------ procedure TSMSForm.spbSMSManageClick(Sender: TObject); begin ShellExecute(handle, 'open', PChar(MainForm.GetDefaultBrowser),PChar(Format(MainForm.RealICQClient.WebAppBaseURL + BaseURL, [StrToBase64(MainForm.RealICQClient.LoginName), StrToBase64(MD5En(MainForm.RealICQClient.Password)), StrToBase64(SMSURL)])),'',SW_SHOWDEFAULT); end; procedure TSMSForm.RichEdInputerChange(Sender: TObject); //var // iCount, OnSMSLength: Integer; //SenderName: String; begin if Length(Trim(RichEdInputer.Text)) = 0 then begin lblSMSState.Caption := '准备发送消息'; end else begin lblSMSState.Caption := '已输入 ' + IntToStr(Length(RichEdInputer.Text)) + ' 个字符'; { if Length(Trim(MainForm.RealICQClient.Me.DisplayName)) = 0 then SenderName := MainForm.RealICQClient.Me.LoginName else SenderName := MainForm.RealICQClient.Me.DisplayName; SenderName := ' -- ' + SenderName + '(可直接回复)'; OnSMSLength := 120 - Length(SenderName); if Length(RichEdInputer.Text) mod OnSMSLength = 0 then iCount := Length(RichEdInputer.Text) div OnSMSLength else iCount := Length(RichEdInputer.Text) div OnSMSLength + 1; lblSMSState.Caption := '将发送 ' + IntToStr(iCount) + ' 条短信'; } if TimerForGetHasSendSmsCount.Interval>7000 then begin MainForm.RealICQClient.SendGetCanSendSMSCount; TimerForGetHasSendSmsCount.Interval:=5000; end; CalculateSMSCount; end; RichEdInputer.MaxLength :=MaxSmsLength; if MaxSmsLength - Length(Trim(RichEdInputer.Text))<0 then begin MessageBox(Handle, '对不起,您输入的消息太长', '提示', MB_ICONINFORMATION); RichEdInputer.Text:= Copy(RichEdInputer.Text,1,900); RichEdInputer.SelStart:=900; end; end; //------------------------------------------------------------------------------ procedure TSMSForm.RichEdInputerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var Point: TPoint; begin if Button = mbRight then begin Point.X := X; Point.Y := Y; Point := RichEdInputer.ClientToScreen(Point); ppForInputer.Popup(Point.X, Point.Y); end; end; //------------------------------------------------------------------------------ procedure TSMSForm.lblDestClick(Sender: TObject); begin SeeUserInformation(Receiver); end; //------------------------------------------------------------------------------ procedure TSMSForm.lblDestMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin lblDest.Left := lblDest.Left + 1; lblDest.Top := lblDest.Top + 1; end; //------------------------------------------------------------------------------ procedure TSMSForm.lblDestMouseEnter(Sender: TObject); begin lblDest.Cursor := crHandPoint; lblDest.Font.Style := [fsUnderline] end; //------------------------------------------------------------------------------ procedure TSMSForm.lblDestMouseLeave(Sender: TObject); begin lblDest.Cursor := crDefault; lblDest.Font.Style := [] end; //------------------------------------------------------------------------------ procedure TSMSForm.InvokeCMD(InvokeIE: Boolean; Value1, Value2: Integer; var vaIn, vaOut: OleVariant); const CLSID_WebBrowser: TGUID = '{ED016940-BD5B-11cf-BA4E-00C04FD70816}'; var CmdTarget: IOleCommandTarget; PtrGUID: PGUID; begin New(PtrGUID); if InvokeIE then PtrGUID^ := CLSID_WebBrowser else PtrGuid := PGUID(nil); if WebBrowser.Document <> nil then try WebBrowser.Document.QueryInterface(IOleCommandTarget, CmdTarget); if CmdTarget <> nil then try CmdTarget.Exec(PtrGuid, Value1, Value2, vaIn, vaOut); finally CmdTarget._Release; end; except end; Dispose(PtrGUID); end; //------------------------------------------------------------------------------ procedure TSMSForm.lblDestMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin lblDest.Left := lblDest.Left - 1; lblDest.Top := lblDest.Top - 1; end; //------------------------------------------------------------------------------ procedure TSMSForm.miCopyFromIEClick(Sender: TObject); var vaIn, vaOut: Olevariant; begin InvokeCmd(FALSE, OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut); end; procedure TSMSForm.miSeeUserInformationClick(Sender: TObject); var iLoop: Integer; ListItem: TRealICQContacterListItem; begin for iLoop := 0 to FLVTeamMembers.Items.Count - 1 do begin ListItem := FLVTeamMembers.Items.Objects[iLoop] as TRealICQContacterListItem; if ListItem.Selected then begin SeeUserInformation(ListItem.LoginName); Break; end; end; end; procedure TSMSForm.miSelAllFromIEClick(Sender: TObject); var vaIn, vaOut: Olevariant; begin InvokeCmd(FALSE, OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut); end; //------------------------------------------------------------------------------ procedure TSMSForm.miSendMessageClick(Sender: TObject); var iLoop: Integer; ListItem: TRealICQContacterListItem; begin for iLoop := 0 to FLVTeamMembers.Items.Count - 1 do begin ListItem := FLVTeamMembers.Items.Objects[iLoop] as TRealICQContacterListItem; if ListItem.Selected then begin if AnsiSameText(ListItem.LoginName, MainForm.RealICQClient.LoginName) then begin MessageBox(Handle, '对不起,不可以和自己对话!', '提示', MB_ICONINFORMATION); Exit; end; OpenTalkingForm(ListItem.LoginName); Break; end; end; end; procedure TSMSForm.N1Click(Sender: TObject); var iLoop: Integer; ListItem: TRealICQContacterListItem; begin for iLoop := 0 to FLVTeamMembers.Items.Count - 1 do begin ListItem := FLVTeamMembers.Items.Objects[iLoop] as TRealICQContacterListItem; if ListItem.Selected then begin FLVTeamMembers.Items.Delete(ListItem.ItemIndex); Break; end; end; lblTeamMemberCount.Caption := Format('接收者(%d/%d)', [FLVTeamMembers.OnlineNumeric, FLVTeamMembers.Items.Count]); end; //------------------------------------------------------------------------------ //------------------------------------------------------------------------------ initialization SMSForms := TList.Create; SMSMessages := TStringList.Create; finalization FreeAndNil(SMSForms); FreeAndNil(SMSMessages); end.