|
Основной форум Сюда все проблемы связанные с программированием. |
30.09.2008, 21:57
|
#1
|
Знающий
Регистрация: 16.09.2008
Сообщений: 299
Написано 71 полезных сообщений (для 123 пользователей)
|
интересные исходники или идеи реализации в MP
Открываю тему по созданию несложных, но интересных программ, выполненных по возможности только средствами MIDletPascal.
__Добавляйте сюда свои исходники и работающие алгоритмы.
____Многое можно сделать проще, даже возможностями MIDletPascal...
|
(Offline)
|
|
30.09.2008, 22:28
|
#2
|
Знающий
Регистрация: 16.09.2008
Сообщений: 299
Написано 71 полезных сообщений (для 123 пользователей)
|
Ответ: интересные исходники или идеи реализации в MP
начну с первого, что нашел в дебрях своего жеского диска... Это самообучающаяся игра в пешки 3x3. игра хранит историю ходов успешных партий и вероятность таких ходов тем выше, чем больше партий сыгранно...
идея взята из какой-то математической книжки, где игра реализовалась в спичечных коробках
размеры поля можно увеличить, за это отвечают константы yMax,xMax
Но на моей моторолле размер RMS-памяти для приложения ограничен, как вспоминаю вроде 16кб, поэтому при увеличении поля увеличивается размер сохраняемой истории и RMS-память переполняется...
Последний раз редактировалось Piligrim, 06.10.2008 в 20:59.
|
(Offline)
|
|
30.09.2008, 22:44
|
#3
|
Знающий
Регистрация: 16.09.2008
Сообщений: 299
Написано 71 полезных сообщений (для 123 пользователей)
|
Ответ: интересные исходники или идеи реализации в MP
Вот исходник игры в составление слов.
Программма играет сама с собой в поле 5x5 клеток и подставляет максимально длинное слово из словаря.
в быстродействии программы большую роль играет модель телефона. на моей моторолле приходилось ждать нового слова секунд по 50, а на непомню-каком-сони-эриксоне всего 5 сек...
прикрепленный файл-это словарь слов в win-кодировке. последняя строка файла это "*<enter>"
Последний раз редактировалось Piligrim, 06.10.2008 в 21:06.
|
(Offline)
|
|
30.09.2008, 22:46
|
#4
|
Знающий
Регистрация: 16.09.2008
Сообщений: 299
Написано 71 полезных сообщений (для 123 пользователей)
|
Ответ: интересные исходники или идеи реализации в MP
на сегодня думаю хватит.. будет время поищу остальное...
|
(Offline)
|
|
30.09.2008, 23:11
|
#5
|
Оптимист
Регистрация: 07.01.2006
Сообщений: 961
Написано 105 полезных сообщений (для 259 пользователей)
|
Ответ: интересные исходники или идеи реализации в MP
Увеличить место под RMS можно добавив MIDlet-Data-Size : 50000 в манифест. Это в байтах.
|
(Offline)
|
|
Сообщение было полезно следующим пользователям:
|
|
01.10.2008, 13:40
|
#6
|
Разработчик
Регистрация: 06.04.2008
Сообщений: 541
Написано 196 полезных сообщений (для 637 пользователей)
|
Ответ: интересные исходники или идеи реализации в MP
abcdef, очень интересные проги. Тут кстати можно вложения делать.
|
(Offline)
|
|
01.10.2008, 22:10
|
#7
|
Знающий
Регистрация: 16.09.2008
Сообщений: 299
Написано 71 полезных сообщений (для 123 пользователей)
|
Ответ: интересные исходники или идеи реализации в MP
вот нашел простенький исходник,.. когда-то от нечего делать собирал квест по книжке Гарри Гарисона.
Из-за ограничения по памяти, грузить текстовку из ресурсов пришлось блоками,... которые подгружаются когда пользователь еще читает текст
Прикрепленный файл - текст квеста, имеет формат:
--$0
текст главы 0
....
--$117
текст главы 117
....
--$END
^- это была последняя строка файла
в тексте есть метки, вида: $183$ - таким образом добавляется переход на на нужную главу
var
res : resource;
go, sss : array[0..15] of string;
s, l : string;
ch : char;
max,i,len: integer;
var
exitCmd, gotoCmd, cmd : command;
choiceIs : array[0..15] of integer;
choiceId : integer;
editId : integer;
textId : integer;
function ansi(str : string) : string;
var {rus_ansi to unicode}
s : string;
i,c : integer;
begin
s := '';
for i := 0 to length(str)-1 do
begin
c := ord(getChar(str,i)) and 255;
if (c>=192) then c := c+(1040-192) else
if (c<32) and (c<>10) then c := 32;
s := s+chr(c);
end;
ansi := s;
end;
function findBlock(s : string) : string;
begin {get text Block from resource file}
findBlock := '';
res := openResource('/quest.txt');
if (resourceAvailable(res)=true) then
begin
s := '--'+s;
repeat
l := readLine(res);
cmd := getClickedCommand;
if cmd = exitCmd then l := '--$END';
until (l=s) or (l='--$END');
s := '';
if l<>'--$END' then
repeat
l := readLine(res);
if copy(l,0,3)='--$' then l := '';
s := s+l+chr(10);
until (l='');
closeResource(res);
findBlock := s;
end;
end;
procedure menu;
begin {get text points}
max := 0;
len := length(s);
i := 0;
if len>0 then
repeat
ch := getChar(s,i);
if ch='$' then
begin
l := '';
repeat
l := l+ch;
i := i+1;
ch := getChar(s,i);
until ch='$';
go[max] := l;
max := max+1;
end;
i := i+1;
until (i>=len);
end;
begin
showForm;
exitCmd := createCommand('Exit', CM_EXIT, 1);
gotoCmd := createCommand('Go', CM_OK, 1);
addCommand(exitCmd);
s := findBlock('$0');
repeat
if s='' then s := 'ERROR: BLOCK NOT FOUND'+chr(10)+'to start $0$';
textId := formAddString(ansi(s));
choiceId := formAddChoice('', CH_EXCLUSIVE);
editId := formAddTextField('', '', 10, TF_NUMERIC);{}
menu;
for i := 0 to max-1 do
begin
sss[i] := findBlock(go[i]);
choiceIs[i] := choiceAppendString(choiceId, go[i]);
if cmd=exitCmd then Break;
end;
if cmd<>exitCmd then
begin
addCommand(gotoCmd);
repeat
cmd := getClickedCommand;
until cmd<>emptyCommand;
removeCommand(gotoCmd);
if cmd<>exitCmd then
begin
s := formGetText(editId);
if s='' then
begin{}
for i := 0 to max-1 do
if choiceIsSelected(choiceId, choiceIs[i]) then s := sss[i];
end
else s := findBlock('$'+s){}
end;
end;
formRemove(editId);
formRemove(choiceId);
formRemove(textId);
until cmd = exitCmd;
removeCommand(exitCmd);
end.
|
(Offline)
|
|
Эти 3 пользователя(ей) сказали Спасибо abcdef за это полезное сообщение:
|
|
01.10.2008, 22:23
|
#8
|
Оптимист
Регистрация: 07.01.2006
Сообщений: 961
Написано 105 полезных сообщений (для 259 пользователей)
|
Ответ: интересные исходники или идеи реализации в MP
О! Да это похоже "Стань стальной крысой"
|
(Offline)
|
|
02.10.2008, 12:23
|
#9
|
Знающий
Регистрация: 16.09.2008
Сообщений: 299
Написано 71 полезных сообщений (для 123 пользователей)
|
Ответ: интересные исходники или идеи реализации в MP
вопрос к pilgrim: могу ли я выложить свой исходник к написанной вами с ребятами мобильной версии Fallout quest? т.е. ресурсы из вашей программы, а движек-мой. или пусть пылится?
p.s. администраторам форума: пожайлуста удаляйте мои дублирующие посты. - это по причине плохой связи и частых обрывов
|
(Offline)
|
|
02.10.2008, 14:39
|
#10
|
Оптимист
Регистрация: 07.01.2006
Сообщений: 961
Написано 105 полезных сообщений (для 259 пользователей)
|
Ответ: интересные исходники или идеи реализации в MP
Fallout Quest Mobile писал 0vZ. Но он здесь больше не появляется. Думаю он будет не против.
Кстати, есть еще один квест, точнее книга-игра Fallout II:По ту сторону баррикад. Есть мысль и её перенести на телефон.
|
(Offline)
|
|
02.10.2008, 19:44
|
#11
|
Знающий
Регистрация: 16.09.2008
Сообщений: 299
Написано 71 полезных сообщений (для 123 пользователей)
|
Ответ: интересные исходники или идеи реализации в MP
впервые когда увидел эту игру, понравилась задумка, разнообразие и стилизованность рисунков... но после нескольких уровней зависала, не находя какого-то файла с ресурсами, тогда и захотелось сделать свой движек (тем более что она изначально была сделана на MP) и пройти ее до конца.
ввиду некоторых ограничений MIDletPascal, в частности нельзя добавлять ресурсы в подкаталогах пришлось часть операций сделать вручную, т.е. порядок сборки игры таков:
1. скомпилировать jar-файл из представленного исходника.
2. открываем jar-файл (для тех кто незнает - переименовываем его из *.jar в *.zip и открываем архиватором).
3. копируем файлы ИЗ прикрепленного архива в наш *.jar т.е. *.zip файл, закрываем zip, переименовываем его обратно в *.jar
4. Теперь игра готова, но для нормальной работы ее нужно перевести в полноэкранный режим, для этого ищем на просторах интернета программку FillJava -она добавляет class-файл в котором мы записываем размеры экрана, а именно 176x212... если ваш телефон имеет дисплей 128x128 - то имеется версия и для такого разрешения, но копировать ее я не стал, итак эти пол-метра минут 50 качалось..
_______________
игра может зависать на некоторых моделях телефонов из-за больших потребностей в памяти (такое бывало на некоторых мотороллах), если такое случилось, то удалите часть рисунков из какого-нить уровня...
_______________
p.s. в коде мне больше всего понравился метод создания собственного шрифта.
Последний раз редактировалось Piligrim, 06.10.2008 в 21:08.
|
(Offline)
|
|
Сообщение было полезно следующим пользователям:
|
|
02.10.2008, 20:07
|
#12
|
Знающий
Регистрация: 16.09.2008
Сообщений: 299
Написано 71 полезных сообщений (для 123 пользователей)
|
Ответ: интересные исходники или идеи реализации в MP
интересно! а где-же файлик ресурсов, который я только что прикреплял?
544 КБ fquest.zip .... блин столько траффика впустую... кстати ресурсы немножко редактировал, из оригинальной версии могут не пойти.. эх,завтра утром опять прийдется разоряться..
pilgrim по поводу новой версии, я только что-нить программить, если будет время.. дизайн и рисунки не смогу..
|
(Offline)
|
|
03.10.2008, 05:08
|
#13
|
Знающий
Регистрация: 16.09.2008
Сообщений: 299
Написано 71 полезных сообщений (для 123 пользователей)
|
Ответ: интересные исходники или идеи реализации в MP
ресурсы к игре Fallout Quest Mobile
|
(Offline)
|
|
03.10.2008, 05:39
|
#14
|
Знающий
Регистрация: 16.09.2008
Сообщений: 299
Написано 71 полезных сообщений (для 123 пользователей)
|
Ответ: интересные исходники или идеи реализации в MP
интересная статистика скачанных файлов: простым квестом интересовались больше, чем более сложными программами, тогда вот нашел что по-проще.. это наброски алгоритма по которым можно сделать аналог игры Worms, добавить: логику_противника/рисунки/генерация_случайной_карты/скроллирование_карты/разрыв_снарядов.
const
g = 9.81;
count = 100;
var
vx,vy,t,dt,rad : real;
angle,power,step : integer;
gx,gy,key,w,h : integer;
xp,yp : integer;
xx,yy,dx,dy,ok,no : integer;
exitCmd,editCmd,cmd: command;
function inbar(x,y,x1,y1,x2,y2 : integer) : boolean;
begin
if (x>=x1) and (x<=x2) and (y>=y1) and (y<=y2) then inbar := true
else inbar := false;
end;
procedure draw(b : boolean);
begin
rad:= pi*angle/180;
vx := cos(rad);
vy := sin(rad);
gx := xp+trunc(vx*10);
gy := yp-trunc(vy*10);
vx := vx*power;
vy := vy*power;
dt := (2*vy/g)/count;
setColor(0,0,0);
if b then setColor(0,255,0);
drawText('angle='+angle, 0,0);
drawText('power='+power, 0,16);
drawText('x='+(gx+trunc(vx*dt*count)), 0,32);
drawText('ok='+ok+'/no='+no, 0,48);
drawText('[email protected]', 0,64);
if b then setColor(255,255,100);
drawLine(xp, yp, gx, gy);
t := dt*step;
gx := gx+trunc(vx*t);
gy := gy-trunc((vy*t)-(g*t*t/2));
if b then setColor(255,0,0);
fillEllipse(gx-2,gy-2,6,6);
if b then setColor(0,255,100);
fillEllipse(gx-3,gy-3,3,3);
setColor(255,255,255);
drawLine(0,yp,w,yp);
drawRect(xp*4,yp-15,5,15);
{play}
setColor(0,0,0);
if b then setColor(0,255,0);
drawRect(xx-10,yp-1,20,2);
if b=false then {move block}
begin
xx := xx+dx;
if (xx>=w) or (xx<=xp*5+5) then dx :=-dx;
end;
if b then repaint;
end;
procedure init;
begin
xx := w div 2;
yy := yp-2;
dx := random(2)+1;
if random(100) > 50 then dx:=-dx;
dy := 0;
end;
begin
exitCmd := createCommand('Exit', CM_EXIT, 1);
addCommand(exitCmd);
randomize;
w := getWidth;
h := getHeight;
xp := 5;
yp := h-5;
angle := 90;
power := 0;
ok := 0;
no := 0;
init;
setColor(0,0,0);
fillRect(0,0,w,h);
repeat
{out to screen}
draw(true);
delay(10);
draw(false);
{gun-logic}
if inbar(gx,gy, xx-10-2,yp-1-2,xx-10+20+2,yp-1+2+2) then
begin
init;
power := 0;
ok := ok+1;
end;
if ((gx>w) or (gy>yp)) or ((gx>=xp*5) and (gx<=xp*5+5) and (gy>=yp-15)) then
begin
power := 0;
no := no+1;
end
{play control}
if (power=0) then
begin
key := keyToAction(getKeyPressed);
if key=GA_UP then if (angle<170) then angle:=angle+1;
if key=GA_DOWN then if (angle>10) then angle:=angle-1;
if key=GA_FIRE then
begin
step := 0;
power := 10;
repeat
key := keyToAction(getKeyPressed);
if (power<70) then power:=power+1;
draw(true);
delay(50);
draw(false);
until (key<>GA_FIRE);
end;
end
else step := step+1;
cmd := getClickedCommand;
until cmd<>emptyCommand;
removeCommand(exitCmd);
end.
|
(Offline)
|
|
03.10.2008, 14:07
|
#15
|
ПроЭктировщик
Регистрация: 28.03.2007
Сообщений: 194
Написано 7 полезных сообщений (для 25 пользователей)
|
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.
|
(Offline)
|
|
Сообщение было полезно следующим пользователям:
|
|
Ваши права в разделе
|
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения
HTML код Выкл.
|
|
|
Часовой пояс GMT +4, время: 17:28.
|