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;
  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    = 'tiger2.he.net';
  93         DOLIB_LOGIN_URL     = '/~tora3n2c/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
  99 { TDolib }
 100
 101 constructor TDolib.Create;
 102 begin
 103         FSession   := nil;
 104         FConnected := False;
 105 end;
 106
 107 destructor TDolib.Destroy;
 108 begin
 109         if Connected then
 110                 Disconnect;
 111         inherited;
 112 end;
 113
 114 function TDolib.Connect: boolean;
 115 begin
 116         Result := False;
 117         if not Connected then begin
 118                 DOLIB_LOGIN(FProxyAddress, FProxyPort, FUserName, FPassword);
 119                 FConnected  :=  True;
 120                 if  (AnsiPos(DOLIB_LOGIN_ERROR, SessionID) = 1) then  begin
 121                         Disconnect;
 122                         Result      :=  False;
 123                 end else if ErrorCode <> 0 then begin
 124                         Disconnect;
 125                         Result := False;
 126                 end else begin
 127                         Result := True;
 128 //                      Result      :=  (ErrorCode = 0);
 129                 end;
 130         end;
 131 end;
 132 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
 133 begin
 134         Result := False;
 135         if not Connected then begin
 136                 ForcedDOLIB_LOGIN(FProxyAddress, FProxyPort, FUserName, FPassword);
 137         Result := True;
 138         end;
 139 end;
 140
 141 function TDolib.Disconnect: boolean;
 142 begin
 143         Result := True;
 144   if FSession <> nil then
 145     FreeAndNil(FSession);
 146   FConnected := False;
 147 end;
 148
 149 function TDolib.GetVersion: string;
 150 var
 151         v : DWORD;
 152         mj, mn : integer;
 153 begin
 154         v  := DOLIB_VERSION;
 155         mj := v shr 16;
 156         mn := v and $ffff;
 157         Result := Format('%d.%.2d', [mj, mn]);
 158 end;
 159
 160 function TDolib.GetSessionID: string;
 161 begin
 162         if Connected then
 163                 Result := FSession.FSessionID
 164         else
 165                 Result := '';
 166 end;
 167
 168 function TDolib.GetUserAgent: string;
 169 begin
 170         if Connected then
 171                 Result := FSession.FUserAgent
 172         else
 173                 Result := '';
 174 end;
 175
 176 function TDolib.GetErrorMsg: string;
 177 begin
 178         if Connected then
 179                 Result := FSession.FErrorString
 180         else
 181     Result  :=  'Error: ID\82©\83p\83X\83\8f\81[\83h\82ª\90³\82µ\82\82 \82è\82Ü\82¹\82ñ\81B';
 182 end;
 183
 184 function TDolib.GetErrorCode: integer;
 185 begin
 186         if Connected then
 187                 Result := FSession.ErrorCode
 188         else
 189                 Result := 0;
 190 end;
 191
 192 procedure TDolib.MakeError(Session: TDolibSession; Error: DWORD);
 193 var
 194         Buf: array[0..4096] of Char;
 195 begin
 196         Session.ErrorCode := Error;
 197         if Error = ERROR_NOT_ENOUGH_MEMORY then
 198                 Session.ErrorString := DOLIB_ENOMEM_STRING
 199         else begin
 200                 FillChar(Buf, SizeOf(Buf), #0);
 201                 FormatMessage({FORMAT_MESSAGE_ALLOCATE_BUFFER or}
 202                         FORMAT_MESSAGE_IGNORE_INSERTS or
 203                         FORMAT_MESSAGE_FROM_SYSTEM or
 204                         FORMAT_MESSAGE_FROM_HMODULE,
 205                         Pointer(GetModuleHandle('wininet')), Error,
 206                         (((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Ö¥`)¼®ÎÞ°Ý
 207 //                      MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
 208                         Buf, SizeOf(Buf), nil);
 209                 Session.ErrorString := Buf;
 210         end;
 211 end;
 212
 213 {\8eQ\8dlURL
 214 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
 215 http://members.jcom.home.ne.jp/monazilla/document/wininetdel.html
 216 http://support.microsoft.com/default.aspx?scid=kb;EN-US;q168151
 217 http://msdn.microsoft.com/library/default.asp?url=/workshop/networking/wininet/wininet.asp
 218 http://homepage1.nifty.com/~suzuki/delphi/wininet.html
 219 }
 220 procedure TDolib.DOLIB_LOGIN(Proxy: string; Port: Integer; ID: string; Pass: string);
 221 var
 222         hSession: HINTERNET;
 223         hConnect: HINTERNET;
 224         hRequest: HINTERNET;
 225         ProxyHostPort: string;
 226         Buf: array[0..4096] of Char;
 227         UserInfo: string;
 228         UserAgent: string;
 229         cb: DWORD;
 230         Delim: Integer;
 231 begin
 232         FSession := TDolibSession.Create;
 233
 234         if Proxy <> '' then begin
 235                 ProxyHostPort := Format('%s:%d', [Proxy, Port]);
 236                 hSession := InternetOpen(DOLIB_LOGIN_UA, INTERNET_OPEN_TYPE_PROXY, PChar(ProxyHostPort), '', 0);
 237         end else begin
 238                 hSession := InternetOpen(DOLIB_LOGIN_UA, INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0);
 239         end;
 240
 241         if not Assigned(hSession) then
 242                 MakeError(FSession, GetLastError())
 243         else begin
 244                 hConnect := InternetConnect(hSession, DOLIB_LOGIN_HOST,
 245                         INTERNET_DEFAULT_HTTPS_PORT, nil, nil,
 246                         INTERNET_SERVICE_HTTP, INTERNET_FLAG_SECURE, 0);
 247                 if not Assigned(hConnect) then
 248                         MakeError(FSession, GetLastError())
 249                 else begin
 250                         hRequest := HttpOpenRequest(hConnect, 'POST', DOLIB_LOGIN_URL,
 251                                 nil, nil, nil,
 252                                 INTERNET_FLAG_NO_CACHE_WRITE or INTERNET_FLAG_NO_COOKIES or
 253                                 INTERNET_FLAG_NO_UI or INTERNET_FLAG_SECURE, 0);
 254                         if not Assigned(hRequest) then
 255                                 MakeError(FSession, GetLastError())
 256                         else begin
 257                                 UserInfo := Format('ID=%s&PW=%s', [ID, Pass]);
 258                                 UserAgent := Format('%s %s', [DOLIB_2CH_UA, ClientUA]) + #13#10;
 259                                 if not HttpSendRequest(hRequest, PChar(UserAgent), DWORD(-1), PChar(UserInfo), Length(UserInfo)) then
 260                                         MakeError(FSession, GetLastError())
 261                                 else begin
 262                                         if not InternetReadFile(hRequest, @Buf, SizeOf(Buf), cb) then
 263                                                 MakeError(FSession, GetLastError())
 264                                         else if (cb < 11) or (Pos('SESSION-ID=', Buf) <> 1) then
 265                                                 MakeError(FSession, ERROR_INVALID_DATA)
 266                                         else begin
 267                                                 if Buf[cb - 1] = #10 then
 268                                                         Buf[cb - 1] := #0;
 269                                                 FSession.SessionID := Copy(Buf, 12, cb);
 270                                                 if FSession.SessionID = '' then
 271                                                         MakeError(FSession, ERROR_NOT_ENOUGH_MEMORY);
 272                                                 Delim := Pos(':', Buf);
 273                                                 if Delim = 0 then
 274                                                         MakeError(FSession, ERROR_INVALID_DATA)
 275                                                 else begin
 276                                                         FSession.UserAgent := Copy(Buf, 12, Delim - 12);
 277                                                         if FSession.UserAgent = '' then
 278                                                                 MakeError(FSession, ERROR_NOT_ENOUGH_MEMORY);
 279                                                 end;
 280                                         end;
 281                                 end;
 282                                 InternetCloseHandle(hRequest);
 283                         end;
 284                         InternetCloseHandle(hConnect);
 285                 end;
 286                 InternetCloseHandle(hSession);
 287         end;
 288 end;
 289 //SSL\8fá\8aQ\97p\8b\90§\83\8d\83O\83C\83\93
 290 procedure TDolib.ForcedDOLIB_LOGIN(Proxy: string; Port: Integer; ID: string; Pass: string);
 291 var
 292         hSession: HINTERNET;
 293         hConnect: HINTERNET;
 294         hRequest: HINTERNET;
 295         ProxyHostPort: string;
 296         Buf: array[0..4096] of Char;
 297         UserInfo: string;
 298         UserAgent: string;
 299         cb: DWORD;
 300         Delim: Integer;
 301 begin
 302         FSession := TDolibSession.Create;
 303
 304         if Proxy <> '' then begin
 305                 ProxyHostPort := Format('%s:%d', [Proxy, Port]);
 306                 hSession := InternetOpen(DOLIB_LOGIN_UA, INTERNET_OPEN_TYPE_PROXY, PChar(ProxyHostPort), '', 0);
 307         end else begin
 308                 hSession := InternetOpen(DOLIB_LOGIN_UA, INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0);
 309         end;
 310
 311         if not Assigned(hSession) then
 312                 MakeError(FSession, GetLastError())
 313         else begin
 314                 hConnect := InternetConnect(hSession, DOLIB_LOGIN_HOST,
 315                         INTERNET_DEFAULT_HTTPS_PORT, nil, nil,
 316                         INTERNET_SERVICE_HTTP, INTERNET_FLAG_SECURE, 0);
 317                 if not Assigned(hConnect) then
 318                         MakeError(FSession, GetLastError())
 319                 else begin
 320                         hRequest := HttpOpenRequest(hConnect, 'POST', DOLIB_LOGIN_URL,
 321                                 nil, nil, nil,
 322                                 INTERNET_FLAG_NO_CACHE_WRITE or INTERNET_FLAG_NO_COOKIES or
 323                                 INTERNET_FLAG_NO_UI or INTERNET_FLAG_SECURE, 0);
 324                         if not Assigned(hRequest) then
 325                                 MakeError(FSession, GetLastError())
 326                         else begin
 327                                 UserInfo := Format('ID=%s&PW=%s', [ID, Pass]);
 328                                 UserAgent := Format('%s %s', [DOLIB_2CH_UA, ClientUA]) + #13#10;
 329                                 HttpSendRequest(hRequest, PChar(UserAgent), DWORD(-1), PChar(UserInfo), Length(UserInfo));
 330                 if not InternetReadFile(hRequest, @Buf, SizeOf(Buf), cb) then
 331                     MakeError(FSession, GetLastError())
 332                 else if (cb < 11) or (Pos('SESSION-ID=', Buf) <> 1) then
 333                     MakeError(FSession, ERROR_INVALID_DATA)
 334                 else begin
 335                     if Buf[cb - 1] = #10 then
 336                         Buf[cb - 1] := #0;
 337                     FSession.SessionID := Copy(Buf, 12, cb);
 338                     if FSession.SessionID = '' then
 339                         MakeError(FSession, ERROR_NOT_ENOUGH_MEMORY);
 340                     Delim := Pos(':', Buf);
 341                     if Delim = 0 then
 342                         MakeError(FSession, ERROR_INVALID_DATA)
 343                     else begin
 344                         FSession.UserAgent := Copy(Buf, 12, Delim - 12);
 345                         if FSession.UserAgent = '' then
 346                             MakeError(FSession, ERROR_NOT_ENOUGH_MEMORY);
 347                     end;
 348                                 end;
 349                                 InternetCloseHandle(hRequest);
 350                         end;
 351                         InternetCloseHandle(hConnect);
 352                 end;
 353                 InternetCloseHandle(hSession);
 354         end;
 355 end;
 356 end.
 357