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.3.2.1 - (show annotations) (download) (as text)
Mon May 24 08:54:23 2004 UTC (19 years, 10 months ago) by h677
Branch: BRANCH_TORA
Changes since 1.3: +3 -3 lines
File MIME type: text/x-pascal
ソキヌァセレサェURL、ヒハムケケ

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 { TDolib }
100
101 constructor TDolib.Create;
102 begin
103 FSession := nil;
104 FConnected := False;
105 end;
106
107 destructor TDolib.Destroy;
108 begin
109 if Connected then
110 Disconnect;
111 inherited;
112 end;
113
114 function TDolib.Connect: boolean;
115 begin
116 Result := False;
117 if not Connected then begin
118 DOLIB_LOGIN(FProxyAddress, FProxyPort, FUserName, FPassword);
119 FConnected := True;
120 if (AnsiPos(DOLIB_LOGIN_ERROR, SessionID) = 1) then begin
121 Disconnect;
122 Result := False;
123 end else if ErrorCode <> 0 then begin
124 Disconnect;
125 Result := False;
126 end else begin
127 Result := True;
128 // Result := (ErrorCode = 0);
129 end;
130 end;
131 end;
132 function TDolib.ForcedConnect: boolean; //2003/12/20縺セ縺ァ縺ョSSL髫懷ョウ逕ィ蠑キ蛻カ繝ュ繧ー繧、繝ウ??2/21莉・髯阪↑繧蛾?壼クク繝ュ繧ー繧、繝ウ??/span>
133 begin
134 Result := False;
135 if not Connected then begin
136 ForcedDOLIB_LOGIN(FProxyAddress, FProxyPort, FUserName, FPassword);
137 Result := True;
138 end;
139 end;
140
141 function TDolib.Disconnect: boolean;
142 begin
143 Result := True;
144 if FSession <> nil then
145 FreeAndNil(FSession);
146 FConnected := False;
147 end;
148
149 function TDolib.GetVersion: string;
150 var
151 v : DWORD;
152 mj, mn : integer;
153 begin
154 v := DOLIB_VERSION;
155 mj := v shr 16;
156 mn := v and $ffff;
157 Result := Format('%d.%.2d', [mj, mn]);
158 end;
159
160 function TDolib.GetSessionID: string;
161 begin
162 if Connected then
163 Result := FSession.FSessionID
164 else
165 Result := '';
166 end;
167
168 function TDolib.GetUserAgent: string;
169 begin
170 if Connected then
171 Result := FSession.FUserAgent
172 else
173 Result := '';
174 end;
175
176 function TDolib.GetErrorMsg: string;
177 begin
178 if Connected then
179 Result := FSession.FErrorString
180 else
181 Result := 'Error: ID縺九ヱ繧ケ繝ッ繝シ繝峨′豁」縺励¥縺ゅj縺セ縺帙s縲?#39;;
182 end;
183
184 function TDolib.GetErrorCode: integer;
185 begin
186 if Connected then
187 Result := FSession.ErrorCode
188 else
189 Result := 0;
190 end;
191
192 procedure TDolib.MakeError(Session: TDolibSession; Error: DWORD);
193 var
194 Buf: array[0..4096] of Char;
195 begin
196 Session.ErrorCode := Error;
197 if Error = ERROR_NOT_ENOUGH_MEMORY then
198 Session.ErrorString := DOLIB_ENOMEM_STRING
199 else begin
200 FillChar(Buf, SizeOf(Buf), #0);
201 FormatMessage({FORMAT_MESSAGE_ALLOCATE_BUFFER or}
202 FORMAT_MESSAGE_IGNORE_INSERTS or
203 FORMAT_MESSAGE_FROM_SYSTEM or
204 FORMAT_MESSAGE_FROM_HMODULE,
205 Pointer(GetModuleHandle('wininet')), Error,
206 (((Word(SUBLANG_DEFAULT)) shl 10) or Word(LANG_NEUTRAL)), //Delphi縺ォMAKELANGID繝槭け繝ュ縺檎┌縺九▲縺溘?縲?ツエ?・マ会ス・`)?シ?ョ?趣セ橸スー??/span>
207 // MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
208 Buf, SizeOf(Buf), nil);
209 Session.ErrorString := Buf;
210 end;
211 end;
212
213 {蜿り?ザRL
214 kage菴懆??&繧薙?DOLIB繧ッ繝ュ繝シ繝ウ繧ス繝シ繧ケ?亥、ァ螟峨♀縺?@繧?≧縺斐*縺?∪縺励◆??/span>
215 http://members.jcom.home.ne.jp/monazilla/document/wininetdel.html
216 http://support.microsoft.com/default.aspx?scid=kb;EN-US;q168151
217 http://msdn.microsoft.com/library/default.asp?url=/workshop/networking/wininet/wininet.asp
218 http://homepage1.nifty.com/~suzuki/delphi/wininet.html
219 }
220 procedure TDolib.DOLIB_LOGIN(Proxy: string; Port: Integer; ID: string; Pass: string);
221 var
222 hSession: HINTERNET;
223 hConnect: HINTERNET;
224 hRequest: HINTERNET;
225 ProxyHostPort: string;
226 Buf: array[0..4096] of Char;
227 UserInfo: string;
228 UserAgent: string;
229 cb: DWORD;
230 Delim: Integer;
231 begin
232 FSession := TDolibSession.Create;
233
234 if Proxy <> '' then begin
235 ProxyHostPort := Format('%s:%d', [Proxy, Port]);
236 hSession := InternetOpen(DOLIB_LOGIN_UA, INTERNET_OPEN_TYPE_PROXY, PChar(ProxyHostPort), '', 0);
237 end else begin
238 hSession := InternetOpen(DOLIB_LOGIN_UA, INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0);
239 end;
240
241 if not Assigned(hSession) then
242 MakeError(FSession, GetLastError())
243 else begin
244 hConnect := InternetConnect(hSession, DOLIB_LOGIN_HOST,
245 INTERNET_DEFAULT_HTTPS_PORT, nil, nil,
246 INTERNET_SERVICE_HTTP, INTERNET_FLAG_SECURE, 0);
247 if not Assigned(hConnect) then
248 MakeError(FSession, GetLastError())
249 else begin
250 hRequest := HttpOpenRequest(hConnect, 'POST', DOLIB_LOGIN_URL,
251 nil, nil, nil,
252 INTERNET_FLAG_NO_CACHE_WRITE or INTERNET_FLAG_NO_COOKIES or
253 INTERNET_FLAG_NO_UI or INTERNET_FLAG_SECURE, 0);
254 if not Assigned(hRequest) then
255 MakeError(FSession, GetLastError())
256 else begin
257 UserInfo := Format('ID=%s&PW=%s', [ID, Pass]);
258 UserAgent := Format('%s %s', [DOLIB_2CH_UA, ClientUA]) + #13#10;
259 if not HttpSendRequest(hRequest, PChar(UserAgent), DWORD(-1), PChar(UserInfo), Length(UserInfo)) then
260 MakeError(FSession, GetLastError())
261 else begin
262 if not InternetReadFile(hRequest, @Buf, SizeOf(Buf), cb) then
263 MakeError(FSession, GetLastError())
264 else if (cb < 11) or (Pos('SESSION-ID=', Buf) <> 1) then
265 MakeError(FSession, ERROR_INVALID_DATA)
266 else begin
267 if Buf[cb - 1] = #10 then
268 Buf[cb - 1] := #0;
269 FSession.SessionID := Copy(Buf, 12, cb);
270 if FSession.SessionID = '' then
271 MakeError(FSession, ERROR_NOT_ENOUGH_MEMORY);
272 Delim := Pos(':', Buf);
273 if Delim = 0 then
274 MakeError(FSession, ERROR_INVALID_DATA)
275 else begin
276 FSession.UserAgent := Copy(Buf, 12, Delim - 12);
277 if FSession.UserAgent = '' then
278 MakeError(FSession, ERROR_NOT_ENOUGH_MEMORY);
279 end;
280 end;
281 end;
282 InternetCloseHandle(hRequest);
283 end;
284 InternetCloseHandle(hConnect);
285 end;
286 InternetCloseHandle(hSession);
287 end;
288 end;
289 //SSL髫懷ョウ逕ィ蠑キ蛻カ繝ュ繧ー繧、繝ウ
290 procedure TDolib.ForcedDOLIB_LOGIN(Proxy: string; Port: Integer; ID: string; Pass: string);
291 var
292 hSession: HINTERNET;
293 hConnect: HINTERNET;
294 hRequest: HINTERNET;
295 ProxyHostPort: string;
296 Buf: array[0..4096] of Char;
297 UserInfo: string;
298 UserAgent: string;
299 cb: DWORD;
300 Delim: Integer;
301 begin
302 FSession := TDolibSession.Create;
303
304 if Proxy <> '' then begin
305 ProxyHostPort := Format('%s:%d', [Proxy, Port]);
306 hSession := InternetOpen(DOLIB_LOGIN_UA, INTERNET_OPEN_TYPE_PROXY, PChar(ProxyHostPort), '', 0);
307 end else begin
308 hSession := InternetOpen(DOLIB_LOGIN_UA, INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0);
309 end;
310
311 if not Assigned(hSession) then
312 MakeError(FSession, GetLastError())
313 else begin
314 hConnect := InternetConnect(hSession, DOLIB_LOGIN_HOST,
315 INTERNET_DEFAULT_HTTPS_PORT, nil, nil,
316 INTERNET_SERVICE_HTTP, INTERNET_FLAG_SECURE, 0);
317 if not Assigned(hConnect) then
318 MakeError(FSession, GetLastError())
319 else begin
320 hRequest := HttpOpenRequest(hConnect, 'POST', DOLIB_LOGIN_URL,
321 nil, nil, nil,
322 INTERNET_FLAG_NO_CACHE_WRITE or INTERNET_FLAG_NO_COOKIES or
323 INTERNET_FLAG_NO_UI or INTERNET_FLAG_SECURE, 0);
324 if not Assigned(hRequest) then
325 MakeError(FSession, GetLastError())
326 else begin
327 UserInfo := Format('ID=%s&PW=%s', [ID, Pass]);
328 UserAgent := Format('%s %s', [DOLIB_2CH_UA, ClientUA]) + #13#10;
329 HttpSendRequest(hRequest, PChar(UserAgent), DWORD(-1), PChar(UserInfo), Length(UserInfo));
330 if not InternetReadFile(hRequest, @Buf, SizeOf(Buf), cb) then
331 MakeError(FSession, GetLastError())
332 else if (cb < 11) or (Pos('SESSION-ID=', Buf) <> 1) then
333 MakeError(FSession, ERROR_INVALID_DATA)
334 else begin
335 if Buf[cb - 1] = #10 then
336 Buf[cb - 1] := #0;
337 FSession.SessionID := Copy(Buf, 12, cb);
338 if FSession.SessionID = '' then
339 MakeError(FSession, ERROR_NOT_ENOUGH_MEMORY);
340 Delim := Pos(':', Buf);
341 if Delim = 0 then
342 MakeError(FSession, ERROR_INVALID_DATA)
343 else begin
344 FSession.UserAgent := Copy(Buf, 12, Delim - 12);
345 if FSession.UserAgent = '' then
346 MakeError(FSession, ERROR_NOT_ENOUGH_MEMORY);
347 end;
348 end;
349 InternetCloseHandle(hRequest);
350 end;
351 InternetCloseHandle(hConnect);
352 end;
353 InternetCloseHandle(hSession);
354 end;
355 end;
356 end.
357

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