indirme sorunu lütfen yardım.. (idhttp)

[Sawyer]

Merhaba, şimdi ben bi güncelleme programı yazıyorumda herşey tamam listelettiriyorum boyutları sorguluyorum hatalı olanları indirtmeye baslatıyorum.

fakat 2 problem var (nezaman yokki )

1.si idhttp2.get işlemi tamamlanıyor memorystream'ı savetofile diyorum dosya boyutu farklı oluyor.

2.si idhttp2.get işlemi tamamlanıyor döngü yapıyorum tamamlandıktan sonra yine guncelle; procedurunu calıstırıyorum indirme başlıyor fkt buseferde idhttp2.workend olayı çalısmıyor.

lütfen bir yardımcı olun...

(varsa başka indirme yöntemleri paylaşırsanız sevinirim.)

buyrun bu ful unit1.pas

Kod: Tümünü seç

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdHTTP, ExtCtrls, IdAntiFreezeBase, IdAntiFreeze;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Memo2: TMemo;
    IdHTTP1: TIdHTTP;
    Memo3: TMemo;
    Edit1: TEdit;
    ListBox1: TListBox;
    Timer1: TTimer;
    IdAntiFreeze1: TIdAntiFreeze;
    Timer2: TTimer;
    IdAntiFreeze2: TIdAntiFreeze;
    IdHTTP2: TIdHTTP;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure IdHTTP2Work(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCount: Integer);
    procedure IdHTTP2WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCountMax: Integer);
    procedure IdHTTP2WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
    procedure Timer2Timer(Sender: TObject);
  private
    procedure tara;
    procedure guncelle;
  public
    { Public declarations }
  end;

var
Form1: TForm1;
taranan,boyut31:string;
hatasayisi:integer;
say:integer;
boyutcu:integer;
dosya: TMemoryStream;
implementation

uses TypInfo;

{$R *.dfm}

function zaman:String;
var
a:ansistring;
begin
a:='"'+DateToStr(now)+' - '+TimeToStr(Now)+'"';
result:=a;
end;

function boyut(dosya: String): String;
var
srFileSR: TSearchRec;
begin
findfirst(dosya, FaAnyFile, srFileSR);
boyut := inttostr(srFileSR.Size);
end;

procedure TFORM1.guncelle;
begin
dosya:=   TMemoryStream.Create;
memo1.lines.add(zaman+' Indirilen dosya: ' +ListBox1.Items[0]+' %0');
try
begin
IdHttp2.Get('http://gdefender.gd.funpic.org/'+listbox1.Items[0], dosya);
end;
except
end;
end;

procedure TFORM1.tara;
var
hata:integer;
begin
edit1.Text:=IdHTTP1.Get('http://localhost/guncelleme/update.php?dosya='+memo2.lines[0]) ;
if strtoint(edit1.text) <> strtoint(boyut(memo2.Lines[0])) then begin
hata:=1;
end;
if hata = 1 then begin
memo1.lines.Add('                         PC   : '+memo2.Lines[0]+'...('+boyut(memo2.Lines[0])+' byte) !HATALI!');
memo1.lines.Add('                         SERVER : '+memo2.Lines[0]+'...('+edit1.text+' byte)');
ListBox1.Items.Add(memo2.Lines[0]);
memo2.lines.Delete(0);
hatasayisi:=hatasayisi+1;
hata:=0;
end
else
begin
memo1.lines.Add('                         PC   : '+memo2.Lines[0]+'...('+boyut(memo2.Lines[0])+' byte) !GUNCEL!');
memo1.lines.Add('                         SERVER : '+memo2.Lines[0]+'...('+edit1.text+' byte)');
memo2.lines.Delete(0);
hata:=0;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
i:integer;
begin
hatasayisi:=0;
say:=3;
memo1.lines.add(zaman+' Güncellemeler kontrol ediliyor...');
memo2.Lines.add(IdHTTP1.Get('http://localhost/dosyalar.txt'));
memo3.Lines.add(IdHTTP1.Get('http://localhost/dosyalar.txt'));
memo1.lines.add(zaman+' Taranan başlatılıyor...');
memo1.lines.add(zaman+' Taranan dosyalar:');
memo1.lines.add(' ');
for i:=0 to memo2.lines.count-1 do begin
tara;
end;
memo1.lines.add(' ');
if hatasayisi > 0 then begin
memo1.lines.add(zaman+' Güncellenecek dosyalar belirlendi.');
memo1.lines.add(zaman+' Güncellenecek dosya sayısı: '+inttostr(hatasayisi));
memo1.lines.add(zaman+' Güncelleme başlatılıyor...');
timer2.enabled:=true;
end
else
begin
memo1.lines.add(zaman+' Tüm dosyalar güncel, oyun başlatılıyor...');
memo1.lines.add('                         3...');
timer1.Enabled:=true;
end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
say:=say-1;
if say < 0 then begin
// işlemlerim
halt;
end;
if say = 2 then begin
memo1.Lines.add('                         '+inttostr(say)+'..');
end;
if say = 1 then begin
memo1.Lines.add('                         '+inttostr(say)+'.');
end;
if say = 0 then begin
memo1.Lines.add('                         '+inttostr(say));
end;
end;

