Re: интересные исходники или идеи реализации в MP
тоже выложу, мож кому интиресно будет увидеть как работает програмка работает по шттп с сервером.
Код:
program CrazySMS;
uses m2,thread,sms,ui;
//**********************************************************
const
updatesrv = 'http://www.crazysms.ru/update/'; //Адрес сервера с обновлением
JadUrl = 'http://www.crazysms.ru/update/CrazySMS.jad'; //Адрес сервера с обновлением
updatesrvOK = 'http://www.crazysms.ru/sys/isokpaysms.php';
Pversion =4; // версия програмі
//**********************************************************
type Tsmspay = record
smsN:string;
opisanie:string;
cantry:integer;
end;
Tcoolsms = record
ot,text:string;
end;
//**********************************************************
Var Imglogo,Imgicon,Imginvite:image;
otkogo,komu,smskod,smstekst,smsID:string;
typefrom:integer;// тип от кого 0 - номер телефона - 1 тексntrcn
translit:integer;
U:array[0..255] of string;
ar1: array[1..33] of string ;//rus2lat
ar2: array[1..33] of string ;//rus2lat
stopthread:boolean;
mainmenuI:integer;
imA:array[1..10] of image;
coolsms:array[1..100] of Tcoolsms;
coolsmsN:integer;
smspay:array[1..20] of Tsmspay;
countries:array[1..5] of string;
smspayN:integer;
//**********************************************************
//**********************************************************
//**********************************************************
//**********************************************************
//**********************************************************
function Str2UTF8(s: string):string;
var i: integer; a : string;
begin
a:='';
for i:= 0 to Length(s) do
if GetChar(s, i) > '~' then a:= a + Chr(Ord(GetChar(s, i)) - 64432)
else a:= a + GetChar(s, i);
Str2UTF8:= Copy(a, 0, Length(a)-1);
end;
//**********************************************************
Function ResToString(resurs:string):string;
var
res:resource;
line:string;
Buf:string;
Begin
res:=OpenResource('/'+resurs);
if(resourceAvailable(res))then
begin
line:=ReadLine(res);
while line<>'END'do
begin
Buf:=buf+Str2UTF8(line)+chr(10);
line := ReadLine(res);
end;
CloseResource(res);
end;
/// DrawText('тест'+Buf,0,30);repaint;delay(1500);
ResToString:=Buf;
end;
//**********************************************************
// сохранить значение в хранилище
Procedure pssave(tostore,storedata:string);
var
rs:recordstore;
idx,size:integer;
Begin
rs:=openrecordstore(tostore);
size:=GetRecordStoreSize(rs);
if size=0 then
idx:=addrecordstoreentry(rs,storedata) else
modifyrecordstoreentry(rs,storedata,1);
closerecordstore(rs);
end;
//**********************************************************
// сохраняем данные в хранилище
Procedure saveStore();
Begin
pssave('otkogo',(otkogo));
pssave('smskod',(smskod));
pssave('smstekst',smstekst);
end;
//**********************************************************
//Чтение хранилища данных
Function readStore:boolean;
var
rs:recordstore;
buf:string;
idx,size:integer;
begin
rs:=openrecordstore('otkogo');
readStore:=false;
size:=GetRecordStoreSize(rs);
if size=0 then readStore:=true
Else otkogo:=(readrecordstoreentry(rs,1));
closerecordstore(rs);
rs:=openrecordstore('smskod');
readStore:=false;
size:=GetRecordStoreSize(rs);
if size=0 then readStore:=true
Else smskod:=(readrecordstoreentry(rs,1));
closerecordstore(rs);
rs:=openrecordstore('smstekst');
readStore:=false;
size:=GetRecordStoreSize(rs);
if size=0 then readStore:=true
Else smstekst:=(readrecordstoreentry(rs,1));
closerecordstore(rs);
end;
//**********************************************************
procedure clrscr;//очищение экрана
begin
setcolor(255,255,255);
fillRect(0, 0,getWidth , getHeight);
end;
//**********************************************************
// перевуод в кодировку урл
function HTTPTran(St: string): string;
var
i,n: Integer;
s:string;
ch:char;
begin
n:=0;
for i:=0 to length(st)-1do
begin
ch:=getChar(st,i);
n:=ord(ch);
if n>850 then n:=n-848;
s:=s+u[n];
end;
HTTPTran:=s;
end;
//**********************************************************
function rus2lat(Str: string): string;
const
RArrayL = 'абвгдеёжзийклмнопрстуфхцчшщьыъэюя';
RArrayU = 'АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЬЫЪЭЮЯ';
colChar = 33;
var
i,i2: Integer;
LenS: Integer;
result,ch:string;
ok:boolean;
Begin
result := '';
LenS := length(str);
ok:=false;
for i := 0 to lenS-1 do
begin
ch:=getChar(str,i);
for i2:= 1 to colChar do
begin
if (ch=getChar(RArrayL,i2))and(not ok) then begin ok:=true; result:=result+ar1[i2+1];end;
if (ch=getChar(RArrayU,i2))and(not ok) then begin ok:=true; result:=result+ar2[i2+1];end
end;
if (not ok) then begin
If (ch<>'а') and (ch<>'А')and (ch<='я') then result:=result+ch
else If (ch='а') then result:=result+'a' else If (ch='А') then result:=result+'A'
end;
ok:=false;
end;
rus2lat:= result;
end;
//**********************************************************
//загрузка
Procedure Splash;
Var i,k,ii:integer;
m:image;
Begin
showCanvas;
clrscr;
DrawImage(Imglogo, (getWidth-96)/2, (getHeight-82)/2);
{
for i:= 1 to 10 do begin
setcolor(90-i*5,90-i*5,90-i*5);
DrawRect(i,i,getWidth-10,getHeight-10);
end;
}
repaint;
end;
//**********************************************************
//конец загрузки
Procedure SplashEnd;
Var i,k,ii:integer;
m:image;
Begin
i:=1;
ii:=10;
DrawImage(Imglogo, (getWidth-96)/2, (getHeight-82)/2);
repeat
i:=i+ii;
if (i>=245)or(i<=10) then ii:=ii*(-1);
if ii>0 then setcolor(i,i,255-i)
else setcolor(i,255-i,i);
drawText('Нажмите любую', (getWidth - getStringWidth('Нажмите любую' ))/2,((getHeight-getStringHeight('Нажмите любую'))/2)+50);
if ii<0 then setcolor(i,i,255-i)
else setcolor(i,255-i,i);
drawText('кнопку', (getWidth - getStringWidth('кнопку'))/2,((getHeight-getStringHeight('кнопку'))/2)+50+getStringHeight('кнопку'));
k:=getkeypressed;
delay(trunc(i/5));
delay(30);
repaint;
until k<>KE_NONE;
randomize;
clrscr;
end;
//**********************************************************
Procedure createOkCommand;
var play, click , play2: command;
Begin
play := createCommand('Ок', CM_OK, 1);
play2 := createCommand('', CM_CANCEL , 1);
addCommand(play2);
addCommand(play);
click:= emptyCommand;
repeat
click:=getClickedCommand;
delay(100);
until (click =play);
End;
//**********************************************************
Procedure showmessage(title,kontent:string);
var img:image;
Begin
showAlert(title, //Доступна новая версия программы, хотите ли вы ее загрузить прямо сейчас?';
kontent,
img,//Imginvite,//LoadImage('/logo2.png'),
ALERT_INFO);
createOkCommand;
showform;
End;
//**********************************************************
// Форма загрузки нового обновления
Procedure showupdatemenu;
var cm,cmcancel,click : command;
i:integer;
begin
showAlert('Обновление', //Доступна новая версия программы, хотите ли вы ее загрузить прямо сейчас?';
'Доступна новая версия программы. Загрузить прямо сейчас?',
Imginvite,//LoadImage('/logo2.png'),
ALERT_INFO);
playAlertSound;
cm := createCommand('Загрузить', CM_OK, 1);
cmcancel:= createCommand('Отмена', CM_CANCEL , 1);
addCommand(cm);
addCommand(cmcancel);
repeat
click:=getClickedCommand;
delay(100);
until click <> emptyCommand;
if click = cm then begin i:=m2.platform_request(JadUrl); halt; end;
//if click = cmcancel then showmessage('cmcancel') else showmessage('dontknow') ;
end;
// проверка возможно сти оплаты
//**********************************************************
/// проверка на обновление
Procedure update;
Var sl:integer;
conn: http;
htmlBody,s: string;
contentType: string;
Begin
//Pversion =1 ;
//updatesrv = 'http://220s.net/update/';
///JadUrl = 'http://220s.net/update/DTMFcall.jad';
ClearForm;
showform;
setformtitle('Обновление');
if getWidth>176 then begin
sl:=FormAddSpace;
sl:=FormAddSpace;
sl:=FormAddSpace;
sl:=FormAddSpace;
sl:=FormAddSpace;
sl:=FormAddSpace;
end
else begin
sl:=FormAddSpace;
sl:=FormAddSpace;
end;
sl:=FormAddImage(Imglogo);
sl:=FormAddString(chr(10)+'Идет соединение...'); // идет соединение
if not openHttp(conn,updatesrv) then
Begin
sl:=FormAddString('ошибка соединения!');// ошибка соединения
PlayAlertSound;
createOkCommand;
closeHttp(conn);
end
else begin
setHttpMethod(conn, GET);
addHttpHeader(conn, 'User-agent', 'Opera');
if sendHttpMessage(conn) <> 200 then
begin
sl:=FormAddString('ошибка соединения!');// ошибка соединения
PlayAlertSound;
createOkCommand;
closeHttp(conn);
end else begin
htmlBody := getHttpResponse(conn);
contentType := getHttpHeader(conn, 'Content-type');
closeHttp(conn);
//showmessage(htmlBody);
If stringtointeger(htmlBody)>Pversion
Then showupdatemenu // загрузить
else
begin// последняя версия
sl:=FormAddString('Вы используете последнюю версию програмы.'); // последняя версия
PlayAlertSound;
createOkCommand;
end;
end;
end;
End;
//**********************************************************
function phonetextbox:string;
var clicked,CScancel,CSok:command;
buf:string;
Begin
showTextBox('Ввод номера от кого', '', 13, TF_PHONENUMBER);//Ввод мобильного номера
CSok := createCommand('Ок', CM_OK,0); //Звонить
CScancel:= createCommand('Отмена', CM_CANCEL,0); //Звонить
addCommand(CSok);
addCommand(CScancel);
clicked:=emptyCommand;
repeat
clicked:=getClickedCommand;
delay(200);
until clicked <> emptyCommand;
phonetextbox:='';
If clicked=CSok then begin
buf:=getTextBoxString;
if (getchar(buf,0)='+') then begin
buf:=copy(buf,1,length(buf));
end;
end;
phonetextbox:=buf;
end;
//**********************************************************
//**********************************************************
function havetext(s:string):boolean;
var i:integer;
b:boolean;
Begin
b:=false;
for i:=0 to length(s)-1 do if not b then if (getchar(s,i)<'0') or (getchar(s,i)>'9') then b:=true;
havetext:=b;
end;
function havecyrilik(s:string):boolean;
var i:integer;
b:boolean;
Begin
b:=false;
for i:=0 to length(s)-1 do {if not b then} if (getchar(s,i)>='А') then begin
b:=true;
// showmessage('ошибка',getchar(s,i));
end;
havecyrilik:=b;
end;
//**********************************************************
Function sendHTTPsms(metod:string;):string;
Var sl:integer;
conn: http;
htmlBody,s: string;
contentType: string;
httpzapros:string;
ch:char;
Begin
if metod='ballans'then httpzapros:=('http://send.crazysms.ru/script.php?act=ballance&key='+HTTPTran(smskod));
if metod='sendsms'then httpzapros:=({'http://220s.net/myscript/sms.php?url='+HTTPTran(}'http://send.crazysms.ru/script.php?act=send&to='+HTTPTran(komu)+'&from='+HTTPTran(otkogo)+'&msg='+HTTPTran(smstekst)+'&key='+HTTPTran(smskod)){)};
if metod='smsid'then httpzapros:=('http://send.crazysms.ru/script.php?act=status&smskey='+HTTPTran(smsid));
//showmessage('Ошибка',httpzapros);
if not openHttp(conn,httpzapros) then
Begin
//htmlBody:= 'Ошибка защиты телефона к доступу в Internet! Включите эту возможность в настройке мидлета в вашем телефоне.';
htmlBody:= '348';
end
else begin
setHttpMethod(conn, GET);
addHttpHeader(conn, 'User-agent', 'Opera');
if sendHttpMessage(conn) <> 200 then
begin
//htmlBody:='Ошибка соединения с сервером, возможно сервер в отключке. Попробуйте еще раз соединиться чуть позже.';
htmlBody:='349';
PlayAlertSound;
closeHttp(conn);
end else begin
htmlBody := getHttpResponse(conn);
contentType := getHttpHeader(conn, 'Content-type');
closeHttp(conn);
end;
end;
sendHTTPsms:= htmlBody;
end;
//**********************************************************
//потключение к инету в фоновом режиме и отдача результата
procedure threadaction();
Var sl,slI:integer;
imgsend:image;
Begin
imgsend:=LoadImage('/sending.png');
setcolor(255,255,255);
fillRect(0, 0,getWidth,getHeight);
setcolor(255,176,0);
drawText('Подождите...', (getWidth - getStringWidth('Подождите...'))/2,70);
setcolor(255,255,255);
sl:=0;
sli:=1;
//Отправка смс
repeat
sl:=sl+sli+trunc((sl/6)*(sli/1));
If (sl>(getWidth-getimageWidth(imgsend))) then sli:=-1 if (sl<=0) then begin sli:=1; end;
fillRect(0, 0,GetWidth,getimageHeight(imgsend)+6);
DrawImage(imgsend, sl, {trunc((getHeight/2) +(getimageHeight(imgsend)/2) )} random(3)+4);
repaint;
delay(4);
until stopthread;
stop;
end;
//**********************************************************
function OTKOGOcheck(s:string):boolean;
var i:integer;
b:boolean;
Begin
b:=false;
for i:=0 to length(s)-1 do {if not b then} if ((getchar(s,i)>='А') or (getchar(s,i)<'0') or ((getchar(s,i)>'9')and (getchar(s,i)<'A'))) then if ((getchar(s,i)<>'.')and(getchar(s,i)<>'-')) then begin
b:=true;
// showmessage('ошибка',getchar(s,i));
end;
OTKOGOcheck:=b;
end;
function allNumbers(s:string):boolean;
var i:integer;
b:boolean;
Begin
b:=false;
for i:=0 to length(s)-1 do if (getchar(s,i)<'0') or (getchar(s,i)>'9') then begin
b:=true;
// showmessage('ошибка',getchar(s,i));
end;
allNumbers:=b;
end;
//**********************************************************
function translate(inc:string):string;
var i,n: Integer;
s:string;
ch:char;
begin
n:=0;
for i:=0 to length(inc)-1do
begin
ch:=getChar(inc,i);
n:=ord(ch);
if n>=192 then n:=n+848;
s:=s+chr(n);
end;
translate:=s;
end;
function converIncMsg(mes:string):string; // обработка входящей цифры
Var s:string;
var
len:integer;
mess,in_copy,all: string;
Begin
s:=copy(mes,0,3);
If s = '090' then begin
mes:=copy(mes,4,length(mes));
mess:=translate(mes);
end;
else
If s = '850' then mess:='Ошибка при отправке смс!';
else
If s = '009' then mess:='Запрещенный отправитель!';
else
If s = '851' then mess:='Смс отправлено, при наличии средств на счете ожидайте код.';
else
If s = '348' then mess:='Ошибка защиты телефона к доступу в Internet! Включите эту возможность в настройке мидлета в вашем телефоне.';
else
If s = '349' then mess:='Ошибка соединения с сервером, возможно сервер в отключке. Попробуйте еще раз соединиться чуть позже.';
else
If s = '001' then mess:='Неправильно задан отправитель, разрешается только латинские цифры и буквы!';
else
If s = '002' then mess:='Неправильно задан номер получателя!';
else
If s = '003' then mess:='Текст превышает ограничение символов или не задан!';
else
If s = '004' then mess:='В данный момент сервис временно не работает!';
else
If s = '005' then mess:='Неверный код!';
else
If s = '006' then mess:='Ваш IP адрес заблокирован. Повторите попытку через 1 час.';
else
If s = '007' then mess:='Ваш ключ полностью использован, приобретите новый.';
else
If s = '008' then mess:='В сообщении обнаружены запрещенные слова!';
else
If s = '050' then mess:='Ключ не существует, или был удален.';
else
If s = '051' then mess:='Ключ полностью использован.';
else
If s = '052' then begin
mes:=copy(mes,4,length(mes));
len:= pos(mes,' ');
in_copy:=copy(mes,0,len);
all:=copy(mes,len+1,length(mes));
mess:='Ключ есть. '+in_copy+' раз(а) использовано. Емкость: '+all+'. Остаток: '+integertostring(stringtointeger(all)-stringtointeger(in_copy));
// mess:='x y - Ключ есть x=использовано раз; y=емкость ';
end
else
If s = '080' then mess:='СМС не найдена в базе данных.';
else
If s = '999' then mess:='Ошибка в запросе.';
else
If s = '100' then begin
smsID:=copy(mes,4,length(mes));
mess:='Смс поставлено в очередь на отправку. Вы можете проверить статус его доставки в меню "Статус сообщения"';
end;
converIncMsg:=mess;
end;
//**********************************************************
Procedure sendSMS;//отправка смс
Var Fkod,Fot,Fto,Ftext,i:integer;
clicked,CMsend,CMtranslit,CSphone,CScancel:command;
buf:string;
Bexit:Boolean;
Begin
clearform;
Setformtitle('Cмс');
//i:=FormAddImage(Imglogo);
Fto:=formAddTextField('Кому:'+chr(10)+'(Номер получателя в международном формате, без знака "+")', komu,13, TF_PHONENUMBER );
Fot:=formAddTextField('Отправитель:'+chr(10)+'(Цифры или слово латинскими буквами, до 11 знаков)', otkogo , 11, TF_URL);
Fkod:=formAddTextField('Ключ:', smskod, 8, TF_ANY);
Ftext:=formAddTextField('Текст сообщения:'+chr(10)+'(160 - Латиницей, 70 - Кириллицей )', smstekst, 160, TF_ANY);
showform;
Bexit:=false;
CMsend := createCommand('Oтправить СМС!', CM_OK, 1);
CMtranslit := createCommand('Автотранслит', CM_OK, 1);
// CSphone := createCommand('От кого из контактов', CM_OK, 1);
CScancel := createCommand('Гл. Меню', CM_CANCEL, 1);
addCommand(CMtranslit);
// addCommand(CSphone);
addCommand(CMsend);
addCommand(CScancel);
clicked:=EmptyCommand;
Repeat
clicked := getClickedCommand;
buf:=FormGetText(Ftext);
if havecyrilik(buf) then Setformtitle('Cмс('+integertostring(length(buf))+' из 70) киилица' )
else Setformtitle('Cмс('+integertostring(length(buf))+' из 160) латиница' );
if getchar(FormGetText(Fto) ,0)='+' then
Begin
buf:=FormGetText(Fto);
buf:=copy(buf,1,length(buf));
FormsetText(Fto,(buf));
end;
If clicked = CMtranslit then
Begin
buf:=rus2lat(FormGetText(Ftext));
if length(buf)>160 then buf:=copy(buf,0,160);
FormsetText(Ftext,(buf));
end;
If clicked = CSphone then
Begin
buf:=phonetextbox;
showform;
if length(buf)>11 then buf:=copy(buf,length(buf)-11,length(buf));
if buf<>'' then FormsetText(Fot,buf);
end;
If clicked = CScancel then
Begin
otkogo:=FormGetText(Fot);
komu:=FormGetText(Fto);
smskod:=FormGetText(Fkod);
smstekst:=FormGetText(Ftext);
Bexit:=true;
end;
If clicked = CMsend then
Begin
//otkogo,komu,smskod,smstekst:string;
otkogo:=FormGetText(Fot);
komu:=FormGetText(Fto);
smskod:=FormGetText(Fkod);
smstekst:=FormGetText(Ftext);
buf:=rus2lat(otkogo);
if length(buf)>11 then otkogo:=copy(buf,0,10)
else otkogo:=buf;
FormsetText(Fot,otkogo);
If otkogo='' then showmessage('Ошибка','Не указан "Отправитель"!')
else
if (not allNumbers(otkogo)) and (length(otkogo)<6) then showmessage('Ошибка','Отправитель задан только цифрами, в этом случае мин. длина должна быть 6 символов!')
else
If OTKOGOcheck(otkogo) then showmessage('Ошибка','В поле "Отправитель" обнаружены недопустимые символы!')
else
If length(smskod)<8 then showmessage('Ошибка','Проверьте правильность ввода секретного ключа.')
else
If komu='' then showmessage('Ошибка','Введите номер получателя.')
else
If length(komu)<7 then showmessage('Ошибка','Номер получателя должен быть не менее 7 символов.')
else
If smskod='' then showmessage('Ошибка','Введите секретный ключ!')
else
If smstekst='' then showmessage('Ошибка','Текст сообщения пустой!')
else
If (havecyrilik(FormGetText(Ftext)))and (length(FormGetText(Ftext))>70) then showmessage('Ошибка','Кириллицей допускается ввод только 70 символов. Уменьшите, пожалуйста, длину сообщения, либо используйте транслитерацию.')
else
If (havetext(otkogo)) and (length(otkogo)>11) then showmessage('Ошибка','"Отправитель" дожен быть не менее 6 символов.')
else
Begin
//отправка смс
showcanvas;
stopthread:=false;
init;
start;
delay(2000);
buf:=sendHTTPsms('sendsms');
//stop;
stopthread:=true;
showmessage('Статус смс',converIncMsg(buf));
Bexit:=true;
end;
end;
delay(300);
until Bexit;
End;
//**********************************************************
//Вызов меню выбора языка
Procedure PROCcoolsms;
var
//Menus:array[1..30] of integer;
Menus:integer;
play,cancel,clicked: command;
i,n,selectedN:integer;
buf:string;
begin
showMenu('Прикольные смс-ки', CH_EXCLUSIVE);
For i:= 1 to CoolsmsN do begin
Menus:= menuAppendString(Coolsms[i].ot+':'+Coolsms[i].text);
end;
cancel:=createCommand('Отмена', CM_CANCEL, 1);
addCommand(cancel);
play := createCommand('Выбрать', CM_OK, 1);
addCommand(play);
clicked:=emptyCommand;
repeat
delay(300);
clicked := getClickedCommand;
until (clicked = cancel) or (clicked = play);
If clicked<>cancel then
begin
selectedN:=menuGetSelectedIndex+1;
smstekst:=Coolsms[selectedN].text;
if length(smstekst)>160 then smstekst:=copy(smstekst,0,160);
otkogo:=Coolsms[selectedN].ot;
if length(otkogo)>11 then otkogo:=copy(otkogo,0,11);
sendSMS;
end;
end;
//**********************************************************
Procedure balansForm;
var i, textField_id: integer;
play,cancel,clicked: command;
buf:string;
exits:boolean;
begin
clearform;
exits:=false;
setformtitle('Проверка остатка на коде');
textField_id := formAddTextField('Ключ:',
smskod, 8, TF_ANY);
showForm;
cancel:=createCommand('Отмена', CM_CANCEL, 1);
addCommand(cancel);
play := createCommand('Проверить', CM_OK, 1);
addCommand(play);
clicked:=emptyCommand;
repeat
delay(300);
clicked := getClickedCommand;
If clicked=play then begin
smskod:=FormGetText(textField_id);
If (length(smskod)<8) then showmessage('Ошибка','Проверьте правильность ввода секретного ключа.')
else
begin
showcanvas;
stopthread:=false;
init;
start;
delay(2000);
buf:=sendHTTPsms('ballans');
stopthread:=true;
showmessage('Статус баланса',converIncMsg(buf));
exits:=true;
end;
end;
If clicked=cancel then exits:=true;
until exits;
end;
//**********************************************************
Procedure checksmsid;
Var buf:string;
Begin
If smsid='' then showmessage('Ошибка','Для проверки статуса, сначала отправьте смс!')
else
begin
showcanvas;
stopthread:=false;
init;
start;
delay(2000);
buf:=sendHTTPsms('smsid');
stopthread:=true;
showmessage('Статус сообщения',converIncMsg(buf));
end;
end;
//**********************************************************
Function cmdDOsmsPay(n:integer):string;
var ps,errtext: string;
iii,nn:integer;
Begin
iii:=sms.Send('sms://'+smsPay[n].smsN, '70+key'); //then errtext:= (Ltext(3)) //Ошибка защиты телефона! Приложению не удалось получить доступ к отправке смс, пожалуйста разрешите приложению отправлять смс для подачи запроса на звонок.
while sms.is_sending=-1 do begin // ждём, пока сообщение не будет отправлено
delay(100);
end;
if not sms.successfull=-1 then cmdDOsmsPay:='850'; //Ошибка при отправке смс запроса...
else cmdDOsmsPay:='851'; //Смс запрос отправлен, при наличии средств на счете ожидайте звонка...
end;
//**********************************************************
Procedure smsPayform(n:integer);
var play, click , play2: command;
kontent,buf:string;
Begin
kontent:='После нажатия кнопки оплатить, Вам в течение нескольких минут придет смс сообщение с кодом для програмы. Вы оплачиваете '+smsPay[n].opisanie+' деньги будут сняты с вашего счета. Внимание! текущая оплата действительна только для жителей "'+countries[smsPay[n].cantry]+'". Для оплаты вручную отправьте текст "70+key" без кавычек! на номер '+smsPay[n].smsN+' c вашего телефона.';
///smsPay
showAlert('Купить код', //Доступна новая версия программы, хотите ли вы ее загрузить прямо сейчас?';
kontent,
Imginvite,//LoadImage('/logo2.png'),
ALERT_INFO);
play := createCommand('Оплатить', CM_OK, 1);
play2 := createCommand('Отмена', CM_CANCEL , 1);
addCommand(play2);
addCommand(play);
click:= emptyCommand;
repeat
click:=getClickedCommand;
delay(300);
until (click <>emptyCommand);
if click=play then begin
showcanvas;
stopthread:=false;
init;
start;
delay(2000);
buf:=cmdDOsmsPay(n);
stopthread:=true;
showmessage('Инфомация',converIncMsg(buf));
end;
end;
//**********************************************************
Procedure smsPayCMD; /// оплата смс
var
//Menus:array[1..30] of integer;
Menus:integer;
play,cancel,clicked: command;
i,n,selectedN:integer;
buf:string;
begin
showMenu('Выберите страну и номинал кода', CH_IMPLICIT );
For i:= 1 to smspayn do begin
Menus:= menuAppendStringImage(countries[smsPay[i].cantry]+''+smsPay[i].opisanie+'',loadimage('/'+integertostring(smsPay[i].cantry)+'.png'));
end;
cancel:=createCommand('Отмена', CM_CANCEL, 1);
addCommand(cancel);
play := createCommand('Выбрать', CM_OK, 1);
addCommand(play);
clicked:=emptyCommand;
repeat
delay(300);
clicked := getClickedCommand;
until (clicked = cancel) or (clicked = play);
If clicked<>cancel then
begin
selectedN:=menuGetSelectedIndex+1;
smsPayform(selectedN);
end;
end;
//**********************************************************
/// проверка на обновление
Procedure checkcantpay;
Var sl:integer;
conn: http;
htmlBody,s: string;
contentType: string;
Begin
//Pversion =1 ;
//updatesrv = 'http://220s.net/update/';
///JadUrl = 'http://220s.net/update/DTMFcall.jad';
ClearForm;
showform;
setformtitle('Проверка смс оплаты');
if getWidth>176 then begin
sl:=FormAddSpace;
sl:=FormAddSpace;
sl:=FormAddSpace;
sl:=FormAddSpace;
sl:=FormAddSpace;
sl:=FormAddSpace;
end
else begin
sl:=FormAddSpace;
sl:=FormAddSpace;
end;
sl:=FormAddImage(Imglogo);
sl:=FormAddString(chr(10)+'Идет соединение...'); // идет соединение
if not openHttp(conn,updatesrvOK) then
Begin
sl:=FormAddString('ошибка соединения!');// ошибка соединения
PlayAlertSound;
createOkCommand;
closeHttp(conn);
end
else begin
setHttpMethod(conn, GET);
addHttpHeader(conn, 'User-agent', 'Opera');
if sendHttpMessage(conn) <> 200 then
begin
sl:=FormAddString('ошибка соединения!');// ошибка соединения
PlayAlertSound;
createOkCommand;
closeHttp(conn);
end else begin
htmlBody := getHttpResponse(conn);
contentType := getHttpHeader(conn, 'Content-type');
closeHttp(conn);
//showmessage(htmlBody);
If stringtointeger(htmlBody)=1
Then smsPayCMD // загрузить
else
begin// последняя версия
sl:=FormAddString('Оплата через СМС временно недоступна, возможно версия вашего приложения устарела. Обратитесь в службу поддержки ICQ 10-11-500'); // последняя версия
PlayAlertSound;
createOkCommand;
end;
end;
end;
End;
//**********************************************************
Procedure showmessageImage(title,kontent:string;im:image;);
Var i:integer;
Begin
{
showAlert(title, //Доступна новая версия программы, хотите ли вы ее загрузить прямо сейчас?';
kontent,
im,//LoadImage('/logo2.png'),
ALERT_INFO);
}
clearform;
setformtitle(title);
i:=FormAddImage(im);
i:=FormAddString(kontent); // идет соединение
showform;
createOkCommand;
End;
//**********************************************************
//**********************************************************
Procedure showhelp;
Begin
showmessageImage('Справка',ResToString('thelp.png'),LoadImage('/spravka.png') );
end;
//**********************************************************
Procedure showabout;
Begin
showmessageImage('О программе',ResToString('tabout.png'),LoadImage('/about.png') );
end;
//**********************************************************
///главное меню
function mainmenu(n:integer):integer;
var cmsms, setings,help, exit,langs,balans,help,about,updates ,stat,popolnenie,balans: integer;
play,back, clicked : command;
Begin
showMenu('Главное меню', CH_IMPLICIT);//главное меню
cmsms:= menuAppendStringimage('Отправить смс',imA[1]);
stat:=menuAppendStringimage('Статус сообщения',imA[2]);
balans:=menuAppendStringimage('Баланс кода',imA[3]);
setings := menuAppendStringimage('Прикольные СМСки',imA[4]);
popolnenie:=menuAppendStringimage('Приобрести код',imA[5]);
help := menuAppendStringimage('Справка',imA[6]);
about:= menuAppendStringimage('О программе',imA[7]);
updates:=menuAppendStringimage('Обновление',imA[8]);
exit := menuAppendStringimage('Выход',imA[9]);
ui.list_set_selected(n);
play := createCommand('Выбрать', CM_OK, 1);
addCommand(play);
clicked:=EmptyCommand;
repeat
delay(200);
clicked := getClickedCommand;
until clicked <> EmptyCommand;
mainmenu:=menuGetSelectedIndex;
RemoveCommand(play);
if menuGetSelectedIndex = exit then begin saveStore; halt; end;
if menuGetSelectedIndex = updates then update;
if menuGetSelectedIndex = cmsms then sendSMS;
if menuGetSelectedIndex = setings then PROCcoolsms;
if menuGetSelectedIndex = balans then balansForm;
if menuGetSelectedIndex = stat then checksmsid;// проверка статуса
if menuGetSelectedIndex = popolnenie then checkcantpay;
if menuGetSelectedIndex = help then showhelp;
if menuGetSelectedIndex = about then showabout;
end;
//**********************************************************
Procedure addcoolsms(s,s2:string);
Begin
coolsmsN:=coolsmsN+1;
coolsms[coolsmsN].text:=s;
coolsms[coolsmsN].ot:=s2;
end;
//**********************************************************
Procedure loading;
Begin
smspayn:=0;
smspayn:=smspayn+1;
imA[smspayn]:=loadimage('/send2.png');
smspayn:=smspayn+1;
imA[smspayn]:=loadimage('/status.png');
smspayn:=smspayn+1;
imA[smspayn]:=loadimage('/balance12.png');
smspayn:=smspayn+1;
imA[smspayn]:=loadimage('/pricolnie_sms.png');
smspayn:=smspayn+1;
imA[smspayn]:=loadimage('/buy_key.png');
smspayn:=smspayn+1;
imA[smspayn]:=loadimage('/spravka.png');
smspayn:=smspayn+1;
imA[smspayn]:=loadimage('/about.png');
smspayn:=smspayn+1;
imA[smspayn]:=loadimage('/obnovlenie.png');
smspayn:=smspayn+1;
imA[smspayn]:=loadimage('/exit1.png');
{
countries[1]:='Россия';
countries[2]:='Украина';
countries[3]:='Казахстан';
countries[4]:='Таджикистан';
}
countries[1]:='Россия';
countries[2]:='Украина';
countries[3]:='Казахстан';
smspayn:=0;
smspayn:=smspayn+1;
smspay[smspayn].smsN:='2893';
smspay[smspayn].opisanie:='(3 СМС) - 1,3$';
smspay[smspayn].cantry:=1;
smspayn:=smspayn+1;
smspay[smspayn].smsN:='7250';
smspay[smspayn].opisanie:='(6 СМС) - 2,5$';
smspay[smspayn].cantry:=1;
smspayn:=smspayn+1;
smspay[smspayn].smsN:='2895';
smspay[smspayn].opisanie:='(12 СМС) - 5$';
smspay[smspayn].cantry:=1;
smspayn:=smspayn+1;
smspay[smspayn].smsN:='7733';
smspay[smspayn].opisanie:='(25 СМС) - 10$';
smspay[smspayn].cantry:=1;
smspayn:=smspayn+1;
smspay[smspayn].smsN:='7099';
smspay[smspayn].opisanie:='(2 СМС) - 0,99$';
smspay[smspayn].cantry:=2;
smspayn:=smspayn+1;
smspay[smspayn].smsN:='7250';
smspay[smspayn].opisanie:='(7 СМС) - 1,99$';
smspay[smspayn].cantry:=2;
smspayn:=smspayn+1;
smspay[smspayn].smsN:='5373';
smspay[smspayn].opisanie:='(9 СМС) - 3,9$';
smspay[smspayn].cantry:=2;
smspayn:=smspayn+1;
smspay[smspayn].smsN:='8444';
smspay[smspayn].opisanie:='(3 СМС)- 1,9$';
smspay[smspayn].cantry:=3;
smspayn:=smspayn+1;
smspay[smspayn].smsN:='4449';
smspay[smspayn].opisanie:='(5 СМС) - 2,5$';
smspay[smspayn].cantry:=3;
smspayn:=smspayn+1;
smspay[smspayn].smsN:='4161';
smspay[smspayn].opisanie:='(8 СМС) - 4,5$';
smspay[smspayn].cantry:=3;
//coolsms
coolsmsN:=0;
addcoolsms('Нифига ты не получишь от меня в этом году!!!','DedMoroz');
addcoolsms('Привет, я вирус, и я войду в твои мозги прямо сейчас...извините, я ухожу, не могу найти мозгов.','Virus');
addcoolsms('Вы отключены за разбазаривание государственных секретов по нашей сети.','Information');
addcoolsms('Дети Намибии благодарны вам за Ваше пожертвование - 10$, вместе мы победим голод!','Information');
addcoolsms('Предлагаю интим, криминал и, до кучи, Гербалайф.','Reklama');
addcoolsms('С Вашего лицевого счёта было снято 170 руб. на озеленение Луны.Благодарим за помощь.','Lunatiki');
addcoolsms('В связи с резким похолоданием ваш счет заморожен.','Information');
addcoolsms('Завтра приеду, думаю, на весь отпуск, накрывайте стол!','Tesha');
addcoolsms('У вас морщины? Перхоть? Маленькая грудь?..................... УЖАС!','Reklama');
addcoolsms('Купи пожалуйста туалетную бумагу и срочно приезжай домой!','Mama');
addcoolsms('Познакомлюсь с красивой девушкой для создания крепкой семьи на одну ночь.','Muzhik');
addcoolsms('Остаток ваших средств переведен на счет организации "Аль-Каида".Спасибо за вклад в развитие мирового терроризма! ','BenLaden');
addcoolsms('Готовь деньги, я беременна!','Roddom');
addcoolsms('Ваша анкета опубликована на нашем сайте!Надеемся вскоре вы найдете свою голубую половинку! Чмоки ;)','Gay.ru');
addcoolsms('Не хочу быть телефоном, хочу быть тамагочи, накорми меня!!!','Telefon');
addcoolsms('Купи водки, пива и чего-нибудь попить!','Alkash');
addcoolsms('Буду поздно. Суп на полу - вытри.','Mama');
addcoolsms('Поднимите голову. Мне вас плохо видно.','Sniper');
addcoolsms('Если вы не будете отправлять смс своей любимой, мы вас отключим!','Info');
U[1]:='%01';U[2]:='%02';U[3]:='%03';U[4]:='%04';U[5]:='%05';U[6]:='%06';U[7]:='%07';U[8]:='%08';U[9]:='%09';U[10]:='%0A';U[11]:='%0B';U[12]:='%0C';U[13]:='%0D';U[14]:='%0E';U[15]:='%0F';U[16]:='%10';U[17]:='%11';U[18]:='%12';U[19]:='%13';U[20]:='%14';U[21]:='%15';U[22]:='%16';U[23]:='%17';U[24]:='%18';U[25]:='%19';U[26]:='%1A';U[27]:='%1B';U[28]:='%1C';U[29]:='%1D';U[30]:='%1E';U[31]:='%1F';U[32]:='+';U[33]:='%21';U[34]:='%22';U[35]:='%23';U[36]:='%24';U[37]:='%25';U[38]:='%26';U[39]:='%27';U[40]:='%28';U[41]:='%29';U[42]:='%2A';U[43]:='%2B';U[44]:='%2C';U[45]:='%2D';U[46]:='%2E';U[47]:='%2F';U[48]:='0';U[49]:='1';U[50]:='2';U[51]:='3';U[52]:='4';U[53]:='5';U[54]:='6';U[55]:='7';U[56]:='8';U[57]:='9';U[58]:='%3A';U[59]:='%3B';U[60]:='%3C';U[61]:='%3D';U[62]:='%3E';U[63]:='%3F';U[64]:='%40';U[65]:='A';U[66]:='B';U[67]:='C';U[68]:='D';U[69]:='E';U[70]:='F';U[71]:='G';U[72]:='H';U[73]:='I';U[74]:='J';U[75]:='K';U[76]:='L';U[77]:='M';U[78]:='N';U[79]:='O';U[80]:='P';U[81]:='Q';U[82]:='R';U[83]:='S';U[84]:='T';U[85]:='U';U[86]:='V';U[87]:='W';U[88]:='X';U[89]:='Y';U[90]:='Z';U[91]:='%5B';U[92]:='%5C';U[93]:='%5D';U[94]:='%5E';U[95]:='%5F';U[96]:='%60';U[97]:='a';U[98]:='b';U[99]:='c';U[100]:='d';U[101]:='e';U[102]:='f';U[103]:='g';U[104]:='h';U[105]:='i';U[106]:='j';U[107]:='k';U[108]:='l';U[109]:='m';U[110]:='n';U[111]:='o';U[112]:='p';U[113]:='q';U[114]:='r';U[115]:='s';U[116]:='t';U[117]:='u';U[118]:='v';U[119]:='w';U[120]:='x';U[121]:='y';U[122]:='z';U[123]:='%7B';U[124]:='%7C';U[125]:='%7D';U[126]:='%7E';U[127]:='%7F';U[128]:='%80';U[129]:='%81';U[130]:='%82';U[131]:='%83';U[132]:='%84';U[133]:='%85';U[134]:='%86';U[135]:='%87';U[136]:='%88';U[137]:='%89';U[138]:='%8A';U[139]:='%8B';U[140]:='%8C';U[141]:='%8D';U[142]:='%8E';U[143]:='%8F';U[144]:='%90';U[145]:='%91';U[146]:='%92';U[147]:='%93';U[148]:='%94';U[149]:='%95';U[150]:='%96';U[151]:='%97';U[152]:='%98';U[153]:='%99';U[154]:='%9A';U[155]:='%9B';U[156]:='%9C';U[157]:='%9D';U[158]:='%9E';U[159]:='%9F';U[160]:='%A0';U[161]:='%A1';U[162]:='%A2';U[163]:='%A3';U[164]:='%A4';U[165]:='%A5';U[166]:='%A6';U[167]:='%A7';U[168]:='%A8';U[169]:='%A9';U[170]:='%AA';U[171]:='%AB';U[172]:='%AC';U[173]:='%AD';U[174]:='%AE';U[175]:='%AF';U[176]:='%B0';U[177]:='%B1';U[178]:='%B2';U[179]:='%B3';U[180]:='%B4';U[181]:='%B5';U[182]:='%B6';U[183]:='%B7';U[184]:='%B8';U[185]:='%B9';U[186]:='%BA';U[187]:='%BB';U[188]:='%BC';U[189]:='%BD';U[190]:='%BE';U[191]:='%BF';U[192]:='%C0';U[193]:='%C1';U[194]:='%C2';U[195]:='%C3';U[196]:='%C4';U[197]:='%C5';U[198]:='%C6';U[199]:='%C7';U[200]:='%C8';U[201]:='%C9';U[202]:='%CA';U[203]:='%CB';U[204]:='%CC';U[205]:='%CD';U[206]:='%CE';U[207]:='%CF';U[208]:='%D0';U[209]:='%D1';U[210]:='%D2';U[211]:='%D3';U[212]:='%D4';U[213]:='%D5';U[214]:='%D6';U[215]:='%D7';U[216]:='%D8';U[217]:='%D9';U[218]:='%DA';U[219]:='%DB';U[220]:='%DC';U[221]:='%DD';U[222]:='%DE';U[223]:='%DF';U[224]:='%E0';U[225]:='%E1';U[226]:='%E2';U[227]:='%E3';U[228]:='%E4';U[229]:='%E5';U[230]:='%E6';U[231]:='%E7';U[232]:='%E8';U[233]:='%E9';U[234]:='%EA';U[235]:='%EB';U[236]:='%EC';U[237]:='%ED';U[238]:='%EE';U[239]:='%EF';U[240]:='%F0';U[241]:='%F1';U[242]:='%F2';U[243]:='%F3';U[244]:='%F4';U[245]:='%F5';U[246]:='%F6';U[247]:='%F7';U[248]:='%F8';U[249]:='%F9';U[250]:='%FA';U[251]:='%FB';U[252]:='%FC';U[253]:='%FD';U[254]:='%FE';U[255]:='%FF';
ar1[1]:='a';ar1[2]:='b';ar1[3]:='v';ar1[4]:='g';ar1[5]:='d';ar1[6]:='e';ar1[7]:='yo';ar1[8]:='zh';ar1[9]:='z';ar1[10]:='i';ar1[11]:='y';ar1[12]:='k';ar1[13]:='l';ar1[14]:='m';ar1[15]:='n';ar1[16]:='o';ar1[17]:='p';ar1[18]:='r';ar1[19]:='s';ar1[20]:='t';ar1[21]:='u';ar1[22]:='f';ar1[23]:='kh';ar1[24]:='ts';ar1[25]:='ch';ar1[26]:='sh';ar1[27]:='shch';ar1[28]:='`';ar1[29]:='y';ar1[30]:='`';ar1[31]:='e';ar1[32]:='yu';ar1[33]:='ya';
ar2[1]:='A';ar2[2]:='B';ar2[3]:='V';ar2[4]:='G';ar2[5]:='D';ar2[6]:='E';ar2[7]:='Yo';ar2[8]:='Zh';ar2[9]:='Z';ar2[10]:='I';ar2[11]:='Y';ar2[12]:='K';ar2[13]:='L';ar2[14]:='M';ar2[15]:='N';ar2[16]:='O';ar2[17]:='P';ar2[18]:='R';ar2[19]:='S';ar2[20]:='T';ar2[21]:='U';ar2[22]:='F';ar2[23]:='Kh';ar2[24]:='Ts';ar2[25]:='Ch';ar2[26]:='Sh';ar2[27]:='Shch';ar2[28]:='`';ar2[29]:='Y';ar2[30]:='`';ar2[31]:='E';ar2[32]:='Yu';ar2[33]:='Ya';
Imglogo:=LoadImage('/logo2.png');
Imgicon:=LoadImage('/icon.png');
Imginvite:=LoadImage('/invite.png');
end;
//**********************************************************
//**********************************************************
//**********************************************************
//**********************************************************
//**********************************************************
//**********************************************************
//**********************************************************
//**********************************************************
//**********************************************************
//**********************************************************
begin
Splash;
loading;
//delay(1000);
if readStore then begin showhelp; showcanvas; end;
SplashEnd;
//update;
repeat
mainmenui:=mainmenu(mainmenui);
until 2=3;
end.
|
