Download

der skal vare ikke være de showmessage

hvad er det der ikke virker. Får du en fejl, og er det compile - eller runtime?

Der er fejl i disse linier:

if DownloadFile('http://www.server.dk/fil.txt, C:\Fil.txt) then
  ShowMessage('Filen er downloaded.');
else
  ShowMessage('Kunne ikke downloade filen.';

Skal være:

if DownloadFile('http://www.server.dk/fil.txt, C:\Fil.txt) then
  ShowMessage('Filen er downloaded.')
else
  ShowMessage('Kunne ikke downloade filen.)';

Kunne måske være fejlen...

DOO.

Denne linie "ShowMessage('Kunne ikke downloade filen.)';" skal være "ShowMessage('Kunne ikke downloade filen.');"

Man skal huske at afslutte filnavnet med en '

if DownloadFile('http://www.server.dk/fil.txt', C:\Fil.txt) then
  ShowMessage('Filen er downloaded.');
else
  ShowMessage('Kunne ikke downloade filen.';

der skal vel også pinger omkring c:\fil.txt

har ikke fået hvad jeg vil ha

Det kan måske hjælpe at præcisere det lidt.

jeg skal kunne hente http://www.worldcraftguide.1go.dk/sprites.zip fra en button men man kna ikke hente fra det link (som er korekt) men skal ind på siden og trykke på linket for at hente det

Fint nok, men hvilken fejl får du?

prøv at tryk på linket

Det har jeg prøvet, så får jeg en zip-fil

prøv at hent den

tror det virker nu

Jeg har hentet den. Den indeholder 8 filer

denher virker ikke
Webbrowser1.Navigate('http://www.worldcraftguide.1go.dk/sprites.zip');

kan du lave en kode der henter den når man trykker på en button (ikke den anden kode der er skrevet 3-4 gange)

nico22> er du smuttet. hvis du ikke svar inden 5 min bliver dette spm lukket

URLDownloadToFile(nil, 'http://www.worldcraftguide.1go.dk/sprites.zip',
    'c:\windows\skrivebord\Test.zip', 0, nil);

husk UrlMon i uses

nico22> kan du lave så at når man trykker på knappen kommer der et nyt vindu hvor der er en progressbar der viser hvor meget der er hentet

så får du 15 point mere

og når den har hentet lukket vinduet igen

ej 30 point mere

vil gerne ha at den henter til mappen hvor programmet ligger i mappen downloads

Jeg kan lave sådan at man kan vælge hvilken mappe det skal kopieres til. Det med progressbaren tror jeg ikke er så nemt :(

man skal ikke kunne selv vælge jeg har skrevet MKDir('Downloads'); hvor tingene der er blevet hentet bliver lagt

og det er en undermappe til den mappe hvori programmet ligger?

det kan være foreskelligt hvor programmet ligger fx c:\tst eller d:\mkz så hvis vi tager c:\tst og køre programmet laves der en dir Downloads hvor filerne bliver lagt

dvs. c:\tst\downloads eller hvad?

ja Downloads er en undermap til der hvor programmet er

ja c:\tst\downloads

okay - jeg tror måske jeg kan lave det med progressbaren, men du må have lidt tålmodighed

ok

læg en progressbar på formen og test denne kode

uses
  UrlMon, ActiveX;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
const
  BufSize = 1024; //1 KB
var
  Stm            : IStream;
  Buffer        : Pointer;
  BytesRead      : Integer;
  TotalBytesRead : Integer;
  Dest          : TStream;
  Stat          : TStatStg;
begin
  URLOpenBlockingStream(nil, 'http://www.worldcraftguide.1go.dk/sprites.zip',
    Stm, 0, nil);

  if Stm = nil then
    Exit;

  ProgressBar1.Position := 0;
  Stm.Stat(Stat, 0);
  TotalBytesRead := 0;

  Dest := TFileStream.Create('c:\windows\skrivebord\test.zip', fmOpenRead or fmCreate);
  GetMem(Buffer, BufSize);
  try
    repeat
      Stm.Read(Buffer, BufSize, @BytesRead);
      Dest.Write(Buffer^, BytesRead);
      Inc(TotalBytesRead, BytesRead);
      ProgressBar1.Position := Trunc((TotalBytesRead / Stat.cbSize) * ProgressBar1.Max);
      Application.ProcessMessages;
    until BytesRead <> BufSize;
  finally
    FreeMem(Buffer, BufSize);
    Dest.Free;
  end;
end;

const
  BufSize = 1024; //1 KB
var
  Stm            : IStream;
  Buffer        : Pointer;
  BytesRead      : Integer;
  TotalBytesRead : Integer;
  Dest          : TStream;
  Stat          : TStatStg;
begin
  URLOpenBlockingStream(nil, 'http://www.worldcraftguide.1go.dk/sprites.zip',
    Stm, 0, nil);

  if Stm = nil then
    Exit;

  ProgressBar1.Position := 0;
  Stm.Stat(Stat, 0);
  TotalBytesRead := 0;

  Dest := TFileStream.Create('c:\windows\skrivebord\test.zip', fmOpenRead or fmCreate);
  GetMem(Buffer, BufSize);
  try
    repeat
      Stm.Read(Buffer, BufSize, @BytesRead);
      Dest.Write(Buffer^, BytesRead);
      Inc(TotalBytesRead, BytesRead);
      ProgressBar1.Position := Trunc((TotalBytesRead / Stat.cbSize) * ProgressBar1.Max);
      Application.ProcessMessages;
    until BytesRead <> BufSize;
  finally
    FreeMem(Buffer, BufSize);
    Dest.Free;

den gemmer ikke i undermappen Downloads

var
  AppPath  : string;
  Downloads : string;
begin
  AppPath := ExtractFilePath(ParamStr(0));
  Downloads := ForceDirectories(AppPath + 'Downloads');

hov - glem det jeg lige postede

kan du ikke lige sette det sammen

const
  BufSize = 1024; //1 KB
var
  AppPath        : string;
  Downloads      : string;
  Stm            : IStream;
  Buffer        : Pointer;
  BytesRead      : Integer;
  TotalBytesRead : Integer;
  Dest          : TStream;
  Stat          : TStatStg;
begin
  AppPath := ExtractFilePath(ParamStr(0));
  ForceDirectories(AppPath + 'Downloads');
  Downloads := AppPath + 'DownLoads\';

  URLOpenBlockingStream(nil, 'http://www.worldcraftguide.1go.dk/sprites.zip',
    Stm, 0, nil);

  if Stm = nil then
    Exit;

  ProgressBar1.Position := 0;
  Stm.Stat(Stat, 0);
  TotalBytesRead := 0;

  Dest := TFileStream.Create(Downloads + 'Test.zip', fmOpenRead or fmCreate);
  GetMem(Buffer, BufSize);
  try
    repeat
      Stm.Read(Buffer, BufSize, @BytesRead);
      Dest.Write(Buffer^, BytesRead);
      Inc(TotalBytesRead, BytesRead);
      ProgressBar1.Position := Trunc((TotalBytesRead / Stat.cbSize) * ProgressBar1.Max);
      Application.ProcessMessages;
    until BytesRead <> BufSize;
  finally
    FreeMem(Buffer, BufSize);
    Dest.Free;
  end;

tak men har et spm mere hvordan laver man et clean på den progressbar (progressbar.clear noget)

alså når den har hentet går der 2 sec og så fjernes de blå streger

ProgressBar.Position := 0;

dooh det kunne jeg have sagt mig selv :)

er noob til delphi men er det noget ligene

    if ProgressBar1.Position := 100 then
    ProgressBar.Position := 0

if ProgressBar1.Position := 100 then
  ProgressBar.Position := 0

sorry

if ProgressBar1.Position = 100 then
  ProgressBar.Position := 0

if ProgressBar1.Position = 100 then
  ProgressBar1.Position := 0

hvordan jeg jeg gøre så at der går 2 sec før den går til 0 (måske noget med en timer)

tror jeg har fundet ud af det

if ProgressBar1.Position = 100 then
timer1.visible := true else
timer1.visible := false

upz ikke visible men enabled

har du icq

hvis jeg laver den om så den henter en anden fil på lidt over 2 mb går programmet i stå

prøv at sætte BufSize til noget mere.

har du icq

Nej

email

hvad sker der hvis man setter bufsite højre\laver (hvad gør det godt for)

hvad skal jeg sette den til

email nico@pc.dk

Jeg har fundet ud af hvorfor det går i stå. Det er fordi kaldet til URLOpenBlockingStream blokerer indtil hele filen er downloaded. Jeg prøver lige at finde ud af noget andet.

er du død?

nope - jeg arbejder på sagen. Det kan tage lidt tid da det er lidt tricky

ok

Jeg har postet hele uniten


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, UrlMon, ActiveX;

type
  TForm1 = class(TForm)
    ProgressBar1: TProgressBar;
    Button4: TButton;
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TStatusCallback = class(TInterfacedObject, IBindStatusCallback)
  private
    FDest    : TStream;
    FProgress : TProgressBar;
  protected
    { IBindStatusCallback methods}
    function OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult; stdcall;
    function GetPriority(out nPriority): HResult; stdcall;
    function OnLowResource(reserved: DWORD): HResult; stdcall;
    function OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG;
      szStatusText: LPCWSTR): HResult; stdcall;
    function OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult; stdcall;
    function GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult; stdcall;
    function OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc;
      stgmed: PStgMedium): HResult; stdcall;
    function OnObjectAvailable(const iid: TGUID; punk: IUnknown): HResult; stdcall;

  public
    constructor Create(const AFileName : string; AProgress: TProgressBar);
    destructor Destroy; override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TStatusCallback }

constructor TStatusCallback.Create(const AFileName: string;
  AProgress: TProgressBar);
begin
  inherited Create;

  FDest    := TFileStream.Create(AFileName, fmOpenRead or fmCreate);
  FProgress := AProgress;
end;

destructor TStatusCallback.Destroy;
begin
  FDest.Free;
  inherited;
end;

function TStatusCallback.GetBindInfo(out grfBINDF: DWORD;
  var bindinfo: TBindInfo): HResult;
begin
  Result := S_OK;
end;

function TStatusCallback.GetPriority(out nPriority): HResult;
begin
  Result := S_OK;
end;

function TStatusCallback.OnDataAvailable(grfBSCF, dwSize: DWORD;
  formatetc: PFormatEtc; stgmed: PStgMedium): HResult;
var
  Buffer : Pointer;
  BytesRead : Integer;
begin
  if formatetc^.tymed <> TYMED_ISTREAM then
  begin
    Result := E_INVALIDARG;
    Exit;
  end;

  GetMem(Buffer, dwSize);
  try
    IStream(stgmed^.stm).Read(Buffer, dwSize, @BytesRead);
    FDest.Write(Buffer^, BytesRead);
  finally
    FreeMem(Buffer, dwSize);
  end;

  Result := S_OK;
end;

function TStatusCallback.OnLowResource(reserved: DWORD): HResult;
begin
  Result := S_OK;
end;

function TStatusCallback.OnObjectAvailable(const iid: TGUID;
  punk: IInterface): HResult;
begin
  Result := S_OK;
end;

function TStatusCallback.OnProgress(ulProgress, ulProgressMax,
  ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult;
begin
  Result := S_OK;

  with FProgress do
  begin
    if ulProgressMax = 0 then
      Exit;

    Position := Trunc((ulProgress / ulProgressMax) * Max);
  end;
end;

function TStatusCallback.OnStartBinding(dwReserved: DWORD;
  pib: IBinding): HResult;
begin
  Result := S_OK;
end;

function TStatusCallback.OnStopBinding(hresult: HResult;
  szError: LPCWSTR): HResult;
begin
  with FProgress do
    Position := Max;

  Result := S_OK;
end;

procedure TForm1.Button4Click(Sender: TObject);
const
  URL = 'http://www.worldcraftguide.1go.dk/sprites.zip';
var
  AppPath        : string;
  Downloads      : string;
begin
  AppPath := ExtractFilePath(ParamStr(0));
  ForceDirectories(AppPath + 'Downloads');
  Downloads := AppPath + 'DownLoads\';

  URLOpenStream(nil, URL, 0, TStatusCallback.Create(Downloads + 'Test.zip', ProgressBar1));
end;

end.

kommer en fejl ved TForm1 = class(TForm) (linien bliver rød)

hvad hedder fejlen

duno linien er bare rød

const
  BufSize = 1024; //1 KB
var
  AppPath        : string;
  Downloads      : string;
  Stm            : IStream;
  Buffer        : Pointer;
  BytesRead      : Integer;
  TotalBytesRead : Integer;
  Dest          : TStream;
  Stat          : TStatStg;
begin
  AppPath := ExtractFilePath(ParamStr(0));
  ForceDirectories(AppPath + 'Downloads');
  Downloads := AppPath + 'DownLoads\';

  URLOpenBlockingStream(nil, 'http://www.worldcraftguide.1go.dk/worldcraft3',
    Stm, 0, nil);

  if Stm = nil then
    Exit;

  ProgressBar1.Position := 0;
  Stm.Stat(Stat, 0);
  TotalBytesRead := 0;

  Dest := TFileStream.Create(Downloads + 'WorldCraft3.exe', fmOpenRead or fmCreate);
  GetMem(Buffer, BufSize);
  try
    repeat
      Stm.Read(Buffer, BufSize, @BytesRead);
      Dest.Write(Buffer^, BytesRead);
      Inc(TotalBytesRead, BytesRead);
      ProgressBar1.Position := Trunc((TotalBytesRead / Stat.cbSize) * ProgressBar1.Max);
      Application.ProcessMessages;
if ProgressBar1.Position = 100 then
timer1.enabled := true else
timer1.enabled := false

    until BytesRead <> BufSize;
  finally
    FreeMem(Buffer, BufSize);
    Dest.Free;

hvis jeg fjerner overståne kode er der en linie der bliver rød og jeg kan ikke starte programmet

det er linien end;

nede i bunden af kode editoren skulle der gerne være en fejl meddelelse

ahh, det er fordi du har slettet begin

[Error] Unit1.pas(88): Local class, interface or object types not allowed

fandt ud af det men har sat den nye kode ind men i TForm1 = class(TForm)  kommer der en fejl [Error] Unit1.pas(88): Local class, interface or object types not allowed

prøv i stedet at oprette et nyt projekt, og paste min kode ind i unit1

jeg har lavet et program og vil ikke starte forefra

så må du tage een bid ad gangen. Start med TStatusCallback

du kan evt. maile din unit til mig, så kan jeg prøve at klistre det sammen.

hvafor en fisk?

TStatusCallback er den klasse der er erklæret under TForm1

unit1:

unit Unit1;

interface

uses
  Windows, URLMon, ActiveX, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, SHDocVw, ComCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    GroupBox3: TGroupBox;
    WebBrowser1: TWebBrowser;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    Button10: TButton;
    Button11: TButton;
    ProgressBar1: TProgressBar;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Unit2, Unit3;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
Form2.ShowModal

end;

procedure TForm1.Button8Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
WebBrowser1.Stop;
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
Webbrowser1.Navigate('http://www.eksperten.dk');

end;

procedure TForm1.Button10Click(Sender: TObject);
begin
Form3.ShowModal
end;

procedure TForm1.Button11Click(Sender: TObject);
begin
WebBrowser1.Refresh;
end;

procedure TForm1.Button4Click(Sender: TObject);

type
  TForm1 = class(TForm)
    ProgressBar1: TProgressBar;
    Button4: TButton;
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TStatusCallback = class(TInterfacedObject, IBindStatusCallback)
  private
    FDest    : TStream;
    FProgress : TProgressBar;
  protected
    { IBindStatusCallback methods}
    function OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult; stdcall;
    function GetPriority(out nPriority): HResult; stdcall;
    function OnLowResource(reserved: DWORD): HResult; stdcall;
    function OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG;
      szStatusText: LPCWSTR): HResult; stdcall;
    function OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult; stdcall;
    function GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult; stdcall;
    function OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc;
      stgmed: PStgMedium): HResult; stdcall;
    function OnObjectAvailable(const iid: TGUID; punk: IUnknown): HResult; stdcall;

  public
    constructor Create(const AFileName : string; AProgress: TProgressBar);
    destructor Destroy; override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TStatusCallback }

