Develop and Download Open Source Software

Browse CVS Repository

Annotation of /gikonavigoeson/gikonavi/Dolib.pas

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


Revision 1.7 - (hide annotations) (download) (as text)
Sat Jul 10 07:52:22 2010 UTC (13 years, 9 months ago) by h677
Branch: MAIN
CVS Tags: v1_63_1_819, v1_62_0_812, v1_63_0_818, v1_63_0_817, v1_63_0_816, v1_63_0_815, v1_62_0_805, v1_62_0_807, v1_62_0_806, v1_62_0_809, v1_62_0_810, v1_62_0_811, v1_62_1_813, HEAD
Branch point for: Bb62, Bb63
Changes since 1.6: +6 -3 lines
File MIME type: text/x-pascal
2ちゃんねるビューアへのログインで、リクエストヘッダを追加

1 hi_ 1.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 h677 1.7 Windows, SysUtils, WinInet, YofUtils;
37 hi_ 1.1
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 h677 1.4 procedure ForcedDOLIB_LOGIN(Proxy: string; Port: Integer; ID: string; Pass: string);
69 hi_ 1.1 public
70     constructor Create;
71     destructor Destroy; override;
72     function Connect: boolean;
73 h677 1.4 function ForcedConnect: boolean; //SSL??絎括??七?吟???違?ゃ??/span>
74 hi_ 1.1 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 h677 1.6 DOLIB_LOGIN_HOST = '2chv.tora3.net';
93     DOLIB_LOGIN_URL = '/futen.cgi';
94 hi_ 1.1 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 h677 1.6 // https://2chv.tora3.net/futen.cgi
99 hi_ 1.1
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 h677 1.2 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 hi_ 1.1
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 h677 1.7 Header: string;
231 hi_ 1.1 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 h677 1.5 hRequest := HttpOpenRequest(hConnect, 'POST', DOLIB_LOGIN_URL,
253 hi_ 1.1 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 h677 1.7 UserInfo := Format('ID=%s&PW=%s', [HttpEncode(ID), HttpEncode(Pass)]);
260     Header := 'Content-Type: application/x-www-form-urlencoded'#13#10;
261 hi_ 1.1 UserAgent := Format('%s %s', [DOLIB_2CH_UA, ClientUA]) + #13#10;
262 h677 1.7 Header := Header + UserAgent;
263     if not HttpSendRequest(hRequest, PChar(Header), DWORD(-1), PChar(UserInfo), Length(UserInfo)) then
264 hi_ 1.1 MakeError(FSession, GetLastError())
265     else begin
266     if not InternetReadFile(hRequest, @Buf, SizeOf(Buf), cb) then
267     MakeError(FSession, GetLastError())
268     else if (cb < 11) or (Pos('SESSION-ID=', Buf) <> 1) then
269     MakeError(FSession, ERROR_INVALID_DATA)
270     else begin
271     if Buf[cb - 1] = #10 then
272     Buf[cb - 1] := #0;
273     FSession.SessionID := Copy(Buf, 12, cb);
274     if FSession.SessionID = '' then
275     MakeError(FSession, ERROR_NOT_ENOUGH_MEMORY);
276     Delim := Pos(':', Buf);
277     if Delim = 0 then
278     MakeError(FSession, ERROR_INVALID_DATA)
279     else begin
280     FSession.UserAgent := Copy(Buf, 12, Delim - 12);
281     if FSession.UserAgent = '' then
282     MakeError(FSession, ERROR_NOT_ENOUGH_MEMORY);
283     end;
284     end;
285     end;
286     InternetCloseHandle(hRequest);
287     end;
288     InternetCloseHandle(hConnect);
289     end;
290     InternetCloseHandle(hSession);
291     end;
292     end;
293 h677 1.3 //SSL??絎括??七?吟???違?ゃ??/span>
294 h677 1.2 procedure TDolib.ForcedDOLIB_LOGIN(Proxy: string; Port: Integer; ID: string; Pass: string);
295     var
296     hSession: HINTERNET;
297     hConnect: HINTERNET;
298     hRequest: HINTERNET;
299     ProxyHostPort: string;
300     Buf: array[0..4096] of Char;
301     UserInfo: string;
302     UserAgent: string;
303     cb: DWORD;
304     Delim: Integer;
305     begin
306     FSession := TDolibSession.Create;
307    
308     if Proxy <> '' then begin
309     ProxyHostPort := Format('%s:%d', [Proxy, Port]);
310     hSession := InternetOpen(DOLIB_LOGIN_UA, INTERNET_OPEN_TYPE_PROXY, PChar(ProxyHostPort), '', 0);
311     end else begin
312     hSession := InternetOpen(DOLIB_LOGIN_UA, INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0);
313     end;
314 hi_ 1.1
315 h677 1.2 if not Assigned(hSession) then
316     MakeError(FSession, GetLastError())
317     else begin
318     hConnect := InternetConnect(hSession, DOLIB_LOGIN_HOST,
319     INTERNET_DEFAULT_HTTPS_PORT, nil, nil,
320     INTERNET_SERVICE_HTTP, INTERNET_FLAG_SECURE, 0);
321     if not Assigned(hConnect) then
322     MakeError(FSession, GetLastError())
323     else begin
324 h677 1.5 hRequest := HttpOpenRequest(hConnect, 'POST', DOLIB_LOGIN_URL,
325 h677 1.2 nil, nil, nil,
326     INTERNET_FLAG_NO_CACHE_WRITE or INTERNET_FLAG_NO_COOKIES or
327     INTERNET_FLAG_NO_UI or INTERNET_FLAG_SECURE, 0);
328     if not Assigned(hRequest) then
329     MakeError(FSession, GetLastError())
330     else begin
331     UserInfo := Format('ID=%s&PW=%s', [ID, Pass]);
332     UserAgent := Format('%s %s', [DOLIB_2CH_UA, ClientUA]) + #13#10;
333     HttpSendRequest(hRequest, PChar(UserAgent), DWORD(-1), PChar(UserInfo), Length(UserInfo));
334     if not InternetReadFile(hRequest, @Buf, SizeOf(Buf), cb) then
335     MakeError(FSession, GetLastError())
336     else if (cb < 11) or (Pos('SESSION-ID=', Buf) <> 1) then
337     MakeError(FSession, ERROR_INVALID_DATA)
338     else begin
339     if Buf[cb - 1] = #10 then
340     Buf[cb - 1] := #0;
341     FSession.SessionID := Copy(Buf, 12, cb);
342     if FSession.SessionID = '' then
343     MakeError(FSession, ERROR_NOT_ENOUGH_MEMORY);
344     Delim := Pos(':', Buf);
345     if Delim = 0 then
346     MakeError(FSession, ERROR_INVALID_DATA)
347     else begin
348     FSession.UserAgent := Copy(Buf, 12, Delim - 12);
349     if FSession.UserAgent = '' then
350     MakeError(FSession, ERROR_NOT_ENOUGH_MEMORY);
351     end;
352     end;
353     InternetCloseHandle(hRequest);
354     end;
355     InternetCloseHandle(hConnect);
356     end;
357     InternetCloseHandle(hSession);
358     end;
359     end;
360 hi_ 1.1 end.
361    

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