Отправка SMS (Delphi).

Discussion in 'С/С++, C#, Rust, Swift, Go, Java, Perl, Ruby' started by dos999, 7 Jul 2010.

  1. dos999

    dos999 Elder - Старейшина

    Joined:
    15 Feb 2008
    Messages:
    137
    Likes Received:
    24
    Reputations:
    0
    В этой теме я хочу рассказать об отправке СМС сообщений используя сервис 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 := 'MyUser@mail.ru';
        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
     
    #1 dos999, 7 Jul 2010
    Last edited: 7 Jul 2010
    2 people like this.
  2. lamer811

    lamer811 Elder - Старейшина

    Joined:
    8 Nov 2009
    Messages:
    135
    Likes Received:
    40
    Reputations:
    12
    ТС спасибо, будет очень полезно
    С меня +
     
  3. zORG

    zORG New Member

    Joined:
    5 Jun 2010
    Messages:
    44
    Likes Received:
    2
    Reputations:
    0
    лучше бы dll сделали
     
  4. dos999

    dos999 Elder - Старейшина

    Joined:
    15 Feb 2008
    Messages:
    137
    Likes Received:
    24
    Reputations:
    0
    2 zORG ничто не мешает сделать dll. Исходники то все сеть.
     
  5. zORG

    zORG New Member

    Joined:
    5 Jun 2010
    Messages:
    44
    Likes Received:
    2
    Reputations:
    0
    не все пишут не делфи
     
  6. buxmanager

    buxmanager Elder - Старейшина

    Joined:
    1 Apr 2009
    Messages:
    1,012
    Likes Received:
    246
    Reputations:
    69
    ТС, спасибо!!! единственное, номер в каком формате вводить и какие страные поддерживаются для бесплатной отправки?
     
  7. akimov_aleks

    akimov_aleks New Member

    Joined:
    3 May 2009
    Messages:
    39
    Likes Received:
    1
    Reputations:
    0
    Ну все... ТС удоли... забьют маил же...
     
  8. DrCepbIu

    DrCepbIu New Member

    Joined:
    26 Jun 2010
    Messages:
    15
    Likes Received:
    2
    Reputations:
    0
    смысл был переписывать...
     
  9. dos999

    dos999 Elder - Старейшина

    Joined:
    15 Feb 2008
    Messages:
    137
    Likes Received:
    24
    Reputations:
    0
    buxmanager +79xxxxxxxxx. Мегафон-Москва, Билайн(По России), МТС(По России)
    DrCepbIu если ты о классе TSMS_Sender, то был смысл его писать для новичков в Delphi.
     
Loading...