| 1 |
h677 |
1.1 |
{ Dolib???潟???若????E???違?ゃ?潟?祉???激?с?括?????篏??? } |
| 2 |
|
|
unit Belib; |
| 3 |
|
|
|
| 4 |
|
|
{$IOCHECKS ON} |
| 5 |
|
|
|
| 6 |
|
|
interface |
| 7 |
|
|
|
| 8 |
|
|
uses |
| 9 |
|
|
Windows, SysUtils, WinInet, YofUtils, Y_TextConverter; |
| 10 |
|
|
|
| 11 |
|
|
type |
| 12 |
|
|
TBelibSession = class(TObject) |
| 13 |
|
|
private |
| 14 |
|
|
FMDMD: string; |
| 15 |
|
|
FDMDM: string; |
| 16 |
|
|
FErrorCode: Integer; |
| 17 |
|
|
FErrorString: string; |
| 18 |
|
|
public |
| 19 |
|
|
property MDMD: string read FMDMD write FMDMD; |
| 20 |
|
|
property DMDM: string read FDMDM write FDMDM; |
| 21 |
|
|
property ErrorCode: Integer read FErrorCode write FErrorCode; |
| 22 |
|
|
property ErrorString: string read FErrorString write FErrorString; |
| 23 |
|
|
end; |
| 24 |
|
|
|
| 25 |
|
|
TBelib = class(TObject) |
| 26 |
|
|
private |
| 27 |
|
|
FSession : TBelibSession; |
| 28 |
|
|
FConnected: boolean; |
| 29 |
|
|
FProxyPort: integer; |
| 30 |
|
|
FUserName: string; |
| 31 |
|
|
FPassword: string; |
| 32 |
|
|
FProxyAddress: string; |
| 33 |
|
|
FClientUA: string; |
| 34 |
|
|
function GetMDMD : string; |
| 35 |
|
|
function GetDMDM : string; |
| 36 |
|
|
function GetErrorCode: integer; |
| 37 |
|
|
function GetErrorMsg: string; |
| 38 |
|
|
procedure MakeError(Session: TBelibSession; Error: DWORD); |
| 39 |
|
|
procedure BELIB_LOGIN(Proxy: string; Port: Integer; ID: string; Pass: string); |
| 40 |
|
|
public |
| 41 |
|
|
constructor Create; |
| 42 |
|
|
destructor Destroy; override; |
| 43 |
|
|
function Connect: boolean; |
| 44 |
|
|
function Disconnect: boolean; |
| 45 |
|
|
property ProxyAddress: string read FProxyAddress write FProxyAddress; |
| 46 |
|
|
property ProxyPort: integer read FProxyPort write FProxyPort; |
| 47 |
|
|
property UserName: string read FUserName write FUserName; |
| 48 |
|
|
property Password: string read FPassword write FPassword; |
| 49 |
|
|
property ClientUA: string read FClientUA write FClientUA; |
| 50 |
|
|
property Connected: boolean read FConnected; |
| 51 |
|
|
property MDMD: string read GetMDMD; |
| 52 |
|
|
property DMDM: string read GetDMDM; |
| 53 |
|
|
property ErrorCode: integer read GetErrorCode; |
| 54 |
|
|
property ErrorMsg: string read GetErrorMsg; |
| 55 |
|
|
end; |
| 56 |
|
|
|
| 57 |
|
|
implementation |
| 58 |
|
|
const |
| 59 |
|
|
BELIB_LOGIN_UA = 'BELIB/1.00'; |
| 60 |
|
|
BELIB_LOGIN_HOST = 'be.2ch.net'; |
| 61 |
|
|
BELIB_LOGIN_URL = '/test/login.php'; |
| 62 |
|
|
BELIB_2CH_UA = 'X-2ch-UA:'; |
| 63 |
|
|
BELIB_ENOMEM_STRING = '?<?≪????莇潟???障??????'; |
| 64 |
|
|
BELIB_LOGIN_ERROR = 'ERROR:'; |
| 65 |
|
|
// http:///?? |
| 66 |
|
|
|
| 67 |
|
|
{ TBelib } |
| 68 |
|
|
|
| 69 |
|
|
constructor TBelib.Create; |
| 70 |
|
|
begin |
| 71 |
|
|
FSession := nil; |
| 72 |
|
|
FConnected := False; |
| 73 |
|
|
end; |
| 74 |
|
|
|
| 75 |
|
|
destructor TBelib.Destroy; |
| 76 |
|
|
begin |
| 77 |
|
|
if Connected then |
| 78 |
|
|
Disconnect; |
| 79 |
|
|
inherited; |
| 80 |
|
|
end; |
| 81 |
|
|
|
| 82 |
|
|
function TBelib.Connect: boolean; |
| 83 |
|
|
begin |
| 84 |
|
|
Result := False; |
| 85 |
|
|
if not Connected then begin |
| 86 |
|
|
BELIB_LOGIN(FProxyAddress, FProxyPort, FUserName, FPassword); |
| 87 |
|
|
FConnected := True; |
| 88 |
|
|
if (Length(MDMD)=0) and (Length(DMDM)=0) then begin |
| 89 |
|
|
Disconnect; |
| 90 |
|
|
Result := False; |
| 91 |
|
|
end else if ErrorCode <> 0 then begin |
| 92 |
|
|
Disconnect; |
| 93 |
|
|
Result := False; |
| 94 |
|
|
end else begin |
| 95 |
|
|
Result := True; |
| 96 |
|
|
// Result := (ErrorCode = 0); |
| 97 |
|
|
end; |
| 98 |
|
|
end; |
| 99 |
|
|
end; |
| 100 |
|
|
|
| 101 |
|
|
function TBelib.Disconnect: boolean; |
| 102 |
|
|
begin |
| 103 |
|
|
Result := True; |
| 104 |
|
|
if FSession <> nil then |
| 105 |
|
|
FreeAndNil(FSession); |
| 106 |
|
|
FConnected := False; |
| 107 |
|
|
end; |
| 108 |
|
|
|
| 109 |
|
|
function TBelib.GetMDMD : string; |
| 110 |
|
|
begin |
| 111 |
|
|
if Connected then |
| 112 |
|
|
Result := FSession.FMDMD |
| 113 |
|
|
else |
| 114 |
|
|
Result := ''; |
| 115 |
|
|
end; |
| 116 |
|
|
|
| 117 |
|
|
function TBelib.GetDMDM : string; |
| 118 |
|
|
begin |
| 119 |
|
|
if Connected then |
| 120 |
|
|
Result := FSession.FDMDM |
| 121 |
|
|
else |
| 122 |
|
|
Result := ''; |
| 123 |
|
|
end; |
| 124 |
|
|
|
| 125 |
|
|
|
| 126 |
|
|
function TBelib.GetErrorMsg: string; |
| 127 |
|
|
begin |
| 128 |
|
|
if Connected then |
| 129 |
|
|
Result := FSession.FErrorString |
| 130 |
|
|
else |
| 131 |
|
|
Result := 'Error: ?<?若???≪?????鴻?????鴻???若????罩c????????障??????'; |
| 132 |
|
|
end; |
| 133 |
|
|
|
| 134 |
|
|
function TBelib.GetErrorCode: integer; |
| 135 |
|
|
begin |
| 136 |
|
|
if Connected then |
| 137 |
|
|
Result := FSession.ErrorCode |
| 138 |
|
|
else |
| 139 |
|
|
Result := 0; |
| 140 |
|
|
end; |
| 141 |
|
|
|
| 142 |
|
|
procedure TBelib.MakeError(Session: TBelibSession; Error: DWORD); |
| 143 |
|
|
var |
| 144 |
|
|
Buf: array[0..4096] of Char; |
| 145 |
|
|
begin |
| 146 |
|
|
Session.ErrorCode := Error; |
| 147 |
|
|
if Error = ERROR_NOT_ENOUGH_MEMORY then |
| 148 |
|
|
Session.ErrorString := BELIB_ENOMEM_STRING |
| 149 |
|
|
else begin |
| 150 |
|
|
FillChar(Buf, SizeOf(Buf), #0); |
| 151 |
|
|
FormatMessage({FORMAT_MESSAGE_ALLOCATE_BUFFER or} |
| 152 |
|
|
FORMAT_MESSAGE_IGNORE_INSERTS or |
| 153 |
|
|
FORMAT_MESSAGE_FROM_SYSTEM or |
| 154 |
|
|
FORMAT_MESSAGE_FROM_HMODULE, |
| 155 |
|
|
Pointer(GetModuleHandle('wininet')), Error, |
| 156 |
|
|
(((Word(SUBLANG_DEFAULT)) shl 10) or Word(LANG_NEUTRAL)), //Delphi??AKELANGID?????????<???c??????(卒鐔ハ?鐔?)鐔種舟鐓??鐔逸? |
| 157 |
|
|
// MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), |
| 158 |
|
|
Buf, SizeOf(Buf), nil); |
| 159 |
|
|
Session.ErrorString := Buf; |
| 160 |
|
|
end; |
| 161 |
|
|
end; |
| 162 |
|
|
|
| 163 |
|
|
{DOLIB?????????????障?? |
| 164 |
|
|
} |
| 165 |
|
|
procedure TBelib.BELIB_LOGIN(Proxy: string; Port: Integer; ID: string; Pass: string); |
| 166 |
|
|
var |
| 167 |
|
|
hSession: HINTERNET; |
| 168 |
|
|
hConnect: HINTERNET; |
| 169 |
|
|
hRequest: HINTERNET; |
| 170 |
|
|
ProxyHostPort: string; |
| 171 |
|
|
Buf: array[0..4096] of Char; |
| 172 |
|
|
UserInfo: string; |
| 173 |
|
|
UserAgent: string; |
| 174 |
|
|
Header: string; |
| 175 |
|
|
cb: DWORD; |
| 176 |
|
|
Delim: Integer; |
| 177 |
|
|
body: string; |
| 178 |
|
|
begin |
| 179 |
|
|
FSession := TBelibSession.Create; |
| 180 |
|
|
|
| 181 |
|
|
if Proxy <> '' then begin |
| 182 |
|
|
ProxyHostPort := Format('%s:%d', [Proxy, Port]); |
| 183 |
|
|
hSession := InternetOpen(BELIB_LOGIN_UA, INTERNET_OPEN_TYPE_PROXY, PChar(ProxyHostPort), '', 0); |
| 184 |
|
|
end else begin |
| 185 |
|
|
hSession := InternetOpen(BELIB_LOGIN_UA, INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0); |
| 186 |
|
|
end; |
| 187 |
|
|
|
| 188 |
|
|
if not Assigned(hSession) then |
| 189 |
|
|
MakeError(FSession, GetLastError()) |
| 190 |
|
|
else begin |
| 191 |
|
|
hConnect := InternetConnect(hSession, BELIB_LOGIN_HOST, |
| 192 |
|
|
INTERNET_DEFAULT_HTTP_PORT, nil, nil, |
| 193 |
|
|
INTERNET_SERVICE_HTTP, 0, 0); |
| 194 |
|
|
if not Assigned(hConnect) then |
| 195 |
|
|
MakeError(FSession, GetLastError()) |
| 196 |
|
|
else begin |
| 197 |
|
|
hRequest := HttpOpenRequest(hConnect, 'POST', BELIB_LOGIN_URL, |
| 198 |
|
|
nil, nil, nil, |
| 199 |
|
|
INTERNET_FLAG_NO_CACHE_WRITE or INTERNET_FLAG_NO_COOKIES or |
| 200 |
|
|
INTERNET_FLAG_NO_UI, 0); |
| 201 |
|
|
if not Assigned(hRequest) then |
| 202 |
|
|
MakeError(FSession, GetLastError()) |
| 203 |
|
|
else begin |
| 204 |
|
|
UserInfo := Format('m=%s&p=%s&submit=%s', [HttpEncode(ID), HttpEncode(Pass), HttpEncode(SJIStoEUC('?脂??#39;))]); |
| 205 |
|
|
Header := 'Content-Type: application/x-www-form-urlencoded'#13#10; |
| 206 |
|
|
UserAgent := Format('%s %s', [BELIB_2CH_UA, ClientUA]) + #13#10; |
| 207 |
|
|
Header := Header + UserAgent; |
| 208 |
|
|
if not HttpSendRequest(hRequest, PChar(Header), DWORD(-1), PChar(UserInfo), Length(UserInfo)) then |
| 209 |
|
|
MakeError(FSession, GetLastError()) |
| 210 |
|
|
else begin |
| 211 |
|
|
if not InternetReadFile(hRequest, @Buf, SizeOf(Buf), cb) then |
| 212 |
|
|
MakeError(FSession, GetLastError()) |
| 213 |
|
|
else if (Pos('cookie', Buf) = 0) or (Pos('"DMDM=', Buf) = 0) |
| 214 |
|
|
or (Pos('"MDMD=', Buf) = 0) then |
| 215 |
|
|
MakeError(FSession, ERROR_INVALID_DATA) |
| 216 |
|
|
else begin |
| 217 |
|
|
body := Buf; |
| 218 |
|
|
FSession.FDMDM := Copy(body, Pos('"DMDM=', body) + 6, Length(body)); |
| 219 |
|
|
FSession.FDMDM := Copy(FSession.FDMDM, 1, Pos(';', FSession.FDMDM) - 1); |
| 220 |
|
|
FSession.FMDMD := Copy(body, Pos('"MDMD=', body) + 6, Length(body)); |
| 221 |
|
|
FSession.FMDMD := Copy(FSession.FMDMD, 1, Pos(';', FSession.FMDMD) - 1); |
| 222 |
|
|
end; |
| 223 |
|
|
end; |
| 224 |
|
|
InternetCloseHandle(hRequest); |
| 225 |
|
|
end; |
| 226 |
|
|
InternetCloseHandle(hConnect); |
| 227 |
|
|
end; |
| 228 |
|
|
InternetCloseHandle(hSession); |
| 229 |
|
|
end; |
| 230 |
|
|
end; |
| 231 |
|
|
end. |
| 232 |
|
|
|