Sign in Join
Wiki copytemporary

Download from SourceForge: what changed

Revision 0 to 1. Removed lines have a minus sign; added lines have a plus sign.

Title: Download from SourceForge

OldNewLine
1+You can use the [[Synapse]] networking library to download files from SourceForge. Because SourceForge stores files on multiple mirrors you have to deal with redirection.
2+
3+``` pascal
4+...
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
55+ 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
59+ begin
60+ URLStart:=AnsiPos(URLMarker, HTMLBody[Counter])+Length(URLMarker);
61+ if URLStart>RefreshStart then
62+ 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;
70+ end;
71+ end;
72+ 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
112+ begin
113+ SFProject:=Copy(URL, SFProjectBegin, j-SFProjectBegin);
114+ SFDirectoryBegin:=PosEx(SFFilesPart, URL, SFProjectBegin)+Length(SFFilesPart);
115+ if SFDirectoryBegin>0 then
116+ 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
127+ begin
128+ SFFilename:=Copy(URL,SFFileBegin, i-SFFileBegin);
129+ //Include trailing /
130+ SFDirectory:=Copy(URL, SFDirectoryBegin, SFFileBegin-SFDirectoryBegin);
131+ FoundCorrectURL:=false;
132+ end;
133+ 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
146+ 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
156+ 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;
188+ end;
189+ end;
190+ result:=URL;
191+end;
192+```
193+
194+Then you can download file using standard method.
195+
196+``` pascal
197+...
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;
215+```
216+
217+## See also
218+
219+- [[Synapse]]
220+
221+---
222+*From the Free Pascal wiki, page "Download from SourceForge", 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