В этой теме я хочу рассказать об отправке СМС сообщений используя сервис mrim.mail.ru (как это делает Mail Agent). На основе компонента автором которого являеться BOBAH13 я напишу класс который только и будет уметь что подключаться и отправлять сообщения (так сказать lite версию. =) ). В компоненте написанным BOBAH13 реализованы все низкоуровневые процессы связанные непосредственно с протоколом, а я лишь буду использовать труды этого щедрого энтузиаста. Итак. Собственно сам класс. Code: unit untSMSSender; interface uses Windows, Messages, SysUtils, Classes, Controls, Dialogs, Forms, client, Sockets, IniFiles, StringExt; const DEF_TCP_R_HOST = 'mrim.mail.ru';//'94.100.178.27'; DEF_TCP_R_PORT = '443'; DEF_MRIM_HOST = 'mrim.mail.ru';//'94.100.178.27'; DEF_MRIM_PORT = 443; INI_SEC_TCP = 'TCPSetting'; INI_SEC_MRIM = 'MRIMSetting'; INI_TCP_R_HOST = 'RemoteHost'; INI_TCP_R_PORT = 'RemotePort'; INI_MRIM_HOST = 'MRIMHost'; INI_MRIM_PORT = 'MRIMPort'; INI_MRIM_MAIL = 'Mail'; INI_MRIM_PASS = 'Password'; type TSMS_Sender = class(TComponent) private FMailClient: TMailClient; FTCPClient: TTcpClient; FRemoteHost, FRemotePort, FMail, FPassWord, FMRIMHost: string; FMRIMPort: Integer; FReady: Boolean; procedure MConErrorAmtorize(Sender: TObject; Reason: string); procedure MConConnection(Sender: TObject); procedure MConDisconnect(Sender: TObject); procedure MConErrorRequestHost(Sender: TObject); procedure MConPing(Sender: TObject); procedure MConStartRequestContactList(Sender: TObject); procedure MConError(Sender: TObject); procedure MConSuccessAutorize(Sender: TObject); procedure MConRecievedHost(Sender: TObject); procedure MConConnect(Sender: TObject); procedure MConHello(Sender: TObject); procedure MConEndRequestContactList(Sender: TObject); function UrlToHost(const AURL: string): string; function UrlToPort(const AURL: string; const ADefault: integer): integer; procedure SetMail(const Value: string); procedure SetPassword(const Value: string); public constructor Create(AOwner: TComponent); property RemoteHost: string read FRemoteHost write FRemoteHost; property RemotePort: string read FRemotePort write FRemotePort; property Mail: string read FMail write SetMail; property Password: string read FPassWord write SetPassword; property MRIMHost: string read FMRIMHost write FMRIMHost; property MRIMPort: Integer read FMRIMPort write FMRIMPort; function Connect: Boolean; function SendSMS(APhone, AText: string): Boolean; end; implementation { TSMS_Sender } constructor TSMS_Sender.Create(AOwner: TComponent); begin FMailClient := TMailClient.Create(nil); FTCPClient := TTcpClient.Create(nil); FTCPClient.RemoteHost := DEF_TCP_R_HOST; FTCPClient.RemotePort := DEF_TCP_R_PORT; FMailClient.MRIMHost := DEF_MRIM_HOST; FMailClient.MRIMPort := DEF_MRIM_PORT; FMailClient.OnConnection := MConConnection; FMailClient.OnDisconnect := MConDisconnect; FMailClient.OnPing := MConPing; FMailClient.OnErrorRequestHost := MConErrorRequestHost; FMailClient.OnStartRequestContactList := MConStartRequestContactList; FMailClient.OnEndRequestContactList := MConEndRequestContactList; FMailClient.OnError := MConError; FMailClient.OnErrorAuthorize := MConErrorAmtorize; FMailClient.OnSuccesAuthorize := MConSuccessAutorize; FMailClient.OnRecievedHost := MConRecievedHost; FMailClient.OnConnect := MConConnect; FMailClient.OnHello := MConHello; FMailClient.OnEndRequestContactList := MConEndRequestContactList; FReady := False; end; procedure TSMS_Sender.MConErrorAmtorize(Sender: TObject; Reason: string); begin ShowMessage(Reason); end; procedure TSMS_Sender.MConError(Sender: TObject); begin ; end; procedure TSMS_Sender.MConConnection(Sender: TObject); begin ; end; procedure TSMS_Sender.MConDisconnect(Sender: TObject); begin ; end; procedure TSMS_Sender.MConErrorRequestHost(Sender: TObject); begin ; end; procedure TSMS_Sender.MConPing(Sender: TObject); begin ; end; procedure TSMS_Sender.MConStartRequestContactList(Sender: TObject); begin ; end; procedure TSMS_Sender.MConSuccessAutorize(Sender: TObject); begin ; end; procedure TSMS_Sender.MConRecievedHost(Sender: TObject); begin FMailClient.Connect; end; procedure TSMS_Sender.MConConnect(Sender: TObject); begin FMailClient.Hello; end; procedure TSMS_Sender.MConHello(Sender: TObject); begin FMailClient.Authorize; end; procedure TSMS_Sender.MConEndRequestContactList(Sender: TObject); begin FReady := true; end; function TSMS_Sender.Connect: Boolean; var LIPAndPort: string; begin try FTCPClient.Active := True; if FTCPClient.Connected then LIPAndPort := FTCPClient.Receiveln(#$A); FTCPClient.Disconnect; if LIPAndPort <> '' then begin FMailClient.Host := UrlToHost(LIPAndPort); FMailClient.Port := UrlToPort(LIPAndPort, DEF_MRIM_PORT); end; if FMailClient.HostInit then FMailClient.Connect else FMailClient.RequestHost; Result := True; except Result := False; end; end; function TSMS_Sender.SendSMS(APhone, AText: string): Boolean; begin try if (FMailClient.Connected) and (FReady) then begin FMailClient.SendSMS(APhone, AText); Result := True; end else Result := False; except Result := False; end; end; function TSMS_Sender.UrlToHost(const AURL: string): string; var i: integer; begin i := Pos(':', AURL); if i = 0 then Result := AURL else Result := Copy(AURL, 1, Pos(':', AURL) - 1); end; function TSMS_Sender.UrlToPort(const AURL: string; const ADefault: integer): integer; var i: integer; begin Result := ADefault; try i := Pos(':', AURL); if i <> 0 then Result := StrToInt(Copy(AURL, i + 1, Length(AURL) - i)); except end; end; procedure TSMS_Sender.SetMail(const Value: string); begin FMailClient.Mail := Value; FMail := Value; end; procedure TSMS_Sender.SetPassword(const Value: string); begin FMailClient.PassWord := Value; FPassWord := Value; end; end. после вызова Connect поочерёдно происходят события MConRecievedHost MConConnect MConHello и т.д. Теперь для того чтобы отправить сообщение нам нужно созадть объект типа TSMS_Sender, вызвать у него функцию Connect, заполнить свойства Mail и Password и после того как произойдёт событие MConSuccessAutorize вызвать с нужными нам параметрами функцию SendSMS. Фишка в том что на момент вызова SendSMS объект уже должен быть авторизован (т.е. готов к отправке), иначе SendSMS вернёт False. т.е. получается что после вызова Connect нужно либо ждать либо гонять в цикле SendSMS пока не вернёт True. Code: procedure TForm1.Button2Click(Sender: TObject); const SECOND = 1/24/60/60; TIME_OUT = SECOND * 20; var LSMSSender: TSMS_Sender; LSend: TDateTime; LRes: Boolean; begin LSMSSender := TSMS_Sender.Create(self); try LSMSSender.Mail := '[email protected]'; LSMSSender.Password := 'mypass'; if LSMSSender.Connect then begin LSend := now + TIME_OUT; LRes := False; while (now < LSend) and (not LRes) do begin LRes := LSMSSender.SendSMS('+7926xxxxxxx', 'проверка связи'); Application.ProcessMessages; Sleep(1000); end; if LRes then ShowMessage('Сообщение отправлено!') else ShowMessage('Сообщение НЕ отправлено!'); end else ShowMessage('Не удалось подключиться к серверу'); finally LSMSSender.Free; end; end; Замечания: - протокол может меняться (за послежний год помоему изменения были 2 раза). - было доставлено сообщение или нет мы проверить неможем. - сообщения (с одного и того же ящика) можно отправлять не чаще чем раз в минуту. - непонятно в чём дело но я сталкивался с тем что программа не отправляет сообщения с ящика если хотябы раз на него не заходили с mail Agent'a. - если все символы в сообщении буржуйские то длинна сообщения может составлять 170 символов, а если хотя бы один русский то всего 50. Способы применения: Ну тут уже у кого на что фантазии хватит. можно эксперементировать от спама, дос атак (на конкретный номер) и отправки пасов, до полезных в повседневной жизни вещей, например программа которая при определённом событии отправляем вам смс (ну что то вроде "хватит ковырять в носу, бегом работать, СЕРВАК УПАЛ 0_о"). Исходники http://depositfiles.com/files/26tp66w86
ТС, спасибо!!! единственное, номер в каком формате вводить и какие страные поддерживаются для бесплатной отправки?
buxmanager +79xxxxxxxxx. Мегафон-Москва, Билайн(По России), МТС(По России) DrCepbIu если ты о классе TSMS_Sender, то был смысл его писать для новичков в Delphi.
