Download from SourceForge/pl: what changed

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

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