21.10.2010, 16:43
|
|
Администратор
|
|
Регистрация: 03.10.2005
Адрес: Россия, Москва
Сообщения: 1,532
Версия 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)
|