Sign in Join
Wiki copytemporary

Download from SourceForge/fr: what changed

Revision 1 to 2. 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-
3-``` pascal
4-...
5-uses httpsend {a Synapse unit}
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+```
63...
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
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;
5513 begin
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
14+ Result:=false;
15+ RetryAttempt := 1;
16+ HTTPGetResult := False;
17+ while ((HTTPGetResult = False) and (RetryAttempt < MaxRetries)) do
5918 begin
60- URLStart:=AnsiPos(URLMarker, HTMLBody[Counter])+Length(URLMarker);
61- if URLStart>RefreshStart then
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
6254 begin
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;
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;
7071 end;
72+ finally
73+ HTMLBody.Free;
7174 end;
75+ result:=URL;
7276 end;
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
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;
11297 begin
113- SFProject:=Copy(URL, SFProjectBegin, j-SFProjectBegin);
114- SFDirectoryBegin:=PosEx(SFFilesPart, URL, SFProjectBegin)+Length(SFFilesPart);
115- if SFDirectoryBegin>0 then
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
116106 begin
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
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
127111 begin
128- SFFilename:=Copy(URL,SFFileBegin, i-SFFileBegin);
129- //Include trailing /
130- SFDirectory:=Copy(URL, SFDirectoryBegin, SFFileBegin-SFDirectoryBegin);
131- FoundCorrectURL:=false;
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;
132133 end;
133134 end;
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
135+
136+ if not FoundCorrectURL then
146137 begin
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
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:
156151 begin
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;
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:
172+ 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;
188190 end;
189- end;
190- result:=URL;
191-end;
192191```
193192
194-Then you can download file using standard method.
195-
196-``` pascal
193+Then you can download file using standard method.
194+```
197195...
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;
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;
215213```
216214
217215## See also
218216
219-- [[Synapse]]
217+ * [[Synapse]]
220218
221219---
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).*
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).*

Back to history