Develop and Download Open Source Software

Browse CVS Repository

Contents of /gikonavigoeson/gikonavi/Dolib.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.1.1.1.2.3 - (show annotations) (download) (as text) (vendor branch)
Thu Sep 9 16:20:30 2004 UTC (19 years, 7 months ago) by yoffy
Branch: stable
Changes since 1.1.1.1.2.2: +4 -3 lines
File MIME type: text/x-pascal
・ミ・ソ48、ヒ・゙。シ・ク。」

1 {*******************************************************}
2 { }
3 { DOLIB API Interface Unit }
4 { }
5 { 2002 Monazilla Project }
6 { Dax mailto:daxmonazilla@yahoo.co.jp }
7 { ?医ヲ?盈ailto:gikonavi@ice.dti2.ne.jp }
8 {********************************************************
9
10 Updates:
11
12 2002/03/02 繝ュ繧ー繧、繝ウ繧ィ繝ゥ繝シ繧呈、懷?縺吶k繧医≧縺ォ菫ョ豁」縺励◆縺九b縲?/span>
13 2002/03/02 DOLIB.dll繧剃スソ繧上↑縺?h縺?↓縺励◆縲?/span>
14 2002/02/27 繝舌げ菫ョ豁」 (GetVersion縺ッ繧ウ繝阪け繝医@縺ヲ縺ェ縺上※繧ょ叙蠕怜庄閭ス縺ォ縺励◆)
15 2002/01/22 DOLIB 1.00C蟇セ蠢懊??/span>
16 莉・荳九?繝励Ο繝代ユ繧」繧定ソス蜉?縲?/span>
17 - Session ......... 繧サ繝?す繝ァ繝ウ縺ョ繝昴う繝ウ繧ソ繧定ソ斐@縺セ縺吶?∝、壼?菴ソ繧上↑縺???/span>
18 - SessionID ....... 繧サ繝?す繝ァ繝ウID繧定ソ斐@縺セ縺吶??/span>
19 - Version ......... DOLIB縺ョ繝舌?繧ク繝ァ繝ウ繧定ソ斐@縺セ縺吶??/span>
20 - UserAgent ....... UA逕ィ縺ョ譁?ュ怜? Monazilla/x.xx 繧定ソ斐@縺セ縺吶??/span>
21 - ErrorCode ....... 繧ィ繝ゥ繝シ繧ウ繝シ繝峨r霑斐@縺セ縺吶??/span>
22 - ErrorMsg ........ 繧ィ繝ゥ繝シ繝。繝?そ繝シ繧ク繧定ソ斐@縺セ縺吶??/span>
23 2002/01/20 Disconnect蠕後↓ Connected繝励Ο繝代ユ繧」繧呈綾縺励※縺ェ縺九▲縺溘??/span>
24 2002/01/19 DOLIB 1.00B蟇セ蠢懊?ゅョ繝シ繧ソ蜿門セ励↓謌仙粥??/span>
25 2002/01/18 DOLIB 1.00蟇セ蠢懊?ゅ@縺九@繧ィ繝ゥ繝シ縺励°霑斐▲縺ヲ譚・縺ェ縺??√??/span>
26 2002/01/18 ghanyan豌上?蜉ゥ險?縺ォ繧医j蜍穂ス懊☆繧九?よ─隰晢シ?/span>
27 2002/01/09 DOLIB 0.01逕ィ縺ォ菴懈?髢句ァ九?ゅ〒繧ょ虚縺九↑縺??縺ァ縺サ縺」縺ィ縺上??/span>
28 }
29 unit Dolib;
30
31 {$IOCHECKS ON}
32
33 interface
34
35 uses
36 Windows, SysUtils, WinInet;
37
38 type
39 TDolibSession = class(TObject)
40 private
41 FSessionID: string;
42 FErrorCode: Integer;
43 FErrorString: string;
44 FUserAgent: string;
45 public
46 property SessionID: string read FSessionID write FSessionID;
47 property ErrorCode: Integer read FErrorCode write FErrorCode;
48 property ErrorString: string read FErrorString write FErrorString;
49 property UserAgent: string read FUserAgent write FUserAgent;
50 end;
51
52 TDolib = class(TObject)
53 private
54 FSession : TDolibSession;
55 FConnected: boolean;
56 FProxyPort: integer;
57 FUserName: string;
58 FPassword: string;
59 FProxyAddress: string;
60 FClientUA: string;
61 function GetSessionID: string;
62 function GetVersion: string;
63 function GetUserAgent: string;
64 function GetErrorCode: integer;
65 function GetErrorMsg: string;
66 procedure MakeError(Session: TDolibSession; Error: DWORD);
67 procedure DOLIB_LOGIN(Proxy: string; Port: Integer; ID: string; Pass: string);
68 procedure ForcedDOLIB_LOGIN(Proxy: string; Port: Integer; ID: string; Pass: string);
69 public
70 constructor Create;
71 destructor Destroy; override;
72 function Connect: boolean;
73 function ForcedConnect: boolean; //SSL髫懷ョウ逕ィ蠑キ蛻カ繝ュ繧ー繧、繝ウ
74 function Disconnect: boolean;
75 property ProxyAddress: string read FProxyAddress write FProxyAddress;
76 property ProxyPort: integer read FProxyPort write FProxyPort;
77 property UserName: string read FUserName write FUserName;
78 property Password: string read FPassword write FPassword;
79 property ClientUA: string read FClientUA write FClientUA;
80 property Connected: boolean read FConnected;
81 property SessionID: string read GetSessionID;
82 property Version: string read GetVersion;
83 property UserAgent: string read GetUserAgent;
84 property ErrorCode: integer read GetErrorCode;
85 property ErrorMsg: string read GetErrorMsg;
86 end;
87
88 implementation
89 const
90 DOLIB_VERSION = $10000;
91 DOLIB_LOGIN_UA = 'DOLIB/1.00';
92 DOLIB_LOGIN_HOST = '2chv.tora3.net';
93 DOLIB_LOGIN_URL = '/futen.cgi';
94 DOLIB_2CH_UA = 'X-2ch-UA:';
95 // DOLIB_2CH_UA = 'X-2ch-UA: gikoNavi/1.00'#13#10;
96 DOLIB_ENOMEM_STRING = '繝。繝「繝ェ縺瑚カウ繧翫∪縺帙s縲?#39;;
97 DOLIB_LOGIN_ERROR = 'ERROR:';
98 // https://2chv.tora3.net/futen.cgi
99
100 { TDolib }
101
102 constructor TDolib.Create;
103 begin
104 FSession := nil;
105 FConnected := False;
106 end;
107
108 destructor TDolib.Destroy;
109 begin
110 if Connected then
111 Disconnect;
112 inherited;
113 end;
114
115 function TDolib.Connect: boolean;
116 begin
117 Result := False;
118 if not Connected then begin
119 DOLIB_LOGIN(FProxyAddress, FProxyPort, FUserName, FPassword);
120 FConnected := True;
121 if (AnsiPos(DOLIB_LOGIN_ERROR, SessionID) = 1) then begin
122 Disconnect;
123 Result := False;
124 end else if ErrorCode <> 0 then begin
125 Disconnect;
126 Result := False;
127 end else begin
128 Result := True;
129 // Result := (ErrorCode = 0);
130 end;
131 end;
132 end;
133 function TDolib.ForcedConnect: boolean; //2003/12/20縺セ縺ァ縺ョSSL髫懷ョウ逕ィ蠑キ蛻カ繝ュ繧ー繧、繝ウ??2/21莉・髯阪↑繧蛾?壼クク繝ュ繧ー繧、繝ウ??/span>
134 begin
135 Result := False;
136 if not Connected then begin
137 ForcedDOLIB_LOGIN(FProxyAddress, FProxyPort, FUserName, FPassword);
138 Result := True;
139 end;
140 end;
141
142 function TDolib.Disconnect: boolean;
143 begin
144 Result := True;
145 if FSession <> nil then
146 FreeAndNil(FSession);
147 FConnected := False;
148 end;
149
150 function TDolib.GetVersion: string;
151 var
152 v : DWORD;
153 mj, mn : integer;
154 begin
155 v := DOLIB_VERSION;
156 mj := v shr 16;
157 mn := v and $ffff;
158 Result := Format('%d.%.2d', [mj, mn]);
159 end;
160
161 function TDolib.GetSessionID: string;
162 begin
163 if Connected then
164 Result := FSession.FSessionID
165 else
166 Result := '';
167 end;
168
169 function TDolib.GetUserAgent: string;
170 begin
171 if Connected then
172 Result := FSession.FUserAgent
173 else
174 Result := '';
175 end;
176
177 function TDolib.GetErrorMsg: string;
178 begin
179 if Connected then
180 Result := FSession.FErrorString
181 else
182 Result := 'Error: ID縺九ヱ繧ケ繝ッ繝シ繝峨′豁」縺励¥縺ゅj縺セ縺帙s縲?#39;;
183 end;
184
185 function TDolib.GetErrorCode: integer;
186 begin
187 if Connected then
188 Result := FSession.ErrorCode
189 else
190 Result := 0;
191 end;
192
193 procedure TDolib.MakeError(Session: TDolibSession; Error: DWORD);
194 var
195 Buf: array[0..4096] of Char;
196 begin
197 Session.ErrorCode := Error;
198 if Error = ERROR_NOT_ENOUGH_MEMORY then
199 Session.ErrorString := DOLIB_ENOMEM_STRING
200 else begin
201 FillChar(Buf, SizeOf(Buf), #0);
202 FormatMessage({FORMAT_MESSAGE_ALLOCATE_BUFFER or}
203 FORMAT_MESSAGE_IGNORE_INSERTS or
204 FORMAT_MESSAGE_FROM_SYSTEM or
205 FORMAT_MESSAGE_FROM_HMODULE,
206 Pointer(GetModuleHandle('wininet')), Error,
207 (((Word(SUBLANG_DEFAULT)) shl 10) or Word(LANG_NEUTRAL)), //Delphi縺ォMAKELANGID繝槭け繝ュ縺檎┌縺九▲縺溘?縲?ツエ?・マ会ス・`)?シ?ョ?趣セ橸スー??/span>
208 // MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
209 Buf, SizeOf(Buf), nil);
210 Session.ErrorString := Buf;
211 end;
212 end;
213
214 {蜿り?ザRL
215 kage菴懆??&繧薙?DOLIB繧ッ繝ュ繝シ繝ウ繧ス繝シ繧ケ?亥、ァ螟峨♀縺?@繧?≧縺斐*縺?∪縺励◆??/span>
216 http://members.jcom.home.ne.jp/monazilla/document/wininetdel.html
217 http://support.microsoft.com/default.aspx?scid=kb;EN-US;q168151
218 http://msdn.microsoft.com/library/default.asp?url=/workshop/networking/wininet/wininet.asp
219 http://homepage1.nifty.com/~suzuki/delphi/wininet.html
220 }
221 procedure TDolib.DOLIB_LOGIN(Proxy: string; Port: Integer; ID: string; Pass: string);
222 var
223 hSession: HINTERNET;
224 hConnect: HINTERNET;
225 hRequest: HINTERNET;
226 ProxyHostPort: string;
227 Buf: array[0..4096] of Char;
228 UserInfo: string;
229 UserAgent: string;
230 cb: DWORD;
231 Delim: Integer;
232 begin
233 FSession := TDolibSession.Create;
234
235 if Proxy <> '' then begin
236 ProxyHostPort := Format('%s:%d', [Proxy, Port]);
237 hSession := InternetOpen(DOLIB_LOGIN_UA, INTERNET_OPEN_TYPE_PROXY, PChar(ProxyHostPort), '', 0);
238 end else begin
239 hSession := InternetOpen(DOLIB_LOGIN_UA, INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0);
240 end;
241
242 if not Assigned(hSession) then
243 MakeError(FSession, GetLastError())
244 else begin
245 hConnect := InternetConnect(hSession, DOLIB_LOGIN_HOST,
246 INTERNET_DEFAULT_HTTPS_PORT, nil, nil,
247 INTERNET_SERVICE_HTTP, INTERNET_FLAG_SECURE, 0);
248 if not Assigned(hConnect) then
249 MakeError(FSession, GetLastError())
250 else begin
251 hRequest := HttpOpenRequest(hConnect, 'POST', DOLIB_LOGIN_URL,
252 nil, nil, nil,
253 INTERNET_FLAG_NO_CACHE_WRITE or INTERNET_FLAG_NO_COOKIES or
254 INTERNET_FLAG_NO_UI or INTERNET_FLAG_SECURE, 0);
255 if not Assigned(hRequest) then
256 MakeError(FSession, GetLastError())
257 else begin
258 UserInfo := Format('ID=%s&PW=%s', [ID, Pass]);
259 UserAgent := Format('%s %s', [DOLIB_2CH_UA, ClientUA]) + #13#10;
260 if not HttpSendRequest(hRequest, PChar(UserAgent), DWORD(-1), PChar(UserInfo), Length(UserInfo)) then
261 MakeError(FSession, GetLastError())
262 else begin
263 if not InternetReadFile(hRequest, @Buf, SizeOf(Buf), cb) then
264 MakeError(FSession, GetLastError())
265 else if (cb < 11) or (Pos('SESSION-ID=', Buf) <> 1) then
266 MakeError(FSession, ERROR_INVALID_DATA)
267 else begin
268 if Buf[cb - 1] = #10 then
269 Buf[cb - 1] := #0;
270 FSession.SessionID := Copy(Buf, 12, cb);
271 if FSession.SessionID = '' then
272 MakeError(FSession, ERROR_NOT_ENOUGH_MEMORY);
273 Delim := Pos(':', Buf);
274 if Delim = 0 then
275 MakeError(FSession, ERROR_INVALID_DATA)
276 else begin
277 FSession.UserAgent := Copy(Buf, 12, Delim - 12);
278 if FSession.UserAgent = '' then
279 MakeError(FSession, ERROR_NOT_ENOUGH_MEMORY);
280 end;
281 end;
282 end;
283 InternetCloseHandle(hRequest);
284 end;
285 InternetCloseHandle(hConnect);
286 end;
287 InternetCloseHandle(hSession);
288 end;
289 end;
290 //SSL髫懷ョウ逕ィ蠑キ蛻カ繝ュ繧ー繧、繝ウ
291 procedure TDolib.ForcedDOLIB_LOGIN(Proxy: string; Port: Integer; ID: string; Pass: string);
292 var
293 hSession: HINTERNET;
294 hConnect: HINTERNET;
295 hRequest: HINTERNET;
296 ProxyHostPort: string;
297 Buf: array[0..4096] of Char;
298 UserInfo: string;
299 UserAgent: string;
300 cb: DWORD;
301 Delim: Integer;
302 begin
303 FSession := TDolibSession.Create;
304
305 if Proxy <> '' then begin
306 ProxyHostPort := Format('%s:%d', [Proxy, Port]);
307 hSession := InternetOpen(DOLIB_LOGIN_UA, INTERNET_OPEN_TYPE_PROXY, PChar(ProxyHostPort), '', 0);
308 end else begin
309 hSession := InternetOpen(DOLIB_LOGIN_UA, INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0);
310 end;
311
312 if not Assigned(hSession) then
313 MakeError(FSession, GetLastError())
314 else begin
315 hConnect := InternetConnect(hSession, DOLIB_LOGIN_HOST,
316 INTERNET_DEFAULT_HTTPS_PORT, nil, nil,
317 INTERNET_SERVICE_HTTP, INTERNET_FLAG_SECURE, 0);
318 if not Assigned(hConnect) then
319 MakeError(FSession, GetLastError())
320 else begin
321 hRequest := HttpOpenRequest(hConnect, 'POST', DOLIB_LOGIN_URL,
322 nil, nil, nil,
323 INTERNET_FLAG_NO_CACHE_WRITE or INTERNET_FLAG_NO_COOKIES or
324 INTERNET_FLAG_NO_UI or INTERNET_FLAG_SECURE, 0);
325 if not Assigned(hRequest) then
326 MakeError(FSession, GetLastError())
327 else begin
328 UserInfo := Format('ID=%s&PW=%s', [ID, Pass]);
329 UserAgent := Format('%s %s', [DOLIB_2CH_UA, ClientUA]) + #13#10;
330 HttpSendRequest(hRequest, PChar(UserAgent), DWORD(-1), PChar(UserInfo), Length(UserInfo));
331 if not InternetReadFile(hRequest, @Buf, SizeOf(Buf), cb) then
332 MakeError(FSession, GetLastError())
333 else if (cb < 11) or (Pos('SESSION-ID=', Buf) <> 1) then
334 MakeError(FSession, ERROR_INVALID_DATA)
335 else begin
336 if Buf[cb - 1] = #10 then
337 Buf[cb - 1] := #0;
338 FSession.SessionID := Copy(Buf, 12, cb);
339 if FSession.SessionID = '' then
340 MakeError(FSession, ERROR_NOT_ENOUGH_MEMORY);
341 Delim := Pos(':', Buf);
342 if Delim = 0 then
343 MakeError(FSession, ERROR_INVALID_DATA)
344 else begin
345 FSession.UserAgent := Copy(Buf, 12, Delim - 12);
346 if FSession.UserAgent = '' then
347 MakeError(FSession, ERROR_NOT_ENOUGH_MEMORY);
348 end;
349 end;
350 InternetCloseHandle(hRequest);
351 end;
352 InternetCloseHandle(hConnect);
353 end;
354 InternetCloseHandle(hSession);
355 end;
356 end;
357 end.
358

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26