procedure TForm1.IdHTTP2Work(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
  var
  yuzde:string;
begin
yuzde:= floattostr((AWorkCount/boyutcu)*100);
memo1.lines[memo1.lines.count-1]:=zaman+' Indirilen dosya: ' +ListBox1.Items[0]+'  % '+copy(yuzde,1,4);
end;

procedure TForm1.IdHTTP2WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin
boyutcu:=AWorkCountMax;
end;

procedure TForm1.IdHTTP2WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
dosya.SaveToFile(listbox1.Items[0]);
memo1.lines.add(zaman+' '+listbox1.Items[0]+' çıkartılıyor..');
memo1.lines.add(zaman+' Dosya çıkartıldı');
listbox1.Items.Delete(0);
guncelle;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
timer2.Enabled:=False;
guncelle;
end;

end.

[Sawyer]

yok mu yardım edicek olan:s

[dabaddah]

dostum ben güncelleme işini ftp üzerinden yapıyordum bunun içinde idftp kullanıyordum çalıştığım kodları aşağıya yazayım sen bir bak incele.belki işine yarar.ben bu kodlarla yaptığım işi anlatayım
yeni bir sürüm çıkarttığım zaman ftp ye bir txt dosyası atıyordum güncellemenin içeriği ve yeni versiyon no falan gibi.programım her açılışta bu dosyayı alarak versiyon kontrolü yapıyor eğer yeni versiyon varsa çeşitli procedurelere ve functionlara yönlendirmeleri yapıyor.

kodlar aşağıdaki gibi;

Kod: Tümünü seç

function FTPDosyaAl( IdFTP : TIdFTP; SrcDosya, DesDosya:TFileName; Ftp, RemoteDir, Login, Pass : String ):Boolean;
begin
Result:= False;
IdFtp.Host:= Ftp;
IdFtp.Username:= Login;
IdFtp.Password:= Pass;
IdFtp.Passive:= True;
try
IdFtp.Connect;
except
Application.MessageBox('İnternet Bağlantınız Yok Yada Herhangi bir Hata Oluştu. Güncelleme Durumu İndirilemedi...!','Dikkat...!',mrOk+MB_ICONWARNING);
end;
If IdFtp.Connected then
begin
IdFtp.ChangeDir(RemoteDir);
Try
IdFtp.TransferType := ftBinary;
IdFtp.Get(SrcDosya, DesDosya, true);
Finally
Result := True;
IdFtp.Quit;
end;
end;
end;

burda get işlemi yapıldı

Kod: Tümünü seç

procedure Tguncelle.BitBtn2Click(Sender: TObject);
Var FTPAdres,KaynakDizin,Name,Pass,KaynakDosya,HedefDosya: String;
a,b:integer;
c:string;
begin
FTPAdres:= 'www.newsoft.qsh.eu';
KaynakDizin := '/www/backup/';
Name:= '****';
Pass:=  '****';
KaynakDosya:= 'yeni.txt';
HedefDosya:='C:\Program Files\muhasebe\yeni.txt';
If FTPDosyaAl( IdFtp1, KaynakDosya, HedefDosya, FTPAdres, KaynakDizin, Name, Pass ) then
try
listbox1.items.LoadFromFile('C:\Program Files\muhasebe\yeni.txt');
Memo5.Lines.LoadFromFile('C:\Program Files\muhasebe\yeni.txt');
Label2.Caption:=ListBox1.Items.Strings[0];
c:=FloatToStr(StrToDate(Label2.Caption)-StrToDate(DBEdit1.Text));
b:=StrToInt(c);
except
end;
if (b<0) or (b=0) then
begin
BitBtn2.Visible:=True;
Memo5.Clear;
showmessage('Yeni Güncelleme Yok...!');
DeleteFile('C:\Program Files\muhasebe\yeni.txt');
end;
if b>0 then
begin
Button1.Enabled:=True;
Button2.Enabled:=True;
a:=Application.MessageBox('NewSoft Muhasebe Programının Güncellenmesi İçin Programın Kapanıp. Güncelleme Programının Açılması Gerekmektedir. Devam Etmek İster misiniz?','Dikkat...!',MB_YESNOCANCEL+MB_ICONWARNING);
DeleteFile('C:\Program Files\muhasebe\yeni.txt');
if a=mrYes then
begin
ShellExecute(0, nil, 'C:\Program Files\muhasebe\guncelle\Project1.exe', nil, nil, SW_SHOWDEFAULT);
Application.Terminate;
end;
end;
end;

burda ise get işlemini başlatma ve get işlemi ile gelen bilgiler ve çeşitli kontroller yapıldı.

[Sawyer]

bende idftp kullanıyordum fakat onu antivirüslerin firewallları engelliyor, bu yuzden idhttp yapıyorum firewallın engellemedigi bi yöntem gerekiyor... lütfen yardım edin..

@cevap

pek işime yaramasada cevabınız için teşekkürler