Download from SourceForge/pl: what changed

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

Title: Download from SourceForge/pl

New		Line
1	+	<div style="font-size:1.88em;margin:0.75em 0;">
2	+
3	+	Pobieranie z SourceForge
4	+
5	+	</div>
6	+
7	+	Możesz użyć biblioteki sieciowej [[Synapse]] do pobierania plików z SourceForge. Ponieważ SourceForge przechowuje pliki na wielu serwerach lustrzanych, musisz poradzić sobie z przekierowaniami.
8	+
9	+	``` pascal
10	+	...
11	+	uses httpsend {moduł Synapse}
12	+	...
13	+	function DownloadHTTPStream(URL: string; Buffer: TStream): boolean;
14	+	// Pobieranie pliku; w razie potrzeby próbuje ponownie.
15	+	const
16	+	MaxRetries = 3;
17	+	var
18	+	RetryAttempt: integer;
19	+	HTTPGetResult: boolean;
20	+	begin
21	+	Result:=false;
22	+	RetryAttempt := 1;
23	+	HTTPGetResult := False;
24	+	while ((HTTPGetResult = False) and (RetryAttempt < MaxRetries)) do
25	+	begin
26	+	HTTPGetResult := HttpGetBinary(URL, Buffer);
27	+	//Application.ProcessMessages;
28	+	Sleep(100 * RetryAttempt);
29	+	RetryAttempt := RetryAttempt + 1;
30	+	end;
31	+	if HTTPGetResult = False then
32	+	raise Exception.Create('Nie można załadować dokumentu ze zdalnego serwera');
33	+	Buffer.Position := 0;
34	+	if Buffer.Size = 0 then
35	+	raise Exception.Create('Pobrany dokument jest pusty.');
36	+	Result := True;
37	+	end;
38	+
39	+	function SFDirectLinkURL(URL: string; Document: TMemoryStream): string;
40	+	{
41	+	Przekształć tę część dokumentu:
42	+	<noscript>
43	+	<meta http-equiv="refresh" content="5; url=http://downloads.sourceforge.net/project/base64decoder/base64decoder/version%202.0/b64util.zip?r=&ts=1329648745&use_mirror=kent">
44	+	</noscript>
45	+	na poprawny adres URL:
46	+	http://downloads.sourceforge.net/project/base64decoder/base64decoder/version%202.0/b64util.zip?r=&ts=1329648745&use_mirror=kent
47	+	}
48	+	const
49	+	Refresh='<meta http-equiv="refresh"';
50	+	URLMarker='url=';
51	+	var
52	+	Counter: integer;
53	+	HTMLBody: TStringList;
54	+	RefreshStart: integer;
55	+	URLStart: integer;
56	+	begin
57	+	HTMLBody:=TStringList.Create;
58	+	try
59	+	HTMLBody.LoadFromStream(Document);
60	+	for Counter:=0 to HTMLBody.Count-1 do
61	+	begin
62	+	// Ta linia powinna znajdować się między tagami noscript i podawać bezpośrednią lokalizację pobierania:
63	+	RefreshStart:=Ansipos(Refresh, HTMLBody[Counter]);
64	+	if RefreshStart>0 then
65	+	begin
66	+	URLStart:=AnsiPos(URLMarker, HTMLBody[Counter])+Length(URLMarker);
67	+	if URLStart>RefreshStart then
68	+	begin
69	+	// Znajdź cudzysłów zamykający "
70	+	URL:=Copy(HTMLBody[Counter],
71	+	URLStart,
72	+	PosEx('"',HTMLBody[Counter],URLStart+1)-URLStart);
73	+	infoln('debug: nowy adres URL po tagu noscript:');
74	+	infoln(URL);
75	+	break;
76	+	end;
77	+	end;
78	+	end;
79	+	finally
80	+	HTMLBody.Free;
81	+	end;
82	+	result:=URL;
83	+	end;
84	+
85	+	function SourceForgeURL(URL: string): string;
86	+	// Wykrywa pobieranie z sourceforge i próbuje poradzić sobie
87	+	// z przekierowaniami i wyodrębnieniem bezpośredniego linku do pobrania.
88	+	// Dziękuję
89	+	// Ocye: http://lazarus.freepascal.org/index.php/topic,13425.msg70575.html#msg70575
90	+
91	+	const
92	+	SFProjectPart = '//sourceforge.net/projects/';
93	+	SFFilesPart = '/files/';
94	+	SFDownloadPart ='/download';
95	+	var
96	+	HTTPSender: THTTPSend;
97	+	i, j: integer;
98	+	FoundCorrectURL: boolean;
99	+	SFDirectory: string; //Katalog Sourceforge
100	+	SFDirectoryBegin: integer;
101	+	SFFileBegin: integer;
102	+	SFFilename: string; //Nazwa pliku Sourceforge
103	+	SFProject: string;
104	+	SFProjectBegin: integer;
105	+	begin
106	+	// Wykryj pobieranie SourceForge; np. z adresu URL
107	+	// 1 2 3 4 5 6 7 8 9
108	+	// 1234557890123456789012345578901234567890123455789012345678901234557890123456789012345578901234567890
109	+	// http://sourceforge.net/projects/base64decoder/files/base64decoder/version%202.0/b64util.zip/download
110	+	// ^^^projekt^^^ ^^^katalog..............^^^ ^^^plik^^^
111	+	FoundCorrectURL:=true; //Załóżmy, że nie jest to pobieranie z SourceForge
112	+	i:=Pos(SFProjectPart, URL);
113	+	if i>0 then
114	+	begin
115	+	// Ewentualnie znaleziony projekt; teraz wyodrębnij części projektu, katalogu i nazwy pliku.
116	+	SFProjectBegin:=i+Length(SFProjectPart);
117	+	j := PosEx(SFFilesPart, URL, SFProjectBegin);
118	+	if (j>0) then
119	+	begin
120	+	SFProject:=Copy(URL, SFProjectBegin, j-SFProjectBegin);
121	+	SFDirectoryBegin:=PosEx(SFFilesPart, URL, SFProjectBegin)+Length(SFFilesPart);
122	+	if SFDirectoryBegin>0 then
123	+	begin
124	+	// Znajdź plik
125	+	// URL może mieć końcowe argumenty... więc: wyszukaj pierwszą
126	+	// napotkaną nazwę z prawej strony, ale powinna być po /files/
127	+	i:=RPos(SFDownloadPart, URL);
128	+	// Teraz poszukaj poprzedni ukośnik /, abyśmy mogli rozpoznać plik.
129	+	// Może to być końcowy / w /files/
130	+	SFFileBegin:=RPosEx('/',URL,i-1)+1;
131	+
132	+	if SFFileBegin>0 then
133	+	begin
134	+	SFFilename:=Copy(URL,SFFileBegin, i-SFFileBegin);
135	+	//Uwzględnij końcowy ukośnik /
136	+	SFDirectory:=Copy(URL, SFDirectoryBegin, SFFileBegin-SFDirectoryBegin);
137	+	FoundCorrectURL:=false;
138	+	end;
139	+	end;
140	+	end;
141	+	end;
142	+
143	+	if not FoundCorrectURL then
144	+	begin
145	+	try
146	+	// Przepisz adres URL, jeśli jest to konieczne do przekierowania pobierania Sourceforge
147	+	// Wykryj bezpośredni link w treści HTML i uzyskaj z niego adres URL
148	+	HTTPSender := THTTPSend.Create;
149	+	//Kto wie, może to pomóc:
150	+	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';
151	+	while not FoundCorrectURL do
152	+	begin
153	+	HTTPSender.HTTPMethod('GET', URL);
154	+	infoln('debug: headers:');
155	+	infoln(HTTPSender.Headers.Text);
156	+	case HTTPSender.Resultcode of
157	+	301, 302, 307:
158	+	begin
159	+	for i := 0 to HTTPSender.Headers.Count - 1 do
160	+	if (Pos('Location: ', HTTPSender.Headers.Strings[i]) > 0) or
161	+	(Pos('location: ', HTTPSender.Headers.Strings[i]) > 0) then
162	+	begin
163	+	j := Pos('use_mirror=', HTTPSender.Headers.Strings[i]);
164	+	if j > 0 then
165	+	URL :=
166	+	'http://' + RightStr(HTTPSender.Headers.Strings[i],
167	+	length(HTTPSender.Headers.Strings[i]) - j - 10) +
168	+	'.dl.sourceforge.net/project/' +
169	+	SFProject + '/' + SFDirectory + SFFilename
170	+	else
171	+	URL:=StringReplace(
172	+	HTTPSender.Headers.Strings[i], 'Location: ', '', []);
173	+	HTTPSender.Clear;//httpsend
174	+	FoundCorrectURL:=true;
175	+	break; // opuść pętlę przepisywania
176	+	end;
177	+	end;
178	+	100..200:
179	+	begin
180	+	//Pobierz stronę sourceforge z bezpośredniego linku
181	+	URL:=SFDirectLinkURL(URL, HTTPSender.Document); //Zapytaj
182	+	FoundCorrectURL:=true; //Już skończyliśmy
183	+	end;
184	+	500: raise Exception.Create('Brak połączenia internetowego');
185	+	//Internal Server Error ('+aURL+')');
186	+	else
187	+	raise Exception.Create('Pobieranie nie powiodło się. Kod błędu ' +
188	+	IntToStr(HTTPSender.ResultCode) + ' (' + HTTPSender.ResultString + ')');
189	+	end;//case
190	+	end;//while
191	+	infoln('debug: wynikowy adres URL po przekierowaniu sf: ' + URL + '');
192	+	finally
193	+	HTTPSender.Free;
194	+	end;
195	+	end;
196	+	result:=URL;
197	+	end;
198	+	```
199	+
200	+	Następnie możesz pobrać plik standardową metodą.
201	+
202	+	``` pascal
203	+	...
204	+	function DownloadHTTP(URL, TargetFile: string): boolean;
205	+	// Pobieranie pliku; w razie potrzeby spróbuj ponownie.
206	+	// Oferty z linkami do pobierania SourceForge
207	+	var
208	+	Buffer: TMemoryStream;
209	+	begin
210	+	result:=false;
211	+	URL:=SourceForgeURL(URL); //Zajmij się adresami URL Sourceforge
212	+	try
213	+	Buffer := TMemoryStream.Create;
214	+	DownloadHTTPStream(URL, Buffer);
215	+	Buffer.SaveToFile(TargetFile);
216	+	result:=true;
217	+	finally
218	+	FreeAndNil(Buffer);
219	+	end;
220	+	end;
221	+	```
222	+
223	+	## Zobacz także
224	+
225	+	- [[Synapse/pl\|Synapse]]
226	+
227	+	---
228	+	From the Free Pascal wiki, page "Download from SourceForge/pl", as it stood on 2022-07-06 after a change by Slawek, 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