res/ExternalBoardPlugIn/BePlugIn.dpr

   1 library BePlugIn;
   2
   3 {
   4         BePlugIn
   5         2\82¿\82á\82ñ\82Ë\82éBE\8f\88\97\9d\83\86\83j\83b\83g
   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 // \8eG\97p\8aÖ\90\94
  92 // =========================================================================
  93
  94 // *************************************************************************
  95 // \83e\83\93\83|\83\89\83\8a\82È\83p\83X\82Ì\8eæ\93¾
  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\83\8d\83O\83t\83H\83\8b\83_\8eæ\93¾
 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  *\83f\83B\83\8c\83N\83g\83\8a\82ª\91¶\8dÝ\82·\82é\82©\83`\83F\83b\83N
 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  *\83f\83B\83\8c\83N\83g\83\8a\8dì\90¬\81i\95¡\90\94\8aK\91w\91Î\89\9e\81j
 139  *************************************************************************)
 140 function ForceDirectoriesEx(Dir: string): Boolean;
 141 begin
 142         Result := True;
 143         if Length(Dir) = 0 then
 144                 raise Exception.Create('\83t\83H\83\8b\83_\82ª\8dì\90¬\8fo\97\88\82Ü\82¹\82ñ');
 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 // \82Æ\82è\82 \82¦\82¸\82Ì\91ã\97p\95i\82È\82Ì\82Å chrWhite \82ð\8dl\97¶\82µ\82Ä\82¢\82È\82¢\82±\82Æ\82É\92\8d\88Ó\81I\81I\81I
 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 \rfunction HttpEncode(
 186 \r       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 // \83v\83\89\83O\83C\83\93\82ª(\90³\82µ\82)\83\8d\81[\83h\82³\82ê\82½
 235 // *************************************************************************
 236 procedure OnLoad(
 237         inInstance : DWORD                              // \83v\83\89\83O\83C\83\93\82Ì\83C\83\93\83X\83^\83\93\83X
 238 ); stdcall;
 239 begin
 240 end;
 241
 242 // *************************************************************************
 243 // \83v\83\89\83O\83C\83\93\82Ì\83o\81[\83W\83\87\83\93\82ð\97v\8b\81\82³\82ê\82½
 244 // *************************************************************************
 245 procedure OnVersionInfo(
 246         var outAgent            : PChar;        // \83o\81[\83W\83\87\83\93\82ð\88ê\90Ø\8aÜ\82Ü\82È\82¢\8f\83\90\88\82È\96¼\8fÌ
 247         var outMajor            : DWORD;        // \83\81\83W\83\83\81[\83o\81[\83W\83\87\83\93
 248         var outMinor            : DWORD;        // \83}\83C\83i\81[\83o\81[\83W\83\87\83\93
 249         var outRelease  : PChar;        // \83\8a\83\8a\81[\83X\92i\8aK\96¼
 250         var outRevision : DWORD         // \83\8a\83r\83W\83\87\83\93\83i\83\93\83o\81[
 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 // \8ew\92è\82µ\82½ URL \82ð\82±\82Ì\83v\83\89\83O\83C\83\93\82Å\8eó\82¯\95t\82¯\82é\82©\82Ç\82¤\82©
 272 // *************************************************************************
 273 function OnAcceptURL(
 274         inURL                   : PChar                         // \94»\92f\82ð\8bÂ\82¢\82Å\82¢\82é URL
 275 ): TAcceptType; stdcall;        // URL \82Ì\8eí\97Þ
 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                 // \83z\83X\83g\96¼\82ª be.2ch.net \82Å\8fI\82í\82é\8fê\8d\87\82Í\8eó\82¯\95t\82¯\82é\82æ\82¤\82É\82µ\82Ä\82¢\82é
 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  // \8dÅ\8cã\82ª '/' \82Å\95Â\82ß\82ç\82ê\82Ä\82é\82È\82ç 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 // \83R\83\93\83X\83g\83\89\83N\83^
 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 // \83f\83X\83g\83\89\83N\83^
 370 // *************************************************************************
 371 destructor TBeThreadItem.Destroy;
 372 begin
 373
 374         FreeDat;
 375
 376         // \88ê\8e\9e\83t\83@\83C\83\8b\82Ì\8fê\8d\87\82Í\8dí\8f\9c\82·\82é
 377         if FIsTemporary then
 378                 DeleteFile( FilePath );
 379
 380         inherited;
 381
 382 end;
 383
 384 // *************************************************************************
 385 // \8ew\92è\82µ\82½ URL \82Ì\83X\83\8c\83b\83h\82Ì\83_\83E\83\93\83\8d\81[\83h\82ð\8ew\8e¦\82³\82ê\82½
 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                         // \82Ç\82±\82É\95Û\91¶\82µ\82Ä\82¢\82¢\82Ì\82©\95ª\82©\82ç\82È\82¢\82Ì\82Å\88ê\8e\9e\83t\83@\83C\83\8b\82É\95Û\91¶
 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         // \95Û\91¶\97p\82Ì\83f\83B\83\8c\83N\83g\83\8a\82ð\8c@\82é
 423         ForceDirectoriesEx( Copy( FilePath, 1, LastDelimiter( '\', FilePath ) ) );
 424
 425         // \93Æ\8e©\82É\83_\83E\83\93\83\8d\81[\83h\82â\83t\83B\83\8b\83^\83\8a\83\93\83O\82ð\8ds\82í\82È\82¢\8fê\8d\87\82Í
 426         // InternalDownload \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
 427         modified        := LastModified;
 428         datURL          := ReadURL + IntToStr( Count + 1 ) + '-'; // \90V\92\85\82Ì\82Ý
 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                                                                                         // \90V\8bK
 452                                                 Result := dsComplete
 453                                         else
 454                                                 // \92Ç\8bL
 455                                                 Result := dsDiffComplete;
 456
 457                                                                                 Size                                    := Size + Length( downResult.Text );
 458                                         // CGI \82©\82ç\82Í\90³\82µ\82¢\93ú\95t\82ª\93¾\82ç\82ê\82È\82¢\82Ì\82Å\8c»\8dÝ\82É\90Ý\92è
 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                         //\89ß\8b\8e\83\8d\83O
 480                         //tmpURL := URL;
 481                         if Assigned( InternalPrint ) then
 482                                 InternalPrint( '\89ß\8b\8e\83\8d\83O\91q\8cÉ\93ü\82è' );
 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\82µ\82Ä\82«\82½Dat\82Ì\82 \82Ú\81[\82ñ\82³\82ê\82½\95ª\82ð\95â\8f[\82µ\82Ä\81A
 504 // \83\8c\83X\90\94\82Æ\88ê\92v\82·\82é\82æ\82¤\82É\82·\82é
 505 // *************************************************************************
 506 procedure       TBeThreadItem.ArrangeDownloadData(
 507         start: Integer; // \90V\8bK\81F\82O\81@\92Ç\8bL\81F\91O\89ñ\82Ü\82Å\82Ì\8eæ\93¾\90\94
 508                 var Data: TStringList   //Dat\82Ì\83f\81[\83^
 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 // \89ß\8b\8e\83\8d\83O\97pDownload\8aÖ\90\94
 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                         // \82Ç\82±\82É\95Û\91¶\82µ\82Ä\82¢\82¢\82Ì\82©\95ª\82©\82ç\82È\82¢\82Ì\82Å\88ê\8e\9e\83t\83@\83C\83\8b\82É\95Û\91¶
 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         // \95Û\91¶\97p\82Ì\83f\83B\83\8c\83N\83g\83\8a\82ð\8c@\82é
 577         ForceDirectoriesEx( Copy( FilePath, 1, LastDelimiter( '\', FilePath ) ) );
 578
 579
 580
 581         // \93Æ\8e©\82É\83_\83E\83\93\83\8d\81[\83h\82â\83t\83B\83\8b\83^\83\8a\83\93\83O\82ð\8ds\82í\82È\82¢\8fê\8d\87\82Í
 582         // InternalDownload \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
 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                                 //**\82±\82±\82ÅHTML\83t\83@\83C\83\8b\82ð\82µ\82½\82ç\82ÎJBBS\82Ìdat\8c`\8e®\82É\95Ï\8a·\82·\82é
 596                                 tmpHTML := TStringList.Create;
 597
 598                                 try
 599                                         tmpHTML.Text := EUCtoSJIS( tmpText );
 600                                         //Title\82Ì\8eæ\93¾
 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                                         //\96{\95¶\82Ì\8eæ\93¾ <DL>\82Ì\8e\9f\82Ì\8ds\82©\82ç</DL>\82Ì\91O\82Ì\8ds\82Ü\82Å
 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>\82»\82ê\82¼\82ê\88ê\8ds\82É\95Ï\8a·\82·\82é
 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                                         //\8fã\82Ü\82Å\82Ì\8f\88\97\9d\82Å\88È\89º\82Ì\82æ\82¤\82È\8c`\82É\82È\82Á\82Ä\82é
 674                                         //<dt><a name="958">958 </a> \96¼\91O\81F<font color="#008800"><b> \96¼\82à\96³\82«\8cR\8et </b></font> \93\8a\8de\93ú\81F 2004/06/30(\90\85) 15:17 [ r1FsjJhA ]<br><dd>\81`\81`
 675                                         //<dt><a name="951">951 </a> \96¼\91O\81F<a href="mailto:sage"><b> \96¼\82à\96³\82«\8cR\8et </B></a> \93\8a\8de\93ú\81F 2004/06/30(\90\85) 12:31 [ .oGr0rtc ]<br><dd>\81`\81`
 676                                         //\8fã\82Ì\82æ\82¤\82È\82Ì\82ð\89º\82Ì\82æ\82¤\82Èdat\82Ì\8c`\8e®\82É\95Ï\8a·\82·\82é
 677                                         //\83\8c\83X\94Ô\8d\86<><font color=#FF0000>HN</font><>\83\81\83\8b\97\93<>\93ú\95t\8e\9e\8d\8f<>\96{\95¶<>\83^\83C\83g\83\8b\81i\82P\82Ì\82Ý\81j<>ID
 678                                         //2<>\96¼\82à\96³\82«\8cR\8et<>sage<>2004/06/22(\89Î) 09:05<>\82Q\82°\82Æ\81[<><>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                                                 //==\82Ü\82¸\82Í\96{\95¶\82ð\8eæ\93¾==//
 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                                                 //==\83\8c\83X\94Ô\8d\86\8eæ\93¾==//
 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                                                 //==\83\81\83\8b\97\93\8eæ\93¾==//
 707                                                 tmpLine := AnsiLowerCase(tmpHTML[i]);
 708                                                 tS := AnsiPos('<a href="mailto:', tmpLine);
 709                                                 if tS > 0 then begin //\83\81\83\8b\97\93\83A\83\8a
 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  //\83\81\83\8b\97\93\96³\82µ
 715                                                         tmpDatToken[2] := '';
 716                                                 end;
 717                                                 //====================//
 718                                                 //==HN\8eæ\93¾==//
 719                                                 tmpLine := AnsiLowerCase(tmpHTML[i]);
 720                                                 tE := AnsiPos('\93\8a\8de\93ú\81F', 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                                                 //==\93ú\95t\8e\9e\8d\8f\82Ì\8eæ\93¾==//
 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\82Ì\8eæ\93¾==//
 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                                         // \90V\8bK
 782                                         Result := dsComplete;
 783
 784                                         Size    := Length( downResult.Text );
 785                                         // CGI \82©\82ç\82Í\90³\82µ\82¢\93ú\95t\82ª\93¾\82ç\82ê\82È\82¢\82Ì\82Å\8c»\8dÝ\82É\90Ý\92è
 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 // \8f\91\82«\8d\9e\82Ý\82ð\8ew\8e¦\82³\82ê\82½
 816 // *************************************************************************
 817 function        TBeThreadItem.Write(
 818         inName                          : string;       // \96¼\91O(\83n\83\93\83h\83\8b)
 819         inMail                          : string;       // \83\81\81[\83\8b\83A\83h\83\8c\83X
 820         inMessage                       : string        // \96{\95¶
 821 ) : TDownloadState;                             // \8f\91\82«\8d\9e\82Ý\82ª\90¬\8c÷\82µ\82½\82©\82Ç\82¤\82©
 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( '\8f\91\82«\8d\9e\82Þ' ) );
 845
 846                 // \93Æ\8e©\82É\92Ê\90M\82µ\82È\82¢\8fê\8d\87\82Í InternalPost \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
 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 // \83\8c\83X\94Ô\8d\86 inNo \82É\91Î\82·\82é html \82ð\97v\8b\81\82³\82ê\82½
 869 // *************************************************************************
 870 function TBeThreadItem.GetRes(
 871         inNo            : Integer               // \97v\8b\81\82³\82ê\82½\83\8c\83X\94Ô\8d\86
 872 ) : string;                                             // \91Î\89\9e\82·\82é HTML
 873 var
 874         res                     : string;
 875         tmp                     : PChar;
 876 begin
 877
 878         // \93Æ\8e©\82É\83t\83B\83\8b\83^\83\8a\83\93\83O\82ð\8ds\82í\82È\82¢\8fê\8d\87\82Í
 879         // InternalAbon \82¨\82æ\82Ñ Dat2HTML \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
 880                 {
 881         LoadDat;
 882         if FDat = nil then begin
 883                 // \83\8d\83O\82É\91¶\8dÝ\82µ\82È\82¢\82Ì\82Å\82±\82Ì\82Ü\82Ü\8fI\97¹
 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 // \83\8c\83X\94Ô\8d\86 inNo \82É\91Î\82·\82é Dat \82ð\97v\8b\81\82³\82ê\82½
 906 // *************************************************************************
 907 function TBeThreadItem.GetDat(
 908         inNo            : Integer               // \97v\8b\81\82³\82ê\82½\83\8c\83X\94Ô\8d\86
 909 ) : string;                                             // \82Q\82¿\82á\82ñ\82Ë\82é\82ÌDat\8c`\8e®
 910 var
 911         res                     : string;
 912         tmp                     : array[1..5] of string;
 913         i                       : Integer;
 914         pTmp            : PChar;
 915 begin
 916         pTmp := nil;
 917         // \93Æ\8e©\82É\83t\83B\83\8b\83^\83\8a\83\93\83O\82ð\8ds\82í\82È\82¢\8fê\8d\87\82Í
 918         // InternalAbon \82¨\82æ\82Ñ Dat2HTML \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
 919         LoadDat;
 920         if (FDat = nil) or (inNo - 1 < 0 ) or (inNo - 1 >= FDat.Count) then begin
 921                 // \83\8d\83O\82É\91¶\8dÝ\82µ\82È\82¢\82Ì\82Å\82±\82Ì\82Ü\82Ü\8fI\97¹
 922                 Result := '';
 923                 Exit;
 924         end;
 925         try
 926                 res := Copy( FDat[ inNo - 1 ], AnsiPos( '<>', FDat[ inNo - 1 ] ) + 2, MaxInt );
 927                 //\96\96\94ö\82ÉID\82ª\95\\8e¦\82³\82ê\82Ä\82¢\82é\82Ì\82Å\82»\82ê\82ð\93\8a\8de\93ú\82Ì\82Æ\82±\82ë\82É\93ü\82ê\82é
 928                 // \96¼\91O<>\83\81\81[\83\8b<>\93ú\95t<>\96{\95¶<>\83X\83\8c\83^\83C<>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                 // \96¼\91O<>\83\81\81[\83\8b<>\93ú\95tID<>\96{\95¶<>\83X\83\8c\83^\83C
 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 // \83X\83\8c\83b\83h\82Ì\83w\83b\83_ html \82ð\97v\8b\81\82³\82ê\82½
 944 // *************************************************************************
 945 function TBeThreadItem.GetHeader(
 946         inOptionalHeader        : string
 947 ) : string;
 948 begin
 949
 950         // \93Æ\8e©\82É\83t\83B\83\8b\83^\83\8a\83\93\83O\82ð\8ds\82í\82È\82¢\8fê\8d\87\82Í
 951         // InternalHeader \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
 952         Result := InternalHeader(
 953                 '<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">' +
 954                 inOptionalHeader );
 955
 956
 957         // GetRes \82ð\8cÄ\82Î\82ê\82é\82±\82Æ\82ª\97\\91z\82³\82ê\82é\82Ì\82Å FDat \82ð\90¶\90¬\82µ\82Ä\82¨\82
 958         try
 959                 FreeDat;
 960                 LoadDat;
 961         except
 962         end;
 963
 964 end;
 965
 966 // *************************************************************************
 967 // \83X\83\8c\83b\83h\82Ì\83t\83b\83^ html \82ð\97v\8b\81\82³\82ê\82½
 968 // *************************************************************************
 969 function TBeThreadItem.GetFooter(
 970         inOptionalFooter : string
 971 ) : string;
 972 begin
 973
 974         // \93Æ\8e©\82É\83t\83B\83\8b\83^\83\8a\83\93\83O\82ð\8ds\82í\82È\82¢\8fê\8d\87\82Í
 975         // InternalFooter \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
 976         Result := InternalFooter( inOptionalFooter );
 977
 978         // \82à\82¤ GetRes \82Í\8cÄ\82Î\82ê\82È\82¢\82Æ\8ev\82¤\82Ì\82Å FDat \82ð\8aJ\95ú\82µ\82Ä\82¨\82
 979         try
 980                 FreeDat;
 981         except
 982         end;
 983
 984 end;
 985
 986 // *************************************************************************
 987 // \82±\82Ì ThreadItem \82ª\91®\82·\82é\94Â\82Ì URL \82ð\97v\8b\81\82³\82ê\82½
 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 \82Ì\90¶\90¬
1014 // *************************************************************************
1015 procedure       TBeThreadItem.LoadDat;
1016 begin
1017
1018         if FDat = nil then begin
1019                 if IsLogFile then begin
1020                         // dat \82Ì\93Ç\82Ý\8d\9e\82Ý
1021                         FDat := TStringList.Create;
1022                         FDat.LoadFromFile( FilePath );
1023                 end;
1024         end;
1025
1026 end;
1027
1028 // *************************************************************************
1029 // FDat \82Ì\8aJ\95ú
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 // \88À\91S\82È\83u\83\89\83E\83U\95\\8e¦\97p\82Ì 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             //\83R\83R\82Å\89ß\8b\8e\83\8d\83O\82©\82Ç\82¤\82©\83`\83F\83b\83N\81H
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 // \88À\91S\82È( '/' \82Å\8fI\82í\82é )\93Ç\82Ý\8d\9e\82Ý\82Ì 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 // \88À\91S\82È( '/' \82Å\8fI\82í\82é )\8f\91\82«\8d\9e\82Ý\82Ì 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 \82ª\90¶\90¬\82³\82ê\82½\8fê\8d\87\82Ì\8f\88\92u(TBeThreadItem \82ð\90¶\90¬\82·\82é)
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 \82ª\94j\8aü\82³\82ê\82½\8fê\8d\87\82Ì\8f\88\92u(TBeThreadItem \82ð\94j\8aü\82·\82é)
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 // \83R\83\93\83X\83g\83\89\83N\83^
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 // \83f\83X\83g\83\89\83N\83^
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         // \88ê\8e\9e\83t\83@\83C\83\8b\82Ì\8fê\8d\87\82Í\8dí\8f\9c\82·\82é
1234         if FIsTemporary then
1235                 DeleteFile( FilePath );
1236
1237         inherited;
1238
1239 end;
1240
1241 // *************************************************************************
1242 // \8ew\92è\82µ\82½\83X\83\8c\88ê\97\97\82Ì\83_\83E\83\93\83\8d\81[\83h\82ð\97v\8b\81\82³\82ê\82½
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         // \93Æ\8e©\82É\83_\83E\83\93\83\8d\81[\83h\82â\83t\83B\83\8b\83^\83\8a\83\93\83O\82ð\8ds\82í\82È\82¢\8fê\8d\87\82Í
1268         // InternalDownload \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
1269         modified                        := LastModified;
1270         responseCode    := InternalDownload( PChar( uri.URI ), modified, downResult );
1271         try
1272                 if responseCode = 200 then begin
1273                         try
1274                                 // \83p\83X\82ð\8eZ\8fo
1275                                 ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
1276                                 if MyLogFolder = '' then begin
1277                                         // \82Ç\82±\82É\95Û\91¶\82µ\82Ä\82¢\82¢\82Ì\82©\95ª\82©\82ç\82È\82¢\82Ì\82Å\88ê\8e\9e\83t\83@\83C\83\8b\82É\95Û\91¶
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                                 // \95Û\91¶\97p\82Ì\83f\83B\83\8c\83N\83g\83\8a\82ð\8c@\82é
1286                                 ForceDirectoriesEx( Copy( FilePath, 1, LastDelimiter( '\', FilePath ) ) );
1287
1288                                 // EUC \82ð Shift_JIS \82É
1289                 tmpText := CustomStringReplace( string( downResult ), '¡÷¡®', ',');
1290                                 FDat.Text := EUCtoSJIS( tmpText );
1291                                 // \95Û\91¶
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 // \83X\83\8c\97§\82Ä\82ð\8ew\8e¦\82³\82ê\82½
1312 // *************************************************************************
1313 function        TBeBoardItem.CreateThread(
1314         inSubject                       : string;       // \83X\83\8c\83^\83C
1315         inName                          : string;       // \96¼\91O(\83n\83\93\83h\83\8b)
1316         inMail                          : string;       // \83\81\81[\83\8b\83A\83h\83\8c\83X
1317         inMessage                       : string        // \96{\95¶
1318 ) : TDownloadState;                             // \8f\91\82«\8d\9e\82Ý\82ª\90¬\8c÷\82µ\82½\82©\82Ç\82¤\82©
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('\91S\90Ó\94C\82ð\95\89\82¤\82±\82Æ\82ð\8f³\91ø\82µ\82Ä\8f\91\82«\8d\9e\82Þ')) + #13#10;
1344                 //s := s + 'subject=' + HttpEncode(TitleEdit.Text) + '&';
1345                 //s := s + 'submit=' + HttpEncode('\91S\90Ó\94C\82ð\95\89\82¤\82±\82Æ\82ð\8f³\91ø\82µ\82Ä\8f\91\82«\8d\9e\82Þ') + #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( '\90V\8bK\8f\91\82«\8d\9e\82Ý' ) );
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('\91S\90Ó\94C\82ð\95\89\82¤\82±\82Æ\82ð\8f³\91ø\82µ\82Ä\8f\91\82«\8d\9e\82Þ') + #13#10;
1366         end else begin
1367                 s := s + 'key=' + ChangeFileExt(FThreadItem.FileName, '') + '&';
1368                 s := s + 'submit=' + HttpEncode('\8f\91\82«\8d\9e\82Þ') + #13#10;
1369         end;
1370
1371 }
1372                 // \93Æ\8e©\82É\92Ê\90M\82µ\82È\82¢\8fê\8d\87\82Í InternalPost \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
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 // \83X\83\8c\88ê\97\97\82Ì URL \82©\82ç\83X\83\8c\83b\83h\82Ì URL \82ð\93±\82«\8fo\82·
1395 // *************************************************************************
1396 function TBeBoardItem.ToThreadURL(
1397         inFileName      : string        // \83X\83\8c\83b\83h\83t\83@\83C\83\8b\96¼
1398 ) : string;                                                     // \83X\83\8c\83b\83h\82Ì 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 // \82±\82Ì\94Â\82É\82¢\82\82Â\82Ì\83X\83\8c\82ª\82 \82é\82©\97v\8b\81\82³\82ê\82½
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                                 // \83p\83X\82ð\8eZ\8fo
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                                         // \93Ç\82Ý\8d\9e\82Ý
1451                                         FDat.LoadFromFile( FilePath );
1452                         finally
1453                                 uri.Free;
1454                                 uriList.Free;
1455                         end;
1456                 end;
1457
1458                 // \93Æ\8e©\82É\83t\83B\83\8b\83^\83\8a\83\93\83O\82ð\8ds\82í\82È\82¢\8fê\8d\87\82Í EnumThread \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
1459                 inherited EnumThread( inCallBack, CustomStringReplace( FDat.Text, ',', '<>' ) );
1460         except
1461         end;
1462
1463 end;
1464
1465 // *************************************************************************
1466 // \83X\83\8c\88ê\97\97\82Ì URL \82ð\8b\81\82ß\82é
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                         // \82±\82±\82É\82Í\97\88\82È\82¢\82Æ\8ev\82¤\82¯\82Ç
1484                         Result := URL;
1485                 end;
1486         finally
1487                 uri.Free;
1488                 uriList.Free;
1489         end;
1490
1491 end;
1492
1493 // *************************************************************************
1494 // TBoardItem \82ª\90¶\90¬\82³\82ê\82½\8fê\8d\87\82Ì\8f\88\92u(TBeBoardItem \82ð\90¶\90¬\82·\82é)
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 \82ª\94j\8aü\82³\82ê\82½\8fê\8d\87\82Ì\8f\88\92u(TBeBoardItem \82ð\94j\8aü\82·\82é)
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 // \83G\83\93\83g\83\8a\83|\83C\83\93\83g
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                         // ===== \83C\83\93\83X\83^\83\93\83X\82Ì\8eæ\82è\88µ\82¢\82ð TThreadItem \82©\82ç TBeThreadItem \82É\95Ï\8dX\82·\82é
1548                         ThreadItemOnCreate      := ThreadItemOnCreateOfTBeThreadItem;
1549                         ThreadItemOnDispose     := ThreadItemOnDisposeOfTBeThreadItem;
1550                         // ===== \83C\83\93\83X\83^\83\93\83X\82Ì\8eæ\82è\88µ\82¢\82ð TBoardItem \82©\82ç TBeBoardItem \82É\95Ï\8dX\82·\82é
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.