| 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 |
|