Новичок
Профиль
Группа: Участник
Сообщений: 15
Регистрация: 5.6.2007
Репутация: нет
Всего: нет
|
Могу поделиться своим вариантом | Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, wininet, IdAntiFreezeBase, IdAntiFreeze,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,
ExtCtrls, JPEG, Buttons;
type
TForm1 = class(TForm)
Label1: TLabel;
ComboBox1: TComboBox;
Edit1: TEdit;
GroupBox1: TGroupBox;
Memo1: TMemo;
Label2: TLabel;
GroupBox2: TGroupBox;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
RadioButton3: TRadioButton;
GroupBox3: TGroupBox;
IdHTTP1: TIdHTTP;
IdAntiFreeze1: TIdAntiFreeze;
Image1: TImage;
Edit2: TEdit;
Panel1: TPanel;
SpeedButton1: TSpeedButton;
Label3: TLabel;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure RadioButton3Click(Sender: TObject);
procedure RadioButton2Click(Sender: TObject);
procedure RadioButton1Click(Sender: TObject);
procedure Memo1Change(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
chars,done,br:integer;
implementation
{$R *.dfm}
procedure check;
begin
br := 0;
if form1.ComboBox1.Text='' then
begin
showmessage('Выбирите оператора!');
br := 1;
exit;
end;
if form1.Edit1.Text='' then
begin
showmessage('Введите номер телефона!');
br := 1;
exit;
end;
if form1.Edit2.Text='' then
begin
showmessage('Введите код!');
br := 1;
exit;
end;
end;
function GetInetFile
(const fileURL, FileName: String): boolean;
const BufferSize = 1024;
var
hSession, hURL: HInternet;
Buffer: array[1..BufferSize] of Byte;
BufferLen: DWORD;
f: File;
sAppName: string;
begin
Application.ProcessMessages;
Result:=False;
sAppName := ExtractFileName(Application.ExeName);
hSession := InternetOpen(PChar(sAppName),
INTERNET_OPEN_TYPE_PRECONFIG,
nil, nil, 0);
try
hURL := InternetOpenURL(hSession,
PChar(fileURL),
nil,0,0,0);
try
AssignFile(f, FileName);
Rewrite(f,1);
repeat
InternetReadFile(hURL, @Buffer,
SizeOf(Buffer), BufferLen);
BlockWrite(f, Buffer, BufferLen)
until BufferLen = 0;
CloseFile(f);
Result:=True;
finally
InternetCloseHandle(hURL)
end
finally
InternetCloseHandle(hSession)
end
end;
procedure getpicture;
var
pos1,pos2,pos3:integer;
img,get:string;
begin
form1.Panel1.Visible := true;
Application.ProcessMessages;
form1.IdAntiFreeze1.Process;
try
get := form1.IdHTTP1.Get('http://beesms.beeline.ua/');
except
Application.MessageBox('Не удается подключиться к Beeline, проверте подключение к интернету','Error',mb_OK);
form1.Close;
end;
pos1 := pos('SRC="..',get);
delete(get,1,pos1+7);
pos2 := pos('"',get);
img := 'http://beesms.beeline.ua/' + copy(get,1,pos2-1);
try
GetInetFile(img,'code.jpg');
except
Application.MessageBox('Не удается скачать проверочный код, проверте подключение к интернету','Error',mb_OK);
end;
form1.Image1.Picture.LoadFromFile('code.jpg');
form1.Panel1.Visible := false;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
done := 0;
chars := 119;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
if done=0 then
begin
getpicture;
end;
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
getpicture;
end;
procedure TForm1.RadioButton3Click(Sender: TObject);
begin
if radiobutton3.Checked=true then
begin
chars := 29;
label2.Caption := 'Осталось символов ' + inttostr(chars - length(memo1.Text));
end;
end;
procedure TForm1.RadioButton2Click(Sender: TObject);
begin
if radiobutton2.Checked=true then
begin
chars := 119;
label2.Caption := 'Осталось символов ' + inttostr(chars - length(memo1.Text));
end;
end;
procedure TForm1.RadioButton1Click(Sender: TObject);
begin
if radiobutton1.Checked=true then
begin
chars := 119;
label2.Caption := 'Осталось символов ' + inttostr(chars - length(memo1.Text));
end;
end;
procedure TForm1.Memo1Change(Sender: TObject);
begin
label2.Caption := 'Осталось символов ' + inttostr(chars - length(memo1.Text));
memo1.MaxLength := chars;
end;
procedure sms;
var
posturl,r:string;
data:TStrings;
begin
check;
if br=1 then
begin
exit;
end;
//
posturl := 'http://beesms.beeline.ua/';
//
try
data := TStringList.Create;
data.Clear;
except
data.Clear;
end;
data.Add('dlina='+inttostr(chars));
if form1.RadioButton1.Checked=true then
begin
data.Add('lg=latukr');
data.Add('lang=latukr');
end;
if form1.RadioButton2.Checked=true then
begin
data.Add('lg=latrus');
data.Add('lang=latrus');
end;
if form1.RadioButton3.Checked=true then
begin
data.Add('lg=rus');
data.Add('lang=rus');
end;
data.Add('num_pref=' + form1.ComboBox1.Text);
data.Add('phone_num=' + trim(form1.Edit1.Text));
data.Add('text_message=' + form1.Memo1.Text);
data.Add('code_form=' + form1.Edit2.Text);
data.Add('op=send_sms');
try
r := form1.IdHTTP1.Post(posturl,data);
except
showmessage('Не удалось отправить сообщение!');
exit;
end;
if pos('Сообщение отправлено',r)<>0 then
begin
showmessage('Сообщение успешно отправлено');
end
else
begin
showmessage('Сообщение не отправлено!');
end;
//last end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
sms;
end;
end.
|
|
Отправка смс, Проблема с отправкой СМС 
Дата 1.10.2007, 19:03 (
Загрузка ...
