ERLEDIGT:Nach Updates prüfen

[theo]

Die Callback Funktion ist als procedure of object deklariert. Muss also eine Methode z.B. von TUpForm sein:
Bsp:
procedure TUpForm.SockCallBack(Sender: TObject; Reason: THookSocketReason;const Value: string);
begin
Val:=StrToIntDef(Value, -1);
end

Und THookSocketReason ist schon in blcksock deklariert, also nicht nochmal machen.

[ts230]

Jetzt geht es aber immer noch nicht :? :? :? :? :? :?
Jetzt sagt er er kann HTTPMethod nicht finden aber die Unit ist eingebunden;

Code: Alles auswählen

unit UpDateForm;
 
{$mode delphi}{$H+}
 
interface
 
uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
  Buttons, ComCtrls, ExtCtrls, memds, DbCtrls,httpsend,blcksock;
 
type
  { TUpForm }
{  THookSocketReason = (
    HR_ResolvingBegin,
    HR_ResolvingEnd,
    HR_SocketCreate,
    HR_SocketClose,
    HR_Bind,
    HR_Connect,
    HR_CanRead,
    HR_CanWrite,
    HR_Listen,
    HR_Accept,
    HR_ReadCount,
    HR_WriteCount,
    HR_Wait,
    HR_Error
    );}
 
  TUpForm = class(TForm)
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    Button1: TButton;
    CheckBox1: TCheckBox;
    Edit1: TEdit;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Memo1: TMemo;
    ProgressBar1: TProgressBar;
    ProgressBar2: TProgressBar;
    SelectDirectoryDialog1: TSelectDirectoryDialog;
    Timer1: TTimer;
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure CheckBox1Change(Sender: TObject);
    procedure CheckGroup1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure SockCallBack(Sender: TObject; Reason: THookSocketReason;const Value: string) register;
  private
    { private declarations }
  public
    { public declarations }
 
  end; 
 
var
  UpForm: TUpForm;
  BinOrt:String;
  Val:integer;
 
 
{ TUpForm }
implementation
 
procedure CopyFile(Source, Destination: string;Pbar:TProgressBar);
var
  FromF, ToF: file of byte;
  Buffer: array[0..4096] of char;
  NumRead: integer;
  FileLength: longint;
begin
  AssignFile(FromF, Source);
  reset(FromF);
  AssignFile(ToF, Destination);
  rewrite(ToF);
  FileLength := FileSize(FromF);
  with Pbar do
  begin
    Min := 0;
    Max := FileLength;
    while FileLength > 0 do
    begin
      BlockRead(FromF, Buffer[0], SizeOf(Buffer), NumRead);
      FileLength := FileLength - NumRead;
      BlockWrite(ToF, Buffer[0], NumRead);
      Position := Position + NumRead;
    end;
    CloseFile(FromF);
    CloseFile(ToF);
  end;
end;
 
procedure TUpForm.BitBtn2Click(Sender: TObject);
begin
  close;
end;
 
procedure TUpForm.SockCallBack(Sender: TObject; Reason: THookSocketReason;const Value: string);
begin
Val:=StrToIntDef(Value, -1);
end;
 
 
 procedure TUpForm.BitBtn1Click(Sender:TObject);
begin
 
 BitBtn1.Enabled:=false;
