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.4 - (show annotations) (download) (as text)
Wed May 19 15:05:24 2004 UTC (19 years, 11 months ago) by h677
Branch: MAIN
Changes since 1.3: +7 -5 lines
File MIME type: text/x-pascal
認証鯖の変更に対応できるようにした

1 {*******************************************************}
2 { }
3 { DOLIB API Interface Unit }
4 { }
5 { 2002 Monazilla Project }
6 { Dax mailto:daxmonazilla@yahoo.co.jp }
7 { 鐚???鐚?mailto:gikonavi@ice.dti2.ne.jp }
8 {********************************************************
9
10 Updates:
11
12 2002/03/02 ???違?ゃ?潟?????若??罎??冴??????????信罩c??????????
13 2002/03/02 DOLIB.dll??篏帥?????????????????
14 2002/02/27 ???遺信罩 (GetVersion???潟???????????????????緇????純??????)
15 2002/01/22 DOLIB 1.00C絲上???
16 篁ヤ????????????c??菴遵????
17 - Session ......... ?祉???激?с?潟?????ゃ?潟?帥??菴????障????紊???篏帥???????
18 - SessionID ....... ?祉???激?с??D??菴????障????
19 - Version ......... DOLIB?????若?吾?с?潟??菴????障????
20 - UserAgent ....... UA??????絖??? Monazilla/x.xx ??菴????障????
21 - ErrorCode ....... ?????若?潟?若????菴????障????
22 - ErrorMsg ........ ?????若?<???祉?若?吾??菴????障????
23 2002/01/20 Disconnect緇?? Connected?????????c???祉?????????c????
24 2002/01/19 DOLIB 1.00B絲上??????若?水????????鐚?
25 2002/01/18 DOLIB 1.00絲上??????????????若????菴??c???ャ????????
26 2002/01/18 ghanyan羂?????????????篏?????????茗?鐚?
27 2002/01/09 DOLIB 0.01?????????紮????с?????????????с?祉?c?????
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 FDolibURL: string;
62 function GetSessionID: string;
63 function GetVersion: string;
64 function GetUserAgent: string;
65 function GetErrorCode: integer;
66 function GetErrorMsg: string;
67 procedure MakeError(Session: TDolibSession; Error: DWORD);
68 procedure DOLIB_LOGIN(Proxy: string; Port: Integer; ID: string; Pass: string);
69 procedure ForcedDOLIB_LOGIN(Proxy: string; Port: Integer; ID: string; Pass: string);
70 public
71 constructor Create;
72 destructor Destroy; override;
73 function Connect: boolean;
74 function ForcedConnect: boolean; //SSL??絎括??七?吟???違?ゃ??/span>
75 function Disconnect: boolean;
76 property ProxyAddress: string read FProxyAddress write FProxyAddress;
77 property ProxyPort: integer read FProxyPort write FProxyPort;
78 property UserName: string read FUserName write FUserName;
79 property Password: string read FPassword write FPassword;
80 property ClientUA: string read FClientUA write FClientUA;
81 property Connected: boolean read FConnected;
82 property SessionID: string read GetSessionID;
83 property Version: string read GetVersion;
84 property UserAgent: string read GetUserAgent;
85 property ErrorCode: integer read GetErrorCode;
86 property ErrorMsg: string read GetErrorMsg;
87 property DolibURL: string read FDolibURL write FDolibURL;
88 end;
89
90 implementation
91 const
92 DOLIB_VERSION = $10000;
93 DOLIB_LOGIN_UA = 'DOLIB/1.00';
94 DOLIB_LOGIN_HOST = 'tiger2.he.net';
95 // DOLIB_LOGIN_URL = '/~tora3n2c/futen.cgi';
96 DOLIB_2CH_UA = 'X-2ch-UA:';
97 // DOLIB_2CH_UA = 'X-2ch-UA: gikoNavi/1.00'#13#10;
98 DOLIB_ENOMEM_STRING = '?<?≪????莇潟???障??????';
99 DOLIB_LOGIN_ERROR = 'ERROR:';
100
101 { TDolib }
102
103 constructor TDolib.Create;
104 begin
105 FSession := nil;
106 FConnected := False;
107 end;
108
109 destructor TDolib.Destroy;
110 begin
111 if Connected then
112 Disconnect;
113 inherited;
114 end;
115
116 function TDolib.Connect: boolean;
117 begin
118 Result := False;
119 if not Connected then begin
120 DOLIB_LOGIN(FProxyAddress, FProxyPort, FUserName, FPassword);
121 FConnected := True;
122 if (AnsiPos(DOLIB_LOGIN_ERROR, SessionID) = 1) then begin
123 Disconnect;
124 Result := False;
125 end else if ErrorCode <> 0 then begin
126 Disconnect;
127 Result := False;
128 end else begin
129 Result := True;
130 // Result := (ErrorCode = 0);
131 end;
132 end;
133 end;
134 function TDolib.ForcedConnect: boolean; //2003/12/20?障?с??SL??絎括??七?吟???違?ゃ?鰹?12/21篁ラ????????絽吾???違?ゃ?鰹?
135 begin
136 Result := False;
137 if not Connected then begin
138 ForcedDOLIB_LOGIN(FProxyAddress, FProxyPort, FUserName, FPassword);
139 Result := True;
140 end;
141 end;
142
143 function TDolib.Disconnect: boolean;
144 begin
145 Result := True;
146 if FSession <> nil then
147 FreeAndNil(FSession);
148 FConnected := False;
149 end;
150
151 function TDolib.GetVersion: string;
152 var
153 v : DWORD;
154 mj, mn : integer;
155 begin
156 v := DOLIB_VERSION;
157 mj := v shr 16;
158 mn := v and $ffff;
159 Result := Format('%d.%.2d', [mj, mn]);
160 end;
161
162 function TDolib.GetSessionID: string;
163 begin
164 if Connected then
165 Result := FSession.FSessionID
166 else
167 Result := '';
168 end;
169
170 function TDolib.GetUserAgent: string;
171 begin
172 if Connected then
173 Result := FSession.FUserAgent
174 else
175 Result := '';
176 end;
177
178 function TDolib.GetErrorMsg: string;
179 begin
180 if Connected then
181 Result := FSession.FErrorString
182 else
183 Result := 'Error: ID?????鴻???若????罩c????????障??????';
184 end;
185
186 function TDolib.GetErrorCode: integer;
187 begin
188 if Connected then
189 Result := FSession.ErrorCode
190 else
191 Result := 0;
192 end;
193
194 procedure TDolib.MakeError(Session: TDolibSession; Error: DWORD);
195 var
196 Buf: array[0..4096] of Char;
197 begin
198 Session.ErrorCode := Error;
199 if Error = ERROR_NOT_ENOUGH_MEMORY then
200 Session.ErrorString := DOLIB_ENOMEM_STRING
201 else begin
202 FillChar(Buf, SizeOf(Buf), #0);
203 FormatMessage({FORMAT_MESSAGE_ALLOCATE_BUFFER or}
204 FORMAT_MESSAGE_IGNORE_INSERTS or
205 FORMAT_MESSAGE_FROM_SYSTEM or
206 FORMAT_MESSAGE_FROM_HMODULE,
207 Pointer(GetModuleHandle('wininet')), Error,
208 (((Word(SUBLANG_DEFAULT)) shl 10) or Word(LANG_NEUTRAL)), //Delphi??AKELANGID?????????<???c??????(卒鐔ハ?鐔?)鐔種舟鐓??鐔逸?
209 // MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
210 Buf, SizeOf(Buf), nil);
211 Session.ErrorString := Buf;
212 end;
213 end;
214
215 {????URL
216 kage篏?????????OLIB?????若?潟?純?若?刻?紊у??????????????????障????鐚?
217 http://members.jcom.home.ne.jp/monazilla/document/wininetdel.html
218 http://support.microsoft.com/default.aspx?scid=kb;EN-US;q168151
219 http://msdn.microsoft.com/library/default.asp?url=/workshop/networking/wininet/wininet.asp
220 http://homepage1.nifty.com/~suzuki/delphi/wininet.html
221 }
222 procedure TDolib.DOLIB_LOGIN(Proxy: string; Port: Integer; ID: string; Pass: string);
223 var
224 hSession: HINTERNET;
225 hConnect: HINTERNET;
226 hRequest: HINTERNET;
227 ProxyHostPort: string;
228 Buf: array[0..4096] of Char;
229 UserInfo: string;
230 UserAgent: string;
231 cb: DWORD;
232 Delim: Integer;
233 begin
234 FSession := TDolibSession.Create;
235
236 if Proxy <> '' then begin
237 ProxyHostPort := Format('%s:%d', [Proxy, Port]);
238 hSession := InternetOpen(DOLIB_LOGIN_UA, INTERNET_OPEN_TYPE_PROXY, PChar(ProxyHostPort), '', 0);
239 end else begin
240 hSession := InternetOpen(DOLIB_LOGIN_UA, INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0);
241 end;
242
243 if not Assigned(hSession) then
244 MakeError(FSession, GetLastError())
245 else begin
246 hConnect := InternetConnect(hSession, DOLIB_LOGIN_HOST,
247 INTERNET_DEFAULT_HTTPS_PORT, nil, nil,
248 INTERNET_SERVICE_HTTP, INTERNET_FLAG_SECURE, 0);
249 if not Assigned(hConnect) then
250 MakeError(FSession, GetLastError())
251 else begin
252 hRequest := HttpOpenRequest(hConnect, 'POST', PChar(FDolibURL),
253 nil, nil, nil,
254 INTERNET_FLAG_NO_CACHE_WRITE or INTERNET_FLAG_NO_COOKIES or
255 INTERNET_FLAG_NO_UI or INTERNET_FLAG_SECURE, 0);
256 if not Assigned(hRequest) then
257 MakeError(FSession, GetLastError())
258 else begin
259 UserInfo := Format('ID=%s&PW=%s', [ID, Pass]);
260 UserAgent := Format('%s %s', [DOLIB_2CH_UA, ClientUA]) + #13#10;
261 if not HttpSendRequest(hRequest, PChar(UserAgent), DWORD(-1), PChar(UserInfo), Length(UserInfo)) then
262 MakeError(FSession, GetLastError())
263 else begin
264 if not InternetReadFile(hRequest, @Buf, SizeOf(Buf), cb) then
265 MakeError(FSession, GetLastError())
266 else if (cb < 11) or (Pos('SESSION-ID=', Buf) <> 1) then
267 MakeError(FSession, ERROR_INVALID_DATA)
268 else begin
269 if Buf[cb - 1] = #10 then
270 Buf[cb - 1] := #0;
271 FSession.SessionID := Copy(Buf, 12, cb);
272 if FSession.SessionID = '' then
273 MakeError(FSession, ERROR_NOT_ENOUGH_MEMORY);
274 Delim := Pos(':', Buf);
275 if Delim = 0 then
276 MakeError(FSession, ERROR_INVALID_DATA)
277 else begin
278 FSession.UserAgent := Copy(Buf, 12, Delim - 12);
279 if FSession.UserAgent = '' then
280 MakeError(FSession, ERROR_NOT_ENOUGH_MEMORY);
281 end;
282 end;
283 end;
284 InternetCloseHandle(hRequest);
285 end;
286 InternetCloseHandle(hConnect);
287 end;
288 InternetCloseHandle(hSession);
289 end;
290 end;
291 //SSL??絎括??七?吟???違?ゃ??/span>
292 procedure TDolib.ForcedDOLIB_LOGIN(Proxy: string; Port: Integer; ID: string; Pass: string);
293 var
294 hSession: HINTERNET;
295 hConnect: HINTERNET;
296 hRequest: HINTERNET;
297 ProxyHostPort: string;
298 Buf: array[0..4096] of Char;
299 UserInfo: string;
300 UserAgent: string;
301 cb: DWORD;
302 Delim: Integer;
303 begin
304 FSession := TDolibSession.Create;
305
306 if Proxy <> '' then begin
307 ProxyHostPort := Format('%s:%d', [Proxy, Port]);
308 hSession := InternetOpen(DOLIB_LOGIN_UA, INTERNET_OPEN_TYPE_PROXY, PChar(ProxyHostPort), '', 0);
309 end else begin
310 hSession := InternetOpen(DOLIB_LOGIN_UA, INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0);
311 end;
312
313 if not Assigned(hSession) then
314 MakeError(FSession, GetLastError())
315 else begin
316 hConnect := InternetConnect(hSession, DOLIB_LOGIN_HOST,
317 INTERNET_DEFAULT_HTTPS_PORT, nil, nil,
318 INTERNET_SERVICE_HTTP, INTERNET_FLAG_SECURE, 0);
319 if not Assigned(hConnect) then
320 MakeError(FSession, GetLastError())
321 else begin
322 hRequest := HttpOpenRequest(hConnect, 'POST', PChar(FDolibURL),
323 nil, nil, nil,
324 INTERNET_FLAG_NO_CACHE_WRITE or INTERNET_FLAG_NO_COOKIES or
325 INTERNET_FLAG_NO_UI or INTERNET_FLAG_SECURE, 0);
326 if not Assigned(hRequest) then
327 MakeError(FSession, GetLastError())
328 else begin
329 UserInfo := Format('ID=%s&PW=%s', [ID, Pass]);
330 UserAgent := Format('%s %s', [DOLIB_2CH_UA, ClientUA]) + #13#10;
331 HttpSendRequest(hRequest, PChar(UserAgent), DWORD(-1), PChar(UserInfo), Length(UserInfo));
332 if not InternetReadFile(hRequest, @Buf, SizeOf(Buf), cb) then
333 MakeError(FSession, GetLastError())
334 else if (cb < 11) or (Pos('SESSION-ID=', Buf) <> 1) then
335 MakeError(FSession, ERROR_INVALID_DATA)
336 else begin
337 if Buf[cb - 1] = #10 then
338 Buf[cb - 1] := #0;
339 FSession.SessionID := Copy(Buf, 12, cb);
340 if FSession.SessionID = '' then
341 MakeError(FSession, ERROR_NOT_ENOUGH_MEMORY);
342 Delim := Pos(':', Buf);
343 if Delim = 0 then
344 MakeError(FSession, ERROR_INVALID_DATA)
345 else begin
346 FSession.UserAgent := Copy(Buf, 12, Delim - 12);
347 if FSession.UserAgent = '' then
348 MakeError(FSession, ERROR_NOT_ENOUGH_MEMORY);
349 end;
350 end;
351 InternetCloseHandle(hRequest);
352 end;
353 InternetCloseHandle(hConnect);
354 end;
355 InternetCloseHandle(hSession);
356 end;
357 end;
358 end.
359

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