constructor TStatusCallback.Create(const AFileName: string;
  AProgress: TProgressBar);
begin
  inherited Create;

  FDest    := TFileStream.Create(AFileName, fmOpenRead or fmCreate);
  FProgress := AProgress;
end;

destructor TStatusCallback.Destroy;
begin
  FDest.Free;
  inherited;
end;

function TStatusCallback.GetBindInfo(out grfBINDF: DWORD;
  var bindinfo: TBindInfo): HResult;
begin
  Result := S_OK;
end;

function TStatusCallback.GetPriority(out nPriority): HResult;
begin
  Result := S_OK;
end;

function TStatusCallback.OnDataAvailable(grfBSCF, dwSize: DWORD;
  formatetc: PFormatEtc; stgmed: PStgMedium): HResult;
var
  Buffer : Pointer;
  BytesRead : Integer;
begin
  if formatetc^.tymed <> TYMED_ISTREAM then
  begin
    Result := E_INVALIDARG;
    Exit;
  end;

  GetMem(Buffer, dwSize);
  try
    IStream(stgmed^.stm).Read(Buffer, dwSize, @BytesRead);
    FDest.Write(Buffer^, BytesRead);
  finally
    FreeMem(Buffer, dwSize);
  end;

  Result := S_OK;
end;

function TStatusCallback.OnLowResource(reserved: DWORD): HResult;
begin
  Result := S_OK;
