res/ExternalBoardPlugIn/ShitarabaJBBSPlugIn.dpr

   1 library ShitarabaJBBSPlugIn;
   2
   3 {
   4         ShitarabaJBBSPlugIn
   5         \82µ\82½\82ç\82Î\8f\88\97\9d\83\86\83j\83b\83g
   6         $Id: ShitarabaJBBSPlugIn.dpr,v 1.31 2004/09/28 11:01:54 h677 Exp $
   7 }
   8
   9 uses
  10         Windows, SysUtils, Classes, Math, DateUtils, Dialogs,
  11         IdURI,
  12         PlugInMain in 'PlugInMain.pas',
  13         ThreadItem in 'ThreadItem.pas',
  14         BoardItem in 'BoardItem.pas',
  15         FilePath in 'FilePath.pas',
  16         Y_TextConverter in 'Y_TextConverter.pas',
  17         MojuUtils in '..\..\MojuUtils.pas';
  18
  19 {$R *.res}
  20
  21 type
  22         // =========================================================================
  23         // TShitarabaThreadItem
  24         // =========================================================================
  25         TShitarabaThreadItem = class(TThreadItem)
  26         private
  27                 FIsTemporary    : Boolean;
  28                 FDat                                    : TStringList;
  29
  30         public
  31                 constructor     Create( inInstance : DWORD );
  32                 destructor      Destroy; override;
  33
  34         private
  35                 function        Download : TDownloadState;
  36                 function        StorageDownload(Path, Document : string) : TDownloadState;
  37                 function        Write( inName : string; inMail : string; inMessage : string ) : TDownloadState;
  38                 function        GetRes( inNo : Integer ) : string;
  39                 function        GetDat( inNo : Integer ) : string;
  40                 function        GetHeader( inOptionalHeader : string ) : string;
  41                 function        GetFooter( inOptionalFooter : string ) : string;
  42                 function        GetBoardURL : string;
  43                 procedure       ArrangeDownloadData( start: Integer;var Data: TStringList);
  44                 procedure       LoadDat;
  45                 procedure       FreeDat;
  46                 function        BrowsableURL : string;
  47                 function        ReadURL : string;
  48                 function        WriteURL : string;
  49         end;
  50
  51         // =========================================================================
  52         // TShitarabaBoardItem
  53         // =========================================================================
  54         TShitarabaBoardItem = class(TBoardItem)
  55         private
  56                 FIsTemporary    : Boolean;
  57                 FDat                                    : TStringList;
  58
  59         public
  60                 constructor     Create( inInstance : DWORD );
  61                 destructor      Destroy; override;
  62
  63         private
  64                 function        Download : TDownloadState;
  65                 function        CreateThread( inSubject : string; inName : string; inMail : string; inMessage : string ) : TDownloadState;
  66                 function        ToThreadURL( inFileName : string ) : string;
  67                 procedure       EnumThread( inCallBack : TBoardItemEnumThreadCallBack );
  68
  69                 function        SubjectURL : string;
  70         end;
  71
  72 const
  73         LOG_DIR                                         = 'ShitarabaJBBS\';
  74         SUBJECT_NAME                    = 'subject.txt';
  75
  76         PLUGIN_NAME                             = 'ShitarabaJBBS';
  77         MAJOR_VERSION                   = 1;
  78         MINOR_VERSION                   = 1;
  79         RELEASE_VERSION         = 'alpha';
  80         REVISION_VERSION        = 3;
  81
  82         SYNCRONIZE_MENU_CAPTION = '\82µ\82½\82ç\82ÎJBBS\94Â\8dX\90V';
  83
  84 var
  85         SyncronizeMenu          : HMENU;
  86
  87 // =========================================================================
  88 // \8eG\97p\8aÖ\90\94
  89 // =========================================================================
  90
  91 // *************************************************************************
  92 // \83e\83\93\83|\83\89\83\8a\82È\83p\83X\82Ì\8eæ\93¾
  93 // *************************************************************************
  94 function TemporaryFile : string;
  95 var
  96         tempPath : array [0..MAX_PATH] of       char;
  97 begin
  98
  99         GetTempPath( SizeOf(tempPath), tempPath );
 100         repeat
 101                 Result := tempPath + IntToStr( Random( $7fffffff ) );
 102         until not FileExists( Result );
 103
 104 end;
 105
 106 // *************************************************************************
 107 // \82µ\82½\82ç\82Î\97p\83\8d\83O\83t\83H\83\8b\83_\8eæ\93¾
 108 // *************************************************************************
 109 function MyLogFolder : string;
 110 var
 111         folder : PChar;
 112 begin
 113
 114         folder := LogFolder;
 115         if Length( folder ) = 0 then
 116                 Result := ''
 117         else
 118                 Result := folder + LOG_DIR;
 119     DisposeResultString(folder);
 120
 121 end;
 122
 123 (*************************************************************************
 124  *\83f\83B\83\8c\83N\83g\83\8a\82ª\91¶\8dÝ\82·\82é\82©\83`\83F\83b\83N
 125  *************************************************************************)
 126 function DirectoryExistsEx(const Name: string): Boolean;
 127 var
 128         Code: Integer;
 129 begin
 130         Code := GetFileAttributes(PChar(Name));
 131         Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
 132 end;
 133
 134 (*************************************************************************
 135  *\83f\83B\83\8c\83N\83g\83\8a\8dì\90¬\81i\95¡\90\94\8aK\91w\91Î\89\9e\81j
 136  *************************************************************************)
 137 function ForceDirectoriesEx(Dir: string): Boolean;
 138 begin
 139         Result := True;
 140         if Length(Dir) = 0 then
 141                 raise Exception.Create('\83t\83H\83\8b\83_\82ª\8dì\90¬\8fo\97\88\82Ü\82¹\82ñ');
 142         Dir := ExcludeTrailingPathDelimiter(Dir);
 143         if (Length(Dir) < 3) or DirectoryExistsEx(Dir)
 144                 or (ExtractFilePath(Dir) = Dir) then Exit; // avoid 'xyz:\' problem.
 145         Result := ForceDirectoriesEx(ExtractFilePath(Dir)) and CreateDir(Dir);
 146 end;
 147
 148 // \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
 149 procedure ExtractHttpFields(
 150         const chrSep : TSysCharSet;
 151         const chrWhite : TSysCharSet;
 152         const strValue : string;
 153         var strResult : TStringList;
 154         unknownFlag : boolean = false
 155 );
 156 var
 157         last, p, strLen : Integer;
 158 begin
 159
 160         strLen := Length( strValue );
 161         p := 1;
 162         last := 1;
 163
 164         while p <= strLen do
 165         begin
 166
 167                 if strValue[ p ] in chrSep then
 168                 begin
 169                         strResult.Add( Copy( strValue, last, p - last ) );
 170                         last := p + 1;
 171                 end;
 172
 173                 p := p + 1;
 174
 175         end;
 176
 177         if last <> p then
 178                 strResult.Add( Copy( strValue, last, strLen - last + 1 ) );
 179
 180 end;
 181
 182 \rfunction HttpEncode(
 183 \r       const strValue : string
 184 ) : string;
 185 var
 186         i : Integer;
 187         strLen : Integer;
 188         strResult : string;
 189         b : Integer;
 190 const
 191         kHexCode : array [0..15] of char = (
 192                                 '0', '1', '2', '3', '4', '5', '6', '7',
 193                                 '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' );
 194 begin
 195
 196         strLen := Length( strValue );
 197         i := 1;
 198
 199         while i <= strLen do
 200         begin
 201
 202                 case strValue[ i ] of
 203                 '0' .. '9', 'a' .. 'z', 'A' .. 'Z', '*', '-', '.', '@', '_':
 204                         begin
 205                                 strResult := strResult + strValue[ i ];
 206                         end;
 207                 else
 208                         begin
 209                                 b := Integer( strValue[ i ] );
 210                                 strResult := strResult + '%'
 211                                                                 + kHexCode[ b div $10 ]
 212                                                                 + kHexCode[ b mod $10 ];
 213                         end;
 214                 end;
 215
 216                 i := i + 1;
 217
 218         end;
 219
 220         Result := strResult;
 221
 222 end;
 223
 224
 225
 226 // =========================================================================
 227 // PlugIn
 228 // =========================================================================
 229
 230 // *************************************************************************
 231 // \83v\83\89\83O\83C\83\93\82ª(\90³\82µ\82)\83\8d\81[\83h\82³\82ê\82½
 232 // *************************************************************************
 233 procedure OnLoad(
 234         inInstance : DWORD                              // \83v\83\89\83O\83C\83\93\82Ì\83C\83\93\83X\83^\83\93\83X
 235 ); stdcall;
 236 begin
 237
 238         // \83v\83\89\83O\83C\83\93\83\81\83j\83\85\81[\82É\92Ç\89Á
 239         SyncronizeMenu := AddPlugInMenu( inInstance, SYNCRONIZE_MENU_CAPTION );
 240
 241 end;
 242
 243 // *************************************************************************
 244 // \83v\83\89\83O\83C\83\93\82Ì\83o\81[\83W\83\87\83\93\82ð\97v\8b\81\82³\82ê\82½
 245 // *************************************************************************
 246 procedure OnVersionInfo(
 247         var outAgent            : PChar;        // \83o\81[\83W\83\87\83\93\82ð\88ê\90Ø\8aÜ\82Ü\82È\82¢\8f\83\90\88\82È\96¼\8fÌ
 248         var outMajor            : DWORD;        // \83\81\83W\83\83\81[\83o\81[\83W\83\87\83\93
 249         var outMinor            : DWORD;        // \83}\83C\83i\81[\83o\81[\83W\83\87\83\93
 250         var outRelease  : PChar;        // \83\8a\83\8a\81[\83X\92i\8aK\96¼
 251         var outRevision : DWORD         // \83\8a\83r\83W\83\87\83\93\83i\83\93\83o\81[
 252 ); stdcall;
 253 begin
 254
 255         try
 256                 outAgent                := CreateResultString( PChar( PLUGIN_NAME ) );
 257                 outMajor                := MAJOR_VERSION;
 258                 outMinor                := MINOR_VERSION;
 259                 outRelease      := CreateResultString( PChar( RELEASE_VERSION ) );
 260                 outRevision     := REVISION_VERSION;
 261         except
 262                 outAgent                := nil;
 263                 outMajor                := 0;
 264                 outMinor                := 0;
 265                 outRelease      := nil;
 266                 outRevision     := 0;
 267         end;
 268
 269 end;
 270
 271 // *************************************************************************
 272 // \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©
 273 // *************************************************************************
 274 function OnAcceptURL(
 275         inURL                   : PChar                         // \94»\92f\82ð\8bÂ\82¢\82Å\82¢\82é URL
 276 ): TAcceptType; stdcall;        // URL \82Ì\8eí\97Þ
 277 var
 278         uri                             : TIdURI;
 279         uriList         : TStringList;
 280         foundPos        : Integer;
 281 //      i                       : Integer;
 282 const
 283         BBS_HOST_OLD    = 'jbbs.shitaraba.com';
 284         BBS_HOST_OLD2   = 'jbbs.livedoor.com';
 285         BBS_HOST                = 'jbbs.livedoor.jp';
 286         THREAD_MARK     = '/bbs/read.cgi';
 287 begin
 288
 289         try
 290                 // \83z\83X\83g\96¼\82ª jbbs.livedoor.com \82Å\8fI\82í\82é\8fê\8d\87\82Í\8eó\82¯\95t\82¯\82é\82æ\82¤\82É\82µ\82Ä\82¢\82é
 291                 uri                     := TIdURI.Create( inURL );
 292                 uriList := TStringList.Create;
 293                 try
 294                         if (uri.Host = BBS_HOST_OLD) or (uri.Host = BBS_HOST_OLD2) then
 295                                 uri.Host := BBS_HOST;
 296
 297                         ExtractHttpFields( ['/'], [], uri.Path, uriList );
 298                         if (AnsiPos( BBS_HOST, uri.Host ) > 0) and (Length( uri.Host ) - AnsiPos( BBS_HOST, uri.Host ) + 1 = Length( BBS_HOST )) then begin
 299                                 foundPos := AnsiPos( THREAD_MARK, inURL );
 300
 301                                 if foundPos > 0 then
 302                                         Result := atThread
 303                                 else if (uriList.Count > 2) and (AnsiPos('.html', uri.Document) > 0) then
 304                                         Result := atThread
 305                                 else if uriList.Count > 2 then  // \8dÅ\8cã\82ª '/' \82Å\95Â\82ß\82ç\82ê\82Ä\82é\82È\82ç 4
 306                                         Result := atBoard
 307                                 else
 308                                         Result := atBBS;
 309
 310                         end else begin
 311                                 Result := atNoAccept;
 312                         end;
 313
 314                 finally
 315                         uri.Free;
 316                         uriList.Free;
 317                 end;
 318         except
 319                 Result := atNoAccept;
 320         end;
 321
 322 end;
 323
 324 // *************************************************************************
 325 // \82µ\82½\82ç\82ÎJBBS\94Â\8dX\90V
 326 // *************************************************************************
 327 procedure OnBoardSyncronizeMenu(
 328         inHandle        : HMENU                                 // \83\81\83j\83\85\81[\83n\83\93\83h\83\8b
 329 ); stdcall;
 330 var
 331         category                        : string;
 332         keyword                         : string;
 333         savepath                        : string;
 334         success                         : Boolean;
 335         initdir                         : string;
 336         filter                          : string;
 337
 338         agent                                   : PChar;
 339         major                                   : DWORD;
 340         minor                                   : DWORD;
 341         release                         : PChar;
 342         revision                        : DWORD;
 343
 344         url                                             : string;
 345         modified                        : Double;
 346         tmp                                             : PChar;
 347         downResult              : string;
 348         saveText                        : TStringList;
 349         responseCode    : Longint;
 350
 351         found                                   : Integer;
 352         found2                          : Integer;
 353         board                                   : string;
 354 const
 355         CATEGORY_INPUT  = '\83J\83e\83S\83\8a\82ð\93ü\97Í\82µ\82Ä\82\82¾\82³\82¢';
 356         KEYWORD_INPUT           = '\8c\9f\8dõ\82·\82é\94Â\96¼\82ð\93ü\97Í\82µ\82Ä\82\82¾\82³\82¢';
 357         SAVEPATH_SELECT = '\95Û\91¶\82·\82é\83t\83@\83C\83\8b\96¼\82ð\93ü\97Í\82µ\82Ä\82\82¾\82³\82¢';
 358         BBS_HOST                                = 'http://jbbs.livedoor.com/';
 359 label
 360         NextBoard;
 361 begin
 362
 363         category := 'computer';
 364         success := InputQuery( SYNCRONIZE_MENU_CAPTION, CATEGORY_INPUT, category );
 365         if not success then
 366                 Exit;
 367         keyword         := InputBox( SYNCRONIZE_MENU_CAPTION, KEYWORD_INPUT, '' );
 368         if keyword = '' then
 369                 Exit;
 370
 371         VersionInfo( agent, major, minor, release, revision );
 372         try
 373                 initdir := PreferencesFolder;
 374                 filter  := '\82·\82Ä\82×\82Ì\83t\83@\83C\83\8b (*.*)|*.*';
 375                 if agent = 'gikoNavi' then begin
 376                         if DirectoryExists( initdir + 'Board\' ) then
 377                                 initdir := initdir + 'Board\';
 378                         filter  := '\94Â\83t\83@\83C\83\8b (*.txt)|*.txt';
 379                 end;
 380         finally
 381                 DisposeResultString( agent );
 382                 DisposeResultString( release );
 383         end;
 384         savepath        := keyword;
 385         success         := PromptForFileName( savepath, filter, 'txt', SYNCRONIZE_MENU_CAPTION, initdir, True );
 386         if not success then
 387                 Exit;
 388
 389         InternalPrint( '\94Â\8fî\95ñ\82ð\8eæ\93¾\92\86\82Å\82·' );
 390         try
 391                 url :=
 392                         BBS_HOST + 'bbs/left_menu.cgi?CATEGORY=' + category +
 393                         '&WORD=' + HttpEncode( SJIStoEUC( keyword ) );
 394
 395                 responseCode := InternalDownload( PChar( url ), modified, tmp );
 396                 try
 397                         if (responseCode = 200) or (responseCode = 206) then begin
 398                                 saveText := TStringList.Create;
 399                                 saveText.Add( '[' + keyword + ']' );
 400                                 downResult := EUCtoSJIS( tmp );
 401                                 found := AnsiPos( '<a ', downResult );
 402                                 while found > 0 do begin
 403                                         downResult := Copy( downResult, found + 3, MaxInt );    // 3 = Length( '<a ' )
 404                                         found := AnsiPos( 'href=', downResult );
 405                                         if found = 0 then
 406                                                 Break;
 407
 408                                         if downResult[ found + 5 ] = '"' then begin // 5 = Length( 'href=' )
 409                                                 downResult := Copy( downResult, found + 6, MaxInt );    // 6 = Length( 'href="' )
 410                                                 found := AnsiPos( '"', downResult );
 411                                         end else begin
 412                                                 downResult := Copy( downResult, found + 5, MaxInt );    // 5 = Length( 'href=' )
 413                                                 found           := AnsiPos( ' ', downResult );
 414                                                 found2  := AnsiPos( '>', downResult );
 415                                                 if (found = 0) or (found2 = 0) then
 416                                                         found := Max( found, found2 )
 417                                                 else
 418                                                         found := Min( found, found2 );
 419                                         end;
 420                                         board := Copy( downResult, 1, found - 1 );
 421                                         downResult := Copy( downResult, found, MaxInt );
 422
 423                                         if board = BBS_HOST then
 424                                                 goto NextBoard;
 425                                         if AnsiPos( '../', board ) = 1 then
 426                                                 board := BBS_HOST + Copy( board, 1 + 3, MaxInt );       // 3 = Length( '../' )
 427
 428                                         found := AnsiPos( '>', downResult );
 429                                         if found = 0 then
 430                                                 Break;
 431                                         downResult := Copy( downResult, found + 1, MaxInt );    // 1 = Length( '>' )
 432
 433                                         found := AnsiPos( '</a>', downResult );
 434                                         if found = 0 then
 435                                                 Break;
 436                                         board := Copy( downResult, 1, found - 1 ) + '=' + board;
 437                                         downResult := Copy( downResult, found + 4, MaxInt );    // 4 = Length( '</a>' )
 438
 439                                         saveText.Add( board );
 440 NextBoard:
 441                                         found := AnsiPos( '<a ', downResult );
 442                                 end;
 443                                 saveText.SaveToFile( savepath );
 444                                 saveText.Free;
 445                         end else begin
 446                                 InternalPrint( PChar( '\94Â\8fî\95ñ\82Ì\8eæ\93¾\82É\8e¸\94s\82µ\82Ü\82µ\82½(' + IntToStr( responseCode ) + ')' ) );
 447                         end;
 448                 finally
 449                         DisposeResultString( tmp );
 450                 end;
 451                 InternalPrint( '\94Â\8fî\95ñ\82ð\8eæ\93¾\8a®\97¹' );
 452         except
 453                 InternalPrint( '\94Â\8fî\95ñ\82Ì\8eæ\93¾\82É\8e¸\94s\82µ\82Ü\82µ\82½' );
 454         end;
 455
 456 end;
 457
 458 // \83\81\83j\83\85\81[\83n\83\93\83h\83\89
 459 procedure OnPlugInMenu(
 460         inHandle : HMENU                                        // \83\81\83j\83\85\81[\83n\83\93\83h\83\8b
 461 ); stdcall;
 462 begin
 463
 464         if inHandle = SyncronizeMenu then
 465                 OnBoardSyncronizeMenu( inHandle );
 466
 467 end;
 468
 469 // =========================================================================
 470 // TShitarabaThreadItem
 471 // =========================================================================
 472
 473 // *************************************************************************
 474 // \83R\83\93\83X\83g\83\89\83N\83^
 475 // *************************************************************************
 476 constructor TShitarabaThreadItem.Create(
 477         inInstance      : DWORD
 478 );
 479 var
 480         uri                                     : TIdURI;
 481         uriList                 : TStringList;
 482 begin
 483
 484         inherited;
 485
 486         OnDownload              := Download;
 487         OnWrite                         := Write;
 488         OnGetRes                        := GetRes;
 489         OnGetDat                        := GetDat;
 490         OnGetHeader             := GetHeader;
 491         OnGetFooter             := GetFooter;
 492         OnGetBoardURL   := GetBoardURL;
 493
 494         FilePath                        := '';
 495         FIsTemporary    := False;
 496         FDat                                    := nil;
 497         URL                                             := BrowsableURL;
 498
 499         uri                     := TIdURI.Create( ReadURL );
 500         uriList := TStringList.Create;
 501         try
 502                 ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
 503                 if (AnsiPos('.html', uri.Document) = 0) then begin //\92Ê\8fí
 504                         if uriList[ 5 ] = 'l100' then begin
 505                                 FileName        := uriList[ 4 ] + '.dat';
 506                                 FilePath        := MyLogFolder + uriList[ 2 ] + '\' + uriList[ 3 ] + '\' + uriList[ 4 ] + '.dat';
 507                                 IsLogFile       := FileExists( FilePath );
 508                         end else begin
 509                                 FileName        := uriList[ 5 ] + '.dat';
 510                                 FilePath        := MyLogFolder + uriList[ 3 ] + '\' + uriList[ 4 ] + '\' + uriList[ 5 ] + '.dat';
 511                                 IsLogFile       := FileExists( FilePath );
 512                         end;
 513                 end else begin  //\89ß\8b\8e\83\8d\83O
 514                         //http://jbbs.livedoor.com/game/1578/storage/1086710948.html
 515                         FileName        := Copy(uri.Document, 1, Length(uri.Document) - 5) + '.dat';
 516                         FilePath        := MyLogFolder + CustomStringReplace(CustomStringReplace(uri.Path, '/storage', ''), '/', '\') + FileName;
 517                         IsLogFile       := FileExists( FilePath );
 518
 519                 end;
 520         finally
 521                 uri.Free;
 522                 uriList.Free;
 523         end;
 524
 525 end;
 526
 527 // *************************************************************************
 528 // \83f\83X\83g\83\89\83N\83^
 529 // *************************************************************************
 530 destructor TShitarabaThreadItem.Destroy;
 531 begin
 532
 533         FreeDat;
 534
 535         // \88ê\8e\9e\83t\83@\83C\83\8b\82Ì\8fê\8d\87\82Í\8dí\8f\9c\82·\82é
 536         if FIsTemporary then
 537                 DeleteFile( FilePath );
 538
 539         inherited;
 540
 541 end;
 542
 543 // *************************************************************************
 544 // \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½
 545 // *************************************************************************
 546 function TShitarabaThreadItem.Download : TDownloadState;
 547 var
 548         modified                        : Double;
 549         tmp                                             : PChar;
 550         downResult              : TStringList;
 551         responseCode    : Longint;
 552         logStream                       : TFileStream;
 553         uri                                             : TIdURI;
 554         uriList                         : TStringList;
 555         datURL                          : string;
 556                 tmpText: string;
 557 begin
 558
 559         Result := dsError;
 560
 561         uri := TIdURI.Create( ReadURL );
 562         if(( AnsiPos('.html', uri.Document) >0 ) and ( AnsiPos('/storage/', uri.Path) > 0 )) then begin
 563                 //\89ß\8b\8e\83\8d\83O
 564                 Result := StorageDownload(uri.Path, uri.Document);
 565                 uri.Free;
 566         end else begin
 567                 //\8c»\8dÝ\90¶\82«\82Ä\82é\83X\83\8c\83b\83h
 568                 uriList := TStringList.Create;
 569                 try
 570                         ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
 571                         FileName := uriList[ 5 ] + '.dat';
 572                         // http://jbbs.livedoor.com/bbs/rawmode.cgi/game/1578/1067968274/l100
 573                         // protocol://host/1/2/3/4/5/uriList.Count - 1
 574                         if MyLogFolder = '' then begin
 575                                 // \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¶
 576                                 FilePath                        := TemporaryFile;
 577                                 FIsTemporary    := True;
 578                         end else begin
 579                                 FilePath                        := MyLogFolder + uriList[ 3 ] + '\' + uriList[ 4 ] + '\' + uriList[ 5 ] + '.dat';
 580                                 FIsTemporary    := False;
 581                         end;
 582                 finally
 583                         uri.Free;
 584                         uriList.Free;
 585                 end;
 586
 587                 // \95Û\91¶\97p\82Ì\83f\83B\83\8c\83N\83g\83\8a\82ð\8c@\82é
 588                 ForceDirectoriesEx( Copy( FilePath, 1, LastDelimiter( '\', FilePath ) ) );
 589
 590                 // \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Í
 591                 // InternalDownload \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
 592                 modified        := LastModified;
 593                 datURL          := ReadURL + IntToStr( Count + 1 ) + '-'; // \90V\92\85\82Ì\82Ý
 594                 responseCode := InternalDownload( PChar( datURL ), modified, tmp, 0 );
 595
 596                 try
 597                         if (responseCode = 200) or (responseCode = 206) then begin
 598                                 downResult := TStringList.Create;
 599                                 try
 600                                                                         tmpText := CustomStringReplace( string( tmp ), '¡÷¡®', ',' );
 601                                         downResult.Text := EUCtoSJIS( tmpText );
 602                                                                         ArrangeDownloadData(Count, downResult);
 603                                         if downResult.Count > 0 then begin
 604                                                 if FileExists( FilePath ) then
 605                                                         logStream := TFileStream.Create( FilePath, fmOpenReadWrite or fmShareDenyWrite )
 606                                                 else
 607                                                         logStream := TFileStream.Create( FilePath, fmCreate or fmShareDenyWrite );
 608                                                 try
 609                                                         logStream.Position      := logStream.Size;
 610                                                         logStream.Write( PChar( downResult.Text )^, Length( downResult.Text ) );
 611                                                 finally
 612                                                         logStream.Free;
 613                                                 end;
 614
 615                                                 if Count = 0 then
 616                                                                                                 // \90V\8bK
 617                                                         Result := dsComplete
 618                                                 else
 619                                                         // \92Ç\8bL
 620                                                         Result := dsDiffComplete;
 621
 622                                                                                         Size                                    := Size + Length( downResult.Text );
 623                                                 // CGI \82©\82ç\82Í\90³\82µ\82¢\93ú\95t\82ª\93¾\82ç\82ê\82È\82¢\82Ì\82Å\8c»\8dÝ\82É\90Ý\92è
 624                                                 LastModified    := Now;
 625
 626
 627
 628                                                 NewReceive              := Count + 1;
 629                                                 Count                                   := Count + downResult.Count;
 630                                                 NewResCount             := downResult.Count;
 631
 632
 633
 634                                         end else begin
 635                                                 Result := dsNotModify;
 636                                         end;
 637                                 finally
 638                                         downResult.Free;
 639                                 end;
 640                         end else if responseCode = 302 then begin
 641                                 //http://jbbs.shitaraba.com/bbs/read.cgi/game/3477/1077473358/
 642                                 //http://jbbs.shitaraba.com/game/bbs/read.cgi?BBS=3477&KEY=1077473358
 643                                 //http://jbbs.shitaraba.com/game/3477/storage/1077473358.html
 644                                 //\89ß\8b\8e\83\8d\83O
 645                                 uri := TIdURI.Create( ReadURL );
 646                                 uriList := TStringList.Create;
 647                                 try
 648                                         ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
 649                                         URL := uri.Protocol + '://' + uri.Host +
 650                                                         '/' + uriList[3] + '/' + uriList[4] + '/storage/' + uriList[ 5 ] + '.html';
 651                                 finally
 652                                         uriList.Free;
 653                                         uri.Free;
 654                                 end;
 655                                 uri := TIdURI.Create( ReadURL );
 656                                 Result := StorageDownload(uri.Path, uri.Document);
 657                                 uri.Free;
 658                         end else if responseCode = 304 then begin
 659                                 Result := dsNotModify;
 660                         end;
 661                 finally
 662                         DisposeResultString( tmp );
 663                 end;
 664         end;
 665
 666 end;
 667 // *************************************************************************
 668 // download\82µ\82Ä\82«\82½Dat\82Ì\82 \82Ú\81[\82ñ\82³\82ê\82½\95ª\82ð\95â\8f[\82µ\82Ä\81A
 669 // \83\8c\83X\90\94\82Æ\88ê\92v\82·\82é\82æ\82¤\82É\82·\82é
 670 // *************************************************************************
 671 procedure       TShitarabaThreadItem.ArrangeDownloadData(
 672         start: Integer; // \90V\8bK\81F\82O\81@\92Ç\8bL\81F\91O\89ñ\82Ü\82Å\82Ì\8eæ\93¾\90\94
 673                 var Data: TStringList   //Dat\82Ì\83f\81[\83^
 674 );
 675 var
 676         i: Integer;
 677                 n: Integer;
 678                 tmp: string;
 679 begin
 680         i := start;
 681                 while i < Data.count + start do begin
 682                         try
 683                                         tmp := Copy(Data[i - start], 1 , AnsiPos('<>', Data[ i - start ] )-1 );
 684                                                 try
 685                                                         n := StrToInt(tmp);
 686                                                                 if n > i + 1 then begin
 687                                                                         Data.Insert(i - start, Format('%d<><><><><><>', [i+1]));
 688                                                                 end;
 689                                                                 Inc(i);
 690                                                 except
 691                                                         Inc(i);
 692                         end;
 693                                 except
 694
 695                                 end;
 696                 end;
 697
 698 end;
 699 // *************************************************************************
 700 // \89ß\8b\8e\83\8d\83O\97pDownload\8aÖ\90\94
 701 // *************************************************************************
 702 function        TShitarabaThreadItem.StorageDownload(
 703         Path, Document : string
 704 ) : TDownloadState;
 705 var
 706         modified                        : Double;
 707         tmp                                             : PChar;
 708         downResult              : TStringList;
 709         responseCode    : Longint;
 710         logStream                       : TFileStream;
 711         //uri                                           : TIdURI;
 712         //uriList                               : TStringList;
 713         datURL                          : string;
 714         tmpText, tmpLine, tmpTitle: string;
 715         tmpHTML: TStringList;
 716
 717         i, j, tS, tE: Integer;
 718         tmpDatToken : array[0..6] of string;
 719 begin
 720
 721         Result := dsError;
 722
 723         //uri := TIdURI.Create( ReadURL );
 724         try
 725                 FileName := Copy(Document, 1, Length(Document) - 5) + '.dat';
 726                 if MyLogFolder = '' then begin
 727                         // \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¶
 728                         FilePath                        := TemporaryFile;
 729                         FIsTemporary    := True;
 730                 end else begin
 731                         FilePath        := MyLogFolder
 732                                                         + CustomStringReplace(CustomStringReplace(Path, '/storage', ''), '/', '\')
 733                                                         + FileName;
 734
 735                         FIsTemporary    := False;
 736                 end;
 737         finally
 738                 //uri.Free;
 739         end;
 740
 741         // \95Û\91¶\97p\82Ì\83f\83B\83\8c\83N\83g\83\8a\82ð\8c@\82é
 742         ForceDirectoriesEx( Copy( FilePath, 1, LastDelimiter( '\', FilePath ) ) );
 743
 744
 745
 746         // \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Í
 747         // InternalDownload \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
 748         modified        := LastModified;
 749
 750         datURL          := ReadURL;
 751         responseCode := InternalDownload( PChar( datURL ), modified, tmp, 0 );
 752
 753         try
 754                 if (responseCode = 200) or (responseCode = 206) then begin
 755                         downResult := TStringList.Create;
 756                         try
 757                                 tmpText := CustomStringReplace( string( tmp ), '¡÷¡®', ',' );
 758
 759
 760
 761                                 //**\82±\82±\82ÅHTML\83t\83@\83C\83\8b\82ð\82µ\82½\82ç\82ÎJBBS\82Ìdat\8c`\8e®\82É\95Ï\8a·\82·\82é
 762                                 tmpHTML := TStringList.Create;
 763
 764                                 try
 765                                         tmpHTML.Text := EUCtoSJIS( tmpText );
 766                                         //Title\82Ì\8eæ\93¾
 767                                         for i := 0 to tmpHTML.Count - 1 do begin
 768                                                 tmpLine := AnsiLowerCase(tmpHTML[i]);
 769                                                 tS := AnsiPos('<title>', tmpLine);
 770                                                 tE := AnsiPos('</title>', tmpLine);
 771
 772                                                 if tS > 0 then begin
 773                                                         if tE - tS  = 1 then begin
 774                                                                 tmpTitle := '';
 775                                                         end else begin
 776                                                                 tmpTitle := Copy(tmpHTML[i], ts + 7, Length(tmpHTML[i]));
 777                                                                 tmpLine := AnsiLowerCase(tmpTitle);
 778                                                                 tE := AnsiPos('</title>', tmpLine);
 779
 780                                                                 if tE > 0 then begin
 781                                                                         tmpTitle := Copy(tmpTitle, 1, tE - 1);
 782                                                                 end else begin
 783                                                                         j := i + 1;
 784                                                                         tmpLine := AnsiLowerCase(tmpHTML[j]);
 785                                                                         tE := AnsiPos('</title>', tmpLine);
 786                                                                         tmpTitle := tmpTitle  + tmpHTML[j];
 787                                                                         while( tE = 0 ) do begin
 788                                                                                 j := i + 1;
 789                                                                                 if j = tmpHTML.Count then break;
 790                                                                                 tmpLine := AnsiLowerCase(tmpHTML[j]);
 791                                                                                 tE := AnsiPos('</title>', tmpLine);
 792                                                                                 tmpTitle := tmpTitle  + tmpHTML[j];
 793                                                                         end;
 794                                                                         if tE = 0 then tmpTitle := ''
 795                                                                         else begin
 796                                                                                 tmpLine := AnsiLowerCase(tmpTitle);
 797                                                                                 tE := AnsiPos('</title>', tmpLine);
 798                                                                                 tmpTitle := Copy(tmpTitle, 1, tE - 1);
 799                                                                         end;
 800                                                                 end;
 801                                                         end;
 802                                                 end;
 803                                         end;
 804                                         //Title := tmpTitle;
 805                                         //tS := 0; tE := 0;
 806                                         //\96{\95¶\82Ì\8eæ\93¾ <DL>\82Ì\8e\9f\82Ì\8ds\82©\82ç</DL>\82Ì\91O\82Ì\8ds\82Ü\82Å
 807                                         for i := tmpHTML.Count - 1 downto 0 do begin
 808                                                 tmpLine := AnsiLowerCase(tmpHTML[i]);
 809                                                 tE := AnsiPos('</dl>', tmpLine);
 810                                                 if tE > 0 then begin
 811                             tmpHTML[i] := COpy(tmpHTML[i], 1, tE -1);
 812                                                         break;
 813                                                 end;
 814                                                 tmpHTML.Delete(i);
 815                                         end;
 816                                         j := 0;
 817                                         for i := 0 to tmpHTML.Count - 1 do begin
 818                                                 tmpLine := AnsiLowerCase(tmpHTML[i]);
 819                                                 tS := AnsiPos('<dl>', tmpLine);
 820                                                 if tS > 0 then begin
 821                                                         j := i + 1;
 822                                                         break;
 823                                                 end;
 824                                         end;
 825                                         for i := j downto 0 do
 826                                                 tmpHTML.Delete(i);
 827
 828                                         //<DD><DT>\82»\82ê\82¼\82ê\88ê\8ds\82É\95Ï\8a·\82·\82é
 829                                         for i := tmpHTML.Count - 1 downto 1 do begin
 830                                                 tmpLine := AnsiLowerCase(tmpHTML[i]);
 831                                                 if (AnsiPos('<dd>', tmpLine) = 0) and (AnsiPos('<dt>', tmpLine) = 0) then begin
 832                                                         tmpLine := CustomStringReplace(tmpHTML[i-1], #13#10, '') +
 833                                                                                         CustomStringReplace(tmpHTML[i], #13#10, '');
 834                                                         tmpHTML.Insert(i-1, tmpLine);
 835                                                         tmpHTML.Delete(i + 1);
 836                                                         tmpHTML.Delete(i);
 837                                                 end;
 838                                         end;
 839                                         //\8fã\82Ü\82Å\82Ì\8f\88\97\9d\82Å\88È\89º\82Ì\82æ\82¤\82È\8c`\82É\82È\82Á\82Ä\82é
 840                                         //<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`
 841                                         //<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`
 842                                         //\8fã\82Ì\82æ\82¤\82È\82Ì\82ð\89º\82Ì\82æ\82¤\82Èdat\82Ì\8c`\8e®\82É\95Ï\8a·\82·\82é
 843                                         //\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
 844                                         //2<>\96¼\82à\96³\82«\8cR\8et<>sage<>2004/06/22(\89Î) 09:05<>\82Q\82°\82Æ\81[<><>26bmLAzg
 845                                         for i := 0 to tmpHTML.Count - 1 do begin
 846                                                 tmpDatToken[0] := ''; tmpDatToken[1] := ''; tmpDatToken[2] := '';
 847                                                 tmpDatToken[3] := ''; tmpDatToken[4] := ''; tmpDatToken[6] := '';
 848                                                 //==\82Ü\82¸\82Í\96{\95¶\82ð\8eæ\93¾==//
 849                                                 tmpLine := AnsiLowerCase(tmpHTML[i]);
 850                                                 tS := AnsiPos('<dd>', tmpLine);
 851                                                 if tS > 0 then begin
 852                                                         tmpDatToken[4] := Copy(tmpHTML[i], tS + 4, Length(tmpHTML[i]));
 853                                                         tmpHTML[i] := Copy(tmpHTML[i], 1, tS -1);
 854                                                 end else
 855                                                         tmpDatToken[4] := '';
 856                                                 //====================//
 857                                                 //==\83\8c\83X\94Ô\8d\86\8eæ\93¾==//
 858                                                 tmpLine := AnsiLowerCase(tmpHTML[i]);
 859                                                 tS := AnsiPos('">', tmpLine);
 860                                                 tE := AnsiPos('</a>', tmpLine);
 861                                                 if tE > tS then begin
 862                                                         tmpDatToken[0] := Copy(tmpHTML[i], tS + 2, tE - (tS + 2) - 1);
 863                                                         tmpDatToken[0] := Trim(tmpDatToken[0]);
 864                                                         tmpHTML[i] := Copy(tmpHTML[i], tE + 4, Length(tmpHTML[i]));
 865                                                 end else
 866                                                         tmpDatToken[0] := IntToStr(i);
 867                                                 tS := AnsiPos('<', tmpHTML[i]);
 868                                                 if tS > 0 then begin
 869                                                         tmpHTML[i] := Copy(tmpHTML[i], tS, Length(tmpHTML[i]));
 870                                                 end;
 871                                                 //====================//
 872                                                 //==\83\81\83\8b\97\93\8eæ\93¾==//
 873                                                 tmpLine := AnsiLowerCase(tmpHTML[i]);
 874                                                 tS := AnsiPos('<a href="mailto:', tmpLine);
 875                                                 if tS > 0 then begin //\83\81\83\8b\97\93\83A\83\8a
 876                                                         tE := AnsiPos('">', tmpLine);
 877                                                         tmpDatToken[2] := Copy(tmpHTML[i], tS + 16, tE - (tS + 16));
 878                                                         tmpHTML[i] := Copy(tmpHTML[i], tE + 5, Length(tmpHTML[i]));
 879                             tmpHTML[i] := CustomStringReplace(tmpHTML[i], '</a>', '', true);
 880                                                 end else begin  //\83\81\83\8b\97\93\96³\82µ
 881                                                         tmpDatToken[2] := '';
 882                                                 end;
 883                                                 //====================//
 884                                                 //==HN\8eæ\93¾==//
 885                                                 tmpLine := AnsiLowerCase(tmpHTML[i]);
 886                                                 tE := AnsiPos('\93\8a\8de\93ú\81F', tmpLine);
 887                                                 if tE > 0 then begin
 888                                                         tmpDatToken[1] := Trim(Copy(tmpHTML[i], 1, tE - 1 ));
 889                                                         tmpDatToken[1] := CustomStringReplace(tmpDatToken[1], '<b>', '', true);
 890                                                         tmpDatToken[1] := CustomStringReplace(tmpDatToken[1], '</b>', '', true);
 891                                                         tmpHTML[i] := Copy(tmpHTML[i], tE + 8, Length(tmpHTML[i]));
 892                                                 end else begin
 893                                                         tmpDatToken[1] := '';
 894                                                 end;
 895                                                 //====================//
 896                                                 //==\93ú\95t\8e\9e\8d\8f\82Ì\8eæ\93¾==//
 897                                                 tmpLine := AnsiLowerCase(tmpHTML[i]);
 898                                                 tE := AnsiPos('[', tmpLine);
 899                                                 if tE > 0 then begin
 900                                                         tmpDatToken[3] := Trim(Copy(tmpHTML[i], 1, tE - 1 ));
 901                                                         tmpHTML[i] := Copy(tmpHTML[i], tE + 1, Length(tmpHTML[i]));
 902                                                 end else begin
 903                                                         tmpDatToken[3] := '';
 904                                                 end;
 905                                                 //====================//
 906                                                 //==ID\82Ì\8eæ\93¾==//
 907                                                 tmpLine := AnsiLowerCase(tmpHTML[i]);
 908                                                 tE := AnsiPos(']', tmpLine);
 909                                                 if tE > 0 then begin
 910                                                         tmpDatToken[6] := Trim(Copy(tmpHTML[i], 1, tE - 1 ));
 911                                                 end else begin
 912                                                         tmpDatToken[6] := '';
 913                                                 end;
 914                                                 //====================//
 915                                                 tS := StrToIntDef(tmpDatToken[0], -1);
 916                                                 if  tS = 1      then
 917                                                         tmpLine := tmpDatToken[0] + '<>' + tmpDatToken[1] + '<>' + tmpDatToken[2] + '<>' +
 918                                                                         tmpDatToken[3] + '<>' + tmpDatToken[4] + '<>' + tmpTitle + '<>' + tmpDatToken[6]
 919                                                 else
 920                                                         tmpLine := tmpDatToken[0] + '<>' + tmpDatToken[1] + '<>' +tmpDatToken[2] + '<>' +
 921                                                                         tmpDatToken[3] + '<>' + tmpDatToken[4] + '<><>' + tmpDatToken[6];
 922                                                 tmpHTML[i] := tmpLine;
 923                                         end;
 924
 925
 926
 927
 928                                         downResult.Text := tmpHTML.Text;
 929                                 finally
 930                                         tmpHTML.free;
 931                                 end;
 932
 933                                 ArrangeDownloadData(Count, downResult);
 934
 935                                 if downResult.Count > 0 then begin
 936                                         if FileExists( FilePath ) then
 937                                                 DeleteFile(FilePath);
 938
 939                                         logStream := TFileStream.Create( FilePath, fmCreate or fmShareDenyWrite );
 940                                         try
 941                                                 logStream.Position      := 0;
 942                                                 logStream.Write( PChar( downResult.Text )^, Length( downResult.Text ) );
 943                                         finally
 944                                                 logStream.Free;
 945                                         end;
 946
 947                                         // \90V\8bK
 948                                         Result := dsComplete;
 949
 950                                         Size    := Length( downResult.Text );
 951                                         // CGI \82©\82ç\82Í\90³\82µ\82¢\93ú\95t\82ª\93¾\82ç\82ê\82È\82¢\82Ì\82Å\8c»\8dÝ\82É\90Ý\92è
 952                                         LastModified    := Now;
 953
 954
 955
 956                                         NewReceive              := 1;
 957                                         Count                                   := downResult.Count;
 958                                         NewResCount             := downResult.Count;
 959                                         //http://jbbs.livedoor.com/bbs/read.cgi/game/1578/1086710948/l100
 960                                         //http://jbbs.livedoor.com/game/1578/storage/1086710948.html
 961                                         //URL := 'http://jbbs.livedoor.com/bbs/read.cgi' +
 962                                         //              CustomStringReplace(Path, '/storage', '')
 963                                         //              + FileName;
 964                                         DownloadHost := 'storage';
 965                                 end else begin
 966                                         Result := dsNotModify;
 967                                 end;
 968                         finally
 969                                 downResult.Free;
 970                         end;
 971                 end else if responseCode = 304 then begin
 972                         Result := dsNotModify;
 973                 end;
 974         finally
 975                 DisposeResultString( tmp );
 976         end;
 977
 978 end;
 979
 980 // *************************************************************************
 981 // \8f\91\82«\8d\9e\82Ý\82ð\8ew\8e¦\82³\82ê\82½
 982 // *************************************************************************
 983 function        TShitarabaThreadItem.Write(
 984         inName                          : string;       // \96¼\91O(\83n\83\93\83h\83\8b)
 985         inMail                          : string;       // \83\81\81[\83\8b\83A\83h\83\8c\83X
 986         inMessage                       : string        // \96{\95¶
 987 ) : TDownloadState;                             // \8f\91\82«\8d\9e\82Ý\82ª\90¬\8c÷\82µ\82½\82©\82Ç\82¤\82©
 988 var
 989         postData                        : string;
 990         postResult              : PChar;
 991         uri                                             : TIdURI;
 992         uriList                         : TStringList;
 993         responseCode    : Integer;
 994 begin
 995
 996         uri                     := TIdURI.Create( URL );
 997         uriList := TStringList.Create;
 998         try
 999                 ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
1000
1001                 // http://jbbs.livedoor.com/bbs/read.cgi/game/1578/1067968274/l100
1002                 postData        :=
1003                         'NAME='                 + HttpEncode( SJIStoEUC( inName ) ) +
1004                         '&MAIL='                + HttpEncode( SJIStoEUC( inMail ) ) +
1005                         '&MESSAGE='     + HttpEncode( SJIStoEUC( inMessage ) ) +
1006                         '&BBS='                 + uriList[ 4 ] +
1007                         '&KEY='                 + uriList[ 5 ] +
1008                         '&DIR='                 + uriList[ 3 ] +
1009                         '&TIME='                + IntToStr( DateTimeToUnix( Now ) ) +
1010                         '&submit='      + HttpEncode( SJIStoEUC( '\8f\91\82«\8d\9e\82Þ' ) );
1011
1012                 // \93Æ\8e©\82É\92Ê\90M\82µ\82È\82¢\8fê\8d\87\82Í InternalPost \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
1013                 responseCode := InternalPost( PChar( WriteURL ), PChar( postData ), postResult );
1014                 try
1015                         if (responseCode = 200) or
1016                                 ((responseCode = 302) and (Length( Trim( postResult ) ) = 0)) then begin
1017                                 Result := dsComplete
1018                         end else begin
1019                                 Result := dsError;
1020                                 if Assigned( InternalPrint ) then
1021                                         InternalPrint( postResult );
1022                         end;
1023                 finally
1024                         DisposeResultString( postResult );
1025                 end;
1026         finally
1027                 uri.Free;
1028                 uriList.Free;
1029         end;
1030
1031 end;
1032
1033 // *************************************************************************
1034 // \83\8c\83X\94Ô\8d\86 inNo \82É\91Î\82·\82é html \82ð\97v\8b\81\82³\82ê\82½
1035 // *************************************************************************
1036 function TShitarabaThreadItem.GetRes(
1037         inNo            : Integer               // \97v\8b\81\82³\82ê\82½\83\8c\83X\94Ô\8d\86
1038 ) : string;                                             // \91Î\89\9e\82·\82é HTML
1039 var
1040         res                     : string;
1041         tmp                     : PChar;
1042 begin
1043
1044         // \93Æ\8e©\82É\83t\83B\83\8b\83^\83\8a\83\93\83O\82ð\8ds\82í\82È\82¢\8fê\8d\87\82Í
1045         // InternalAbon \82¨\82æ\82Ñ Dat2HTML \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
1046                 {
1047         LoadDat;
1048         if FDat = nil then begin
1049                 // \83\8d\83O\82É\91¶\8dÝ\82µ\82È\82¢\82Ì\82Å\82±\82Ì\82Ü\82Ü\8fI\97¹
1050                 Result := '';
1051                 Exit;
1052         end;
1053         res := Copy( FDat[ inNo - 1 ], AnsiPos( '<>', FDat[ inNo - 1 ] ) + 2, MaxInt );
1054                 }
1055         res := GetDat( inNo );
1056         if res = '' then begin
1057                 Result := '';
1058                 Exit;
1059         end else begin
1060                 tmp := InternalAbonForOne( PChar( res ), PChar( FilePath ),inNo );
1061                 try
1062                         Result := Dat2HTML( string( tmp ), inNo );
1063                 finally
1064                         DisposeResultString( tmp );
1065                 end;
1066         end;
1067
1068 end;
1069
1070 // *************************************************************************
1071 // \83\8c\83X\94Ô\8d\86 inNo \82É\91Î\82·\82é Dat \82ð\97v\8b\81\82³\82ê\82½
1072 // *************************************************************************
1073 function TShitarabaThreadItem.GetDat(
1074         inNo            : Integer               // \97v\8b\81\82³\82ê\82½\83\8c\83X\94Ô\8d\86
1075 ) : string;                                             // \82Q\82¿\82á\82ñ\82Ë\82é\82ÌDat\8c`\8e®
1076 var
1077         res                     : string;
1078         tmp                     : array[1..5] of string;
1079         i                       : Integer;
1080         pTmp            : PChar;
1081 begin
1082         pTmp := nil;
1083         // \93Æ\8e©\82É\83t\83B\83\8b\83^\83\8a\83\93\83O\82ð\8ds\82í\82È\82¢\8fê\8d\87\82Í
1084         // InternalAbon \82¨\82æ\82Ñ Dat2HTML \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
1085         LoadDat;
1086         if (FDat = nil) or (inNo - 1 < 0 ) or (inNo - 1 >= FDat.Count) then begin
1087                 // \83\8d\83O\82É\91¶\8dÝ\82µ\82È\82¢\82Ì\82Å\82±\82Ì\82Ü\82Ü\8fI\97¹
1088                 Result := '';
1089                 Exit;
1090         end;
1091         try
1092                 res := Copy( FDat[ inNo - 1 ], AnsiPos( '<>', FDat[ inNo - 1 ] ) + 2, MaxInt );
1093                 //\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é
1094                 // \96¼\91O<>\83\81\81[\83\8b<>\93ú\95t<>\96{\95¶<>\83X\83\8c\83^\83C<>ID
1095                 for i := 0 to 4 do begin
1096                         tmp[ i + 1 ] := Copy( res, 1, AnsiPos('<>', res) - 1 );
1097                         Delete( res, 1, AnsiPos('<>', res) + 1 );
1098                 end;
1099                 // \96¼\91O<>\83\81\81[\83\8b<>\93ú\95tID<>\96{\95¶<>\83X\83\8c\83^\83C
1100                 pTmp := CreateResultString(tmp[1] + '<>' + tmp[2] + '<>' + tmp[3] + ' ' + res + '<>'+ tmp[4] + '<>' +tmp[5]);
1101                 Result := string(pTmp);
1102         finally
1103                 DisposeResultString(pTmp);
1104         end;
1105
1106 end;
1107
1108 // *************************************************************************
1109 // \83X\83\8c\83b\83h\82Ì\83w\83b\83_ html \82ð\97v\8b\81\82³\82ê\82½
1110 // *************************************************************************
1111 function TShitarabaThreadItem.GetHeader(
1112         inOptionalHeader        : string
1113 ) : string;
1114 begin
1115
1116         // \93Æ\8e©\82É\83t\83B\83\8b\83^\83\8a\83\93\83O\82ð\8ds\82í\82È\82¢\8fê\8d\87\82Í
1117         // InternalHeader \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
1118         Result := InternalHeader(
1119                 '<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">' +
1120                 inOptionalHeader );
1121
1122
1123         // GetRes \82ð\8cÄ\82Î\82ê\82é\82±\82Æ\82ª\97\\91z\82³\82ê\82é\82Ì\82Å FDat \82ð\90¶\90¬\82µ\82Ä\82¨\82
1124         try
1125                 FreeDat;
1126                 LoadDat;
1127         except
1128         end;
1129
1130 end;
1131
1132 // *************************************************************************
1133 // \83X\83\8c\83b\83h\82Ì\83t\83b\83^ html \82ð\97v\8b\81\82³\82ê\82½
1134 // *************************************************************************
1135 function TShitarabaThreadItem.GetFooter(
1136         inOptionalFooter : string
1137 ) : string;
1138 begin
1139
1140         // \93Æ\8e©\82É\83t\83B\83\8b\83^\83\8a\83\93\83O\82ð\8ds\82í\82È\82¢\8fê\8d\87\82Í
1141         // InternalFooter \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
1142         Result := InternalFooter( inOptionalFooter );
1143
1144         // \82à\82¤ GetRes \82Í\8cÄ\82Î\82ê\82È\82¢\82Æ\8ev\82¤\82Ì\82Å FDat \82ð\8aJ\95ú\82µ\82Ä\82¨\82
1145         try
1146                 FreeDat;
1147         except
1148         end;
1149
1150 end;
1151
1152 // *************************************************************************
1153 // \82±\82Ì ThreadItem \82ª\91®\82·\82é\94Â\82Ì URL \82ð\97v\8b\81\82³\82ê\82½
1154 // *************************************************************************
1155 function        TShitarabaThreadItem.GetBoardURL : string;
1156 var
1157         uri                                             : TIdURI;
1158         uriList                         : TStringList;
1159         tmphost:        String;
1160 const
1161         BBS_HOST_OLD    = 'jbbs.shitaraba.com';
1162         BBS_HOST_OLD2   = 'jbbs.livedoor.com';
1163         BBS_HOST                = 'jbbs.livedoor.jp';
1164 begin
1165
1166         uri                     := TIdURI.Create( ReadURL );
1167         uriList := TStringList.Create;
1168         try
1169                 ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
1170
1171                 tmphost := uri.Host;
1172
1173                 if (tmphost = BBS_HOST_OLD) or (tmphost = BBS_HOST_OLD2) then
1174                         tmphost := BBS_HOST;
1175
1176                 if( AnsiPos('.html', uri.Document) = 0 ) then begin //\92Ê\8fí
1177                         FileName := uriList[ 5 ] + '.dat';
1178                         // http://jbbs.livedoor.com/bbs/read.cgi/computer/351/1090404452/l100
1179                         // http://jbbs.livedoor.com/bbs/read.cgi/game/1578/1067968274/l100
1180                         // http://jbbs.livedoor.com/game/1000/subject.txt
1181                         Result          := CreateResultString(
1182                                 uri.Protocol + '://' + tmphost + '/' + uriList[ 3 ] + '/' + uriList[ 4 ] + '/' );
1183                 end else begin
1184                         //http://jbbs.livedoor.com/game/1578/storage/1086710948.html
1185                         Result  := CreateResultString(
1186                                 uri.Protocol + '://' + tmphost + CustomStringReplace(uri.Path, '/storage', ''));
1187                 end;
1188
1189         finally
1190                 uri.Free;
1191                 uriList.Free;
1192         end;
1193
1194 end;
1195
1196 // *************************************************************************
1197 // FDat \82Ì\90¶\90¬
1198 // *************************************************************************
1199 procedure       TShitarabaThreadItem.LoadDat;
1200 begin
1201
1202         if FDat = nil then begin
1203                 if IsLogFile then begin
1204                         // dat \82Ì\93Ç\82Ý\8d\9e\82Ý
1205                         FDat := TStringList.Create;
1206                         FDat.LoadFromFile( FilePath );
1207                 end;
1208         end;
1209
1210 end;
1211
1212 // *************************************************************************
1213 // FDat \82Ì\8aJ\95ú
1214 // *************************************************************************
1215 procedure       TShitarabaThreadItem.FreeDat;
1216 begin
1217
1218         if FDat <> nil then begin
1219                 FDat.Free;
1220                 FDat := nil;
1221         end;
1222
1223 end;
1224
1225 // *************************************************************************
1226 // \88À\91S\82È\83u\83\89\83E\83U\95\\8e¦\97p\82Ì URL
1227 // *************************************************************************
1228 function        TShitarabaThreadItem.BrowsableURL : string;
1229 const
1230         THREAD_MARK     = '/bbs/read.cgi';
1231 var
1232         uri                             : TIdURI;
1233         uriList         : TStringList;
1234         foundPos        : Integer;
1235         dir, tmphost            : string;
1236 const
1237         BBS_HOST_OLD    = 'jbbs.shitaraba.com';
1238         BBS_HOST_OLD2   = 'jbbs.livedoor.com';
1239         BBS_HOST                = 'jbbs.livedoor.jp';
1240 begin
1241
1242         foundPos := AnsiPos( '?', URL );
1243         if foundPos > 0 then begin
1244                 // \8b\8c\8e®
1245                 uri := TIdURI.Create( URL );
1246                 uriList := TStringList.Create;
1247                 try
1248                         ExtractHttpFields( ['/'], [], uri.Path, uriList );
1249                         dir := uriList[ 1 ];
1250
1251                         tmphost := uri.Host;
1252                         if (tmphost = BBS_HOST_OLD) or (tmphost = BBS_HOST_OLD2)  then
1253                                 tmphost := BBS_HOST;
1254
1255                         ExtractHttpFields( ['&'], [], Copy( URL, foundPos + 1, MaxInt ), uriList );
1256                         Result :=
1257                                 uri.Protocol + '://' + tmphost + '/bbs/read.cgi/' +
1258                                 dir + '/' + uriList.Values[ 'BBS' ] + '/' + uriList.Values[ 'KEY' ] + '/l100';
1259                 finally
1260                         uri.Free;
1261                         uriList.Free;
1262                 end;
1263         end else begin
1264                 if Copy( URL, Length( URL ), 1 ) = '/' then
1265                         uri := TIdURI.Create( URL )
1266                 else
1267                         uri := TIdURI.Create( URL + '/' );
1268
1269                 uriList := TStringList.Create;
1270                 try
1271                         ExtractHttpFields( ['/'], [], uri.Path, uriList );
1272
1273                         tmphost := uri.Host;
1274                         if (tmphost = BBS_HOST_OLD) or (tmphost = BBS_HOST_OLD2)  then
1275                                 tmphost := BBS_HOST;
1276
1277                         if( AnsiPos(THREAD_MARK, URL) > 0) and (uriList.Count > 5) then begin
1278                                 Result :=
1279                                         uri.Protocol + '://' + tmphost + THREAD_MARK + '/' +
1280                                         uriList[ 3 ] + '/' + uriList[ 4 ] + '/' + uriList[ 5 ] + '/l100';
1281
1282                         end else if AnsiPos(THREAD_MARK, URL) = 0 then begin
1283                         //\83R\83R\82Å\89ß\8b\8e\83\8d\83O\82©\82Ç\82¤\82©\83`\83F\83b\83N\81H
1284                                 if(AnsiPos('.html/', uri.Path) > 0) then begin
1285                                         Result := uri.Protocol + '://' + tmphost + Copy(uri.Path, 1, Length(uri.Path) - 1);
1286                                 end else
1287                                         Result := URL;
1288                         end;
1289                 finally
1290                         uri.Free;
1291                         uriList.Free;
1292                 end;
1293         end;
1294
1295 end;
1296
1297 // *************************************************************************
1298 // \88À\91S\82È( '/' \82Å\8fI\82í\82é )\93Ç\82Ý\8d\9e\82Ý\82Ì URL
1299 // *************************************************************************
1300 function        TShitarabaThreadItem.ReadURL : string;
1301 const
1302         THREAD_MARK     = '/bbs/read.cgi';
1303 var
1304         uri                             : TIdURI;
1305         uriList         : TStringList;
1306         foundPos        : Integer;
1307         dir, tmphost                    : string;
1308 const
1309         BBS_HOST_OLD    = 'jbbs.shitaraba.com';
1310         BBS_HOST_OLD2   = 'jbbs.livedoor.com';
1311         BBS_HOST                = 'jbbs.livedoor.jp';
1312 begin
1313
1314         foundPos := AnsiPos( '?', URL );
1315         if foundPos > 0 then begin
1316                 // \8b\8c\8e®
1317                 uri := TIdURI.Create( URL );
1318                 uriList := TStringList.Create;
1319                 try
1320                         ExtractHttpFields( ['/'], [], uri.Path, uriList );
1321                         dir := uriList[ 1 ];
1322
1323                         tmphost := uri.Host;
1324                         if (tmphost = BBS_HOST_OLD) or (tmphost = BBS_HOST_OLD2)  then
1325                                 tmphost := BBS_HOST;
1326
1327                         ExtractHttpFields( ['&'], [], Copy( URL, foundPos + 1, MaxInt ), uriList );
1328                         // http://jbbs.livedoor.com/bbs/read.cgi?DIR=game&BBS=1578&KEY=1067968274
1329                         Result :=
1330                                 uri.Protocol + '://' + tmphost + '/bbs/rawmode.cgi/' +
1331                                 dir + '/' + uriList.Values[ 'BBS' ] + '/' + uriList.Values[ 'KEY' ] + '/';
1332                 finally
1333                         uri.Free;
1334                         uriList.Free;
1335                 end;
1336         end else begin
1337                 if Copy( URL, Length( URL ), 1 ) = '/' then
1338                         uri := TIdURI.Create( URL )
1339                 else
1340                         uri := TIdURI.Create( URL + '/' );
1341                 uriList := TStringList.Create;
1342                 try
1343                         ExtractHttpFields( ['/'], [], uri.Path, uriList );
1344
1345                         tmphost := uri.Host;
1346                         if (tmphost = BBS_HOST_OLD) or (tmphost = BBS_HOST_OLD2)  then
1347                                 tmphost := BBS_HOST;
1348                         // http://jbbs.livedoor.com/bbs/read.cgi/game/1578/1067968274/l100
1349                         if( AnsiPos(THREAD_MARK, URL) > 0) and (uriList.Count > 5) then begin
1350                                 Result :=
1351                                         uri.Protocol + '://' + tmphost + '/bbs/rawmode.cgi/' +
1352                                         uriList[ 3 ] + '/' + uriList[ 4 ] + '/' + uriList[ 5 ] + '/';
1353                         end else if AnsiPos(THREAD_MARK, URL) = 0 then begin
1354                         //\83R\83R\82Å\89ß\8b\8e\83\8d\83O\82©\82Ç\82¤\82©\83`\83F\83b\83N\81H
1355                                 if(AnsiPos('.html/', uri.Path) > 0) then begin
1356                                         Result := uri.Protocol + '://' + tmphost + Copy(uri.Path, 1, Length(uri.Path) - 1);
1357                                 end else
1358                                         Result := URL;
1359                         end;
1360                 finally
1361                         uri.Free;
1362                         uriList.Free;
1363                 end;
1364         end;
1365
1366 end;
1367
1368 // *************************************************************************
1369 // \88À\91S\82È( '/' \82Å\8fI\82í\82é )\8f\91\82«\8d\9e\82Ý\82Ì URL
1370 // *************************************************************************
1371 function        TShitarabaThreadItem.WriteURL : string;
1372 var
1373         uri                     : TIdURI;
1374         uriList : TStringList;
1375 begin
1376
1377         if Copy( URL, Length( URL ), 1 ) = '/' then
1378                 uri := TIdURI.Create( URL )
1379         else
1380                 uri := TIdURI.Create( URL + '/' );
1381         uriList := TStringList.Create;
1382         try
1383                 ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
1384                 // http://jbbs.livedoor.com/bbs/read.cgi/game/1578/1067968274/l100
1385                 Result          :=
1386                         uri.Protocol + '://' + uri.Host + '/bbs/write.cgi/' +
1387                         uriList[ 3 ] + '/' + uriList[ 4 ] + '/' + uriList[ 5 ] + '/';
1388         finally
1389                 uri.Free;
1390                 uriList.Free;
1391         end;
1392
1393 end;
1394
1395 // *************************************************************************
1396 // TThreadItem \82ª\90¶\90¬\82³\82ê\82½\8fê\8d\87\82Ì\8f\88\92u(TShitarabaThreadItem \82ð\90¶\90¬\82·\82é)
1397 // *************************************************************************
1398 procedure ThreadItemOnCreateOfTShitarabaThreadItem(
1399         inInstance : DWORD
1400 );
1401 var
1402         threadItem : TShitarabaThreadItem;
1403 begin
1404
1405         threadItem := TShitarabaThreadItem.Create( inInstance );
1406         ThreadItemSetLong( inInstance, tipContext, DWORD( threadItem ) );
1407
1408 end;
1409
1410 // *************************************************************************
1411 // TThreadItem \82ª\94j\8aü\82³\82ê\82½\8fê\8d\87\82Ì\8f\88\92u(TShitarabaThreadItem \82ð\94j\8aü\82·\82é)
1412 // *************************************************************************
1413 procedure ThreadItemOnDisposeOfTShitarabaThreadItem(
1414         inInstance : DWORD
1415 );
1416 var
1417         threadItem : TShitarabaThreadItem;
1418 begin
1419
1420         threadItem := TShitarabaThreadItem( ThreadItemGetLong( inInstance, tipContext ) );
1421         threadItem.Free;
1422
1423 end;
1424
1425 // =========================================================================
1426 // TShitarabaBoardItem
1427 // =========================================================================
1428
1429 // *************************************************************************
1430 // \83R\83\93\83X\83g\83\89\83N\83^
1431 // *************************************************************************
1432 constructor TShitarabaBoardItem.Create(
1433         inInstance      : DWORD
1434 );
1435 var
1436         uri                                     : TIdURI;
1437         uriList                 : TStringList;
1438 const
1439         BBS_HOST_OLD    = 'jbbs.shitaraba.com';
1440         BBS_HOST_OLD2   = 'jbbs.livedoor.com';
1441         BBS_HOST                = 'jbbs.livedoor.jp';
1442 begin
1443
1444         inherited;
1445
1446         OnDownload                                              := Download;
1447         OnCreateThread                          := CreateThread;
1448         OnEnumThread                                    := EnumThread;
1449         OnFileName2ThreadURL    := ToThreadURL;
1450
1451         FilePath                        := '';
1452         FIsTemporary    := False;
1453         FDat                                    := nil;
1454
1455         uri                     := TIdURI.Create( SubjectURL );
1456         uriList := TStringList.Create;
1457         try
1458                 if (uri.Host = BBS_HOST_OLD) or (uri.Host = BBS_HOST_OLD2) then
1459                         uri.Host := BBS_HOST;
1460                 URL := uri.Protocol + '://' + uri.Host + uri.Path;
1461
1462                 ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
1463                 // http://jbbs.livedoor.com/game/1000/subject.txt
1464                 FilePath        := MyLogFolder + uriList[ 1 ] + '\' + uriList[ 2 ] + '\' + uri.Document;
1465                 IsLogFile       := FileExists( FilePath );
1466         finally
1467                 uri.Free;
1468                 uriList.Free;
1469         end;
1470
1471 end;
1472
1473 // *************************************************************************
1474 // \83f\83X\83g\83\89\83N\83^
1475 // *************************************************************************
1476 destructor TShitarabaBoardItem.Destroy;
1477 begin
1478
1479         if FDat <> nil then begin
1480                 try
1481                         FDat.Free;
1482                         FDat := nil;
1483                 except
1484                 end;
1485         end;
1486
1487         // \88ê\8e\9e\83t\83@\83C\83\8b\82Ì\8fê\8d\87\82Í\8dí\8f\9c\82·\82é
1488         if FIsTemporary then
1489                 DeleteFile( FilePath );
1490
1491         inherited;
1492
1493 end;
1494
1495 // *************************************************************************
1496 // \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½
1497 // *************************************************************************
1498 function TShitarabaBoardItem.Download : TDownloadState;
1499 var
1500         modified                        : Double;
1501         downResult              : PChar;
1502         responseCode    : Longint;
1503         uri                                             : TIdURI;
1504         uriList                         : TStringList;
1505         i                                                       : Integer;
1506                 tmpText : String;
1507 begin
1508
1509         Result := dsError;
1510
1511         if FDat <> nil then begin
1512                 try
1513                         FDat.Free;
1514                         FDat := nil;
1515                 except
1516                 end;
1517         end;
1518         FDat            := TStringList.Create;
1519         uri                     := TIdURI.Create( SubjectURL );
1520         uriList := TStringList.Create;
1521         // \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Í
1522         // InternalDownload \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
1523         modified                        := LastModified;
1524         responseCode    := InternalDownload( PChar( uri.URI ), modified, downResult );
1525         try
1526                 if responseCode = 200 then begin
1527                         try
1528                                 // \83p\83X\82ð\8eZ\8fo
1529                                 ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
1530                                 if MyLogFolder = '' then begin
1531                                         // \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¶
1532                                         FilePath                        := TemporaryFile;
1533                                         FIsTemporary    := True;
1534                                 end else begin
1535                                         FilePath                        := MyLogFolder + uriList[ 1 ] + '\' + uriList[ 2 ] + '\' + uri.Document;
1536                                         FIsTemporary    := False
1537                                 end;
1538
1539                                 // \95Û\91¶\97p\82Ì\83f\83B\83\8c\83N\83g\83\8a\82ð\8c@\82é
1540                                 ForceDirectoriesEx( Copy( FilePath, 1, LastDelimiter( '\', FilePath ) ) );
1541
1542                                 // EUC \82ð Shift_JIS \82É
1543                                                                 tmpText := CustomStringReplace( string( downResult ), '¡÷¡®', ',');
1544                                 FDat.Text := EUCtoSJIS( tmpText );
1545                                 // \82µ\82½\82ç\82Î JBBS \82Í\83`\83F\83b\83N\97p\82É\90æ\93ª\82Æ\8dÅ\8fI\8ds\82ª\93¯\82¶
1546                                 i := FDat.Count - 1;
1547                                 if i > 0 then   // 1 \8cÂ\82¾\82Á\82½\82ç\8fã\89º\82à\82\82»\82à\96³\82¢\82©\82ç 0 \82Í\8aÜ\82Ü\82¸
1548                                         if FDat[ 0 ] = FDat[ i ] then
1549                                                 FDat.Delete( i );
1550                                 // \95Û\91¶
1551                                 FDat.SaveToFile( FilePath );
1552
1553                                 IsLogFile                       := True;
1554                                 RoundDate                       := Now;
1555                                 LastModified    := modified;
1556                                 LastGetTime             := Now;
1557                         finally
1558                                 uri.Free;
1559                                 uriList.Free;
1560                         end;
1561                         Result := dsComplete;
1562                 end;
1563         finally
1564                 DisposeResultString( downResult );
1565         end;
1566
1567 end;
1568
1569 // *************************************************************************
1570 // \83X\83\8c\97§\82Ä\82ð\8ew\8e¦\82³\82ê\82½
1571 // *************************************************************************
1572 function        TShitarabaBoardItem.CreateThread(
1573         inSubject                       : string;       // \83X\83\8c\83^\83C
1574         inName                          : string;       // \96¼\91O(\83n\83\93\83h\83\8b)
1575         inMail                          : string;       // \83\81\81[\83\8b\83A\83h\83\8c\83X
1576         inMessage                       : string        // \96{\95¶
1577 ) : TDownloadState;                             // \8f\91\82«\8d\9e\82Ý\82ª\90¬\8c÷\82µ\82½\82©\82Ç\82¤\82©
1578 var
1579         postURL                         : string;
1580         postData                        : string;
1581         postResult              : PChar;
1582         uri                                             : TIdURI;
1583         uriList                         : TStringList;
1584         responseCode    : Integer;
1585 begin
1586
1587         uri                     := TIdURI.Create( URL );
1588         uriList := TStringList.Create;
1589         try
1590                 ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
1591
1592                 // http://jbbs.livedoor.com/bbs/write.cgi/game/1578/new/
1593                 // http://jbbs.livedoor.com/game/1000/subject.txt
1594                 postURL         :=
1595                         uri.Protocol + '://' + uri.Host + '/bbs/write.cgi/' +
1596                         uriList[ 1 ] + '/' + uriList[ 2 ] + '/new/';
1597                 postData        :=
1598                         'SUBJECT='      + HttpEncode( SJIStoEUC( inSubject ) ) +
1599                         '&NAME='                + HttpEncode( SJIStoEUC( inName ) ) +
1600                         '&MAIL='                + HttpEncode( SJIStoEUC( inMail ) ) +
1601                         '&MESSAGE='     + HttpEncode( SJIStoEUC( inMessage ) ) +
1602                         '&BBS='                 + uriList[ 4 ] +
1603                         '&DIR='                 + uriList[ 3 ] +
1604                         '&TIME='                + IntToStr( DateTimeToUnix( Now ) ) +
1605                         '&submit='      + HttpEncode( SJIStoEUC( '\90V\8bK\8f\91\82«\8d\9e\82Ý' ) );
1606
1607                 // \93Æ\8e©\82É\92Ê\90M\82µ\82È\82¢\8fê\8d\87\82Í InternalPost \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
1608                 responseCode := InternalPost( PChar( postURL ), PChar( postData ), postResult );
1609                 try
1610                         if (responseCode = 200) or
1611                                 ((responseCode = 302) and (Length( Trim( postResult ) ) = 0)) then begin
1612                                 Result := dsComplete
1613                         end else begin
1614                                 Result := dsError;
1615                                 if Assigned( InternalPrint ) then
1616                                         InternalPrint( postResult );
1617                         end;
1618                 finally
1619                         DisposeResultString( postResult );
1620                 end;
1621         finally
1622                 uri.Free;
1623                 uriList.Free;
1624         end;
1625
1626 end;
1627
1628 // *************************************************************************
1629 // \83X\83\8c\88ê\97\97\82Ì URL \82©\82ç\83X\83\8c\83b\83h\82Ì URL \82ð\93±\82«\8fo\82·
1630 // *************************************************************************
1631 function TShitarabaBoardItem.ToThreadURL(
1632         inFileName      : string        // \83X\83\8c\83b\83h\83t\83@\83C\83\8b\96¼
1633 ) : string;                                                     // \83X\83\8c\83b\83h\82Ì URL
1634 var
1635         threadURL               : string;
1636         uri                                     : TIdURI;
1637         uriList                 : TStringList;
1638         found                           : Integer;
1639 begin
1640
1641         found := AnsiPos( '.', inFileName );
1642         if found > 0 then
1643                 inFileName := Copy( inFileName, 1, found - 1 );
1644
1645         uri                     := TIdURI.Create( SubjectURL );
1646         uriList := TStringList.Create;
1647         try
1648                 try
1649                         ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
1650                         threadURL       := uri.Protocol + '://' + uri.Host + '/bbs/read.cgi/' +
1651                                 uriList[ 1 ] + '/' + uriList[ 2 ] + '/' + inFileName + '/l100';
1652                         Result          := threadURL;
1653                 finally
1654                         uri.Free;
1655                         uriList.Free;
1656                 end;
1657         except
1658                 Result := '';
1659         end;
1660
1661 end;
1662
1663 // *************************************************************************
1664 // \82±\82Ì\94Â\82É\82¢\82\82Â\82Ì\83X\83\8c\82ª\82 \82é\82©\97v\8b\81\82³\82ê\82½
1665 // *************************************************************************
1666 procedure       TShitarabaBoardItem.EnumThread(
1667         inCallBack      : TBoardItemEnumThreadCallBack
1668 );
1669 var
1670         uri                                     : TIdURI;
1671         uriList                 : TStringList;
1672 begin
1673
1674         try
1675                 if FDat = nil then begin
1676                         FDat            := TStringList.Create;
1677                         uri                     := TIdURI.Create( SubjectURL );
1678                         uriList := TStringList.Create;
1679                         try
1680                                 // \83p\83X\82ð\8eZ\8fo
1681                                 ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
1682                                 // http://jbbs.livedoor.com/game/1000/subject.txt
1683                                 FilePath        := MyLogFolder + uriList[ 1 ] + '\' + uriList[ 2 ] + '\' + uri.Document;
1684                                 if FileExists( FilePath ) then
1685                                         // \93Ç\82Ý\8d\9e\82Ý
1686                                         FDat.LoadFromFile( FilePath );
1687                         finally
1688                                 uri.Free;
1689                                 uriList.Free;
1690                         end;
1691                 end;
1692
1693                 // \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é
1694                 inherited EnumThread( inCallBack, CustomStringReplace( FDat.Text, ',', '<>' ) );
1695         except
1696         end;
1697
1698 end;
1699
1700 // *************************************************************************
1701 // \83X\83\8c\88ê\97\97\82Ì URL \82ð\8b\81\82ß\82é
1702 // *************************************************************************
1703 function        TShitarabaBoardItem.SubjectURL : string;
1704 var
1705         uri                     : TIdURI;
1706         uriList : TStringList;
1707 begin
1708
1709         uri                     := TIdURI.Create( URL );
1710         uriList := TStringList.Create;
1711         try
1712                 if uri.Document <> SUBJECT_NAME then begin
1713                         if Copy( URL, Length( URL ), 1 ) = '/' then
1714                                 Result := URL + SUBJECT_NAME
1715                         else
1716                                 Result := URL + '/' + SUBJECT_NAME;
1717                 end else begin
1718                         // \82±\82±\82É\82Í\97\88\82È\82¢\82Æ\8ev\82¤\82¯\82Ç
1719                         Result := URL;
1720                 end;
1721         finally
1722                 uri.Free;
1723                 uriList.Free;
1724         end;
1725
1726 end;
1727
1728 // *************************************************************************
1729 // TBoardItem \82ª\90¶\90¬\82³\82ê\82½\8fê\8d\87\82Ì\8f\88\92u(TShitarabaBoardItem \82ð\90¶\90¬\82·\82é)
1730 // *************************************************************************
1731 procedure BoardItemOnCreateOfTShitarabaBoardItem(
1732         inInstance : DWORD
1733 );
1734 var
1735         boardItem : TShitarabaBoardItem;
1736 begin
1737
1738         boardItem := TShitarabaBoardItem.Create( inInstance );
1739         BoardItemSetLong( inInstance, bipContext, DWORD( boardItem ) );
1740
1741 end;
1742
1743 // *************************************************************************
1744 // TBoardItem \82ª\94j\8aü\82³\82ê\82½\8fê\8d\87\82Ì\8f\88\92u(TShitarabaBoardItem \82ð\94j\8aü\82·\82é)
1745 // *************************************************************************
1746 procedure BoardItemOnDisposeOfTShitarabaBoardItem(
1747         inInstance : DWORD
1748 );
1749 var
1750         boardItem : TShitarabaBoardItem;
1751 begin
1752
1753         boardItem := TShitarabaBoardItem( BoardItemGetLong( inInstance, bipContext ) );
1754         boardItem.Free;
1755
1756 end;
1757
1758
1759
1760 // =========================================================================
1761 // \83G\83\93\83g\83\8a\83|\83C\83\93\83g
1762 // =========================================================================
1763 procedure DLLEntry(
1764         ul_reason_for_call : DWORD
1765 );
1766 var
1767         module : HMODULE;
1768 begin
1769
1770         case ul_reason_for_call of
1771                 DLL_PROCESS_ATTACH:
1772                 begin
1773                         Randomize;
1774
1775                         module := GetModuleHandle( nil );
1776
1777                         LoadInternalAPI( module );
1778                         LoadInternalFilePathAPI( module );
1779                         LoadInternalThreadItemAPI( module );
1780                         LoadInternalBoardItemAPI( module );
1781
1782                         // ===== \83C\83\93\83X\83^\83\93\83X\82Ì\8eæ\82è\88µ\82¢\82ð TThreadItem \82©\82ç TShitarabaThreadItem \82É\95Ï\8dX\82·\82é
1783                         ThreadItemOnCreate      := ThreadItemOnCreateOfTShitarabaThreadItem;
1784                         ThreadItemOnDispose     := ThreadItemOnDisposeOfTShitarabaThreadItem;
1785                         // ===== \83C\83\93\83X\83^\83\93\83X\82Ì\8eæ\82è\88µ\82¢\82ð TBoardItem \82©\82ç TShitarabaBoardItem \82É\95Ï\8dX\82·\82é
1786                         BoardItemOnCreate               := BoardItemOnCreateOfTShitarabaBoardItem;
1787                         BoardItemOnDispose      := BoardItemOnDisposeOfTShitarabaBoardItem;
1788                 end;
1789                 DLL_PROCESS_DETACH:
1790                 begin
1791                         RemovePlugInMenu( SyncronizeMenu );
1792                 end;
1793                 DLL_THREAD_ATTACH:
1794                         ;
1795                 DLL_THREAD_DETACH:
1796                         ;
1797         end;
1798
1799 end;
1800
1801 exports
1802         OnLoad,
1803         OnVersionInfo,
1804         OnAcceptURL,
1805         OnPlugInMenu;
1806
1807 begin
1808
1809         try
1810                 DllProc := @DLLEntry;
1811                 DLLEntry( DLL_PROCESS_ATTACH );
1812         except end;
1813
1814 end.