Ответ: Проект Мегапросто
Если кто нибудь сумеет помочь переделать способ загрузки и сохранения чтобы программа не жрала так память я буду только рад спасибо всем кто читал=) если что не так оформил поправьте я как бы новичёк=)
вот скомпилированная прога: http://m.megafonpro.ru/ml/upload/mpr...st._000_.3.jar
а вот исходный код:
Код:
Uses parse,proweb,jsr75i,replace,str,im,canvas;
var i, rc,a,b,nu,int,go,m1,m2,m3,m4,m5,m6,m7,m8,c1,c2,c3,c,doka,ope: integer;
text,str,ni,mo,save,dow,na,nulstr: string;
textin,user,cox,nazv,cifra,ci,index,nastr,fil,doc,x,y:integer;
s,name,nazvan,new,contr,enter,nastroi,pars,files,del:string;
img,null:image;keyCode: integer;
click,ok,back:command;
cmdNext,clicked:command;
rs : recordStore;
begin
rs := openRecordStore('cox');
name := readRecordStoreEntry(rs, 1);
ok:=CreateCommand('ОК',CM_OK,1);
back:=CreateCommand('Назад',CM_BACK,1);
repeat
ni:='';
open('http://m.megafonpro.ru/ml/?mpro=1&c=index&m=index');
if get_error='' then set_method(GET);
if get_error='' then rc:=request;
if get_error='' then str:=get_data;
close;parse.html(str);c:=parse.len;
ni:=encode(parse.get (111),'utf-8', mo);
ShowMenu('На сайте '+ni+' человек',CH_IMPLICIT);
m1:=MenuAppendString('Фильмы');
m2:=MenuAppendString('Музыка');
m3:=MenuAppendString('Фото');
m4:=MenuAppendString('Игры');
m5:=MenuAppendString('Программы');
m7:=MenuAppendString('НАСТРОЙКИ');
m8:=MenuAppendString('Выход');
AddCommand(ok);
repeat
delay(100);
click:=GetClickedCommand;
until click=ok;
if MenuIsSelected(0) then begin//Video
i:=0;
nu:=0;
a:=0;
b:=0;
c:=0;
doka:=0;
int:=0;
new:=nulstr;
ni:=nulstr;
str:=nulstr;
na:=nulstr;
mo:=nulstr;
dow:=nulstr;
repeat{
str:= jsr75i.get_roots;
del:=replacer(str,'|',' ');}
new:=''+name+'';
name:='/'+new+'magabasesettings';
int:=file_exists(name);
if int>0 then begin
str:='';
ShowForm;
i := FormAddString('Загрузим файл сюда:'+new+'');
go:= FormAddTextField('Номер файла', '', 200, TF_NUMERIC);
save:=new;
open('http://m.megafonpro.ru/ml/?c=blog&m=comments&selected_tab=0&id=566588');
if get_error='' then set_method(GET);
if get_error='' then rc:=request;
if get_error='' then str:=get_data;
close;
parse.html(str);
c:=parse.len;
repeat
if parse.get(a)='startvideo' then begin
b:=a+11;
ni:=encode(parse.get (b),'utf-8', mo);
nu:=Length(parse.get (b));
end;
a:=a+1;
until b>0;
if nu>0 then begin open('http://m.megafonpro.ru/ml/upload/mpro/files/312/video._000_.'+ni+'.txt');
if get_error='' then set_method(GET);
if get_error='' then rc:=request;
if get_error='' then str:=get_data;
close;
parse.html(str);
c:=parse.len;
b:=0;
ni:=mo;
repeat
ni:=encode(parse.get (b),'utf-8', mo);
i := FormAddString(''+ni+''+chr(10)+'');
b:=b+1;
until b=c;
end;
cmdNext := CreateCommand('Старт', CM_OK, 1);
AddCommand(cmdNext);
repeat until GetClickedCommand = cmdNext;
dow := FormGetText(go);
showcanvas;
str:='';
a:=0;
b:=0;
c:=0;
open('http://m.megafonpro.ru/ml/upload/mpro/files/312/files._000_.'+dow+'.txt');
if get_error='' then set_method(GET);
if get_error='' then rc:=request;
if get_error='' then str:=get_data;
close;
parse.html(str);
c:=parse.len;
ni:=parse.get(0);
img:=Image_From_URL(ni);
img:=resize_image(img,getWidth,getHeight);
drawImage(img,0,0);
img:=null;
ni:=parse.get(1);
na:=ni;
b:=2;
repeat
SetColor(255, 105, 180);
FillRoundRect(0, getheight-17, getwidth, getheight, 2,2 );
SetColor(255, 0, 0);
FillRoundRect(5, getheight-14, b*getwidth/c-30, 10, 2,2 );
DrawText(''+b*100/c+'%', getwidth-25, getheight-18);
Repaint;
a:=a+1;new:='';
ni:=parse.get(b);
new:='/'+save+na+a+'.rar';
doka:=file_exists(new);
if doka=0 then begin
open(''+ni+'');
if get_error='' then set_method(GET);
if get_error='' then rc:=request;
if get_error='' then str:=get_data;
close;
write_file_a(new,str);
end;
b:=b+1;
str:='';
doka:=0;
until b=c;
end;
if int<1 then begin
write_file_a(name,name);
end;
until int>0;
i:=0;
nu:=0;
a:=0;
b:=0;
c:=0;
doka:=0;
int:=0;
new:=nulstr;
ni:=nulstr;
str:=nulstr;
na:=nulstr;
mo:=nulstr;
dow:=nulstr;
clearform;showcanvas;
end;
if MenuIsSelected(1) then begin//Music
i:=0;
nu:=0;
a:=0;
b:=0;
c:=0;
doka:=0;
int:=0;
new:=nulstr;
ni:=nulstr;
str:=nulstr;
na:=nulstr;
mo:=nulstr;
dow:=nulstr;
RemoveCommand(ok);
repeat{
str:= jsr75i.get_roots;
del:=replacer(str,'|',' ');}
new:=''+name+'';
name:='/'+new+'magabasesettings';
int:=file_exists(name);
if int>0 then begin
str:='';
ShowForm;
i := FormAddString('Загрузим файл сюда:'+new+'');
go:= FormAddTextField('Номер файла', '', 200, TF_NUMERIC);
save:=new;
open('http://m.megafonpro.ru/ml/?c=blog&m=comments&selected_tab=0&id=566589');
if get_error='' then set_method(GET);
if get_error='' then rc:=request;
if get_error='' then str:=get_data;
close;
parse.html(str);
c:=parse.len;
repeat
if parse.get(a)='startmusicoss' then begin
b:=a+11;
ni:=encode(parse.get (b),'utf-8', mo);
nu:=Length(parse.get (b));
end;
a:=a+1;
until b>0;
if nu>0 then begin open('http://m.megafonpro.ru/ml/upload/mpro/files/312/audio._000_.'+ni+'.txt');
if get_error='' then set_method(GET);
if get_error='' then rc:=request;
if get_error='' then str:=get_data;
close;
parse.html(str);
c:=parse.len;
b:=0;
ni:=mo;
repeat
ni:=encode(parse.get (b),'utf-8', mo);
i := FormAddString(''+ni+''+chr(10)+'');
b:=b+1;
until b=c;
end;
cmdNext := CreateCommand('Старт', CM_OK, 1);
AddCommand(cmdNext);
repeat until GetClickedCommand = cmdNext;
dow := FormGetText(go);
showcanvas;
str:='';
a:=0;
b:=0;
c:=0;
open('http://m.megafonpro.ru/ml/upload/mpro/files/312/files._000_.'+dow+'.txt');
if get_error='' then set_method(GET);
if get_error='' then rc:=request;
if get_error='' then str:=get_data;
close;
parse.html(str);
c:=parse.len;
ni:=parse.get(0);
img:=Image_From_URL(ni);
img:=resize_image(img,getWidth,getHeight);
drawImage(img,0,0);
img:=null;
ni:=parse.get(1);
na:=ni;
b:=2;
repeat
SetColor(255, 105, 180);
FillRoundRect(0, getheight-17, getwidth, getheight, 2,2 );
SetColor(255, 0, 0);
FillRoundRect(5, getheight-14, b*getwidth/c-30, 10, 2,2 );
DrawText(''+b*100/c+'%', getwidth-25, getheight-18);
Repaint;
a:=a+1;new:='';
ni:=parse.get(b);
new:='/'+save+na+a+'.rar';
doka:=file_exists(new);
if doka=0 then begin
open(''+ni+'');
if get_error='' then set_method(GET);
if get_error='' then rc:=request;
if get_error='' then str:=get_data;
close;
write_file_a(new,str);
end;
b:=b+1;
str:='';
doka:=0;
until b=c;
end;
if int<1 then begin
write_file_a(name,name);
end;
until int>0;
i:=0;
nu:=0;
a:=0;
b:=0;
c:=0;
doka:=0;
int:=0;
new:=nulstr;
ni:=nulstr;
str:=nulstr;
na:=nulstr;
mo:=nulstr;
dow:=nulstr;
clearform;showcanvas;
end;
if MenuIsSelected(2) then begin//Foto
i:=0;
nu:=0;
a:=0;
b:=0;
c:=0;
doka:=0;
int:=0;
new:=nulstr;
ni:=nulstr;
str:=nulstr;
na:=nulstr;
mo:=nulstr;
dow:=nulstr;
RemoveCommand(ok);
repeat
{
str:= jsr75i.get_roots;
del:=replacer(str,'|',' ');}
new:=''+name+'';
name:='/'+new+'magabasesettings';
int:=file_exists(name);
if int>0 then begin
str:='';
ShowForm;
i := FormAddString('Загрузим файл сюда:'+new+'');
go:= FormAddTextField('Номер файла', '', 200, TF_NUMERIC);
save:=new;
open('http://m.megafonpro.ru/ml/?c=blog&m=comments&selected_tab=0&id=566590');
if get_error='' then set_method(GET);
if get_error='' then rc:=request;
if get_error='' then str:=get_data;
close;
parse.html(str);
c:=parse.len;
repeat
if parse.get(a)='startfoto' then begin
b:=a+11;
ni:=encode(parse.get (b),'utf-8', mo);
nu:=Length(parse.get (b));
end;
a:=a+1;
until b>0;
if nu>0 then begin open('http://m.megafonpro.ru/ml/upload/mpro/files/312/foto._000_.'+ni+'.txt');
if get_error='' then set_method(GET);
if get_error='' then rc:=request;
if get_error='' then str:=get_data;
close;
parse.html(str);
c:=parse.len;
b:=0;
ni:=mo;
repeat
ni:=encode(parse.get (b),'utf-8', mo);
i := FormAddString(''+ni+''+chr(10)+'');
b:=b+1;
until b=c;
end;
cmdNext := CreateCommand('Старт', CM_OK, 1);
AddCommand(cmdNext);
repeat until GetClickedCommand = cmdNext;
dow := FormGetText(go);
showcanvas;
str:='';
a:=0;
b:=0;
c:=0;
open('http://m.megafonpro.ru/ml/upload/mpro/files/312/files._000_.'+dow+'.txt');
if get_error='' then set_method(GET);
if get_error='' then rc:=request;
if get_error='' then str:=get_data;
close;
parse.html(str);
c:=parse.len;
ni:=parse.get(0);
img:=Image_From_URL(ni);
img:=resize_image(img,getWidth,getHeight);
drawImage(img,0,0);
img:=null;
ni:=parse.get(1);
na:=ni;
b:=2;
repeat
SetColor(255, 105, 180);
FillRoundRect(0, getheight-17, getwidth, getheight, 2,2 );
SetColor(255, 0, 0);
FillRoundRect(5, getheight-14, b*getwidth/c-30, 10, 2,2 );
DrawText(''+b*100/c+'%', getwidth-25, getheight-18);
Repaint;
a:=a+1;new:='';
ni:=parse.get(b);
new:='/'+save+na+a+'.rar';
doka:=file_exists(new);
if doka=0 then begin
open(''+ni+'');
if get_error='' then set_method(GET);
if get_error='' then rc:=request;
if get_error='' then str:=get_data;
close;
write_file_a(new,str);
end;
b:=b+1;
str:='';
doka:=0;
until b=c;
end;
if int<1 then begin
write_file_a(name,name);
end;
until int>0;
i:=0;
nu:=0;
a:=0;
b:=0;
c:=0;
doka:=0;
int:=0;
new:=nulstr;
ni:=nulstr;
str:=nulstr;
na:=nulstr;
mo:=nulstr;
dow:=nulstr;
clearform;showcanvas;
end;
if MenuIsSelected(3) then begin//Games
i:=0;
nu:=0;
a:=0;
b:=0;
c:=0;
doka:=0;
int:=0;
new:=nulstr;
ni:=nulstr;
str:=nulstr;
na:=nulstr;
mo:=nulstr;
dow:=nulstr;
RemoveCommand(ok);
repeat
{
str:= jsr75i.get_roots;
del:=replacer(str,'|',' ');}
new:=''+name+'';
name:='/'+new+'magabasesettings';
int:=file_exists(name);
if int>0 then begin
str:='';
ShowForm;
i := FormAddString('Загрузим файл сюда:'+new+'');
go:= FormAddTextField('Номер файла', '', 200, TF_NUMERIC);
save:=new;
open('http://m.megafonpro.ru/ml/?c=blog&m=comments&selected_tab=0&id=566591');
if get_error='' then set_method(GET);
if get_error='' then rc:=request;
if get_error='' then str:=get_data;
close;
parse.html(str);
c:=parse.len;
repeat
if parse.get(a)='startgame' then begin
b:=a+11;
ni:=encode(parse.get (b),'utf-8', mo);
nu:=Length(parse.get (b));
end;
a:=a+1;
until b>0;
if nu>0 then begin open('http://m.megafonpro.ru/ml/upload/mpro/files/312/games._000_.'+ni+'.txt');
if get_error='' then set_method(GET);
if get_error='' then rc:=request;
if get_error='' then str:=get_data;
close;
parse.html(str);
c:=parse.len;
b:=0;
ni:=mo;
repeat
ni:=encode(parse.get (b),'utf-8', mo);
i := FormAddString(''+ni+''+chr(10)+'');
b:=b+1;
until b=c;
end;
cmdNext := CreateCommand('Старт', CM_OK, 1);
AddCommand(cmdNext);
repeat until GetClickedCommand = cmdNext;
dow := FormGetText(go);
showcanvas;
str:='';
a:=0;
b:=0;
c:=0;
open('http://m.megafonpro.ru/ml/upload/mpro/files/312/files._000_.'+dow+'.txt');
if get_error='' then set_method(GET);
if get_error='' then rc:=request;
if get_error='' then str:=get_data;
close;
parse.html(str);
c:=parse.len;
ni:=parse.get(0);
img:=Image_From_URL(ni);
img:=resize_image(img,getWidth,getHeight);
drawImage(img,0,0);
img:=null;
ni:=parse.get(1);
na:=ni;
b:=2;
repeat
SetColor(255, 105, 180);
FillRoundRect(0, getheight-17, getwidth, getheight, 2,2 );
SetColor(255, 0, 0);
FillRoundRect(5, getheight-14, b*getwidth/c-30, 10, 2,2 );
DrawText(''+b*100/c+'%', getwidth-25, getheight-18);
Repaint;
a:=a+1;new:='';
ni:=parse.get(b);
new:='/'+save+na+a+'.rar';
doka:=file_exists(new);
if doka=0 then begin
open(''+ni+'');
if get_error='' then set_method(GET);
if get_error='' then rc:=request;
if get_error='' then str:=get_data;
close;
write_file_a(new,str);
end;
b:=b+1;
str:='';
doka:=0;
until b=c;
end;
if int<1 then begin
write_file_a(name,name);
end;
until int>0;
i:=0;
nu:=0;
a:=0;
b:=0;
c:=0;
doka:=0;
int:=0;
new:=nulstr;
ni:=nulstr;
str:=nulstr;
na:=nulstr;
mo:=nulstr;
dow:=nulstr;
clearform;showcanvas;
end;
if MenuIsSelected(4) then begin//Programms
i:=0;
nu:=0;
a:=0;
b:=0;
c:=0;
doka:=0;
int:=0;
new:=nulstr;
ni:=nulstr;
str:=nulstr;
na:=nulstr;
mo:=nulstr;
dow:=nulstr;
RemoveCommand(ok);
repeat
{
str:= jsr75i.get_roots;
del:=replacer(str,'|',' ');}
new:=''+name+'';
name:='/'+new+'magabasesettings';
int:=file_exists(name);
if int>0 then begin
str:='';
ShowForm;
i := FormAddString('Загрузим файл сюда:'+new+'');
go:= FormAddTextField('Номер файла', '', 200, TF_NUMERIC);
save:=new;
open('http://m.megafonpro.ru/ml/?c=blog&m=comments&selected_tab=0&id=566595');
if get_error='' then set_method(GET);
if get_error='' then rc:=request;
if get_error='' then str:=get_data;
close;
parse.html(str);
c:=parse.len;
repeat
if parse.get(a)='startprogramm' then begin
b:=a+11;
ni:=encode(parse.get (b),'utf-8', mo);
nu:=Length(parse.get (b));
end;
a:=a+1;
until b>0;
if nu>0 then begin open('http://m.megafonpro.ru/ml/upload/mpro/files/312/programm._000_.'+ni+'.txt');
if get_error='' then set_method(GET);
if get_error='' then rc:=request;
if get_error='' then str:=get_data;
close;
parse.html(str);
c:=parse.len;
b:=0;
ni:=mo;
repeat
ni:=encode(parse.get (b),'utf-8', mo);
i := FormAddString(''+ni+''+chr(10)+'');
b:=b+1;
until b=c;
end;
cmdNext := CreateCommand('Старт', CM_OK, 1);
AddCommand(cmdNext);
repeat until GetClickedCommand = cmdNext;
dow := FormGetText(go);
showcanvas;
str:='';
a:=0;
b:=0;
c:=0;
open('http://m.megafonpro.ru/ml/upload/mpro/files/312/files._000_.'+dow+'.txt');
if get_error='' then set_method(GET);
if get_error='' then rc:=request;
if get_error='' then str:=get_data;
close;
parse.html(str);
c:=parse.len;
ni:=parse.get(0);
img:=Image_From_URL(ni);
img:=resize_image(img,getWidth,getHeight);
drawImage(img,0,0);
img:=null;
ni:=parse.get(1);
na:=ni;
b:=2;
repeat
SetColor(255, 105, 180);
FillRoundRect(0, getheight-17, getwidth, getheight, 2,2 );
SetColor(255, 0, 0);
FillRoundRect(5, getheight-14, b*getwidth/c-30, 10, 2,2 );
DrawText(''+b*100/c+'%', getwidth-25, getheight-18);
Repaint;
a:=a+1;new:='';
ni:=parse.get(b);
new:='/'+save+na+a+'.rar';
doka:=file_exists(new);
if doka=0 then begin
open(''+ni+'');
if get_error='' then set_method(GET);
if get_error='' then rc:=request;
if get_error='' then str:=get_data;
close;
write_file_a(new,str);
end;
b:=b+1;
str:='';
doka:=0;
until b=c;
end;
if int<1 then begin
write_file_a(name,name);
end;
until int>0;
i:=0;
nu:=0;
a:=0;
b:=0;
c:=0;
doka:=0;
int:=0;
new:=nulstr;
ni:=nulstr;
str:=nulstr;
na:=nulstr;
mo:=nulstr;
dow:=nulstr;
clearform;showcanvas;
end;
if MenuIsSelected(5) then begin//Nastroiki
clearform; ShowForm;
rs := openRecordStore('cox');
name := readRecordStoreEntry(rs, 1);
cox:= FormAddTextField('Куда программа должна сохранять загруженные файлы?', ''+name+'', 200, TF_ANY);
cmdNext := CreateCommand('ок ', CM_OK, 1); AddCommand(cmdNext);
repeat until GetClickedCommand = cmdNext;
name := FormGetText(cox);
index := addRecordStoreEntry(rs, name);
clearform; ShowForm;
end;
if MenuGetSelectedIndex=m8 then halt;
until 1>2;
end.
|