Извините, ничего не найдено.

abcdef · 30.09.2008, 21:57

Открываю тему по созданию несложных, но интересных программ, выполненных по возможности только средствами MIDletPascal.

__Добавляйте сюда свои исходники и работающие алгоритмы.

____Многое можно сделать проще, даже возможностями MIDletPascal...

abcdef · 30.09.2008, 22:28

начну с первого, что нашел в дебрях своего жеского диска... Это самообучающаяся игра в пешки 3x3. игра хранит историю ходов успешных партий и вероятность таких ходов тем выше, чем больше партий сыгранно...
идея взята из какой-то математической книжки, где игра реализовалась в спичечных коробках

размеры поля можно увеличить, за это отвечают константы yMax,xMax
Но на моей моторолле размер RMS-памяти для приложения ограничен, как вспоминаю вроде 16кб, поэтому при увеличении поля увеличивается размер сохраняемой истории и RMS-память переполняется...

abcdef · 30.09.2008, 22:44

Вот исходник игры в составление слов.
Программма играет сама с собой в поле 5x5 клеток и подставляет максимально длинное слово из словаря.
в быстродействии программы большую роль играет модель телефона. на моей моторолле приходилось ждать нового слова секунд по 50, а на непомню-каком-сони-эриксоне всего 5 сек...

прикрепленный файл-это словарь слов в win-кодировке. последняя строка файла это "*<enter>"

abcdef · 30.09.2008, 22:46

на сегодня думаю хватит.. будет время поищу остальное...

Piligrim · 30.09.2008, 23:11

Увеличить место под RMS можно добавив MIDlet-Data-Size : 50000 в манифест. Это в байтах.

Romanzes · 01.10.2008, 13:40

abcdef, очень интересные проги. Тут кстати можно вложения делать.

abcdef · 01.10.2008, 22:10

вот нашел простенький исходник,.. когда-то от нечего делать собирал квест по книжке Гарри Гарисона.
Из-за ограничения по памяти, грузить текстовку из ресурсов пришлось блоками,... которые подгружаются когда пользователь еще читает текст

Прикрепленный файл - текст квеста, имеет формат:
--$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.

Piligrim · 01.10.2008, 22:23

О! Да это похоже "Стань стальной крысой"

abcdef · 02.10.2008, 12:23

вопрос к pilgrim: могу ли я выложить свой исходник к написанной вами с ребятами мобильной версии Fallout quest? т.е. ресурсы из вашей программы, а движек-мой. или пусть пылится?

p.s. администраторам форума: пожайлуста удаляйте мои дублирующие посты. - это по причине плохой связи и частых обрывов

Piligrim · 02.10.2008, 14:39

Fallout Quest Mobile писал 0vZ. Но он здесь больше не появляется. Думаю он будет не против.
Кстати, есть еще один квест, точнее книга-игра Fallout II:По ту сторону баррикад. Есть мысль и её перенести на телефон.

abcdef · 02.10.2008, 19:44

впервые когда увидел эту игру, понравилась задумка, разнообразие и стилизованность рисунков... но после нескольких уровней зависала, не находя какого-то файла с ресурсами, тогда и захотелось сделать свой движек (тем более что она изначально была сделана на MP) и пройти ее до конца.

ввиду некоторых ограничений MIDletPascal, в частности нельзя добавлять ресурсы в подкаталогах пришлось часть операций сделать вручную, т.е. порядок сборки игры таков:
1. скомпилировать jar-файл из представленного исходника.
2. открываем jar-файл (для тех кто незнает - переименовываем его из *.jar в *.zip и открываем архиватором).
3. копируем файлы ИЗ прикрепленного архива в наш *.jar т.е. *.zip файл, закрываем zip, переименовываем его обратно в *.jar
4. Теперь игра готова, но для нормальной работы ее нужно перевести в полноэкранный режим, для этого ищем на просторах интернета программку FillJava -она добавляет class-файл в котором мы записываем размеры экрана, а именно 176x212... если ваш телефон имеет дисплей 128x128 - то имеется версия и для такого разрешения, но копировать ее я не стал, итак эти пол-метра минут 50 качалось..
_______________
игра может зависать на некоторых моделях телефонов из-за больших потребностей в памяти (такое бывало на некоторых мотороллах), если такое случилось, то удалите часть рисунков из какого-нить уровня...
_______________
p.s. в коде мне больше всего понравился метод создания собственного шрифта.

abcdef · 02.10.2008, 20:07

интересно! а где-же файлик ресурсов, который я только что прикреплял?
544 КБ fquest.zip .... блин столько траффика впустую... кстати ресурсы немножко редактировал, из оригинальной версии могут не пойти.. эх,завтра утром опять прийдется разоряться..

pilgrim по поводу новой версии, я только что-нить программить, если будет время.. дизайн и рисунки не смогу..

abcdef · 03.10.2008, 05:08

ресурсы к игре Fallout Quest Mobile

abcdef · 03.10.2008, 05:39

интересная статистика скачанных файлов: простым квестом интересовались больше, чем более сложными программами, тогда вот нашел что по-проще.. это наброски алгоритма по которым можно сделать аналог игры 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.

Kurdt · 03.10.2008, 14:07

тоже выложу, мож кому интиресно будет увидеть как работает програмка работает по шттп с сервером.

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.