BitBtn2.Enabled:=false;
BitBtn3.Enabled:=false;
BitBtn4.Enabled:=false;
Edit1.Enabled:=false;
Button1.Enabled:=false;
CheckBox1.Enabled:=false;
ShowMessage('Folgende Dinge werden gemacht:'+#13+'Download der Software');
 
  Timer1.Enabled:=true;
 
  with THTTPSend.Create do
 
Sock.OnStatus := SockCallBack;
 
    begin
 
 
 
      if HTTPMethod('GET',BinOrt) then
 
 
 
      try
 
      Document.SaveToFile('TS');
 
 
      except
 
 
 
        MessageDlg('Fehler','Es konnte leider kein Download gestartet werden.',mtError,[mbOk],'');
 
 
 
      end;
 
 
 
    Free;
 
    end;
end;
 
 procedure TUpForm.BitBtn3Click(Sender:TObject);
begin
BitBtn1.Enabled:=false;
BitBtn2.Enabled:=false;
BitBtn3.Enabled:=false;
BitBtn4.Enabled:=false;
Edit1.Enabled:=false;
Button1.Enabled:=false;
CheckBox1.Enabled:=false;
ShowMessage('Folgende Dinge werden gemacht:'+#13+'Download der Software'+#13+'Installieren');
 If CheckBox1.Checked = true then
  begin
     try
        Application.ProcessMessages;
        CopyFile('feuerfiech.ini',Edit1.Text+'feuerfiech.ini',ProgressBar2);
     except
        MessageDlg('Fehler','Konnte feuerfiech.xml nicht kopieren'+#13+'Bitte probieren sie Manuelles Kopieren in den backup-Ordner.',mtError,[mbOk],'');
 
      end;
   ShowMessage('backup beendet.'+#13+'Starte verbleibende Aktionen...');
  end;
end;
 
procedure TUpForm.Button1Click(Sender: TObject);
begin
  SelectDirectoryDialog1.Execute;
  Edit1.text:=SelectDirectoryDialog1.FileName;
end;
 
procedure TUpForm.CheckBox1Change(Sender: TObject);
begin
  Edit1.Enabled:=CheckBox1.Checked;
    Button1.Enabled:=CheckBox1.Checked;
end;
 
procedure TUpForm.CheckGroup1Click(Sender: TObject);
begin
 
end;
 
procedure TUpForm.FormCreate(Sender: TObject);
begin
 
end;
 
procedure TUpForm.FormShow(Sender: TObject);
 
 var t:TStringList;
 i:integer;
begin
BitBtn1.Enabled:=true;
BitBtn2.Enabled:=true;
BitBtn3.Enabled:=true;
BitBtn4.Enabled:=true;
 
Edit1.Enabled:=true;
Button1.Enabled:=true;
CheckBox1.Enabled:=true;
 memo1.Clear;
 
  with THTTPSend.Create do
 
    begin
 
      if HTTPMethod('GET','http://tiersendung.ti.funpic.de/tristan/territorium_desc.txt') then
 
      try
 
        t:= TStringList.Create;
 
        t.LoadFromStream(Document);
        i:=0;
Application.ProcessMessages;
For i:=0 to 50 do
Memo1.Lines.Add(t.Strings[i]);
 
 
      except
 
        MessageDlg('Fehler','Es konnte keine Verbindung zum Internet hergestellt werden.',mtError,[mbOk],'');
 
 
      end;
 
      Label3.Caption:='0/'+t.Strings[51]+' Kb';
      BinOrt:=t.Strings[53];
      try
Progressbar1.max:=strtoint(t.Strings[52]);
 
except
 
        MessageDlg('Fehler','Die Datei ist falsch aufgebaut.'+#13+'Das bedeutet,das die Fortschrittsanzeige nicht gehen wird.',mtError,[mbOk],'');
 
 
      end;
 
    t.Free;
    Free;
    end;
end;
 
procedure TUpForm.Timer1Timer(Sender: TObject);
begin
  Timer1.Interval:=30;
  ProgressBar1.Position:=Val;
end;
 
initialization
  {$I updateform.lrs}
 
end.

[Christian]

HTTPMethod ist keine Unit, manchmal hilfts den eigenen Code zu lesen bevor man Postet

[ts230]

ja aber er Findet die Funktion HTTPMethod nur an dieser Stelle nich t

[ts230]

Ich weiß jetzt wiso es niicht geht:
Ich hab das CallBack vor dem begin gemacht

[ts230]

Nachtrag:
Die ProgressBar geht nicht
Wenn ich auf "Download" klicke,wird es zwar auch runtergeladen,aber ich seh nichts In der ProgressBar(immer auf 0).
Weiß jemand was das Problem ist?
Ich mache ja auch

Code: Alles auswählen

ProgressBar1.Position:=Val div 1024;//Val sind Bytes?

[shokwave]

Schwer zu sagen..

Wo machst du das? Im Timer? Is der auch gestartet?

[theo]

Application.ProcessMessages;

[ts230]

ich hab Application.ProcessMessages jetzt in den Timer und vor das Download gepackt und es geht net.
Der Timer ist gestartet und het als Intervall 50ms
In der ProgressBar schwankts immer zwischen 1 und 55 als Wert.
Wenn er fertig ist,steht es auf 0

[theo]

Manno, wie wär's wenn du mal selber ein bisschen schauen würdest?
Lass dir mal ausgeben, was Value und Reason überhaupt zurückgeben.
Nach Reason unterscheidest du gar nicht. Zählt Value überhaupt hoch oder gibt der immer nur die Chunkgrösse zurück? Schau nochmal hier: http://synapse.ararat.cz/doku.php/public:howto:onstatus
Und meld dich morgen wieder...

[ts230]

Es geht :freu:
Ich muss den HTTPSend global zur Verfügung stellen.
Dann gehts auch...