Autor Beitrag
G-man
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 258

Win 2000, Win ME, SuSE 8.2
D5 Standard, D6 Professional
BeitragVerfasst: Di 08.04.03 16:49 
Ahoi,
ich hab ein Problem...
Ich will mit der Funktion urlDownloadToFile(...) eine Datei aus dem Internet ziehen.
Das funktioniert auch schon seit ein paar Monaten.
Aber:
Wie kann ich da ein Progressbar einbinden?
Wär` toll wenn mir einer weiterhelfen könnte :idea: .

G-man
Luncustaf
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 324

Win 2k
D7 Ent.
BeitragVerfasst: Di 08.04.03 17:15 
du musst die größe der datei ermitteln und dann

ausblenden Quelltext
1:
progress1.max := recievedfilesize					


setzen dann musste pro runtergeladenes byte de progressbar erhöhen - genauen code kann ich dir aussem kopf nicht geben aber hier im forum gibt es nen beispiel dazu such mal danach


gr€€tz
matze
ontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic starofftopic star
Beiträge: 4613
Erhaltene Danke: 24

XP home, prof
Delphi 2009 Prof,
BeitragVerfasst: Di 08.04.03 17:57 
so einfach geht das nicht, denn UrlMON greift auf die IE biliotheken zu. und denen abzuluchsen, wieviel sie schon runtergeladen haben geht nicht so einfach.

du kannst auch nicht einfach abfragen, wie gross die datei schon ist, denn die IE routine lädt das erst mal in den Cache.
deswegen geht das runterladen ein und derselben datei mehrmals hintereinander auch so schnell - die wird nur auch dem cache geladen.

_________________
In the beginning was the word.
And the word was content-type: text/plain.
Cashels
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 167



BeitragVerfasst: Di 08.04.03 18:39 
Hallo,

hab ich modeliert aus der httpGet Komponente. Weiss nicht mehr wo ich die her hatte.

Gruss,
Tom

PS: Als Extrasahnehäufchen kannst du sogar Datei aus passwortgeschützten Verzeichnissen runterladen. (Stichwort .htaccess)

Gruss,
Tom

ausblenden volle Höhe Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
procedure TPingThread.DownloadFileFromURL (SourceURL : string ;
                                           Destination : string ;
                                           Username : string ;
                                           Password : string ) ;
var
  hSession, hConnect, hRequest: hInternet;
  HostName, FileName: String;
  f: File;
  Buf: Pointer;
  dwBufLen, dwIndex: DWord;
  Data: Array[0..$400] of Char;
  TempStr: String;
  RequestMethod: PChar;
  InternetFlag: DWord;
  AcceptType: LPStr;

  SL : TStringList ;

  procedure ParseURL(URL: String; var HostName, FileName: String);

    procedure ReplaceChar(c1, c2: Char; var St: String);
    var
      p: Integer;
    begin
      while True do
       begin
        p := Pos(c1, St);
        if p = 0 then Break
        else St[p] := c2;
       end;
    end;

  var
    i: Integer;
  begin
    if Pos('http://', LowerCase(URL)) <> 0 then
      System.Delete(URL, 1, 7);

    i := Pos('/', URL);
    HostName := Copy(URL, 1, i);
    FileName := Copy(URL, i, Length(URL) - i + 1);

    if (Length(HostName) > 0) and (HostName[Length(HostName)] = '/') then
      SetLength(HostName, Length(HostName) - 1);
  end;

 procedure CloseHandles;
 begin
   InternetCloseHandle(hRequest);
   InternetCloseHandle(hConnect);
   InternetCloseHandle(hSession);
 end;

begin
     if ProgressID > 0
     then EventNr := csDownloadStart ;
     FFileName := Destination ;

     FAcceptTypes := '*/*' ;
     FAgent := 'Delphi 4 HTTPGet' ;
     FBinaryData := true ;
     FUseCache := false ;
     FURL := SourceURL ;
     FFileName :=  Destination ;
     FUsername := Username ;
     FPassword := Password ;
     FPostQuery := '' ;
     FReferer := '' ;
     FToFile := true ;

     { Eigentlicher Download }
     FResult := false ;
     try
        ParseURL(FURL, HostName, FileName);

        if FAgent <> '' then
         hSession := InternetOpen(PChar(FAgent),
           INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0)
        else
         hSession := InternetOpen(nil,
           INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

        hConnect := InternetConnect(hSession, PChar(HostName),
          INTERNET_DEFAULT_HTTP_PORT, PChar(FUserName), PChar(FPassword), INTERNET_SERVICE_HTTP, 0, 0);

        if FPostQuery = '' then RequestMethod := 'GET'
        else RequestMethod := 'POST';

        if FUseCache then InternetFlag := 0
        else InternetFlag := INTERNET_FLAG_RELOAD;

        AcceptType := PChar('Accept: ' + FAcceptTypes);
        hRequest := HttpOpenRequest(hConnect, RequestMethod, PChar(FileName), 'HTTP/1.0',
                    PChar(FReferer), @AcceptType, InternetFlag, 0);

        if FPostQuery = '' then
         HttpSendRequest(hRequest, nil, 0, nil, 0)
        else
         HttpSendRequest(hRequest, 'Content-Type: application/x-www-form-urlencoded', 47,
                         PChar(FPostQuery), Length(FPostQuery));

        if Terminated then
         begin
          CloseHandles;
          FResult := False;
          Exit;
         end;

        dwIndex  := 0;
        dwBufLen := 1024;
        GetMem(Buf, dwBufLen);

        FResult := HttpQueryInfo(hRequest, HTTP_QUERY_CONTENT_LENGTH,
                                  Buf, dwBufLen, dwIndex);

        if Terminated then
         begin
          FreeMem(Buf);
          CloseHandles;     
          FResult := False;
          Exit;
         end;

        if FResult or not FBinaryData then
         begin
          if FResult then
            FFileSize := StrToInt(StrPas(Buf));

          BytesReaded := 0;

          if FToFile then
           begin
            AssignFile(f, FFileName);
            Rewrite(f, 1);
           end ;

          while True do
           begin
            if Terminated then
             begin
              if FToFile then CloseFile(f);
              FreeMem(Buf);
              CloseHandles;

              FResult := False;
              Exit;
             end;

            if not InternetReadFile(hRequest, @Data, SizeOf(Data), BytesToRead) then Break
            else
             if BytesToRead = 0 then Break
             else
              begin
               if FToFile then begin
                BlockWrite(f, Data, BytesToRead) ;
               end else begin
                TempStr := Data;
                SetLength(TempStr, BytesToRead);
               end;

               inc(BytesReaded, BytesToRead);
               FTotalSize := FFileSize ;
               FReaded := BytesReaded ;

               // PROGRESSBAR HIER SETZEN

              end;
           end;

          if FToFile then
            FResult := FFileSize = Integer(BytesReaded)
          else
           begin
            FResult := BytesReaded <> 0;
           end;

          if FToFile then CloseFile(f);
         end;

        FreeMem(Buf);

        CloseHandles;
     except
     end;
end ;
G-man Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 258

Win 2000, Win ME, SuSE 8.2
D5 Standard, D6 Professional
BeitragVerfasst: Do 10.04.03 11:57 
Titel: Danke
Cool...
Vielen Dank für die vielen Tipps.
:!: Ich probier`s mal aus und werde sehen ob die Tipps sich eignen.

thnx for all posts:

G-man 8)
G-man Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 258

Win 2000, Win ME, SuSE 8.2
D5 Standard, D6 Professional
BeitragVerfasst: Mo 14.04.03 17:31 
Hab's ausprobiert, funktioniert, aber hätte jemand noch ein Beispiel für URLDownloadToFile et Progressbar??
Wär`.net.

G-Man