end;

function TStatusCallback.OnObjectAvailable(const iid: TGUID;
  punk: IInterface): HResult;
begin
  Result := S_OK;
end;

function TStatusCallback.OnProgress(ulProgress, ulProgressMax,
  ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult;
begin
  Result := S_OK;

  with FProgress do
  begin
    if ulProgressMax = 0 then
      Exit;

    Position := Trunc((ulProgress / ulProgressMax) * Max);
  end;
end;

function TStatusCallback.OnStartBinding(dwReserved: DWORD;
  pib: IBinding): HResult;
begin
  Result := S_OK;
end;

function TStatusCallback.OnStopBinding(hresult: HResult;
  szError: LPCWSTR): HResult;
begin
  with FProgress do
    Position := Max;

  Result := S_OK;
end;

procedure TForm1.Button4Click(Sender: TObject);
const
  URL = 'http://www.worldcraftguide.1go.dk/sprites.zip';
var
  AppPath        : string;
  Downloads      : string;
begin
  AppPath := ExtractFilePath(ParamStr(0));
  ForceDirectories(AppPath + 'Downloads');
  Downloads := AppPath + 'DownLoads\';

  URLOpenStream(nil, URL, 0, TStatusCallback.Create(Downloads + 'Test.zip', ProgressBar1));
end;


end;

procedure TForm1.Button6Click(Sender: TObject);
const
  BufSize = 1024; //1 KB
var
  AppPath        : string;
  Downloads      : string;
  Stm            : IStream;
  Buffer        : Pointer;
  BytesRead      : Integer;
  TotalBytesRead : Integer;
  Dest          : TStream;
  Stat          : TStatStg;
begin
  AppPath := ExtractFilePath(ParamStr(0));
  ForceDirectories(AppPath + 'Downloads');
  Downloads := AppPath + 'DownLoads\';

  URLOpenBlockingStream(nil, 'http://www.worldcraftguide.1go.dk/sprites.zip',
    Stm, 0, nil);

  if Stm = nil then
    Exit;

  ProgressBar1.Position := 0;
  Stm.Stat(Stat, 0);
  TotalBytesRead := 0;

  Dest := TFileStream.Create(Downloads + 'Test.zip', fmOpenRead or fmCreate);
  GetMem(Buffer, BufSize);
  try
    repeat
      Stm.Read(Buffer, BufSize, @BytesRead);
      Dest.Write(Buffer^, BytesRead);
      Inc(TotalBytesRead, BytesRead);
      ProgressBar1.Position := Trunc((TotalBytesRead / Stat.cbSize) * ProgressBar1.Max);
      Application.ProcessMessages;
if ProgressBar1.Position = 100 then
ShowMessage('Finen er hentet') else
timer1.enabled := true


    until BytesRead <> BufSize;
  finally
    FreeMem(Buffer, BufSize);
    Dest.Free;
end;
end;
procedure TForm1.Button5Click(Sender: TObject);
const
  BufSize = 10024; //1 KB
var
  AppPath        : string;
  Downloads      : string;
  Stm            : IStream;
  Buffer        : Pointer;
  BytesRead      : Integer;
  TotalBytesRead : Integer;
  Dest          : TStream;
  Stat          : TStatStg;
begin
  AppPath := ExtractFilePath(ParamStr(0));
  ForceDirectories(AppPath + 'Downloads');
  Downloads := AppPath + 'DownLoads\';

  URLOpenBlockingStream(nil, 'http://www.worldcraftguide.1go.dk/worldcraft3.exe',
    Stm, 0, nil);

  if Stm = nil then
    Exit;

  ProgressBar1.Position := 0;
  Stm.Stat(Stat, 0);
  TotalBytesRead := 0;

  Dest := TFileStream.Create(Downloads + 'worldcraft3.exe', fmOpenRead or fmCreate);
  GetMem(Buffer, BufSize);
  try
    repeat
      Stm.Read(Buffer, BufSize, @BytesRead);
      Dest.Write(Buffer^, BytesRead);
      Inc(TotalBytesRead, BytesRead);
      ProgressBar1.Position := Trunc((TotalBytesRead / Stat.cbSize) * ProgressBar1.Max);
      Application.ProcessMessages;
if ProgressBar1.Position = 100 then
timer1.enabled := true else
timer1.enabled := false

    until BytesRead <> BufSize;
  finally
    FreeMem(Buffer, BufSize);
    Dest.Free;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
ProgressBar1.Position :=0
end;

end.

hvor gammel er du?

du mangler klasseerklæringen af TStatusCallback. Sæt den ind efter TForm1

type
  TForm1 = class(TForm)
    ProgressBar1: TProgressBar;
    Button4: TButton;
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TStatusCallback = class(TInterfacedObject, IBindStatusCallback)
  private
    FDest    : TStream;
    FProgress : TProgressBar;
  protected
    { IBindStatusCallback methods}
    function OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult; stdcall;
    function GetPriority(out nPriority): HResult; stdcall;
    function OnLowResource(reserved: DWORD): HResult; stdcall;
    function OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG;
      szStatusText: LPCWSTR): HResult; stdcall;
    function OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult; stdcall;
    function GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult; stdcall;
    function OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc;
      stgmed: PStgMedium): HResult; stdcall;
    function OnObjectAvailable(const iid: TGUID; punk: IUnknown): HResult; stdcall;

  public
    constructor Create(const AFileName : string; AProgress: TProgressBar);
    destructor Destroy; override;
  end;

Jeg er 24

kom til at slette filen project1 (over skrive den) brugerfladen hvad gør jeg

skal jeg starte forefra med hele mit program så?

Har du fået det til at køre?

upz du får lige 30 mere som lovet http://www.eksperten.dk/spm/238278