Показать сообщение отдельно
Старый 02.11.2012, 15:56   #3
Deport
Оператор ЭВМ
 
Аватар для Deport
 
Регистрация: 06.03.2009
Сообщений: 38
Написано 3 полезных сообщений
(для 3 пользователей)
Подмигивание Ответ: Проект Мегапросто

Если кто нибудь сумеет помочь переделать способ загрузки и сохранения чтобы программа не жрала так память я буду только рад спасибо всем кто читал=) если что не так оформил поправьте я как бы новичёк=)
вот скомпилированная прога: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.
(Offline)
 
Ответить с цитированием