DLL модуль

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.