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         public
  69                 constructor Create;
  70                 destructor  Destroy; override;
  71                 function  Connect: boolean;
  72                 function  Disconnect: boolean;
  73                 property  ProxyAddress: string  read  FProxyAddress write FProxyAddress;
  74                 property  ProxyPort: integer  read  FProxyPort  write FProxyPort;
  75                 property  UserName: string  read  FUserName write FUserName;
  76                 property  Password: string  read  FPassword write FPassword;
  77                 property  ClientUA: string  read  FClientUA write FClientUA;
  78                 property  Connected: boolean  read  FConnected;
  79                 property  SessionID: string read  GetSessionID;
  80                 property  Version: string read  GetVersion;
  81                 property  UserAgent: string read  GetUserAgent;
  82                 property  ErrorCode: integer read  GetErrorCode;
  83                 property  ErrorMsg: string  read  GetErrorMsg;
  84         end;
  85
  86 implementation
  87 const
  88         DOLIB_VERSION       = $10000;
  89         DOLIB_LOGIN_UA      = 'DOLIB/1.00';
  90         DOLIB_LOGIN_HOST    = 'tiger2.he.net';
  91         DOLIB_LOGIN_URL     = '/~tora3n2c/futen.cgi';
  92         DOLIB_2CH_UA        = 'X-2ch-UA:';
  93 //      DOLIB_2CH_UA        = 'X-2ch-UA: gikoNavi/1.00'#13#10;
  94         DOLIB_ENOMEM_STRING = '\83\81\83\82\83\8a\82ª\91«\82è\82Ü\82¹\82ñ\81B';
  95         DOLIB_LOGIN_ERROR   = 'ERROR:';
  96
  97 { TDolib }
  98
  99 constructor TDolib.Create;
 100 begin
 101         FSession   := nil;
 102         FConnected := False;
 103 end;
 104
 105 destructor TDolib.Destroy;
 106 begin
 107         if Connected then
 108                 Disconnect;
 109         inherited;
 110 end;
 111
 112 function TDolib.Connect: boolean;
 113 begin
 114         Result := False;
 115         if not Connected then begin
 116                 DOLIB_LOGIN(FProxyAddress, FProxyPort, FUserName, FPassword);
 117                 FConnected  :=  True;
 118                 if  (AnsiPos(DOLIB_LOGIN_ERROR, SessionID) = 1) then  begin
 119                         Disconnect;
 120                         Result      :=  False;
 121                 end else if ErrorCode <> 0 then begin
 122                         Disconnect;
 123                         Result := False;
 124                 end else begin
 125                         Result := True;
 126 //                      Result      :=  (ErrorCode = 0);
 127                 end;
 128         end;
 129 end;
 130
 131 function TDolib.Disconnect: boolean;
 132 begin
 133         Result := True;
 134   if FSession <> nil then
 135     FreeAndNil(FSession);
 136   FConnected := False;
 137 end;
 138
 139 function TDolib.GetVersion: string;
 140 var
 141         v : DWORD;
 142         mj, mn : integer;
 143 begin
 144         v  := DOLIB_VERSION;
 145         mj := v shr 16;
 146         mn := v and $ffff;
 147         Result := Format('%d.%.2d', [mj, mn]);
 148 end;
 149
 150 function TDolib.GetSessionID: string;
 151 begin
 152         if Connected then
 153                 Result := FSession.FSessionID
 154         else
 155                 Result := '';
 156 end;
 157
 158 function TDolib.GetUserAgent: string;
 159 begin
 160         if Connected then
 161                 Result := FSession.FUserAgent
 162         else
 163                 Result := '';
 164 end;
 165
 166 function TDolib.GetErrorMsg: string;
 167 begin
 168         if Connected then
 169                 Result := FSession.FErrorString
 170         else
 171     Result  :=  'Error: ID\82©\83p\83X\83\8f\81[\83h\82ª\90³\82µ\82\82 \82è\82Ü\82¹\82ñ\81B';
 172 end;
 173
 174 function TDolib.GetErrorCode: integer;
 175 begin
 176         if Connected then
 177                 Result := FSession.ErrorCode
 178         else
 179                 Result := 0;
 180 end;
 181
 182 procedure TDolib.MakeError(Session: TDolibSession; Error: DWORD);
 183 var
 184         Buf: array[0..4096] of Char;
 185 begin
 186         Session.ErrorCode := Error;
 187         if Error = ERROR_NOT_ENOUGH_MEMORY then
 188                 Session.ErrorString := DOLIB_ENOMEM_STRING
 189         else begin
 190                 FillChar(Buf, SizeOf(Buf), #0);
 191                 FormatMessage({FORMAT_MESSAGE_ALLOCATE_BUFFER or}
 192                         FORMAT_MESSAGE_IGNORE_INSERTS or
 193                         FORMAT_MESSAGE_FROM_SYSTEM or
 194                         FORMAT_MESSAGE_FROM_HMODULE,
 195                         Pointer(GetModuleHandle('wininet')), Error,
 196                         (((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Ö¥`)¼®ÎÞ°Ý
 197 //                      MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
 198                         Buf, SizeOf(Buf), nil);
 199                 Session.ErrorString := Buf;
 200         end;
 201 end;
 202
 203 {\8eQ\8dlURL
 204 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
 205 http://members.jcom.home.ne.jp/monazilla/document/wininetdel.html
 206 http://support.microsoft.com/default.aspx?scid=kb;EN-US;q168151
 207 http://msdn.microsoft.com/library/default.asp?url=/workshop/networking/wininet/wininet.asp
 208 http://homepage1.nifty.com/~suzuki/delphi/wininet.html
 209 }
 210 procedure TDolib.DOLIB_LOGIN(Proxy: string; Port: Integer; ID: string; Pass: string);
 211 var
 212         hSession: HINTERNET;
 213         hConnect: HINTERNET;
 214         hRequest: HINTERNET;
 215         ProxyHostPort: string;
 216         Buf: array[0..4096] of Char;
 217         UserInfo: string;
 218         UserAgent: string;
 219         cb: DWORD;
 220         Delim: Integer;
 221 begin
 222         FSession := TDolibSession.Create;
 223
 224         if Proxy <> '' then begin
 225                 ProxyHostPort := Format('%s:%d', [Proxy, Port]);
 226                 hSession := InternetOpen(DOLIB_LOGIN_UA, INTERNET_OPEN_TYPE_PROXY, PChar(ProxyHostPort), '', 0);
 227         end else begin
 228                 hSession := InternetOpen(DOLIB_LOGIN_UA, INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0);
 229         end;
 230
 231         if not Assigned(hSession) then
 232                 MakeError(FSession, GetLastError())
 233         else begin
 234                 hConnect := InternetConnect(hSession, DOLIB_LOGIN_HOST,
 235                         INTERNET_DEFAULT_HTTPS_PORT, nil, nil,
 236                         INTERNET_SERVICE_HTTP, INTERNET_FLAG_SECURE, 0);
 237                 if not Assigned(hConnect) then
 238                         MakeError(FSession, GetLastError())
 239                 else begin
 240                         hRequest := HttpOpenRequest(hConnect, 'POST', DOLIB_LOGIN_URL,
 241                                 nil, nil, nil,
 242                                 INTERNET_FLAG_NO_CACHE_WRITE or INTERNET_FLAG_NO_COOKIES or
 243                                 INTERNET_FLAG_NO_UI or INTERNET_FLAG_SECURE, 0);
 244                         if not Assigned(hRequest) then
 245                                 MakeError(FSession, GetLastError())
 246                         else begin
 247                                 UserInfo := Format('ID=%s&PW=%s', [ID, Pass]);
 248                                 UserAgent := Format('%s %s', [DOLIB_2CH_UA, ClientUA]) + #13#10;
 249                                 if not HttpSendRequest(hRequest, PChar(UserAgent), DWORD(-1), PChar(UserInfo), Length(UserInfo)) then
 250                                         MakeError(FSession, GetLastError())
 251                                 else begin
 252                                         if not InternetReadFile(hRequest, @Buf, SizeOf(Buf), cb) then
 253                                                 MakeError(FSession, GetLastError())
 254                                         else if (cb < 11) or (Pos('SESSION-ID=', Buf) <> 1) then
 255                                                 MakeError(FSession, ERROR_INVALID_DATA)
 256                                         else begin
 257                                                 if Buf[cb - 1] = #10 then
 258                                                         Buf[cb - 1] := #0;
 259                                                 FSession.SessionID := Copy(Buf, 12, cb);
 260                                                 if FSession.SessionID = '' then
 261                                                         MakeError(FSession, ERROR_NOT_ENOUGH_MEMORY);
 262                                                 Delim := Pos(':', Buf);
 263                                                 if Delim = 0 then
 264                                                         MakeError(FSession, ERROR_INVALID_DATA)
 265                                                 else begin
 266                                                         FSession.UserAgent := Copy(Buf, 12, Delim - 12);
 267                                                         if FSession.UserAgent = '' then
 268                                                                 MakeError(FSession, ERROR_NOT_ENOUGH_MEMORY);
 269                                                 end;
 270                                         end;
 271                                 end;
 272                                 InternetCloseHandle(hRequest);
 273                         end;
 274                         InternetCloseHandle(hConnect);
 275                 end;
 276                 InternetCloseHandle(hSession);
 277         end;
 278 end;
 279
 280 end.
 281