Форум по Delphi программированию



Вернуться   Форум по Delphi программированию > Разное > Исходники и статьи
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 21.10.2010, 16:43
Аватар для Admin
Admin Admin вне форума
Администратор
 
Регистрация: 03.10.2005
Адрес: Россия, Москва
Сообщения: 1,537
Версия Delphi: Delphi 7
Репутация: выкл
Лампочка Исходник - dSMSFree - Отправка бесплатных SMS

Пример отправки бесплатных SMS на мобильные телефоны оператора Life : ) - Белорусь.
Для компиляции нужна бесплатная библиотека Synapse.

Код:
// Проверяйте обновления на http://drugoy.net //

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, WinInet, ComCtrls, ExtCtrls, JPEG, Buttons, httpsend;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Edit1: TEdit;
    Label1: TLabel;
    sendbt: TButton;
    MemoMess: TMemo;
    capchaed: TEdit;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Label2: TLabel;
    Edit2: TEdit;
    Image1: TImage;
    TabSheet3: TTabSheet;
    Memo2: TMemo;
    Edit3: TEdit;
    Panel1: TPanel;
    Label3: TLabel;
    Label4: TLabel;
    Procedure GetCaptcha;
    procedure sendbtClick(Sender: TObject);
    procedure MemoMessClick(Sender: TObject);
    procedure MemoMessChange(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  LastCookies: string;

implementation

{$R *.dfm}

Procedure TForm1.GetCaptcha;
var
  JPG : TJPEGImage;
  HTTP: THTTPSend;
  InetON: bool;
begin
  Label3.font.Color:=clLime;
  Label3.Caption:='Получение защитного кода';
  form1.Refresh;
  capchaed.Clear;

  HTTP := THTTPSend.Create;
  try
    HTTP.ProxyHost := Edit2.Text;
    HTTP.ProxyPort := Edit3.Text;
    InetON:= HTTP.HTTPMethod('GET', 'http://sms.life.com.by/images/captcha.php');
    LastCookies:= HTTP.Cookies.Text;
    HTTP.Document.SaveToFile('capcha.jpg');
  finally
    HTTP.Free;
  end;
  if InetOn
    then begin
      Label3.font.Color:=clLime;
      Label3.Caption:='Все готово к отправке SMS';
    end else begin
      Label3.Font.Color:=clRed;
      Label3.Caption:='Нет связи с сервером!';
      Sendbt.Enabled:=false;
      Exit;
    end;
  try
    JPG := TJPEGImage.Create;
    JPG.LoadFromFile(ExtractFilePath(Application.ExeName)+'capcha.jpg') ;
    Image1.Picture.Assign(JPG);
  finally
    JPG.Free;
  end;
end;

procedure TForm1.sendbtClick(Sender: TObject);

  function StreamToString(aStream: TStream): string;
  var
    SS: TStringStream;
  begin
    if aStream <> nil then
    begin
      SS := TStringStream.Create('');
      try
        aStream.Position := 0;
        SS.CopyFrom(aStream, aStream.Size);
        Result := SS.DataString;
      finally
        SS.Free;
      end;
    end else
    begin
      Result := '';
    end;
  end;

var
  HTTP: THTTPSend;
  URL, URLData, temp: string;
  ErrOnPost: bool; // Ошибка при отправке (из ответа сервера)
  i:integer;
begin
  ErrOnPost:=false;
  if (Length(Edit1.Text)<>7) then
  begin
    Label3.Font.Color:=clRed;
    Label3.Caption:='Номер телефона не верен!';
    Exit;
  end;
  if Label4.Font.Color=clRed then  // если красный счетчик количества символов
  begin
    Label3.Font.Color:=clRed;
    Label3.Caption:='Слишком длинный текст SMS';
    Exit;
  end;

  Label3.Font.Color:=clLime;
  Label3.Caption:='Отправка сообщения...';

  Form1.Refresh;

  HTTP     := THTTPSend.Create;
  URL      := 'http://sms.life.com.by/ru/';
  URLData  := 'secure='+capchaed.Text+'&number='+edit1.Text+'&message='+memomess.Text+
              '&send_hour=-&send_min=-&send_day=-&send_month=-&send_year=-&delayed_hour=-&delayed_min=-&delayed_day=-&delayed_month=-&delayed_year=-';
  try
    HTTP.ProxyHost := form1.Edit2.Text;
    HTTP.ProxyPort := form1.Edit3.Text;
    HTTP.Document.Write(Pointer(URLData)^, Length(URLData));
    HTTP.MimeType := 'application/x-www-form-urlencoded';
    HTTP.Cookies.Text:=LastCookies;
    HTTP.HTTPMethod('POST', URL);
    temp:= StreamToString(HTTP.Document);
    Memo1.Text:=temp;
    if pos('Спасибо, Ваше сообщение отправлено!', temp)>0 then
    begin
      Label3.Font.Color:=clLime;
      Label3.Caption:='Отправлено ;-)';
      form1.Refresh;
      sleep(200);
    end else begin
      Label3.Font.Color:=clRed;
      Label3.Caption:='Неизвестная ошибка!';
      form1.Refresh;
      ErrOnPost:=true;
      sleep(200);
    end;

    if pos('Неправильно набран защитный код', temp)>0 then
    begin
      Label3.Font.Color:=clRed;
      Label3.Caption:='Неправильный защитный код!';
      form1.Refresh;
      ErrOnPost:=true;
    end;
    if pos('Не все поля формы заполнены', temp)>0 then
    begin
      Label3.Font.Color:=clRed;
      Label3.Caption:='Не все поля формы заполнены!';
      form1.Refresh;
      ErrOnPost:=true;
    end;
    if pos('Превышено ограничение по отправке SMS', temp)>0 then
    begin
      Label3.Font.Color:=clRed;
      Label3.Caption:='Изчерпан лимит SMS на этот номер';
      form1.Refresh;
      ErrOnPost:=true;
    end;
  finally
    HTTP.Free;
  end;

  if ErrOnPost then
  begin
    beep;
    for i:=0 to 7 do  // поморгаем строкой с названием ошибки 
    begin
      if Label3.Font.Color=clRed
        then Label3.Font.Color:=clLime
        else Label3.Font.Color:=clRed;
      form1.Refresh;
      sleep(500);
    end;
  end;
  GetCaptcha;
end;

procedure TForm1.MemoMessClick(Sender: TObject);
begin
  if memoMess.Lines.Strings[0]='Текст сообщения...' then memomess.SelectAll;
end;

procedure TForm1.MemoMessChange(Sender: TObject);
var
  MaxLen, i : integer;
begin

  MaxLen := 160; // Для лат. символов

  for i:=1 to Length(MemoMess.text) do // Проверим есть ли русские символы
  begin
    if  Ord(MemoMess.text[i])>=137
      then  MaxLen := 100;
  end;

  Label4.Caption:=inttostr(Length(MemoMess.text))+' из '+ inttostr(MaxLen);
  If Length(MemoMess.text) < MaxLen
    then  Label4.Font.Color:=clLime
    else  Label4.Font.Color:=clRed;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  GetCaptcha;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if FileExists('capcha.jpg') then deletefile('capcha.jpg');
end;

end.
//    Сайт проекта: http://drugoy.net    //

Автор: drugoy.net (demcty@ya.ru)
Ответить с цитированием
  #2  
Старый 22.10.2010, 20:52
Аватар для ALexandr555
ALexandr555 ALexandr555 вне форума
Специалист
 
Регистрация: 09.10.2010
Адрес: Тольятти
Сообщения: 803
Версия Delphi: Delphi 7
Репутация: 2064
По умолчанию

можно сделать отправку на множество включая билайн, мтс мегафон, без капчи но там транслитом сообщения
Ответить с цитированием
Ответ



Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 02:18.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2021

ВКонтакте   Facebook   Twitter   Ссылка на Telegram