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 + '
 + SMSSending + ')
';
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.