Sign in Join
Wiki copytemporary

Download from SourceForge/fr: what changed

Revision 2 to 3. Removed lines have a minus sign; added lines have a plus sign.

OldNewLine
1-Vous pouvez utiliser la bibliothèque de communication réseau [[Synapse]] pour télécharger les fichiers depuis SourceForge. Parce que SourceForge stocke les fichiers sur de multiples mirroirs, vous devez traiter les redirections.
2-```
1+Vous pouvez utiliser la bibliothèque de communication réseau [[Synapse]] pour télécharger les fichiers depuis SourceForge. Parce que SourceForge stocke les fichiers sur de multiples mirroirs, vous devez traiter les redirections.
2+
3+``` pascal
34...
4- uses httpsend {a Synapse unit}
5- ...
6- function DownloadHTTPStream(URL: string; Buffer: TStream): boolean;
7- // Download file; retry if necessary.
8- const
9- MaxRetries = 3;
10- var
11- RetryAttempt: integer;
12- HTTPGetResult: boolean;
5+uses httpsend {a Synapse unit}
6+...
7+function DownloadHTTPStream(URL: string; Buffer: TStream): boolean;
8+ // Download file; retry if necessary.
9+const
10+ MaxRetries = 3;
11+var
12+ RetryAttempt: integer;
13+ HTTPGetResult: boolean;
14+begin
15+ Result:=false;
16+ RetryAttempt := 1;
17+ HTTPGetResult := False;
18+ while ((HTTPGetResult = False) and (RetryAttempt < MaxRetries)) do
19+ begin
20+ HTTPGetResult := HttpGetBinary(URL, Buffer);
21+ //Application.ProcessMessages;
22+ Sleep(100 * RetryAttempt);
23+ RetryAttempt := RetryAttempt + 1;
24+ end;
25+ if HTTPGetResult = False then
26+ raise Exception.Create('Cannot load document from remote server');
27+ Buffer.Position := 0;
28+ if Buffer.Size = 0 then
29+ raise Exception.Create('Downloaded document is empty.');
30+ Result := True;
31+end;
32+
33+function SFDirectLinkURL(URL: string; Document: TMemoryStream): string;
34+{
35+Transform this part of the body:
36+<noscript>
37+<meta http-equiv="refresh" content="5; url=http://downloads.sourceforge.net/project/base64decoder/base64decoder/version%202.0/b64util.zip?r=&amp;ts=1329648745&amp;use_mirror=kent">
38+</noscript>
39+into a valid URL:
40+http://downloads.sourceforge.net/project/base64decoder/base64decoder/version%202.0/b64util.zip?r=&amp;ts=1329648745&amp;use_mirror=kent
41+}
42+const
43+ Refresh='<meta http-equiv="refresh"';
44+ URLMarker='url=';
45+var
46+ Counter: integer;
47+ HTMLBody: TStringList;
48+ RefreshStart: integer;
49+ URLStart: integer;
50+begin
51+ HTMLBody:=TStringList.Create;
52+ try
53+ HTMLBody.LoadFromStream(Document);
54+ for Counter:=0 to HTMLBody.Count-1 do
1355 begin
14- Result:=false;
15- RetryAttempt := 1;
16- HTTPGetResult := False;
17- while ((HTTPGetResult = False) and (RetryAttempt < MaxRetries)) do
56+ // This line should be between noscript tags and give the direct download locations:
57+ RefreshStart:=Ansipos(Refresh, HTMLBody[Counter]);
58+ if RefreshStart>0 then
1859 begin
19- HTTPGetResult := HttpGetBinary(URL, Buffer);
20- //Application.ProcessMessages;
21- Sleep(100 * RetryAttempt);
22- RetryAttempt := RetryAttempt + 1;
23- end;
24- if HTTPGetResult = False then
25- raise Exception.Create('Cannot load document from remote server');
26- Buffer.Position := 0;
27- if Buffer.Size = 0 then
28- raise Exception.Create('Downloaded document is empty.');
29- Result := True;
30- end;
31-
32- function SFDirectLinkURL(URL: string; Document: TMemoryStream): string;
33- {
34- Transform this part of the body:
35- <noscript>
36- <meta http-equiv="refresh" content="5; url=http://downloads.sourceforge.net/project/base64decoder/base64decoder/version%202.0/b64util.zip?r=&amp;ts=1329648745&amp;use_mirror=kent">
37- </noscript>
38- into a valid URL:
39- http://downloads.sourceforge.net/project/base64decoder/base64decoder/version%202.0/b64util.zip?r=&amp;ts=1329648745&amp;use_mirror=kent
40- }
41- const
42- Refresh='<meta http-equiv="refresh"';
43- URLMarker='url=';
44- var
45- Counter: integer;
46- HTMLBody: TStringList;
47- RefreshStart: integer;
48- URLStart: integer;
49- begin
50- HTMLBody:=TStringList.Create;
51- try
52- HTMLBody.LoadFromStream(Document);
53- for Counter:=0 to HTMLBody.Count-1 do
60+ URLStart:=AnsiPos(URLMarker, HTMLBody[Counter])+Length(URLMarker);
61+ if URLStart>RefreshStart then
5462 begin
55- // This line should be between noscript tags and give the direct download locations:
56- RefreshStart:=Ansipos(Refresh, HTMLBody[Counter]);
57- if RefreshStart>0 then
58- begin
59- URLStart:=AnsiPos(URLMarker, HTMLBody[Counter])+Length(URLMarker);
60- if URLStart>RefreshStart then
61- begin
62- // Look for closing "
63- URL:=Copy(HTMLBody[Counter],
64- URLStart,
65- PosEx('"',HTMLBody[Counter],URLStart+1)-URLStart);
66- infoln('debug: new url after sf noscript:');
67- infoln(URL);
68- break;
69- end;
70- end;
63+ // Look for closing "
64+ URL:=Copy(HTMLBody[Counter],
65+ URLStart,
66+ PosEx('"',HTMLBody[Counter],URLStart+1)-URLStart);
67+ infoln('debug: new url after sf noscript:');
68+ infoln(URL);
69+ break;
7170 end;
72- finally
73- HTMLBody.Free;
7471 end;
75- result:=URL;
7672 end;
77-
78- function SourceForgeURL(URL: string): string;
79- // Detects sourceforge download and tries to deal with
80- // redirection, and extracting direct download link.
81- // Thanks to
82- // Ocye: http://lazarus.freepascal.org/index.php/topic,13425.msg70575.html#msg70575
83- const
84- SFProjectPart = '//sourceforge.net/projects/';
85- SFFilesPart = '/files/';
86- SFDownloadPart ='/download';
87- var
88- HTTPSender: THTTPSend;
89- i, j: integer;
90- FoundCorrectURL: boolean;
91- SFDirectory: string; //Sourceforge directory
92- SFDirectoryBegin: integer;
93- SFFileBegin: integer;
94- SFFilename: string; //Sourceforge name of file
95- SFProject: string;
96- SFProjectBegin: integer;
73+ finally
74+ HTMLBody.Free;
75+ end;
76+ result:=URL;
77+end;
78+
79+function SourceForgeURL(URL: string): string;
80+// Detects sourceforge download and tries to deal with
81+// redirection, and extracting direct download link.
82+// Thanks to
83+// Ocye: http://lazarus.freepascal.org/index.php/topic,13425.msg70575.html#msg70575
84+const
85+ SFProjectPart = '//sourceforge.net/projects/';
86+ SFFilesPart = '/files/';
87+ SFDownloadPart ='/download';
88+var
89+ HTTPSender: THTTPSend;
90+ i, j: integer;
91+ FoundCorrectURL: boolean;
92+ SFDirectory: string; //Sourceforge directory
93+ SFDirectoryBegin: integer;
94+ SFFileBegin: integer;
95+ SFFilename: string; //Sourceforge name of file
96+ SFProject: string;
97+ SFProjectBegin: integer;
98+begin
99+ // Detect SourceForge download; e.g. from URL
100+ // 1 2 3 4 5 6 7 8 9
101+ // 1234557890123456789012345578901234567890123455789012345678901234557890123456789012345578901234567890
102+ // http://sourceforge.net/projects/base64decoder/files/base64decoder/version%202.0/b64util.zip/download
103+ // ^^^project^^^ ^^^directory............^^^ ^^^file^^^
104+ FoundCorrectURL:=true; //Assume not a SF download
105+ i:=Pos(SFProjectPart, URL);
106+ if i>0 then
107+ begin
108+ // Possibly found project; now extract project, directory and filename parts.
109+ SFProjectBegin:=i+Length(SFProjectPart);
110+ j := PosEx(SFFilesPart, URL, SFProjectBegin);
111+ if (j>0) then
97112 begin
98- // Detect SourceForge download; e.g. from URL
99- // 1 2 3 4 5 6 7 8 9
100- // 1234557890123456789012345578901234567890123455789012345678901234557890123456789012345578901234567890
101- // http://sourceforge.net/projects/base64decoder/files/base64decoder/version%202.0/b64util.zip/download
102- // ^^^project^^^ ^^^directory............^^^ ^^^file^^^
103- FoundCorrectURL:=true; //Assume not a SF download
104- i:=Pos(SFProjectPart, URL);
105- if i>0 then
113+ SFProject:=Copy(URL, SFProjectBegin, j-SFProjectBegin);
114+ SFDirectoryBegin:=PosEx(SFFilesPart, URL, SFProjectBegin)+Length(SFFilesPart);
115+ if SFDirectoryBegin>0 then
106116 begin
107- // Possibly found project; now extract project, directory and filename parts.
108- SFProjectBegin:=i+Length(SFProjectPart);
109- j := PosEx(SFFilesPart, URL, SFProjectBegin);
110- if (j>0) then
117+ // Find file
118+ // URL might have trailing arguments... so: search for first
119+ // /download coming up from the right, but it should be after
120+ // /files/
121+ i:=RPos(SFDownloadPart, URL);
122+ // Now look for previous / so we can make out the file
123+ // This might perhaps be the trailing / in /files/
124+ SFFileBegin:=RPosEx('/',URL,i-1)+1;
125+
126+ if SFFileBegin>0 then
111127 begin
112- SFProject:=Copy(URL, SFProjectBegin, j-SFProjectBegin);
113- SFDirectoryBegin:=PosEx(SFFilesPart, URL, SFProjectBegin)+Length(SFFilesPart);
114- if SFDirectoryBegin>0 then
115- begin
116- // Find file
117- // URL might have trailing arguments... so: search for first
118- // /download coming up from the right, but it should be after
119- // /files/
120- i:=RPos(SFDownloadPart, URL);
121- // Now look for previous / so we can make out the file
122- // This might perhaps be the trailing / in /files/
123- SFFileBegin:=RPosEx('/',URL,i-1)+1;
124-
125- if SFFileBegin>0 then
126- begin
127- SFFilename:=Copy(URL,SFFileBegin, i-SFFileBegin);
128- //Include trailing /
129- SFDirectory:=Copy(URL, SFDirectoryBegin, SFFileBegin-SFDirectoryBegin);
130- FoundCorrectURL:=false;
131- end;
132- end;
128+ SFFilename:=Copy(URL,SFFileBegin, i-SFFileBegin);
129+ //Include trailing /
130+ SFDirectory:=Copy(URL, SFDirectoryBegin, SFFileBegin-SFDirectoryBegin);
131+ FoundCorrectURL:=false;
133132 end;
134133 end;
135-
136- if not FoundCorrectURL then
134+ end;
135+ end;
136+
137+ if not FoundCorrectURL then
138+ begin
139+ try
140+ // Rewrite URL if needed for Sourceforge download redirection
141+ // Detect direct link in HTML body and get URL from that
142+ HTTPSender := THTTPSend.Create;
143+ //Who knows, this might help:
144+ HTTPSender.UserAgent:='curl/7.21.0 (i686-pc-linux-gnu) libcurl/7.21.0 OpenSSL/0.9.8o zlib/1.2.3.4 libidn/1.18';
145+ while not FoundCorrectURL do
137146 begin
138- try
139- // Rewrite URL if needed for Sourceforge download redirection
140- // Detect direct link in HTML body and get URL from that
141- HTTPSender := THTTPSend.Create;
142- //Who knows, this might help:
143- HTTPSender.UserAgent:='curl/7.21.0 (i686-pc-linux-gnu) libcurl/7.21.0 OpenSSL/0.9.8o zlib/1.2.3.4 libidn/1.18';
144- while not FoundCorrectURL do
145- begin
146- HTTPSender.HTTPMethod('GET', URL);
147- infoln('debug: headers:');
148- infoln(HTTPSender.Headers.Text);
149- case HTTPSender.Resultcode of
150- 301, 302, 307:
151- begin
152- for i := 0 to HTTPSender.Headers.Count - 1 do
153- if (Pos('Location: ', HTTPSender.Headers.Strings[i]) > 0) or
154- (Pos('location: ', HTTPSender.Headers.Strings[i]) > 0) then
155- begin
156- j := Pos('use_mirror=', HTTPSender.Headers.Strings[i]);
157- if j > 0 then
158- URL :=
159- 'http://' + RightStr(HTTPSender.Headers.Strings[i],
160- length(HTTPSender.Headers.Strings[i]) - j - 10) +
161- '.dl.sourceforge.net/project/' +
162- SFProject + '/' + SFDirectory + SFFilename
163- else
164- URL:=StringReplace(
165- HTTPSender.Headers.Strings[i], 'Location: ', '', []);
166- HTTPSender.Clear;//httpsend
167- FoundCorrectURL:=true;
168- break; //out of rewriting loop
169- end;
170- end;
171- 100..200:
147+ HTTPSender.HTTPMethod('GET', URL);
148+ infoln('debug: headers:');
149+ infoln(HTTPSender.Headers.Text);
150+ case HTTPSender.Resultcode of
151+ 301, 302, 307:
152+ begin
153+ for i := 0 to HTTPSender.Headers.Count - 1 do
154+ if (Pos('Location: ', HTTPSender.Headers.Strings[i]) > 0) or
155+ (Pos('location: ', HTTPSender.Headers.Strings[i]) > 0) then
172156 begin
173- //Assume a sourceforge timer/direct link page
174- URL:=SFDirectLinkURL(URL, HTTPSender.Document); //Find out
175- FoundCorrectURL:=true; //We're done by now
176- end;
177- 500: raise Exception.Create('No internet connection available');
178- //Internal Server Error ('+aURL+')');
179- else
180- raise Exception.Create('Download failed with error code ' +
181- IntToStr(HTTPSender.ResultCode) + ' (' + HTTPSender.ResultString + ')');
182- end;//case
183- end;//while
184- infoln('debug: resulting url after sf redir: *' + URL + '*');
185- finally
186- HTTPSender.Free;
187- end;
188- end;
189- result:=URL;
157+ j := Pos('use_mirror=', HTTPSender.Headers.Strings[i]);
158+ if j > 0 then
159+ URL :=
160+ 'http://' + RightStr(HTTPSender.Headers.Strings[i],
161+ length(HTTPSender.Headers.Strings[i]) - j - 10) +
162+ '.dl.sourceforge.net/project/' +
163+ SFProject + '/' + SFDirectory + SFFilename
164+ else
165+ URL:=StringReplace(
166+ HTTPSender.Headers.Strings[i], 'Location: ', '', []);
167+ HTTPSender.Clear;//httpsend
168+ FoundCorrectURL:=true;
169+ break; //out of rewriting loop
170+ end;
171+ end;
172+ 100..200:
173+ begin
174+ //Assume a sourceforge timer/direct link page
175+ URL:=SFDirectLinkURL(URL, HTTPSender.Document); //Find out
176+ FoundCorrectURL:=true; //We're done by now
177+ end;
178+ 500: raise Exception.Create('No internet connection available');
179+ //Internal Server Error ('+aURL+')');
180+ else
181+ raise Exception.Create('Download failed with error code ' +
182+ IntToStr(HTTPSender.ResultCode) + ' (' + HTTPSender.ResultString + ')');
183+ end;//case
184+ end;//while
185+ infoln('debug: resulting url after sf redir: *' + URL + '*');
186+ finally
187+ HTTPSender.Free;
190188 end;
189+ end;
190+ result:=URL;
191+end;
191192```
192193
193-Then you can download file using standard method.
194-```
194+Then you can download file using standard method.
195+
196+``` pascal
195197...
196- function DownloadHTTP(URL, TargetFile: string): boolean;
197- // Download file; retry if necessary.
198- // Deals with SourceForge download links
199- var
200- Buffer: TMemoryStream;
201- begin
202- result:=false;
203- URL:=SourceForgeURL(URL); //Deal with sourceforge URLs
204- try
205- Buffer := TMemoryStream.Create;
206- DownloadHTTPStream(URL, Buffer);
207- Buffer.SaveToFile(TargetFile);
208- result:=true;
209- finally
210- FreeAndNil(Buffer);
211- end;
212- end;
198+function DownloadHTTP(URL, TargetFile: string): boolean;
199+// Download file; retry if necessary.
200+// Deals with SourceForge download links
201+var
202+ Buffer: TMemoryStream;
203+begin
204+ result:=false;
205+ URL:=SourceForgeURL(URL); //Deal with sourceforge URLs
206+ try
207+ Buffer := TMemoryStream.Create;
208+ DownloadHTTPStream(URL, Buffer);
209+ Buffer.SaveToFile(TargetFile);
210+ result:=true;
211+ finally
212+ FreeAndNil(Buffer);
213+ end;
214+end;
213215```
214216
215217## See also
216218
217- * [[Synapse]]
219+- [[Synapse]]
218220
219221---
220-*From the Free Pascal wiki, page "Download from SourceForge/fr", as the Internet Archive kept it on 2022-08-19. Copyright stays with the author who wrote it, according to the old wiki's [[Licensing]] page. If you have concerns about this material, [message the admin](/wiki-contact).*
222+*From the Free Pascal wiki, page "Download from SourceForge/fr", as it stood on 2020-04-29 after a change by E-ric, out of the wiki's dump of 2024-05-26. Copyright stays with the author who wrote it, according to the old wiki's [[Licensing]] page. If you have concerns about this material, [message the admin](/wiki-contact).*

Back to history