Dolib.pas

   1 {*******************************************************}
   2 {                                                       }
   3 {       DOLIB API Interface Unit                        }
   4 {                                                       }
   5 {       2002 Monazilla Project                          }
   6 {            Dax   mailto:daxmonazilla@yahoo.co.jp      }
   7 {            \81i\83q\81jmailto:gikonavi@ice.dti2.ne.jp       }
   8 {********************************************************
   9
  10 Updates:
  11
  12 2002/03/02 \83\8d\83O\83C\83\93\83G\83\89\81[\82ð\8c\9f\8fo\82·\82é\82æ\82¤\82É\8fC\90³\82µ\82½\82©\82à\81B
  13 2002/03/02 DOLIB.dll\82ð\8eg\82í\82È\82¢\82æ\82¤\82É\82µ\82½\81B
  14 2002/02/27 \83o\83O\8fC\90³ (GetVersion\82Í\83R\83l\83N\83g\82µ\82Ä\82È\82\82Ä\82à\8eæ\93¾\89Â\94\\82É\82µ\82½)
  15 2002/01/22 DOLIB 1.00C\91Î\89\9e\81B
  16                                          \88È\89º\82Ì\83v\83\8d\83p\83e\83B\82ð\92Ç\89Á\81B
  17                                          - Session ......... \83Z\83b\83V\83\87\83\93\82Ì\83|\83C\83\93\83^\82ð\95Ô\82µ\82Ü\82·\81A\91½\95ª\8eg\82í\82È\82¢\81B
  18                                          - SessionID ....... \83Z\83b\83V\83\87\83\93ID\82ð\95Ô\82µ\82Ü\82·\81B
  19                                          - Version ......... DOLIB\82Ì\83o\81[\83W\83\87\83\93\82ð\95Ô\82µ\82Ü\82·\81B
  20                                          - UserAgent ....... UA\97p\82Ì\95¶\8e\9a\97ñ Monazilla/x.xx \82ð\95Ô\82µ\82Ü\82·\81B
  21                                          - ErrorCode ....... \83G\83\89\81[\83R\81[\83h\82ð\95Ô\82µ\82Ü\82·\81B
  22                                          - ErrorMsg ........ \83G\83\89\81[\83\81\83b\83Z\81[\83W\82ð\95Ô\82µ\82Ü\82·\81B
  23 2002/01/20 Disconnect\8cã\82É Connected\83v\83\8d\83p\83e\83B\82ð\96ß\82µ\82Ä\82È\82©\82Á\82½\81B
  24 2002/01/19 DOLIB 1.00B\91Î\89\9e\81B\83f\81[\83^\8eæ\93¾\82É\90¬\8c÷\81I
  25 2002/01/18 DOLIB 1.00\91Î\89\9e\81B\82µ\82©\82µ\83G\83\89\81[\82µ\82©\95Ô\82Á\82Ä\97\88\82È\82¢\81A\81A
  26 2002/01/18 ghanyan\8e\81\82Ì\8f\95\8c¾\82É\82æ\82è\93®\8dì\82·\82é\81B\8a´\8eÓ\81I
  27 2002/01/09 DOLIB 0.01\97p\82É\8dì\90¬\8aJ\8en\81B\82Å\82à\93®\82©\82È\82¢\82Ì\82Å\82Ù\82Á\82Æ\82\81B
  28 }
  29 unit Dolib;
  30
  31 {$IOCHECKS ON}
  32
  33 interface
  34
  35 uses
  36         Windows, SysUtils, WinInet, YofUtils;
  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\8fá\8aQ\97p\8b\90§\83\8d\83O\83C\83\93
  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 = '\83\81\83\82\83\8a\82ª\91«\82è\82Ü\82¹\82ñ\81B';
  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\82Ü\82Å\82ÌSSL\8fá\8aQ\97p\8b\90§\83\8d\83O\83C\83\93\81i12/21\88È\8d~\82È\82ç\92Ê\8fí\83\8d\83O\83C\83\93\81j
 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\82©\83p\83X\83\8f\81[\83h\82ª\90³\82µ\82\82 \82è\82Ü\82¹\82ñ\81B';
 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\82ÉMAKELANGID\83}\83N\83\8d\82ª\96³\82©\82Á\82½\82Ì\81B(\81L¥\83Ö¥`)¼®ÎÞ°Ý
 208 //                      MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
 209                         Buf, SizeOf(Buf), nil);
 210                 Session.ErrorString := Buf;
 211         end;
 212 end;
 213
 214 {\8eQ\8dlURL
 215 kage\8dì\8eÒ\82³\82ñ\82ÌDOLIB\83N\83\8d\81[\83\93\83\\81[\83X\81i\91å\95Ï\82¨\82¢\82µ\82ã\82¤\82²\82´\82¢\82Ü\82µ\82½\81j
 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     Header: 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', DOLIB_LOGIN_URL,
 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', [HttpEncode(ID), HttpEncode(Pass)]);
 260                 Header := 'Content-Type: application/x-www-form-urlencoded'#13#10;
 261                                 UserAgent := Format('%s %s', [DOLIB_2CH_UA, ClientUA]) + #13#10;
 262                 Header := Header + UserAgent;
 263                                 if not HttpSendRequest(hRequest, PChar(Header), DWORD(-1), PChar(UserInfo), Length(UserInfo)) then
 264                                         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 //SSL\8fá\8aQ\97p\8b\90§\83\8d\83O\83C\83\93
 294 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
 315         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                         hRequest := HttpOpenRequest(hConnect, 'POST', DOLIB_LOGIN_URL,
 325                                 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 end.
 361