| Revision | 0156befce0601e9998fc83c7ce6cbb3314557f2f (tree) |
|---|---|
| Zeit | 2005-12-28 02:12:54 |
| Autor | cvs2git <cvs2git> |
| Commiter | cvs2git |
This commit was manufactured by cvs2svn to create branch 'Bb51'.
res/ExternalBoardPlugIn/BePlugIn.dpr| @@ -1,1578 +0,0 @@ | ||
| 1 | -library BePlugIn; | |
| 2 | - | |
| 3 | -{ | |
| 4 | - BePlugIn | |
| 5 | - 2ちゃんねるBE処理ユニット | |
| 6 | - | |
| 7 | -} | |
| 8 | - | |
| 9 | -uses | |
| 10 | - Windows, | |
| 11 | - SysUtils, | |
| 12 | - Classes, | |
| 13 | - Math, | |
| 14 | - DateUtils, | |
| 15 | - Dialogs, | |
| 16 | - IdURI, | |
| 17 | - PlugInMain in 'PlugInMain.pas', | |
| 18 | - ThreadItem in 'ThreadItem.pas', | |
| 19 | - BoardItem in 'BoardItem.pas', | |
| 20 | - FilePath in 'FilePath.pas', | |
| 21 | - Y_TextConverter in 'Y_TextConverter.pas', | |
| 22 | - MojuUtils in '..\..\MojuUtils.pas'; | |
| 23 | - | |
| 24 | -{$R *.res} | |
| 25 | - | |
| 26 | -type | |
| 27 | - // ========================================================================= | |
| 28 | - // TBeThreadItem | |
| 29 | - // ========================================================================= | |
| 30 | - TBeThreadItem = class(TThreadItem) | |
| 31 | - private | |
| 32 | - FIsTemporary : Boolean; | |
| 33 | - FDat : TStringList; | |
| 34 | - | |
| 35 | - public | |
| 36 | - constructor Create( inInstance : DWORD ); | |
| 37 | - destructor Destroy; override; | |
| 38 | - | |
| 39 | - private | |
| 40 | - function Download : TDownloadState; | |
| 41 | - function StorageDownload(AURL : string) : TDownloadState; | |
| 42 | - function Write( inName : string; inMail : string; inMessage : string ) : TDownloadState; | |
| 43 | - function GetRes( inNo : Integer ) : string; | |
| 44 | - function GetDat( inNo : Integer ) : string; | |
| 45 | - function GetHeader( inOptionalHeader : string ) : string; | |
| 46 | - function GetFooter( inOptionalFooter : string ) : string; | |
| 47 | - function GetBoardURL : string; | |
| 48 | - procedure ArrangeDownloadData( start: Integer;var Data: TStringList); | |
| 49 | - procedure LoadDat; | |
| 50 | - procedure FreeDat; | |
| 51 | - function BrowsableURL : string; | |
| 52 | - function ReadURL : string; | |
| 53 | - function WriteURL : string; | |
| 54 | - end; | |
| 55 | - | |
| 56 | - // ========================================================================= | |
| 57 | - // TBeBoardItem | |
| 58 | - // ========================================================================= | |
| 59 | - TBeBoardItem = class(TBoardItem) | |
| 60 | - private | |
| 61 | - FIsTemporary : Boolean; | |
| 62 | - FDat : TStringList; | |
| 63 | - | |
| 64 | - public | |
| 65 | - constructor Create( inInstance : DWORD ); | |
| 66 | - destructor Destroy; override; | |
| 67 | - | |
| 68 | - private | |
| 69 | - function Download : TDownloadState; | |
| 70 | - function CreateThread( inSubject : string; inName : string; inMail : string; inMessage : string ) : TDownloadState; | |
| 71 | - function ToThreadURL( inFileName : string ) : string; | |
| 72 | - procedure EnumThread( inCallBack : TBoardItemEnumThreadCallBack ); | |
| 73 | - | |
| 74 | - function SubjectURL : string; | |
| 75 | - end; | |
| 76 | - | |
| 77 | -const | |
| 78 | - LOG_DIR = 'Be\'; | |
| 79 | - SUBJECT_NAME = 'subject.txt'; | |
| 80 | - | |
| 81 | - PLUGIN_NAME = 'Be'; | |
| 82 | - MAJOR_VERSION = 1; | |
| 83 | - MINOR_VERSION = 1; | |
| 84 | - RELEASE_VERSION = 'alpha'; | |
| 85 | - REVISION_VERSION = 1; | |
| 86 | - | |
| 87 | -//var | |
| 88 | -// SyncronizeMenu : HMENU; | |
| 89 | - | |
| 90 | -// ========================================================================= | |
| 91 | -// 雑用関数 | |
| 92 | -// ========================================================================= | |
| 93 | - | |
| 94 | -// ************************************************************************* | |
| 95 | -// テンポラリなパスの取得 | |
| 96 | -// ************************************************************************* | |
| 97 | -function TemporaryFile : string; | |
| 98 | -var | |
| 99 | - tempPath : array [0..MAX_PATH] of char; | |
| 100 | -begin | |
| 101 | - | |
| 102 | - GetTempPath( SizeOf(tempPath), tempPath ); | |
| 103 | - repeat | |
| 104 | - Result := tempPath + IntToStr( Random( $7fffffff ) ); | |
| 105 | - until not FileExists( Result ); | |
| 106 | - | |
| 107 | -end; | |
| 108 | - | |
| 109 | -// ************************************************************************* | |
| 110 | -// Beログフォルダ取得 | |
| 111 | -// ************************************************************************* | |
| 112 | -function MyLogFolder : string; | |
| 113 | -var | |
| 114 | - folder : PChar; | |
| 115 | -begin | |
| 116 | - | |
| 117 | - folder := LogFolder; | |
| 118 | - if Length( folder ) = 0 then | |
| 119 | - Result := '' | |
| 120 | - else | |
| 121 | - Result := folder + LOG_DIR; | |
| 122 | - DisposeResultString(folder); | |
| 123 | - | |
| 124 | -end; | |
| 125 | - | |
| 126 | -(************************************************************************* | |
| 127 | - *ディレクトリが存在するかチェック | |
| 128 | - *************************************************************************) | |
| 129 | -function DirectoryExistsEx(const Name: string): Boolean; | |
| 130 | -var | |
| 131 | - Code: Integer; | |
| 132 | -begin | |
| 133 | - Code := GetFileAttributes(PChar(Name)); | |
| 134 | - Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0); | |
| 135 | -end; | |
| 136 | - | |
| 137 | -(************************************************************************* | |
| 138 | - *ディレクトリ作成（複数階層対応） | |
| 139 | - *************************************************************************) | |
| 140 | -function ForceDirectoriesEx(Dir: string): Boolean; | |
| 141 | -begin | |
| 142 | - Result := True; | |
| 143 | - if Length(Dir) = 0 then | |
| 144 | - raise Exception.Create('フォルダが作成出来ません'); | |
| 145 | - Dir := ExcludeTrailingPathDelimiter(Dir); | |
| 146 | - if (Length(Dir) < 3) or DirectoryExistsEx(Dir) | |
| 147 | - or (ExtractFilePath(Dir) = Dir) then Exit; // avoid 'xyz:\' problem. | |
| 148 | - Result := ForceDirectoriesEx(ExtractFilePath(Dir)) and CreateDir(Dir); | |
| 149 | -end; | |
| 150 | - | |
| 151 | -// とりあえずの代用品なので chrWhite を考慮していないことに注意！！！ | |
| 152 | -procedure ExtractHttpFields( | |
| 153 | - const chrSep : TSysCharSet; | |
| 154 | - const chrWhite : TSysCharSet; | |
| 155 | - const strValue : string; | |
| 156 | - var strResult : TStringList; | |
| 157 | - unknownFlag : boolean = false | |
| 158 | -); | |
| 159 | -var | |
| 160 | - last, p, strLen : Integer; | |
| 161 | -begin | |
| 162 | - | |
| 163 | - strLen := Length( strValue ); | |
| 164 | - p := 1; | |
| 165 | - last := 1; | |
| 166 | - | |
| 167 | - while p <= strLen do | |
| 168 | - begin | |
| 169 | - | |
| 170 | - if strValue[ p ] in chrSep then | |
| 171 | - begin | |
| 172 | - strResult.Add( Copy( strValue, last, p - last ) ); | |
| 173 | - last := p + 1; | |
| 174 | - end; | |
| 175 | - | |
| 176 | - p := p + 1; | |
| 177 | - | |
| 178 | - end; | |
| 179 | - | |
| 180 | - if last <> p then | |
| 181 | - strResult.Add( Copy( strValue, last, strLen - last + 1 ) ); | |
| 182 | - | |
| 183 | -end; | |
| 184 | - | |
| 185 | - function HttpEncode( | |
| 186 | - const strValue : string | |
| 187 | -) : string; | |
| 188 | -var | |
| 189 | - i : Integer; | |
| 190 | - strLen : Integer; | |
| 191 | - strResult : string; | |
| 192 | - b : Integer; | |
| 193 | -const | |
| 194 | - kHexCode : array [0..15] of char = ( | |
| 195 | - '0', '1', '2', '3', '4', '5', '6', '7', | |
| 196 | - '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' ); | |
| 197 | -begin | |
| 198 | - | |
| 199 | - strLen := Length( strValue ); | |
| 200 | - i := 1; | |
| 201 | - | |
| 202 | - while i <= strLen do | |
| 203 | - begin | |
| 204 | - | |
| 205 | - case strValue[ i ] of | |
| 206 | - '0' .. '9', 'a' .. 'z', 'A' .. 'Z', '*', '-', '.', '@', '_': | |
| 207 | - begin | |
| 208 | - strResult := strResult + strValue[ i ]; | |
| 209 | - end; | |
| 210 | - else | |
| 211 | - begin | |
| 212 | - b := Integer( strValue[ i ] ); | |
| 213 | - strResult := strResult + '%' | |
| 214 | - + kHexCode[ b div $10 ] | |
| 215 | - + kHexCode[ b mod $10 ]; | |
| 216 | - end; | |
| 217 | - end; | |
| 218 | - | |
| 219 | - i := i + 1; | |
| 220 | - | |
| 221 | - end; | |
| 222 | - | |
| 223 | - Result := strResult; | |
| 224 | - | |
| 225 | -end; | |
| 226 | - | |
| 227 | - | |
| 228 | - | |
| 229 | -// ========================================================================= | |
| 230 | -// PlugIn | |
| 231 | -// ========================================================================= | |
| 232 | - | |
| 233 | -// ************************************************************************* | |
| 234 | -// プラグインが(正しく)ロードされた | |
| 235 | -// ************************************************************************* | |
| 236 | -procedure OnLoad( | |
| 237 | - inInstance : DWORD // プラグインのインスタンス | |
| 238 | -); stdcall; | |
| 239 | -begin | |
| 240 | -end; | |
| 241 | - | |
| 242 | -// ************************************************************************* | |
| 243 | -// プラグインのバージョンを要求された | |
| 244 | -// ************************************************************************* | |
| 245 | -procedure OnVersionInfo( | |
| 246 | - var outAgent : PChar; // バージョンを一切含まない純粋な名称 | |
| 247 | - var outMajor : DWORD; // メジャーバージョン | |
| 248 | - var outMinor : DWORD; // マイナーバージョン | |
| 249 | - var outRelease : PChar; // リリース段階名 | |
| 250 | - var outRevision : DWORD // リビジョンナンバー | |
| 251 | -); stdcall; | |
| 252 | -begin | |
| 253 | - | |
| 254 | - try | |
| 255 | - outAgent := CreateResultString( PChar( PLUGIN_NAME ) ); | |
| 256 | - outMajor := MAJOR_VERSION; | |
| 257 | - outMinor := MINOR_VERSION; | |
| 258 | - outRelease := CreateResultString( PChar( RELEASE_VERSION ) ); | |
| 259 | - outRevision := REVISION_VERSION; | |
| 260 | - except | |
| 261 | - outAgent := nil; | |
| 262 | - outMajor := 0; | |
| 263 | - outMinor := 0; | |
| 264 | - outRelease := nil; | |
| 265 | - outRevision := 0; | |
| 266 | - end; | |
| 267 | - | |
| 268 | -end; | |
| 269 | - | |
| 270 | -// ************************************************************************* | |
| 271 | -// 指定した URL をこのプラグインで受け付けるかどうか | |
| 272 | -// ************************************************************************* | |
| 273 | -function OnAcceptURL( | |
| 274 | - inURL : PChar // 判断を仰いでいる URL | |
| 275 | -): TAcceptType; stdcall; // URL の種類 | |
| 276 | -var | |
| 277 | - uri : TIdURI; | |
| 278 | - uriList : TStringList; | |
| 279 | - foundPos : Integer; | |
| 280 | -// i : Integer; | |
| 281 | -const | |
| 282 | - BBS_HOST = 'be.2ch.net'; | |
| 283 | - THREAD_MARK = '/test/read.cgi'; | |
| 284 | -begin | |
| 285 | - | |
| 286 | - try | |
| 287 | - // ホスト名が be.2ch.net で終わる場合は受け付けるようにしている | |
| 288 | - uri := TIdURI.Create( inURL ); | |
| 289 | - uriList := TStringList.Create; | |
| 290 | - try | |
| 291 | - ExtractHttpFields( ['/'], [], uri.Path, uriList ); | |
| 292 | - if (BBS_HOST = uri.Host ) then begin | |
| 293 | - foundPos := AnsiPos( THREAD_MARK, inURL ); | |
| 294 | - | |
| 295 | - if foundPos > 0 then | |
| 296 | - Result := atThread | |
| 297 | - //else if (uriList.Count > 2) and (AnsiPos('.html', uri.Document) > 0) then | |
| 298 | - // Result := atThread | |
| 299 | - else if uriList.Count > 2 then // 最後が '/' で閉められてるなら 4 | |
| 300 | - Result := atBoard | |
| 301 | - else | |
| 302 | - Result := atBBS; | |
| 303 | - | |
| 304 | - end else begin | |
| 305 | - Result := atNoAccept; | |
| 306 | - end; | |
| 307 | - | |
| 308 | - finally | |
| 309 | - uri.Free; | |
| 310 | - uriList.Free; | |
| 311 | - end; | |
| 312 | - except | |
| 313 | - Result := atNoAccept; | |
| 314 | - end; | |
| 315 | - | |
| 316 | -end; | |
| 317 | - | |
| 318 | -// ========================================================================= | |
| 319 | -// TBeThreadItem | |
| 320 | -// ========================================================================= | |
| 321 | - | |
| 322 | -// ************************************************************************* | |
| 323 | -// コンストラクタ | |
| 324 | -// ************************************************************************* | |
| 325 | -constructor TBeThreadItem.Create( | |
| 326 | - inInstance : DWORD | |
| 327 | -); | |
| 328 | -var | |
| 329 | - uri : TIdURI; | |
| 330 | - uriList : TStringList; | |
| 331 | -begin | |
| 332 | - | |
| 333 | - inherited; | |
| 334 | - | |
| 335 | - OnDownload := Download; | |
| 336 | - OnWrite := Write; | |
| 337 | - OnGetRes := GetRes; | |
| 338 | - OnGetDat := GetDat; | |
| 339 | - OnGetHeader := GetHeader; | |
| 340 | - OnGetFooter := GetFooter; | |
| 341 | - OnGetBoardURL := GetBoardURL; | |
| 342 | - | |
| 343 | - FilePath := ''; | |
| 344 | - FIsTemporary := False; | |
| 345 | - FDat := nil; | |
| 346 | - URL := BrowsableURL; | |
| 347 | - | |
| 348 | - uri := TIdURI.Create( ReadURL ); | |
| 349 | - uriList := TStringList.Create; | |
| 350 | - try | |
| 351 | - ExtractHttpFields( ['/', '?'], [], uri.Path, uriList ); | |
| 352 | - if uriList[ 5 ] = 'l50' then begin | |
| 353 | - FileName := uriList[ 4 ] + '.dat'; | |
| 354 | - FilePath := MyLogFolder + uriList[ 2 ] + '\' + uriList[ 3 ] + '\' + uriList[ 4 ] + '.dat'; | |
| 355 | - IsLogFile := FileExists( FilePath ); | |
| 356 | - end else begin | |
| 357 | - FileName := uriList[ 5 ] + '.dat'; | |
| 358 | - FilePath := MyLogFolder + uriList[ 3 ] + '\' + uriList[ 4 ] + '\' + uriList[ 5 ] + '.dat'; | |
| 359 | - IsLogFile := FileExists( FilePath ); | |
| 360 | - end; | |
| 361 | - finally | |
| 362 | - uri.Free; | |
| 363 | - uriList.Free; | |
| 364 | - end; | |
| 365 | - | |
| 366 | -end; | |
| 367 | - | |
| 368 | -// ************************************************************************* | |
| 369 | -// デストラクタ | |
| 370 | -// ************************************************************************* | |
| 371 | -destructor TBeThreadItem.Destroy; | |
| 372 | -begin | |
| 373 | - | |
| 374 | - FreeDat; | |
| 375 | - | |
| 376 | - // 一時ファイルの場合は削除する | |
| 377 | - if FIsTemporary then | |
| 378 | - DeleteFile( FilePath ); | |
| 379 | - | |
| 380 | - inherited; | |
| 381 | - | |
| 382 | -end; | |
| 383 | - | |
| 384 | -// ************************************************************************* | |
| 385 | -// 指定した URL のスレッドのダウンロードを指示された | |
| 386 | -// ************************************************************************* | |
| 387 | -function TBeThreadItem.Download : TDownloadState; | |
| 388 | -var | |
| 389 | - modified : Double; | |
| 390 | - tmp : PChar; | |
| 391 | - downResult : TStringList; | |
| 392 | - responseCode : Longint; | |
| 393 | - logStream : TFileStream; | |
| 394 | - uri : TIdURI; | |
| 395 | - uriList : TStringList; | |
| 396 | - datURL, tmpURL : string; | |
| 397 | - tmpText: string; | |
| 398 | -begin | |
| 399 | - | |
| 400 | - Result := dsError; | |
| 401 | - | |
| 402 | - uri := TIdURI.Create( ReadURL ); | |
| 403 | - uriList := TStringList.Create; | |
| 404 | - try | |
| 405 | - ExtractHttpFields( ['/', '?'], [], uri.Path, uriList ); | |
| 406 | - FileName := uriList[ 5 ] + '.dat'; | |
| 407 | - // http://jbbs.livedoor.com/bbs/rawmode.cgi/game/1578/1067968274/l100 | |
| 408 | - // protocol://host/1/2/3/4/5/uriList.Count - 1 | |
| 409 | - if MyLogFolder = '' then begin | |
| 410 | - // どこに保存していいのか分からないので一時ファイルに保存 | |
| 411 | - FilePath := TemporaryFile; | |
| 412 | - FIsTemporary := True; | |
| 413 | - end else begin | |
| 414 | - FilePath := MyLogFolder + uriList[ 3 ] + '\' + uriList[ 4 ] + '\' + uriList[ 5 ] + '.dat'; | |
| 415 | - FIsTemporary := False; | |
| 416 | - end; | |
| 417 | - finally | |
| 418 | - uri.Free; | |
| 419 | - uriList.Free; | |
| 420 | - end; | |
| 421 | - | |
| 422 | - // 保存用のディレクトリを掘る | |
| 423 | - ForceDirectoriesEx( Copy( FilePath, 1, LastDelimiter( '\', FilePath ) ) ); | |
| 424 | - | |
| 425 | - // 独自にダウンロードやフィルタリングを行わない場合は | |
| 426 | - // InternalDownload に任せることが出来る | |
| 427 | - modified := LastModified; | |
| 428 | - datURL := ReadURL + IntToStr( Count + 1 ) + '-'; // 新着のみ | |
| 429 | - responseCode := InternalDownload( PChar( datURL ), modified, tmp, 0 ); | |
| 430 | - | |
| 431 | - try | |
| 432 | - if (responseCode = 200) or (responseCode = 206) then begin | |
| 433 | - downResult := TStringList.Create; | |
| 434 | - try | |
| 435 | - tmpText := CustomStringReplace( string( tmp ), '｡?ｮ', ',' ); | |
| 436 | - downResult.Text := EUCtoSJIS( tmpText ); | |
| 437 | - ArrangeDownloadData(Count, downResult); | |
| 438 | - if downResult.Count > 0 then begin | |
| 439 | - if FileExists( FilePath ) then | |
| 440 | - logStream := TFileStream.Create( FilePath, fmOpenReadWrite or fmShareDenyWrite ) | |
| 441 | - else | |
| 442 | - logStream := TFileStream.Create( FilePath, fmCreate or fmShareDenyWrite ); | |
| 443 | - try | |
| 444 | - logStream.Position := logStream.Size; | |
| 445 | - logStream.Write( PChar( downResult.Text )^, Length( downResult.Text ) ); | |
| 446 | - finally | |
| 447 | - logStream.Free; | |
| 448 | - end; | |
| 449 | - | |
| 450 | - if Count = 0 then | |
| 451 | - // 新規 | |
| 452 | - Result := dsComplete | |
| 453 | - else | |
| 454 | - // 追記 | |
| 455 | - Result := dsDiffComplete; | |
| 456 | - | |
| 457 | - Size := Size + Length( downResult.Text ); | |
| 458 | - // CGI からは正しい日付が得られないので現在に設定 | |
| 459 | - LastModified := Now; | |
| 460 | - | |
| 461 | - | |
| 462 | - | |
| 463 | - NewReceive := Count + 1; | |
| 464 | - Count := Count + downResult.Count; | |
| 465 | - NewResCount := downResult.Count; | |
| 466 | - | |
| 467 | - | |
| 468 | - | |
| 469 | - end else begin | |
| 470 | - Result := dsNotModify; | |
| 471 | - end; | |
| 472 | - finally | |
| 473 | - downResult.Free; | |
| 474 | - end; | |
| 475 | - end else if responseCode = 302 then begin | |
| 476 | - //http://jbbs.shitaraba.com/bbs/read.cgi/game/3477/1077473358/ | |
| 477 | - //http://jbbs.shitaraba.com/game/bbs/read.cgi?BBS=3477&KEY=1077473358 | |
| 478 | - //http://jbbs.shitaraba.com/game/3477/storage/1077473358.html | |
| 479 | - //過去ログ | |
| 480 | - //tmpURL := URL; | |
| 481 | - if Assigned( InternalPrint ) then | |
| 482 | - InternalPrint( '過去ログ倉庫入り' ); | |
| 483 | - uri := TIdURI.Create( ReadURL ); | |
| 484 | - uriList := TStringList.Create; | |
| 485 | - try | |
| 486 | - ExtractHttpFields( ['/', '?'], [], uri.Path, uriList ); | |
| 487 | - tmpURL := uri.Protocol + '://' + uri.Host + | |
| 488 | - '/' + uriList[3] + '/' + uriList[4] + '/storage/' + uriList[ 5 ] + '.html'; | |
| 489 | - finally | |
| 490 | - uriList.Free; | |
| 491 | - uri.Free; | |
| 492 | - end; | |
| 493 | - Result := StorageDownload(tmpURL); | |
| 494 | - end else if responseCode = 304 then begin | |
| 495 | - Result := dsNotModify; | |
| 496 | - end; | |
| 497 | - finally | |
| 498 | - DisposeResultString( tmp ); | |
| 499 | - end; | |
| 500 | - | |
| 501 | -end; | |
| 502 | -// ************************************************************************* | |
| 503 | -// downloadしてきたDatのあぼーんされた分を補充して、 | |
| 504 | -// レス数と一致するようにする | |
| 505 | -// ************************************************************************* | |
| 506 | -procedure TBeThreadItem.ArrangeDownloadData( | |
| 507 | - start: Integer; // 新規：０ 追記：前回までの取得数 | |
| 508 | - var Data: TStringList //Datのデータ | |
| 509 | -); | |
| 510 | -var | |
| 511 | - i: Integer; | |
| 512 | - n: Integer; | |
| 513 | - tmp: string; | |
| 514 | -begin | |
| 515 | - i := start; | |
| 516 | - while i < Data.count + start do begin | |
| 517 | - try | |
| 518 | - tmp := Copy(Data[i - start], 1 , AnsiPos('<>', Data[ i - start ] )-1 ); | |
| 519 | - try | |
| 520 | - n := StrToInt(tmp); | |
| 521 | - if n > i + 1 then begin | |
| 522 | - Data.Insert(i - start, Format('%d<><><><><><>', [i+1])); | |
| 523 | - end; | |
| 524 | - Inc(i); | |
| 525 | - except | |
| 526 | - Inc(i); | |
| 527 | - end; | |
| 528 | - except | |
| 529 | - | |
| 530 | - end; | |
| 531 | - end; | |
| 532 | - | |
| 533 | -end; | |
| 534 | -// ************************************************************************* | |
| 535 | -// 過去ログ用Download関数 | |
| 536 | -// ************************************************************************* | |
| 537 | -function TBeThreadItem.StorageDownload( | |
| 538 | - AURL : string | |
| 539 | -) : TDownloadState; | |
| 540 | -var | |
| 541 | - modified : Double; | |
| 542 | - tmp : PChar; | |
| 543 | - uri : TIdURI; | |
| 544 | - uriList : TStringList; | |
| 545 | - downResult : TStringList; | |
| 546 | - responseCode : Longint; | |
| 547 | - logStream : TFileStream; | |
| 548 | - tmpText, tmpLine, tmpTitle: string; | |
| 549 | - tmpHTML: TStringList; | |
| 550 | - | |
| 551 | - i, j, tS, tE: Integer; | |
| 552 | - tmpDatToken : array[0..6] of string; | |
| 553 | -begin | |
| 554 | - | |
| 555 | - Result := dsError; | |
| 556 | - uri := TIdURI.Create( ReadURL ); | |
| 557 | - uriList := TStringList.Create; | |
| 558 | - try | |
| 559 | - ExtractHttpFields( ['/', '?'], [], uri.Path, uriList ); | |
| 560 | - FileName := uriList[ 5 ] + '.dat'; | |
| 561 | - // http://jbbs.livedoor.com/bbs/rawmode.cgi/game/1578/1067968274/l100 | |
| 562 | - // protocol://host/1/2/3/4/5/uriList.Count - 1 | |
| 563 | - if MyLogFolder = '' then begin | |
| 564 | - // どこに保存していいのか分からないので一時ファイルに保存 | |
| 565 | - FilePath := TemporaryFile; | |
| 566 | - FIsTemporary := True; | |
| 567 | - end else begin | |
| 568 | - FilePath := MyLogFolder + uriList[ 3 ] + '\' + uriList[ 4 ] + '\' + uriList[ 5 ] + '.dat'; | |
| 569 | - FIsTemporary := False; | |
| 570 | - end; | |
| 571 | - finally | |
| 572 | - uri.Free; | |
| 573 | - uriList.Free; | |
| 574 | - end; | |
| 575 | - | |
| 576 | - // 保存用のディレクトリを掘る | |
| 577 | - ForceDirectoriesEx( Copy( FilePath, 1, LastDelimiter( '\', FilePath ) ) ); | |
| 578 | - | |
| 579 | - | |
| 580 | - | |
| 581 | - // 独自にダウンロードやフィルタリングを行わない場合は | |
| 582 | - // InternalDownload に任せることが出来る | |
| 583 | - modified := LastModified; | |
| 584 | - | |
| 585 | - responseCode := InternalDownload( PChar( AURL ), modified, tmp, 0 ); | |
| 586 | - | |
| 587 | - try | |
| 588 | - if (responseCode = 200) or (responseCode = 206) then begin | |
| 589 | - downResult := TStringList.Create; | |
| 590 | - try | |
| 591 | - tmpText := CustomStringReplace( string( tmp ), '｡?ｮ', ',' ); | |
| 592 | - | |
| 593 | - | |
| 594 | - | |
| 595 | - //**ここでHTMLファイルをしたらばJBBSのdat形式に変換する | |
| 596 | - tmpHTML := TStringList.Create; | |
| 597 | - | |
| 598 | - try | |
| 599 | - tmpHTML.Text := EUCtoSJIS( tmpText ); | |
| 600 | - //Titleの取得 | |
| 601 | - for i := 0 to tmpHTML.Count - 1 do begin | |
| 602 | - tmpLine := AnsiLowerCase(tmpHTML[i]); | |
| 603 | - tS := AnsiPos('<title>', tmpLine); | |
| 604 | - tE := AnsiPos('</title>', tmpLine); | |
| 605 | - | |
| 606 | - if tS > 0 then begin | |
| 607 | - if tE - tS = 1 then begin | |
| 608 | - tmpTitle := ''; | |
| 609 | - end else begin | |
| 610 | - tmpTitle := Copy(tmpHTML[i], ts + 7, Length(tmpHTML[i])); | |
| 611 | - tmpLine := AnsiLowerCase(tmpTitle); | |
| 612 | - tE := AnsiPos('</title>', tmpLine); | |
| 613 | - | |
| 614 | - if tE > 0 then begin | |
| 615 | - tmpTitle := Copy(tmpTitle, 1, tE - 1); | |
| 616 | - end else begin | |
| 617 | - j := i + 1; | |
| 618 | - tmpLine := AnsiLowerCase(tmpHTML[j]); | |
| 619 | - tE := AnsiPos('</title>', tmpLine); | |
| 620 | - tmpTitle := tmpTitle + tmpHTML[j]; | |
| 621 | - while( tE = 0 ) do begin | |
| 622 | - j := i + 1; | |
| 623 | - if j = tmpHTML.Count then break; | |
| 624 | - tmpLine := AnsiLowerCase(tmpHTML[j]); | |
| 625 | - tE := AnsiPos('</title>', tmpLine); | |
| 626 | - tmpTitle := tmpTitle + tmpHTML[j]; | |
| 627 | - end; | |
| 628 | - if tE = 0 then tmpTitle := '' | |
| 629 | - else begin | |
| 630 | - tmpLine := AnsiLowerCase(tmpTitle); | |
| 631 | - tE := AnsiPos('</title>', tmpLine); | |
| 632 | - tmpTitle := Copy(tmpTitle, 1, tE - 1); | |
| 633 | - end; | |
| 634 | - end; | |
| 635 | - end; | |
| 636 | - end; | |
| 637 | - end; | |
| 638 | - //Title := tmpTitle; | |
| 639 | - //tS := 0; tE := 0; | |
| 640 | - //本文の取得 <DL>の次の行から</DL>の前の行まで | |
| 641 | - for i := tmpHTML.Count - 1 downto 0 do begin | |
| 642 | - tmpLine := AnsiLowerCase(tmpHTML[i]); | |
| 643 | - tE := AnsiPos('</dl>', tmpLine); | |
| 644 | - if tE > 0 then begin | |
| 645 | - tmpHTML[i] := COpy(tmpHTML[i], 1, tE -1); | |
| 646 | - break; | |
| 647 | - end; | |
| 648 | - tmpHTML.Delete(i); | |
| 649 | - end; | |
| 650 | - j := 0; | |
| 651 | - for i := 0 to tmpHTML.Count - 1 do begin | |
| 652 | - tmpLine := AnsiLowerCase(tmpHTML[i]); | |
| 653 | - tS := AnsiPos('<dl>', tmpLine); | |
| 654 | - if tS > 0 then begin | |
| 655 | - j := i + 1; | |
| 656 | - break; | |
| 657 | - end; | |
| 658 | - end; | |
| 659 | - for i := j downto 0 do | |
| 660 | - tmpHTML.Delete(i); | |
| 661 | - | |
| 662 | - //<DD><DT>それぞれ一行に変換する | |
| 663 | - for i := tmpHTML.Count - 1 downto 1 do begin | |
| 664 | - tmpLine := AnsiLowerCase(tmpHTML[i]); | |
| 665 | - if (AnsiPos('<dd>', tmpLine) = 0) and (AnsiPos('<dt>', tmpLine) = 0) then begin | |
| 666 | - tmpLine := CustomStringReplace(tmpHTML[i-1], #13#10, '') + | |
| 667 | - CustomStringReplace(tmpHTML[i], #13#10, ''); | |
| 668 | - tmpHTML.Insert(i-1, tmpLine); | |
| 669 | - tmpHTML.Delete(i + 1); | |
| 670 | - tmpHTML.Delete(i); | |
| 671 | - end; | |
| 672 | - end; | |
| 673 | - //上までの処理で以下のような形になってる | |
| 674 | - //<dt><a name="958">958 </a> 名前：<font color="#008800"><b> 名も無き軍師 </b></font> 投稿日： 2004/06/30(水) 15:17 [ r1FsjJhA ]<br><dd>〜〜 | |
| 675 | - //<dt><a name="951">951 </a> 名前：<a href="mailto:sage"><b> 名も無き軍師 </B></a> 投稿日： 2004/06/30(水) 12:31 [ .oGr0rtc ]<br><dd>〜〜 | |
| 676 | - //上のようなのを下のようなdatの形式に変換する | |
| 677 | - //レス番号<><font color=#FF0000>HN</font><>メル欄<>日付時刻<>本文<>タイトル（１のみ）<>ID | |
| 678 | - //2<>名も無き軍師<>sage<>2004/06/22(火) 09:05<>２げとー<><>26bmLAzg | |
| 679 | - for i := 0 to tmpHTML.Count - 1 do begin | |
| 680 | - tmpDatToken[0] := ''; tmpDatToken[1] := ''; tmpDatToken[2] := ''; | |
| 681 | - tmpDatToken[3] := ''; tmpDatToken[4] := ''; tmpDatToken[6] := ''; | |
| 682 | - //==まずは本文を取得==// | |
| 683 | - tmpLine := AnsiLowerCase(tmpHTML[i]); | |
| 684 | - tS := AnsiPos('<dd>', tmpLine); | |
| 685 | - if tS > 0 then begin | |
| 686 | - tmpDatToken[4] := Copy(tmpHTML[i], tS + 4, Length(tmpHTML[i])); | |
| 687 | - tmpHTML[i] := Copy(tmpHTML[i], 1, tS -1); | |
| 688 | - end else | |
| 689 | - tmpDatToken[4] := ''; | |
| 690 | - //====================// | |
| 691 | - //==レス番号取得==// | |
| 692 | - tmpLine := AnsiLowerCase(tmpHTML[i]); | |
| 693 | - tS := AnsiPos('">', tmpLine); | |
| 694 | - tE := AnsiPos('</a>', tmpLine); | |
| 695 | - if tE > tS then begin | |
| 696 | - tmpDatToken[0] := Copy(tmpHTML[i], tS + 2, tE - (tS + 2) - 1); | |
| 697 | - tmpDatToken[0] := Trim(tmpDatToken[0]); | |
| 698 | - tmpHTML[i] := Copy(tmpHTML[i], tE + 4, Length(tmpHTML[i])); | |
| 699 | - end else | |
| 700 | - tmpDatToken[0] := IntToStr(i); | |
| 701 | - tS := AnsiPos('<', tmpHTML[i]); | |
| 702 | - if tS > 0 then begin | |
| 703 | - tmpHTML[i] := Copy(tmpHTML[i], tS, Length(tmpHTML[i])); | |
| 704 | - end; | |
| 705 | - //====================// | |
| 706 | - //==メル欄取得==// | |
| 707 | - tmpLine := AnsiLowerCase(tmpHTML[i]); | |
| 708 | - tS := AnsiPos('<a href="mailto:', tmpLine); | |
| 709 | - if tS > 0 then begin //メル欄アリ | |
| 710 | - tE := AnsiPos('">', tmpLine); | |
| 711 | - tmpDatToken[2] := Copy(tmpHTML[i], tS + 16, tE - (tS + 16)); | |
| 712 | - tmpHTML[i] := Copy(tmpHTML[i], tE + 5, Length(tmpHTML[i])); | |
| 713 | - tmpHTML[i] := CustomStringReplace(tmpHTML[i], '</a>', '', true); | |
| 714 | - end else begin //メル欄無し | |
| 715 | - tmpDatToken[2] := ''; | |
| 716 | - end; | |
| 717 | - //====================// | |
| 718 | - //==HN取得==// | |
| 719 | - tmpLine := AnsiLowerCase(tmpHTML[i]); | |
| 720 | - tE := AnsiPos('投稿日：', tmpLine); | |
| 721 | - if tE > 0 then begin | |
| 722 | - tmpDatToken[1] := Trim(Copy(tmpHTML[i], 1, tE - 1 )); | |
| 723 | - tmpDatToken[1] := CustomStringReplace(tmpDatToken[1], '<b>', '', true); | |
| 724 | - tmpDatToken[1] := CustomStringReplace(tmpDatToken[1], '</b>', '', true); | |
| 725 | - tmpHTML[i] := Copy(tmpHTML[i], tE + 8, Length(tmpHTML[i])); | |
| 726 | - end else begin | |
| 727 | - tmpDatToken[1] := ''; | |
| 728 | - end; | |
| 729 | - //====================// | |
| 730 | - //==日付時刻の取得==// | |
| 731 | - tmpLine := AnsiLowerCase(tmpHTML[i]); | |
| 732 | - tE := AnsiPos('[', tmpLine); | |
| 733 | - if tE > 0 then begin | |
| 734 | - tmpDatToken[3] := Trim(Copy(tmpHTML[i], 1, tE - 1 )); | |
| 735 | - tmpHTML[i] := Copy(tmpHTML[i], tE + 1, Length(tmpHTML[i])); | |
| 736 | - end else begin | |
| 737 | - tmpDatToken[3] := ''; | |
| 738 | - end; | |
| 739 | - //====================// | |
| 740 | - //==IDの取得==// | |
| 741 | - tmpLine := AnsiLowerCase(tmpHTML[i]); | |
| 742 | - tE := AnsiPos(']', tmpLine); | |
| 743 | - if tE > 0 then begin | |
| 744 | - tmpDatToken[6] := Trim(Copy(tmpHTML[i], 1, tE - 1 )); | |
| 745 | - end else begin | |
| 746 | - tmpDatToken[6] := ''; | |
| 747 | - end; | |
| 748 | - //====================// | |
| 749 | - tS := StrToIntDef(tmpDatToken[0], -1); | |
| 750 | - if tS = 1 then | |
| 751 | - tmpLine := tmpDatToken[0] + '<>' + tmpDatToken[1] + '<>' + tmpDatToken[2] + '<>' + | |
| 752 | - tmpDatToken[3] + '<>' + tmpDatToken[4] + '<>' + tmpTitle + '<>' + tmpDatToken[6] | |
| 753 | - else | |
| 754 | - tmpLine := tmpDatToken[0] + '<>' + tmpDatToken[1] + '<>' +tmpDatToken[2] + '<>' + | |
| 755 | - tmpDatToken[3] + '<>' + tmpDatToken[4] + '<><>' + tmpDatToken[6]; | |
| 756 | - tmpHTML[i] := tmpLine; | |
| 757 | - end; | |
| 758 | - | |
| 759 | - | |
| 760 | - | |
| 761 | - | |
| 762 | - downResult.Text := tmpHTML.Text; | |
| 763 | - finally | |
| 764 | - tmpHTML.free; | |
| 765 | - end; | |
| 766 | - | |
| 767 | - ArrangeDownloadData(Count, downResult); | |
| 768 | - | |
| 769 | - if downResult.Count > 0 then begin | |
| 770 | - if FileExists( FilePath ) then | |
| 771 | - DeleteFile(FilePath); | |
| 772 | - | |
| 773 | - logStream := TFileStream.Create( FilePath, fmCreate or fmShareDenyWrite ); | |
| 774 | - try | |
| 775 | - logStream.Position := 0; | |
| 776 | - logStream.Write( PChar( downResult.Text )^, Length( downResult.Text ) ); | |
| 777 | - finally | |
| 778 | - logStream.Free; | |
| 779 | - end; | |
| 780 | - | |
| 781 | - // 新規 | |
| 782 | - Result := dsComplete; | |
| 783 | - | |
| 784 | - Size := Length( downResult.Text ); | |
| 785 | - // CGI からは正しい日付が得られないので現在に設定 | |
| 786 | - LastModified := Now; | |
| 787 | - | |
| 788 | - | |
| 789 | - | |
| 790 | - NewReceive := 1; | |
| 791 | - Count := downResult.Count; | |
| 792 | - NewResCount := downResult.Count; | |
| 793 | - //http://jbbs.livedoor.com/bbs/read.cgi/game/1578/1086710948/l100 | |
| 794 | - //http://jbbs.livedoor.com/game/1578/storage/1086710948.html | |
| 795 | - //URL := 'http://jbbs.livedoor.com/bbs/read.cgi' + | |
| 796 | - // CustomStringReplace(Path, '/storage', '') | |
| 797 | - // + FileName; | |
| 798 | - DownloadHost := 'storage'; | |
| 799 | - end else begin | |
| 800 | - Result := dsNotModify; | |
| 801 | - end; | |
| 802 | - finally | |
| 803 | - downResult.Free; | |
| 804 | - end; | |
| 805 | - end else if responseCode = 304 then begin | |
| 806 | - Result := dsNotModify; | |
| 807 | - end; | |
| 808 | - finally | |
| 809 | - DisposeResultString( tmp ); | |
| 810 | - end; | |
| 811 | - | |
| 812 | -end; | |
| 813 | - | |
| 814 | -// ************************************************************************* | |
| 815 | -// 書き込みを指示された | |
| 816 | -// ************************************************************************* | |
| 817 | -function TBeThreadItem.Write( | |
| 818 | - inName : string; // 名前(ハンドル) | |
| 819 | - inMail : string; // メールアドレス | |
| 820 | - inMessage : string // 本文 | |
| 821 | -) : TDownloadState; // 書き込みが成功したかどうか | |
| 822 | -var | |
| 823 | - postData : string; | |
| 824 | - postResult : PChar; | |
| 825 | - uri : TIdURI; | |
| 826 | - uriList : TStringList; | |
| 827 | - responseCode : Integer; | |
| 828 | -begin | |
| 829 | - | |
| 830 | - uri := TIdURI.Create( URL ); | |
| 831 | - uriList := TStringList.Create; | |
| 832 | - try | |
| 833 | - ExtractHttpFields( ['/', '?'], [], uri.Path, uriList ); | |
| 834 | - | |
| 835 | - // http://jbbs.livedoor.com/bbs/read.cgi/game/1578/1067968274/l100 | |
| 836 | - postData := | |
| 837 | - 'NAME=' + HttpEncode( SJIStoEUC( inName ) ) + | |
| 838 | - '&MAIL=' + HttpEncode( SJIStoEUC( inMail ) ) + | |
| 839 | - '&MESSAGE=' + HttpEncode( SJIStoEUC( inMessage ) ) + | |
| 840 | - '&BBS=' + uriList[ 4 ] + | |
| 841 | - '&KEY=' + uriList[ 5 ] + | |
| 842 | - '&DIR=' + uriList[ 3 ] + | |
| 843 | - '&TIME=' + IntToStr( DateTimeToUnix( Now ) ) + | |
| 844 | - '&submit=' + HttpEncode( SJIStoEUC( '書き込む' ) ); | |
| 845 | - | |
| 846 | - // 独自に通信しない場合は InternalPost に任せることが出来る | |
| 847 | - responseCode := InternalPost( PChar( WriteURL ), PChar( postData ), postResult ); | |
| 848 | - try | |
| 849 | - if (responseCode = 200) or | |
| 850 | - ((responseCode = 302) and (Length( Trim( postResult ) ) = 0)) then begin | |
| 851 | - Result := dsComplete | |
| 852 | - end else begin | |
| 853 | - Result := dsError; | |
| 854 | - if Assigned( InternalPrint ) then | |
| 855 | - InternalPrint( postResult ); | |
| 856 | - end; | |
| 857 | - finally | |
| 858 | - DisposeResultString( postResult ); | |
| 859 | - end; | |
| 860 | - finally | |
| 861 | - uri.Free; | |
| 862 | - uriList.Free; | |
| 863 | - end; | |
| 864 | - | |
| 865 | -end; | |
| 866 | - | |
| 867 | -// ************************************************************************* | |
| 868 | -// レス番号 inNo に対する html を要求された | |
| 869 | -// ************************************************************************* | |
| 870 | -function TBeThreadItem.GetRes( | |
| 871 | - inNo : Integer // 要求されたレス番号 | |
| 872 | -) : string; // 対応する HTML | |
| 873 | -var | |
| 874 | - res : string; | |
| 875 | - tmp : PChar; | |
| 876 | -begin | |
| 877 | - | |
| 878 | - // 独自にフィルタリングを行わない場合は | |
| 879 | - // InternalAbon および Dat2HTML に任せることが出来る | |
| 880 | - { | |
| 881 | - LoadDat; | |
| 882 | - if FDat = nil then begin | |
| 883 | - // ログに存在しないのでこのまま終了 | |
| 884 | - Result := ''; | |
| 885 | - Exit; | |
| 886 | - end; | |
| 887 | - res := Copy( FDat[ inNo - 1 ], AnsiPos( '<>', FDat[ inNo - 1 ] ) + 2, MaxInt ); | |
| 888 | - } | |
| 889 | - res := GetDat( inNo ); | |
| 890 | - if res = '' then begin | |
| 891 | - Result := ''; | |
| 892 | - Exit; | |
| 893 | - end else begin | |
| 894 | - tmp := InternalAbonForOne( PChar( res ), PChar( FilePath ),inNo ); | |
| 895 | - try | |
| 896 | - Result := Dat2HTML( string( tmp ), inNo ); | |
| 897 | - finally | |
| 898 | - DisposeResultString( tmp ); | |
| 899 | - end; | |
| 900 | - end; | |
| 901 | - | |
| 902 | -end; | |
| 903 | - | |
| 904 | -// ************************************************************************* | |
| 905 | -// レス番号 inNo に対する Dat を要求された | |
| 906 | -// ************************************************************************* | |
| 907 | -function TBeThreadItem.GetDat( | |
| 908 | - inNo : Integer // 要求されたレス番号 | |
| 909 | -) : string; // ２ちゃんねるのDat形式 | |
| 910 | -var | |
| 911 | - res : string; | |
| 912 | - tmp : array[1..5] of string; | |
| 913 | - i : Integer; | |
| 914 | - pTmp : PChar; | |
| 915 | -begin | |
| 916 | - pTmp := nil; | |
| 917 | - // 独自にフィルタリングを行わない場合は | |
| 918 | - // InternalAbon および Dat2HTML に任せることが出来る | |
| 919 | - LoadDat; | |
| 920 | - if (FDat = nil) or (inNo - 1 < 0 ) or (inNo - 1 >= FDat.Count) then begin | |
| 921 | - // ログに存在しないのでこのまま終了 | |
| 922 | - Result := ''; | |
| 923 | - Exit; | |
| 924 | - end; | |
| 925 | - try | |
| 926 | - res := Copy( FDat[ inNo - 1 ], AnsiPos( '<>', FDat[ inNo - 1 ] ) + 2, MaxInt ); | |
| 927 | - //末尾にIDが表示されているのでそれを投稿日のところに入れる | |
| 928 | - // 名前<>メール<>日付<>本文<>スレタイ<>ID | |
| 929 | - for i := 0 to 4 do begin | |
| 930 | - tmp[ i + 1 ] := Copy( res, 1, AnsiPos('<>', res) - 1 ); | |
| 931 | - Delete( res, 1, AnsiPos('<>', res) + 1 ); | |
| 932 | - end; | |
| 933 | - // 名前<>メール<>日付ID<>本文<>スレタイ | |
| 934 | - pTmp := CreateResultString(tmp[1] + '<>' + tmp[2] + '<>' + tmp[3] + ' ' + res + '<>'+ tmp[4] + '<>' +tmp[5]); | |
| 935 | - Result := string(pTmp); | |
| 936 | - finally | |
| 937 | - DisposeResultString(pTmp); | |
| 938 | - end; | |
| 939 | - | |
| 940 | -end; | |
| 941 | - | |
| 942 | -// ************************************************************************* | |
| 943 | -// スレッドのヘッダ html を要求された | |
| 944 | -// ************************************************************************* | |
| 945 | -function TBeThreadItem.GetHeader( | |
| 946 | - inOptionalHeader : string | |
| 947 | -) : string; | |
| 948 | -begin | |
| 949 | - | |
| 950 | - // 独自にフィルタリングを行わない場合は | |
| 951 | - // InternalHeader に任せることが出来る | |
| 952 | - Result := InternalHeader( | |
| 953 | - '<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">' + | |
| 954 | - inOptionalHeader ); | |
| 955 | - | |
| 956 | - | |
| 957 | - // GetRes を呼ばれることが予想されるので FDat を生成しておく | |
| 958 | - try | |
| 959 | - FreeDat; | |
| 960 | - LoadDat; | |
| 961 | - except | |
| 962 | - end; | |
| 963 | - | |
| 964 | -end; | |
| 965 | - | |
| 966 | -// ************************************************************************* | |
| 967 | -// スレッドのフッタ html を要求された | |
| 968 | -// ************************************************************************* | |
| 969 | -function TBeThreadItem.GetFooter( | |
| 970 | - inOptionalFooter : string | |
| 971 | -) : string; | |
| 972 | -begin | |
| 973 | - | |
| 974 | - // 独自にフィルタリングを行わない場合は | |
| 975 | - // InternalFooter に任せることが出来る | |
| 976 | - Result := InternalFooter( inOptionalFooter ); | |
| 977 | - | |
| 978 | - // もう GetRes は呼ばれないと思うので FDat を開放しておく | |
| 979 | - try | |
| 980 | - FreeDat; | |
| 981 | - except | |
| 982 | - end; | |
| 983 | - | |
| 984 | -end; | |
| 985 | - | |
| 986 | -// ************************************************************************* | |
| 987 | -// この ThreadItem が属する板の URL を要求された | |
| 988 | -// ************************************************************************* | |
| 989 | -function TBeThreadItem.GetBoardURL : string; | |
| 990 | -var | |
| 991 | - uri : TIdURI; | |
| 992 | - uriList : TStringList; | |
| 993 | - tmphost: String; | |
| 994 | -const | |
| 995 | - BBS_HOST = 'be.2ch.net'; | |
| 996 | -begin | |
| 997 | - | |
| 998 | - uri := TIdURI.Create( ReadURL ); | |
| 999 | - uriList := TStringList.Create; | |
| 1000 | - try | |
| 1001 | - ExtractHttpFields( ['/', '?'], [], uri.Path, uriList ); | |
| 1002 | - FileName := uriList[ 4 ] + '.dat'; | |
| 1003 | - Result := CreateResultString( | |
| 1004 | - uri.Protocol + '://' + uri.host + '/' + uriList[ 3 ] + '/' ); | |
| 1005 | - finally | |
| 1006 | - uri.Free; | |
| 1007 | - uriList.Free; | |
| 1008 | - end; | |
| 1009 | - | |
| 1010 | -end; | |
| 1011 | - | |
| 1012 | -// ************************************************************************* | |
| 1013 | -// FDat の生成 | |
| 1014 | -// ************************************************************************* | |
| 1015 | -procedure TBeThreadItem.LoadDat; | |
| 1016 | -begin | |
| 1017 | - | |
| 1018 | - if FDat = nil then begin | |
| 1019 | - if IsLogFile then begin | |
| 1020 | - // dat の読み込み | |
| 1021 | - FDat := TStringList.Create; | |
| 1022 | - FDat.LoadFromFile( FilePath ); | |
| 1023 | - end; | |
| 1024 | - end; | |
| 1025 | - | |
| 1026 | -end; | |
| 1027 | - | |
| 1028 | -// ************************************************************************* | |
| 1029 | -// FDat の開放 | |
| 1030 | -// ************************************************************************* | |
| 1031 | -procedure TBeThreadItem.FreeDat; | |
| 1032 | -begin | |
| 1033 | - | |
| 1034 | - if FDat <> nil then begin | |
| 1035 | - FDat.Free; | |
| 1036 | - FDat := nil; | |
| 1037 | - end; | |
| 1038 | - | |
| 1039 | -end; | |
| 1040 | - | |
| 1041 | -// ************************************************************************* | |
| 1042 | -// 安全なブラウザ表示用の URL | |
| 1043 | -// ************************************************************************* | |
| 1044 | -function TBeThreadItem.BrowsableURL : string; | |
| 1045 | -var | |
| 1046 | - uri : TIdURI; | |
| 1047 | - uriList : TStringList; | |
| 1048 | - foundPos : Integer; | |
| 1049 | - dir, tmphost : string; | |
| 1050 | -const | |
| 1051 | - THREAD_MARK = '/test/read.cgi'; | |
| 1052 | - BBS_HOST = 'be.2ch.net'; | |
| 1053 | -begin | |
| 1054 | - if Copy( URL, Length( URL ), 1 ) = '/' then | |
| 1055 | - uri := TIdURI.Create( URL ) | |
| 1056 | - else | |
| 1057 | - uri := TIdURI.Create( URL + '/' ); | |
| 1058 | - | |
| 1059 | - uriList := TStringList.Create; | |
| 1060 | - try | |
| 1061 | - ExtractHttpFields( ['/'], [], uri.Path, uriList ); | |
| 1062 | - | |
| 1063 | - if( AnsiPos(THREAD_MARK, URL) > 0) and (uriList.Count > 4) then begin | |
| 1064 | - Result := | |
| 1065 | - uri.Protocol + '://' + uri.host + THREAD_MARK + '/' + | |
| 1066 | - uriList[ 3 ] + '/' + uriList[ 4 ] + '/l50'; | |
| 1067 | - | |
| 1068 | - end else if AnsiPos(THREAD_MARK, URL) = 0 then begin | |
| 1069 | - { | |
| 1070 | - //ココで過去ログかどうかチェック？ | |
| 1071 | - if(AnsiPos('.html/', uri.Path) > 0) then begin | |
| 1072 | - Result := uri.Protocol + '://' + url.host + THREAD_MARK + | |
| 1073 | - CustomStringReplace(CustomStringReplace(uri.Path, '/storage', ''), '.html/', '/') + 'l100'; | |
| 1074 | - end else | |
| 1075 | - } | |
| 1076 | - Result := URL; | |
| 1077 | - end; | |
| 1078 | - finally | |
| 1079 | - uri.Free; | |
| 1080 | - uriList.Free; | |
| 1081 | - end; | |
| 1082 | - | |
| 1083 | -end; | |
| 1084 | - | |
| 1085 | -// ************************************************************************* | |
| 1086 | -// 安全な( '/' で終わる )読み込みの URL | |
| 1087 | -// ************************************************************************* | |
| 1088 | -function TBeThreadItem.ReadURL : string; | |
| 1089 | -var | |
| 1090 | - uri : TIdURI; | |
| 1091 | - uriList : TStringList; | |
| 1092 | - foundPos : Integer; | |
| 1093 | - dir, tmphost : string; | |
| 1094 | -const | |
| 1095 | - THREAD_MARK = '/test/read.cgi'; | |
| 1096 | - BBS_HOST = 'be.2ch.net'; | |
| 1097 | -begin | |
| 1098 | - | |
| 1099 | - if Copy( URL, Length( URL ), 1 ) = '/' then | |
| 1100 | - uri := TIdURI.Create( URL ) | |
| 1101 | - else | |
| 1102 | - uri := TIdURI.Create( URL + '/' ); | |
| 1103 | - uriList := TStringList.Create; | |
| 1104 | - try | |
| 1105 | - ExtractHttpFields( ['/'], [], uri.Path, uriList ); | |
| 1106 | - | |
| 1107 | - if( AnsiPos(THREAD_MARK, URL) > 0) and (uriList.Count > 4) then begin | |
| 1108 | - Result := | |
| 1109 | - uri.Protocol + '://' + uri.Host + THREAD_MARK + | |
| 1110 | - uriList[ 3 ] + '/' + uriList[ 4 ] + '/'; | |
| 1111 | - end; | |
| 1112 | - finally | |
| 1113 | - uri.Free; | |
| 1114 | - uriList.Free; | |
| 1115 | - end; | |
| 1116 | -end; | |
| 1117 | - | |
| 1118 | -// ************************************************************************* | |
| 1119 | -// 安全な( '/' で終わる )書き込みの URL | |
| 1120 | -// ************************************************************************* | |
| 1121 | -function TBeThreadItem.WriteURL : string; | |
| 1122 | -var | |
| 1123 | - uri : TIdURI; | |
| 1124 | - uriList : TStringList; | |
| 1125 | -begin | |
| 1126 | - | |
| 1127 | - if Copy( URL, Length( URL ), 1 ) = '/' then | |
| 1128 | - uri := TIdURI.Create( URL ) | |
| 1129 | - else | |
| 1130 | - uri := TIdURI.Create( URL + '/' ); | |
| 1131 | - uriList := TStringList.Create; | |
| 1132 | - try | |
| 1133 | - ExtractHttpFields( ['/', '?'], [], uri.Path, uriList ); | |
| 1134 | - // http://jbbs.livedoor.com/bbs/read.cgi/game/1578/1067968274/l100 | |
| 1135 | - Result := | |
| 1136 | - uri.Protocol + '://' + uri.Host + '/bbs/write.cgi/' + | |
| 1137 | - uriList[ 3 ] + '/' + uriList[ 4 ] + '/' + uriList[ 5 ] + '/'; | |
| 1138 | - finally | |
| 1139 | - uri.Free; | |
| 1140 | - uriList.Free; | |
| 1141 | - end; | |
| 1142 | - | |
| 1143 | -end; | |
| 1144 | - | |
| 1145 | -// ************************************************************************* | |
| 1146 | -// TThreadItem が生成された場合の処置(TBeThreadItem を生成する) | |
| 1147 | -// ************************************************************************* | |
| 1148 | -procedure ThreadItemOnCreateOfTBeThreadItem( | |
| 1149 | - inInstance : DWORD | |
| 1150 | -); | |
| 1151 | -var | |
| 1152 | - threadItem : TBeThreadItem; | |
| 1153 | -begin | |
| 1154 | - | |
| 1155 | - threadItem := TBeThreadItem.Create( inInstance ); | |
| 1156 | - ThreadItemSetLong( inInstance, tipContext, DWORD( threadItem ) ); | |
| 1157 | - | |
| 1158 | -end; | |
| 1159 | - | |
| 1160 | -// ************************************************************************* | |
| 1161 | -// TThreadItem が破棄された場合の処置(TBeThreadItem を破棄する) | |
| 1162 | -// ************************************************************************* | |
| 1163 | -procedure ThreadItemOnDisposeOfTBeThreadItem( | |
| 1164 | - inInstance : DWORD | |
| 1165 | -); | |
| 1166 | -var | |
| 1167 | - threadItem : TBeThreadItem; | |
| 1168 | -begin | |
| 1169 | - | |
| 1170 | - threadItem := TBeThreadItem( ThreadItemGetLong( inInstance, tipContext ) ); | |
| 1171 | - threadItem.Free; | |
| 1172 | - | |
| 1173 | -end; | |
| 1174 | - | |
| 1175 | -// ========================================================================= | |
| 1176 | -// TBeBoardItem | |
| 1177 | -// ========================================================================= | |
| 1178 | - | |
| 1179 | -// ************************************************************************* | |
| 1180 | -// コンストラクタ | |
| 1181 | -// ************************************************************************* | |
| 1182 | -constructor TBeBoardItem.Create( | |
| 1183 | - inInstance : DWORD | |
| 1184 | -); | |
| 1185 | -var | |
| 1186 | - uri : TIdURI; | |
| 1187 | - uriList : TStringList; | |
| 1188 | -const | |
| 1189 | - BBS_HOST = 'be.2ch.net'; | |
| 1190 | -begin | |
| 1191 | - | |
| 1192 | - inherited; | |
| 1193 | - | |
| 1194 | - OnDownload := Download; | |
| 1195 | - OnCreateThread := CreateThread; | |
| 1196 | - OnEnumThread := EnumThread; | |
| 1197 | - OnFileName2ThreadURL := ToThreadURL; | |
| 1198 | - | |
| 1199 | - FilePath := ''; | |
| 1200 | - FIsTemporary := False; | |
| 1201 | - FDat := nil; | |
| 1202 | - | |
| 1203 | - uri := TIdURI.Create( SubjectURL ); | |
| 1204 | - uriList := TStringList.Create; | |
| 1205 | - try | |
| 1206 | - URL := uri.Protocol + '://' + uri.Host + uri.Path; | |
| 1207 | - | |
| 1208 | - ExtractHttpFields( ['/', '?'], [], uri.Path, uriList ); | |
| 1209 | - // http://jbbs.livedoor.com/game/1000/subject.txt | |
| 1210 | - FilePath := MyLogFolder + uriList[ 1 ] + '\' + uriList[ 2 ] + '\' + uri.Document; | |
| 1211 | - IsLogFile := FileExists( FilePath ); | |
| 1212 | - finally | |
| 1213 | - uri.Free; | |
| 1214 | - uriList.Free; | |
| 1215 | - end; | |
| 1216 | - | |
| 1217 | -end; | |
| 1218 | - | |
| 1219 | -// ************************************************************************* | |
| 1220 | -// デストラクタ | |
| 1221 | -// ************************************************************************* | |
| 1222 | -destructor TBeBoardItem.Destroy; | |
| 1223 | -begin | |
| 1224 | - | |
| 1225 | - if FDat <> nil then begin | |
| 1226 | - try | |
| 1227 | - FDat.Free; | |
| 1228 | - FDat := nil; | |
| 1229 | - except | |
| 1230 | - end; | |
| 1231 | - end; | |
| 1232 | - | |
| 1233 | - // 一時ファイルの場合は削除する | |
| 1234 | - if FIsTemporary then | |
| 1235 | - DeleteFile( FilePath ); | |
| 1236 | - | |
| 1237 | - inherited; | |
| 1238 | - | |
| 1239 | -end; | |
| 1240 | - | |
| 1241 | -// ************************************************************************* | |
| 1242 | -// 指定したスレ一覧のダウンロードを要求された | |
| 1243 | -// ************************************************************************* | |
| 1244 | -function TBeBoardItem.Download : TDownloadState; | |
| 1245 | -var | |
| 1246 | - modified : Double; | |
| 1247 | - downResult : PChar; | |
| 1248 | - responseCode : Longint; | |
| 1249 | - uri : TIdURI; | |
| 1250 | - uriList : TStringList; | |
| 1251 | - i : Integer; | |
| 1252 | - tmpText : String; | |
| 1253 | -begin | |
| 1254 | - | |
| 1255 | - Result := dsError; | |
| 1256 | - | |
| 1257 | - if FDat <> nil then begin | |
| 1258 | - try | |
| 1259 | - FDat.Free; | |
| 1260 | - FDat := nil; | |
| 1261 | - except | |
| 1262 | - end; | |
| 1263 | - end; | |
| 1264 | - FDat := TStringList.Create; | |
| 1265 | - uri := TIdURI.Create( SubjectURL ); | |
| 1266 | - uriList := TStringList.Create; | |
| 1267 | - // 独自にダウンロードやフィルタリングを行わない場合は | |
| 1268 | - // InternalDownload に任せることが出来る | |
| 1269 | - modified := LastModified; | |
| 1270 | - responseCode := InternalDownload( PChar( uri.URI ), modified, downResult ); | |
| 1271 | - try | |
| 1272 | - if responseCode = 200 then begin | |
| 1273 | - try | |
| 1274 | - // パスを算出 | |
| 1275 | - ExtractHttpFields( ['/', '?'], [], uri.Path, uriList ); | |
| 1276 | - if MyLogFolder = '' then begin | |
| 1277 | - // どこに保存していいのか分からないので一時ファイルに保存 | |
| 1278 | - FilePath := TemporaryFile; | |
| 1279 | - FIsTemporary := True; | |
| 1280 | - end else begin | |
| 1281 | - FilePath := MyLogFolder + uriList[ 1 ] + '\' + uriList[ 2 ] + '\' + uri.Document; | |
| 1282 | - FIsTemporary := False | |
| 1283 | - end; | |
| 1284 | - | |
| 1285 | - // 保存用のディレクトリを掘る | |
| 1286 | - ForceDirectoriesEx( Copy( FilePath, 1, LastDelimiter( '\', FilePath ) ) ); | |
| 1287 | - | |
| 1288 | - // EUC を Shift_JIS に | |
| 1289 | - tmpText := CustomStringReplace( string( downResult ), '｡?ｮ', ','); | |
| 1290 | - FDat.Text := EUCtoSJIS( tmpText ); | |
| 1291 | - // 保存 | |
| 1292 | - FDat.SaveToFile( FilePath ); | |
| 1293 | - | |
| 1294 | - IsLogFile := True; | |
| 1295 | - RoundDate := Now; | |
| 1296 | - LastModified := modified; | |
| 1297 | - LastGetTime := Now; | |
| 1298 | - finally | |
| 1299 | - uri.Free; | |
| 1300 | - uriList.Free; | |
| 1301 | - end; | |
| 1302 | - Result := dsComplete; | |
| 1303 | - end; | |
| 1304 | - finally | |
| 1305 | - DisposeResultString( downResult ); | |
| 1306 | - end; | |
| 1307 | - | |
| 1308 | -end; | |
| 1309 | - | |
| 1310 | -// ************************************************************************* | |
| 1311 | -// スレ立てを指示された | |
| 1312 | -// ************************************************************************* | |
| 1313 | -function TBeBoardItem.CreateThread( | |
| 1314 | - inSubject : string; // スレタイ | |
| 1315 | - inName : string; // 名前(ハンドル) | |
| 1316 | - inMail : string; // メールアドレス | |
| 1317 | - inMessage : string // 本文 | |
| 1318 | -) : TDownloadState; // 書き込みが成功したかどうか | |
| 1319 | -var | |
| 1320 | - postURL : string; | |
| 1321 | - postData : string; | |
| 1322 | - postResult : PChar; | |
| 1323 | - uri : TIdURI; | |
| 1324 | - uriList : TStringList; | |
| 1325 | - responseCode : Integer; | |
| 1326 | -begin | |
| 1327 | - | |
| 1328 | - uri := TIdURI.Create( URL ); | |
| 1329 | - uriList := TStringList.Create; | |
| 1330 | - try | |
| 1331 | - ExtractHttpFields( ['/', '?'], [], uri.Path, uriList ); | |
| 1332 | - | |
| 1333 | - postURL := | |
| 1334 | - uri.Protocol + '://' + uri.Host + '/bbs.cgi'; | |
| 1335 | - postData := | |
| 1336 | - 'subject=&' | |
| 1337 | - + 'FROM=' + HttpEncode(SJIStoEUC(inName)) + '&' | |
| 1338 | - + 'mail=' + HttpEncode(SJIStoEUC(inMail)) + '&' | |
| 1339 | - + 'MESSAGE=' + HttpEncode(SJIStoEUC(inMessage)) + '&' | |
| 1340 | - + 'bbs=' + uriList[4] + '&' | |
| 1341 | - + 'time=' + IntToStr(DateTimeToUnix( Now )) + '&' | |
| 1342 | - + 'subject=' + HttpEncode(SJIStoEUC(inSubject)) + '&' | |
| 1343 | - + 'submit=' + HttpEncode(SJIStoEUC('全責任を負うことを承諾して書き込む')) + #13#10; | |
| 1344 | - //s := s + 'subject=' + HttpEncode(TitleEdit.Text) + '&'; | |
| 1345 | - //s := s + 'submit=' + HttpEncode('全責任を負うことを承諾して書き込む') + #13#10; | |
| 1346 | - | |
| 1347 | - {postData := | |
| 1348 | - 'SUBJECT=' + HttpEncode( SJIStoEUC( inSubject ) ) + | |
| 1349 | - '&NAME=' + HttpEncode( SJIStoEUC( inName ) ) + | |
| 1350 | - '&MAIL=' + HttpEncode( SJIStoEUC( inMail ) ) + | |
| 1351 | - '&MESSAGE=' + HttpEncode( SJIStoEUC( inMessage ) ) + | |
| 1352 | - '&BBS=' + uriList[ 4 ] + | |
| 1353 | - '&TIME=' + IntToStr( DateTimeToUnix( Now ) ) + | |
| 1354 | - '&submit=' + HttpEncode( SJIStoEUC( '新規書き込み' ) ); | |
| 1355 | - } | |
| 1356 | -{ | |
| 1357 | - s := s + 'subject=&' | |
| 1358 | - + 'FROM=' + HttpEncode(NameComboBox.Text) + '&' | |
| 1359 | - + 'mail=' + HttpEncode(MailComboBox.Text) + '&' | |
| 1360 | - + 'MESSAGE=' + HttpEncode(body) + '&' | |
| 1361 | - + 'bbs=' + Board.BBSID + '&' | |
| 1362 | - + 'time=' + IntToStr(SendTime) + '&'; | |
| 1363 | - if FThreadItem = nil then begin | |
| 1364 | - s := s + 'subject=' + HttpEncode(TitleEdit.Text) + '&'; | |
| 1365 | - s := s + 'submit=' + HttpEncode('全責任を負うことを承諾して書き込む') + #13#10; | |
| 1366 | - end else begin | |
| 1367 | - s := s + 'key=' + ChangeFileExt(FThreadItem.FileName, '') + '&'; | |
| 1368 | - s := s + 'submit=' + HttpEncode('書き込む') + #13#10; | |
| 1369 | - end; | |
| 1370 | - | |
| 1371 | -} | |
| 1372 | - // 独自に通信しない場合は InternalPost に任せることが出来る | |
| 1373 | - responseCode := InternalPost( PChar( postURL ), PChar( postData ), postResult ); | |
| 1374 | - try | |
| 1375 | - if (responseCode = 200) or | |
| 1376 | - ((responseCode = 302) and (Length( Trim( postResult ) ) = 0)) then begin | |
| 1377 | - Result := dsComplete | |
| 1378 | - end else begin | |
| 1379 | - Result := dsError; | |
| 1380 | - if Assigned( InternalPrint ) then | |
| 1381 | - InternalPrint( postResult ); | |
| 1382 | - end; | |
| 1383 | - finally | |
| 1384 | - DisposeResultString( postResult ); | |
| 1385 | - end; | |
| 1386 | - finally | |
| 1387 | - uri.Free; | |
| 1388 | - uriList.Free; | |
| 1389 | - end; | |
| 1390 | - | |
| 1391 | -end; | |
| 1392 | - | |
| 1393 | -// ************************************************************************* | |
| 1394 | -// スレ一覧の URL からスレッドの URL を導き出す | |
| 1395 | -// ************************************************************************* | |
| 1396 | -function TBeBoardItem.ToThreadURL( | |
| 1397 | - inFileName : string // スレッドファイル名 | |
| 1398 | -) : string; // スレッドの URL | |
| 1399 | -var | |
| 1400 | - threadURL : string; | |
| 1401 | - uri : TIdURI; | |
| 1402 | - uriList : TStringList; | |
| 1403 | - found : Integer; | |
| 1404 | -begin | |
| 1405 | - | |
| 1406 | - found := AnsiPos( '.', inFileName ); | |
| 1407 | - if found > 0 then | |
| 1408 | - inFileName := Copy( inFileName, 1, found - 1 ); | |
| 1409 | - | |
| 1410 | - uri := TIdURI.Create( SubjectURL ); | |
| 1411 | - uriList := TStringList.Create; | |
| 1412 | - try | |
| 1413 | - try | |
| 1414 | - ExtractHttpFields( ['/', '?'], [], uri.Path, uriList ); | |
| 1415 | - threadURL := uri.Protocol + '://' + uri.Host + '/test/read.cgi/' + | |
| 1416 | - uriList[ 1 ] + '/' + inFileName + '/l50'; | |
| 1417 | - Result := threadURL; | |
| 1418 | - finally | |
| 1419 | - uri.Free; | |
| 1420 | - uriList.Free; | |
| 1421 | - end; | |
| 1422 | - except | |
| 1423 | - Result := ''; | |
| 1424 | - end; | |
| 1425 | - | |
| 1426 | -end; | |
| 1427 | - | |
| 1428 | -// ************************************************************************* | |
| 1429 | -// この板にいくつのスレがあるか要求された | |
| 1430 | -// ************************************************************************* | |
| 1431 | -procedure TBeBoardItem.EnumThread( | |
| 1432 | - inCallBack : TBoardItemEnumThreadCallBack | |
| 1433 | -); | |
| 1434 | -var | |
| 1435 | - uri : TIdURI; | |
| 1436 | - uriList : TStringList; | |
| 1437 | -begin | |
| 1438 | - | |
| 1439 | - try | |
| 1440 | - if FDat = nil then begin | |
| 1441 | - FDat := TStringList.Create; | |
| 1442 | - uri := TIdURI.Create( SubjectURL ); | |
| 1443 | - uriList := TStringList.Create; | |
| 1444 | - try | |
| 1445 | - // パスを算出 | |
| 1446 | - ExtractHttpFields( ['/', '?'], [], uri.Path, uriList ); | |
| 1447 | - // http://jbbs.livedoor.com/game/1000/subject.txt | |
| 1448 | - FilePath := MyLogFolder + uriList[ 1 ] + '\' + uriList[ 2 ] + '\' + uri.Document; | |
| 1449 | - if FileExists( FilePath ) then | |
| 1450 | - // 読み込み | |
| 1451 | - FDat.LoadFromFile( FilePath ); | |
| 1452 | - finally | |
| 1453 | - uri.Free; | |
| 1454 | - uriList.Free; | |
| 1455 | - end; | |
| 1456 | - end; | |
| 1457 | - | |
| 1458 | - // 独自にフィルタリングを行わない場合は EnumThread に任せることが出来る | |
| 1459 | - inherited EnumThread( inCallBack, CustomStringReplace( FDat.Text, ',', '<>' ) ); | |
| 1460 | - except | |
| 1461 | - end; | |
| 1462 | - | |
| 1463 | -end; | |
| 1464 | - | |
| 1465 | -// ************************************************************************* | |
| 1466 | -// スレ一覧の URL を求める | |
| 1467 | -// ************************************************************************* | |
| 1468 | -function TBeBoardItem.SubjectURL : string; | |
| 1469 | -var | |
| 1470 | - uri : TIdURI; | |
| 1471 | - uriList : TStringList; | |
| 1472 | -begin | |
| 1473 | - | |
| 1474 | - uri := TIdURI.Create( URL ); | |
| 1475 | - uriList := TStringList.Create; | |
| 1476 | - try | |
| 1477 | - if uri.Document <> SUBJECT_NAME then begin | |
| 1478 | - if Copy( URL, Length( URL ), 1 ) = '/' then | |
| 1479 | - Result := URL + SUBJECT_NAME | |
| 1480 | - else | |
| 1481 | - Result := URL + '/' + SUBJECT_NAME; | |
| 1482 | - end else begin | |
| 1483 | - // ここには来ないと思うけど | |
| 1484 | - Result := URL; | |
| 1485 | - end; | |
| 1486 | - finally | |
| 1487 | - uri.Free; | |
| 1488 | - uriList.Free; | |
| 1489 | - end; | |
| 1490 | - | |
| 1491 | -end; | |
| 1492 | - | |
| 1493 | -// ************************************************************************* | |
| 1494 | -// TBoardItem が生成された場合の処置(TBeBoardItem を生成する) | |
| 1495 | -// ************************************************************************* | |
| 1496 | -procedure BoardItemOnCreateOfTBeBoardItem( | |
| 1497 | - inInstance : DWORD | |
| 1498 | -); | |
| 1499 | -var | |
| 1500 | - boardItem : TBeBoardItem; | |
| 1501 | -begin | |
| 1502 | - | |
| 1503 | - boardItem := TBeBoardItem.Create( inInstance ); | |
| 1504 | - BoardItemSetLong( inInstance, bipContext, DWORD( boardItem ) ); | |
| 1505 | - | |
| 1506 | -end; | |
| 1507 | - | |
| 1508 | -// ************************************************************************* | |
| 1509 | -// TBoardItem が破棄された場合の処置(TBeBoardItem を破棄する) | |
| 1510 | -// ************************************************************************* | |
| 1511 | -procedure BoardItemOnDisposeOfTBeBoardItem( | |
| 1512 | - inInstance : DWORD | |
| 1513 | -); | |
| 1514 | -var | |
| 1515 | - boardItem : TBeBoardItem; | |
| 1516 | -begin | |
| 1517 | - | |
| 1518 | - boardItem := TBeBoardItem( BoardItemGetLong( inInstance, bipContext ) ); | |
| 1519 | - boardItem.Free; | |
| 1520 | - | |
| 1521 | -end; | |
| 1522 | - | |
| 1523 | - | |
| 1524 | - | |
| 1525 | -// ========================================================================= | |
| 1526 | -// エントリポイント | |
| 1527 | -// ========================================================================= | |
| 1528 | -procedure DLLEntry( | |
| 1529 | - ul_reason_for_call : DWORD | |
| 1530 | -); | |
| 1531 | -var | |
| 1532 | - module : HMODULE; | |
| 1533 | -begin | |
| 1534 | - | |
| 1535 | - case ul_reason_for_call of | |
| 1536 | - DLL_PROCESS_ATTACH: | |
| 1537 | - begin | |
| 1538 | - Randomize; | |
| 1539 | - | |
| 1540 | - module := GetModuleHandle( nil ); | |
| 1541 | - | |
| 1542 | - LoadInternalAPI( module ); | |
| 1543 | - LoadInternalFilePathAPI( module ); | |
| 1544 | - LoadInternalThreadItemAPI( module ); | |
| 1545 | - LoadInternalBoardItemAPI( module ); | |
| 1546 | - | |
| 1547 | - // ===== インスタンスの取り扱いを TThreadItem から TBeThreadItem に変更する | |
| 1548 | - ThreadItemOnCreate := ThreadItemOnCreateOfTBeThreadItem; | |
| 1549 | - ThreadItemOnDispose := ThreadItemOnDisposeOfTBeThreadItem; | |
| 1550 | - // ===== インスタンスの取り扱いを TBoardItem から TBeBoardItem に変更する | |
| 1551 | - BoardItemOnCreate := BoardItemOnCreateOfTBeBoardItem; | |
| 1552 | - BoardItemOnDispose := BoardItemOnDisposeOfTBeBoardItem; | |
| 1553 | - end; | |
| 1554 | - //DLL_PROCESS_DETACH: | |
| 1555 | - //begin | |
| 1556 | - // RemovePlugInMenu( SyncronizeMenu ); | |
| 1557 | - //end; | |
| 1558 | - DLL_THREAD_ATTACH: | |
| 1559 | - ; | |
| 1560 | - DLL_THREAD_DETACH: | |
| 1561 | - ; | |
| 1562 | - end; | |
| 1563 | - | |
| 1564 | -end; | |
| 1565 | - | |
| 1566 | -exports | |
| 1567 | - OnLoad, | |
| 1568 | - OnVersionInfo, | |
| 1569 | - OnAcceptURL; | |
| 1570 | - | |
| 1571 | -begin | |
| 1572 | - | |
| 1573 | - try | |
| 1574 | - DllProc := @DLLEntry; | |
| 1575 | - DLLEntry( DLL_PROCESS_ATTACH ); | |
| 1576 | - except end; | |
| 1577 | - | |
| 1578 | -end. |
Fork