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.6 - (show annotations) (download) (as text)
Tue May 25 13:02:48 2004 UTC (19 years, 10 months ago) by h677
Branch: MAIN
CVS Tags: v1_59_0_771, v1_59_0_770, v1_59_0_773, v1_59_0_772, v1_59_0_775, v1_59_0_774, v1_59_0_777, v1_59_0_776, v1_56_0_715, v1_59_0_778, b49, b48, v1_57_0_737, v1_57_0_735, v1_57_0_734, v1_57_0_733, v1_57_0_732, v1_57_0_731, v1_57_0_730, v1_50_2_606, v1_51_0_612, v1_50_0_581, v1_50_0_580, v1_50_0_587, v1_50_0_586, v1_57_0_739, v1_57_0_738, v1_59_1_765, v1_51_1_639, v1_53_0_671, v1_50_0_595, v1_60_0_788, v1_60_0_789, v1_54_0_677, v1_54_0_676, v1_50_0_572, v1_58_0_748, marged-Bb50, v1_58_0_745, v1_60_0_781, v1_60_0_782, v1_58_0_746, v1_60_0_784, v1_54_0_678, v1_60_0_786, v1_60_0_787, v1_56_0_707, v1_59_0_767, v1_56_0_705, v1_56_0_704, v1_56_0_703, v1_56_0_702, v1_56_0_701, v1_56_0_700, v1_59_1_778, v1_51_0_626, v1_57_0_723, b51, v1_52_1_658, v1_51_0_622, v1_59_0_768, v1_59_0_769, v1_50_0_598, v1_57_0_725, v1_57_0_726, v1_57_0_727, v1_57_0_720, v1_57_0_722, v1_57_1_744, v1_50_0_590, bv1_49_0_564, v1_50_0_593, v1_57_0_728, v1_57_0_729, v1_50_0_596, bv1_49_0_563, v1_52_0_646, v1_50_0_557, v1_57_0_736, v1_50_0_585, v1_51_0_611, v1_51_0_620, v1_52_0_644, v1_58_0_752, v1_58_0_750, v1_58_0_751, v1_58_0_756, v1_58_0_757, v1_58_0_754, v1_58_0_755, v1_58_0_759, v1_52_0_643, v1_57_0_719, v1_57_0_718, v1_56_0_716, v1_54_0_687, v1_56_0_710, v1_56_0_711, v1_56_1_717, v1_56_1_716, v1_51_0_634, v1_51_0_635, v1_51_0_636, v1_51_0_637, v1_54_0_688, v1_54_0_689, v1_51_0_632, v1_51_0_633, v1_49_0_548, v1_50_0_603, v1_54_0_684, v1_50_0_582, v1_54_0_685, v1_49_0_540, v1_49_0_542, v1_49_0_545, v1_49_0_544, v1_49_0_547, v1_53_0_664, v1_61_0_796, v1_61_0_797, v1_61_0_795, v1_52_0_647, v1_61_0_798, v1_61_0_799, v1_50_0_604, v1_51_0_638, v1_52_0_648, v1_53_0_661, v1_53_0_663, v1_53_0_662, v1_53_0_665, v1_53_0_667, v1_53_0_666, v1_53_0_669, v1_53_0_668, v1_48_0_530, v1_55_0_692, v1_55_0_693, v1_55_0_696, v1_55_0_697, v1_55_0_694, v1_55_0_695, v1_49_0_554, merged-remodeling, v1_50_0_577, v1_49_0_551, v1_52_0_645, v1_52_0_651, v1_54_1_691, v1_52_0_650, v1_56_2_724, v1_50_0_606, v1_56_2_722, v1_50_0_588, v1_52_0_652, v1_55_1_697, v1_52_0_642, v1_52_0_654, v1_51_0_616, v1_56_0_714, v1_51_0_614, v1_51_0_615, v1_53_0_672, v1_51_0_613, v1_53_0_670, v1_48_0_510, v1_51_1_640, v1_54_0_686, v1_51_0_618, v1_51_0_619, bv1_49_0_565, v1_54_0_680, v1_54_0_681, v1_62_0_804, b50, v1_56_0_712, v1_62_0_803, v1_62_0_802, v1_48_0_535, v1_49_0_552, v1_56_0_713, v1_50_0_574, v1_54_0_682, v1_49_0_553, v1_50_0_584, v_step1, v1_56_0_721, v1_49_0_546, v1_50_0_573, v1_48_0_539, v1_48_0_538, v1_50_0_600, v1_51_0_630, v1_48_0_533, v1_50_0_571, v1_54_0_683, v1_48_0_537, v1_51_0_631, v1_49_2_569, v1_60_0_780, v1_60_0_779, v1_58_0_747, v1_60_0_783, root-of-draw, v1_50_0_576, v1_54_0_679, v1_59_2_785, marged_bRESPOPUP, v1_50_2_604, v1_50_0_578, v1_54_0_675, v1_51_0_628, v1_50_0_579, v1_51_0_617, v1_48_0_536, root-of-Bb50, root-of-Bb51, v1_56_0_706, root-of-remodel, root-of-Bb53, v1_50_0_594, v1_49_0_541, v1_52_1_657, v1_54_0_674, v1_52_0_660, v1_60_1_793, v1_50_0_602, v1_51_0_629, v1_54_0_690, v1_51_0_627, v1_50_0_601, v1_58_0_763, v1_58_0_762, v1_58_0_761, v1_58_0_760, v1_51_0_625, v1_51_0_623, v1_57_2_749, v1_50_0_605, v1_57_0_742, v1_57_0_743, v1_57_0_740, v1_57_0_741, v1_52_0_655, v1_56_0_709, v1_57_0_744, v1_52_0_656, v1_56_0_708, v1_52_0_649, v1_61_0_800, v1_53_1_673, v1_50_0_599, v1_56_0_699, v1_56_0_698, v1_50_0_561, v1_51_0_624, v1_51_1_641, v1_51_0_621, v1_60_0_793, v1_60_0_792, v1_60_0_791, v1_60_0_790, v1_60_2_794, v1_61_1_801
Branch point for: Bb57, Bb56, Bb55, Bb53, Bb52, Bb51, Bb60, Bb61, remodeling, Bb59, Bb58, Bb50, bRESPOPUP, bListSU, Bb49, Bb54, Bdraw
Changes since 1.5: +3 -2 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 { 鐚???鐚?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 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??絎括??七?吟???違?ゃ??/span>
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 = '?<?≪????莇潟???障??????';
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?障?с??SL??絎括??七?吟???違?ゃ?鰹?12/21篁ラ????????絽吾???違?ゃ?鰹?
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?????鴻???若????罩c????????障??????';
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??AKELANGID?????????<???c??????(卒鐔ハ?鐔?)鐔種舟鐓??鐔逸?
208 // MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
209 Buf, SizeOf(Buf), nil);
210 Session.ErrorString := Buf;
211 end;
212 end;
213
214 {????URL
215 kage篏?????????OLIB?????若?潟?純?若?刻?紊у??????????????????障????鐚?
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??絎括??七?吟???違?ゃ??/span>
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