|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
||||
|
||||
Исходник - 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
|
||||
|
||||
можно сделать отправку на множество включая билайн, мтс мегафон, без капчи но там транслитом сообщения
|