This commit was manufactured by cvs2svn to create tag 'v1_62_0_809'.

[gikonavigoeson/gikonavi.git] / Dolib.pas

diff --git a/Dolib.pas b/Dolib.pas
index 259b6d2..a4ac2f3 100644 (file)
--- a/Dolib.pas
+++ b/Dolib.pas
@@ -33,7 +33,7 @@ unit Dolib;
 interface
 
 uses
-       Windows, SysUtils, WinInet;
+       Windows, SysUtils, WinInet, YofUtils;
 
 type
        TDolibSession = class(TObject)
@@ -65,10 +65,12 @@ type
                function GetErrorMsg: string;
                procedure MakeError(Session: TDolibSession; Error: DWORD);
                procedure DOLIB_LOGIN(Proxy: string; Port: Integer; ID: string; Pass: string);
+               procedure ForcedDOLIB_LOGIN(Proxy: string; Port: Integer; ID: string; Pass: string);
        public
                constructor Create;
                destructor  Destroy; override;
                function  Connect: boolean;
+               function  ForcedConnect: boolean;   //SSL\8fá\8aQ\97p\8b­\90§\83\8d\83O\83C\83\93
                function  Disconnect: boolean;
                property  ProxyAddress: string  read  FProxyAddress write FProxyAddress;
                property  ProxyPort: integer  read  FProxyPort  write FProxyPort;
@@ -87,12 +89,13 @@ implementation
 const
        DOLIB_VERSION       = $10000;
        DOLIB_LOGIN_UA      = 'DOLIB/1.00';
-       DOLIB_LOGIN_HOST    = 'tiger2.he.net';
-       DOLIB_LOGIN_URL     = '/~tora3n2c/futen.cgi';
+       DOLIB_LOGIN_HOST    = '2chv.tora3.net';
+       DOLIB_LOGIN_URL     = '/futen.cgi';
        DOLIB_2CH_UA        = 'X-2ch-UA:';
 //     DOLIB_2CH_UA        = 'X-2ch-UA: gikoNavi/1.00'#13#10;
        DOLIB_ENOMEM_STRING = '\83\81\83\82\83\8a\82ª\91«\82è\82Ü\82¹\82ñ\81B';
        DOLIB_LOGIN_ERROR   = 'ERROR:';
+// https://2chv.tora3.net/futen.cgi
 
 { TDolib }
 
@@ -127,6 +130,14 @@ begin
                end;
        end;
 end;
+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
+begin
+       Result := False;
+       if not Connected then begin
+               ForcedDOLIB_LOGIN(FProxyAddress, FProxyPort, FUserName, FPassword);
+        Result := True;
+       end;
+end;
 
 function TDolib.Disconnect: boolean;
 begin
@@ -216,6 +227,7 @@ var
        Buf: array[0..4096] of Char;
        UserInfo: string;
        UserAgent: string;
+    Header: string;
        cb: DWORD;
        Delim: Integer;
 begin
@@ -244,9 +256,11 @@ begin
                        if not Assigned(hRequest) then
                                MakeError(FSession, GetLastError())
                        else begin
-                               UserInfo := Format('ID=%s&PW=%s', [ID, Pass]);
+                               UserInfo := Format('ID=%s&PW=%s', [HttpEncode(ID), HttpEncode(Pass)]);
+                Header := 'Content-Type: application/x-www-form-urlencoded'#13#10;
                                UserAgent := Format('%s %s', [DOLIB_2CH_UA, ClientUA]) + #13#10;
-                               if not HttpSendRequest(hRequest, PChar(UserAgent), DWORD(-1), PChar(UserInfo), Length(UserInfo)) then
+                Header := Header + UserAgent;
+                               if not HttpSendRequest(hRequest, PChar(Header), DWORD(-1), PChar(UserInfo), Length(UserInfo)) then
                                        MakeError(FSession, GetLastError())
                                else begin
                                        if not InternetReadFile(hRequest, @Buf, SizeOf(Buf), cb) then
@@ -276,6 +290,72 @@ begin
                InternetCloseHandle(hSession);
        end;
 end;
+//SSL\8fá\8aQ\97p\8b­\90§\83\8d\83O\83C\83\93
+procedure TDolib.ForcedDOLIB_LOGIN(Proxy: string; Port: Integer; ID: string; Pass: string);
+var
+       hSession: HINTERNET;
+       hConnect: HINTERNET;
+       hRequest: HINTERNET;
+       ProxyHostPort: string;
+       Buf: array[0..4096] of Char;
+       UserInfo: string;
+       UserAgent: string;
+       cb: DWORD;
+       Delim: Integer;
+begin
+       FSession := TDolibSession.Create;
 
+       if Proxy <> '' then begin
+               ProxyHostPort := Format('%s:%d', [Proxy, Port]);
+               hSession := InternetOpen(DOLIB_LOGIN_UA, INTERNET_OPEN_TYPE_PROXY, PChar(ProxyHostPort), '', 0);
+       end else begin
+               hSession := InternetOpen(DOLIB_LOGIN_UA, INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0);
+       end;
+
+       if not Assigned(hSession) then
+               MakeError(FSession, GetLastError())
+       else begin
+               hConnect := InternetConnect(hSession, DOLIB_LOGIN_HOST,
+                       INTERNET_DEFAULT_HTTPS_PORT, nil, nil,
+                       INTERNET_SERVICE_HTTP, INTERNET_FLAG_SECURE, 0);
+               if not Assigned(hConnect) then
+                       MakeError(FSession, GetLastError())
+               else begin
+                       hRequest := HttpOpenRequest(hConnect, 'POST', DOLIB_LOGIN_URL,
+                               nil, nil, nil,
+                               INTERNET_FLAG_NO_CACHE_WRITE or INTERNET_FLAG_NO_COOKIES or
+                               INTERNET_FLAG_NO_UI or INTERNET_FLAG_SECURE, 0);
+                       if not Assigned(hRequest) then
+                               MakeError(FSession, GetLastError())
+                       else begin
+                               UserInfo := Format('ID=%s&PW=%s', [ID, Pass]);
+                               UserAgent := Format('%s %s', [DOLIB_2CH_UA, ClientUA]) + #13#10;
+                               HttpSendRequest(hRequest, PChar(UserAgent), DWORD(-1), PChar(UserInfo), Length(UserInfo));
+                if not InternetReadFile(hRequest, @Buf, SizeOf(Buf), cb) then
+                    MakeError(FSession, GetLastError())
+                else if (cb < 11) or (Pos('SESSION-ID=', Buf) <> 1) then
+                    MakeError(FSession, ERROR_INVALID_DATA)
+                else begin
+                    if Buf[cb - 1] = #10 then
+                        Buf[cb - 1] := #0;
+                    FSession.SessionID := Copy(Buf, 12, cb);
+                    if FSession.SessionID = '' then
+                        MakeError(FSession, ERROR_NOT_ENOUGH_MEMORY);
+                    Delim := Pos(':', Buf);
+                    if Delim = 0 then
+                        MakeError(FSession, ERROR_INVALID_DATA)
+                    else begin
+                        FSession.UserAgent := Copy(Buf, 12, Delim - 12);
+                        if FSession.UserAgent = '' then
+                            MakeError(FSession, ERROR_NOT_ENOUGH_MEMORY);
+                    end;
+                               end;
+                               InternetCloseHandle(hRequest);
+                       end;
+                       InternetCloseHandle(hConnect);
+               end;
+               InternetCloseHandle(hSession);
+       end;
+end;
 end.