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