res/ExternalBoardPlugIn/MachiBBSPlugIn.dpr

   1 library MachiBBSPlugIn;
   2
   3 {
   4         MachiBBSBoardPlugIn
   5         \82Ü\82¿BBS\8f\88\97\9d\83\86\83j\83b\83g
   6 }
   7
   8 uses
   9         Windows, SysUtils, Classes, Math, DateUtils,
  10         IdURI,
  11         PlugInMain in 'PlugInMain.pas',
  12         ThreadItem in 'ThreadItem.pas',
  13         BoardItem in 'BoardItem.pas',
  14         FilePath in 'FilePath.pas',
  15     MojuUtils in '..\..\MojuUtils.pas';
  16
  17 {$R *.res}
  18
  19 type
  20         // =========================================================================
  21         // TMachiBBSThreadItem
  22         // =========================================================================
  23         TMachiBBSThreadItem = class(TThreadItem)
  24         private
  25                 FIsTemporary    : Boolean;
  26                 FDat                                    : TStringList;
  27                 //FFilePath             : String;
  28         public
  29                 constructor     Create( inInstance : DWORD );
  30                 destructor      Destroy; override;
  31
  32         private
  33                 function        Download : TDownloadState;
  34                 function        Write( inName : string; inMail : string; inMessage : string ) : TDownloadState;
  35                 function        GetRes( inNo : Integer ) : string;
  36                 function        GetDat( inNo : Integer ) : string;
  37                 function        GetHeader( inOptionalHeader : string ) : string;
  38                 function        GetFooter( inOptionalFooter : string ) : string;
  39                 function        GetBoardURL : string;
  40
  41                 procedure       To2chDat( ioHTML : TStringList; inStartNo : Integer = 1 );
  42                 procedure       LoadDat;
  43                 procedure       FreeDat;
  44                 function        ReadURL : string;
  45                 //property      FilePath : string read FFilePath;
  46         end;
  47
  48         // =========================================================================
  49         // TMachiBBSBoardItem
  50         // =========================================================================
  51         TMachiBBSBoardItem = class(TBoardItem)
  52         private
  53                 FIsTemporary    : Boolean;
  54                 FDat                                    : TStringList;
  55
  56         public
  57                 constructor     Create( inInstance : DWORD );
  58                 destructor      Destroy; override;
  59
  60         private
  61                 function        Download : TDownloadState;
  62                 function        CreateThread( inSubject : string; inName : string; inMail : string; inMessage : string ) : TDownloadState;
  63                 function        ToThreadURL( inFileName : string ) : string;
  64                 procedure       EnumThread( inCallBack : TBoardItemEnumThreadCallBack );
  65
  66                 function        SubjectURL : string;
  67         end;
  68
  69         // =========================================================================
  70         // \83T\83u\83W\83F\83N\83g\83\8c\83R\81[\83h
  71         // =========================================================================
  72         TSubjectRec = record
  73                 FFileName: string;
  74                 FTitle: string;
  75                 FCount: Integer;
  76         end;
  77
  78 const
  79         LOG_DIR                                         = 'MachiBBS\';
  80         SUBJECT_NAME                    = 'subject.txt';
  81
  82         PLUGIN_NAME                             = 'MachiBBSPlugIn';
  83         MAJOR_VERSION                   = 1;
  84         MINOR_VERSION                   = 0;
  85         RELEASE_VERSION         = 'beta';
  86         REVISION_VERSION        = 22;
  87
  88 // =========================================================================
  89 // \8eG\97p\8aÖ\90\94
  90 // =========================================================================
  91
  92 // *************************************************************************
  93 // \83e\83\93\83|\83\89\83\8a\82È\83p\83X\82Ì\8eæ\93¾
  94 // *************************************************************************
  95 function TemporaryFile : string;
  96 var
  97         tempPath : array [0..MAX_PATH] of       char;
  98 begin
  99
 100         GetTempPath( SizeOf(tempPath), tempPath );
 101         repeat
 102                 Result := tempPath + IntToStr( Random( $7fffffff ) );
 103         until not FileExists( Result );
 104
 105 end;
 106
 107 // *************************************************************************
 108 // \82Ü\82¿BBS\97p\83\8d\83O\83t\83H\83\8b\83_\8eæ\93¾
 109 // *************************************************************************
 110 function MyLogFolder : string;
 111 var
 112         folder : PChar;
 113 begin
 114
 115         folder := LogFolder;
 116         if Length( folder ) = 0 then
 117                 Result := ''
 118         else
 119                 Result := folder + LOG_DIR;
 120     DisposeResultString(folder);
 121
 122 end;
 123
 124 (*************************************************************************
 125  *\83f\83B\83\8c\83N\83g\83\8a\82ª\91¶\8dÝ\82·\82é\82©\83`\83F\83b\83N
 126  *************************************************************************)
 127 function DirectoryExistsEx(const Name: string): Boolean;
 128 var
 129         Code: Integer;
 130 begin
 131         Code := GetFileAttributes(PChar(Name));
 132         Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
 133 end;
 134
 135 (*************************************************************************
 136  *\83f\83B\83\8c\83N\83g\83\8a\8dì\90¬\81i\95¡\90\94\8aK\91w\91Î\89\9e\81j
 137  *************************************************************************)
 138 function ForceDirectoriesEx(Dir: string): Boolean;
 139 begin
 140         Result := True;
 141         if Length(Dir) = 0 then
 142                 raise Exception.Create('\83t\83H\83\8b\83_\82ª\8dì\90¬\8fo\97\88\82Ü\82¹\82ñ');
 143         Dir := ExcludeTrailingPathDelimiter(Dir);
 144         if (Length(Dir) < 3) or DirectoryExistsEx(Dir)
 145                 or (ExtractFilePath(Dir) = Dir) then Exit; // avoid 'xyz:\' problem.
 146         Result := ForceDirectoriesEx(ExtractFilePath(Dir)) and CreateDir(Dir);
 147 end;
 148
 149 // \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
 150 procedure ExtractHttpFields(
 151         const chrSep : TSysCharSet;
 152         const chrWhite : TSysCharSet;
 153         const strValue : string;
 154         var strResult : TStringList;
 155         unknownFlag : boolean = false
 156 );
 157 var
 158         last, p, strLen : Integer;
 159 begin
 160
 161         strLen := Length( strValue );
 162         p := 1;
 163         last := 1;
 164
 165         while p <= strLen do
 166         begin
 167
 168                 if strValue[ p ] in chrSep then
 169                 begin
 170                         strResult.Add( Copy( strValue, last, p - last ) );
 171                         last := p + 1;
 172                 end;
 173
 174                 p := p + 1;
 175
 176         end;
 177
 178         if last <> p then
 179                 strResult.Add( Copy( strValue, last, strLen - last + 1 ) );
 180
 181 end;
 182
 183 \rfunction HttpEncode(
 184 \r       const strValue : string
 185 ) : string;
 186 var
 187         i : Integer;
 188         strLen : Integer;
 189         strResult : string;
 190         b : Integer;
 191 const
 192         kHexCode : array [0..15] of char = (
 193                                 '0', '1', '2', '3', '4', '5', '6', '7',
 194                                 '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' );
 195 begin
 196
 197         strLen := Length( strValue );
 198         i := 1;
 199
 200         while i <= strLen do
 201         begin
 202
 203                 case strValue[ i ] of
 204                 '0' .. '9', 'a' .. 'z', 'A' .. 'Z', '*', '-', '.', '@', '_':
 205                         begin
 206                                 strResult := strResult + strValue[ i ];
 207                         end;
 208                 else
 209                         begin
 210                                 b := Integer( strValue[ i ] );
 211                                 strResult := strResult + '%'
 212                                                                 + kHexCode[ b div $10 ]
 213                                                                 + kHexCode[ b mod $10 ];
 214                         end;
 215                 end;
 216
 217                 i := i + 1;
 218
 219         end;
 220
 221         Result := strResult;
 222
 223 end;
 224
 225
 226
 227 // =========================================================================
 228 // PlugIn
 229 // =========================================================================
 230
 231 // *************************************************************************
 232 // \83v\83\89\83O\83C\83\93\82Ì\83o\81[\83W\83\87\83\93\82ð\97v\8b\81\82³\82ê\82½
 233 // *************************************************************************
 234 procedure OnVersionInfo(
 235         var outAgent            : PChar;        // \83o\81[\83W\83\87\83\93\82ð\88ê\90Ø\8aÜ\82Ü\82È\82¢\8f\83\90\88\82È\96¼\8fÌ
 236         var outMajor            : DWORD;        // \83\81\83W\83\83\81[\83o\81[\83W\83\87\83\93
 237         var outMinor            : DWORD;        // \83}\83C\83i\81[\83o\81[\83W\83\87\83\93
 238         var outRelease  : PChar;        // \83\8a\83\8a\81[\83X\92i\8aK\96¼
 239         var outRevision : DWORD         // \83\8a\83r\83W\83\87\83\93\83i\83\93\83o\81[
 240 ); stdcall;
 241 begin
 242
 243         try
 244                 outAgent                := CreateResultString( PChar( PLUGIN_NAME ) );
 245                 outMajor                := MAJOR_VERSION;
 246                 outMinor                := MINOR_VERSION;
 247                 outRelease      := CreateResultString( PChar( RELEASE_VERSION ) );
 248                 outRevision     := REVISION_VERSION;
 249         except
 250                 outAgent                := nil;
 251                 outMajor                := 0;
 252                 outMinor                := 0;
 253                 outRelease      := nil;
 254                 outRevision     := 0;
 255         end;
 256
 257 end;
 258
 259 // *************************************************************************
 260 // \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©
 261 // *************************************************************************
 262 function OnAcceptURL(
 263         inURL                   : PChar                         // \94»\92f\82ð\8bÂ\82¢\82Å\82¢\82é URL
 264 ): TAcceptType; stdcall;        // URL \82Ì\8eí\97Þ
 265 var
 266         uri                             : TIdURI;
 267         uriList         : TStringList;
 268         foundPos        : Integer;
 269 const
 270         BBS_HOST                = 'machi.to';
 271         BBS_HOST2               = 'machibbs.com';
 272         THREAD_MARK     = '/bbs/read.pl';
 273     THREAD_MARK2= '/bbs/read.cgi';
 274 begin
 275
 276         try
 277                 // \83z\83X\83g\96¼\82ª machi.to \82Å\8fI\82í\82é\8fê\8d\87\82Í\8eó\82¯\95t\82¯\82é\82æ\82¤\82É\82µ\82Ä\82¢\82é
 278                 uri                     := TIdURI.Create( inURL );
 279                 uriList := TStringList.Create;
 280                 try
 281                         ExtractHttpFields( ['/'], [], uri.Path, uriList );
 282                         foundPos := AnsiPos( BBS_HOST, uri.Host );
 283                         if (foundPos > 0) and (Length( uri.Host ) - foundPos + 1 = Length( BBS_HOST )) then begin
 284                                 foundPos := Pos( THREAD_MARK, inURL );
 285                 if (foundPos = 0) then begin
 286                     // \90VURL\91Î\89\9e
 287                     foundPos := Pos( THREAD_MARK2, inURL );
 288                 end;
 289                                 if foundPos > 0 then
 290                                         Result := atThread
 291                                 else if (uriList.Count > 1) and (uri.Path <> '/') then  // \8dÅ\8cã\82ª '/' \82Å\95Â\82ß\82ç\82ê\82Ä\82é\82È\82ç 3
 292                                         Result := atBoard
 293                                 else
 294                                         Result := atBBS;
 295                         end else begin
 296                 foundPos := AnsiPos( BBS_HOST2, uri.Host );
 297                 if (foundPos > 0) and (Length( uri.Host ) - foundPos + 1 = Length( BBS_HOST2 )) then begin
 298                     foundPos := Pos( THREAD_MARK, inURL );
 299                     if (foundPos = 0) then begin
 300                         // \90VURL\91Î\89\9e
 301                         foundPos := Pos( THREAD_MARK2, inURL );
 302                     end;
 303                     if foundPos > 0 then
 304                         Result := atThread
 305                     else if (uriList.Count > 1) and (uri.Path <> '/') then      // \8dÅ\8cã\82ª '/' \82Å\95Â\82ß\82ç\82ê\82Ä\82é\82È\82ç 3
 306                         Result := atBoard
 307                     else
 308                         Result := atBBS;
 309                 end else begin
 310
 311                     Result := atNoAccept;
 312                 end;
 313                         end;
 314                 finally
 315                         uri.Free;
 316                         uriList.Free;
 317                 end;
 318         except
 319                 Result := atNoAccept;
 320         end;
 321
 322 end;
 323
 324 // *************************************************************************
 325 // \8ew\92è\82µ\82½ URL \82ðBoard\82ÌURL\82É\95Ï\8a·
 326 // *************************************************************************
 327 procedure OnExtractBoardURL(
 328         inURL   : PChar;
 329         var outURL      : PChar
 330 ); stdcall;
 331 var
 332         uri                     : TIdURI;
 333         uriList         : TStringList;
 334         URL         : String;
 335 const
 336         THREAD_MARK     = '/bbs/read.pl';
 337     THREAD_MARK2= '/bbs/read.cgi';
 338 begin
 339         URL := string(inURL);
 340         if AnsiPos(THREAD_MARK, URL) > 0 then begin
 341                 if Copy( inURL, Length( inURL ), 1 ) = '/' then
 342                         uri := TIdURI.Create( URL )
 343                 else
 344                         uri := TIdURI.Create( URL + '/' );
 345
 346                 uriList := TStringList.Create;
 347                 try
 348                         ExtractHttpFields(
 349                                 ['&'], [],
 350                                 Copy( uri.Params, AnsiPos( '?', uri.Params ) + 1, Length( uri.Params ) ),uriList );
 351                         // http://hokkaido.machi.to/bbs/read.pl?BBS=hokkaidou&KEY=1061764446
 352                         // http://hokkaido.machi.to/hokkaidou/
 353                         URL := uri.Protocol + '://' + uri.Host + '/' + uriList.Values[ 'BBS' ] + '/';
 354                         outURL := CreateResultString(URL);
 355                 finally
 356                         uri.Free;
 357                         uriList.Free;
 358                 end;
 359     end else if AnsiPos(THREAD_MARK2, URL) > 0 then begin
 360                 if Copy( inURL, Length( inURL ), 1 ) = '/' then
 361                         uri := TIdURI.Create( URL )
 362                 else
 363                         uri := TIdURI.Create( URL + '/' );
 364
 365         uriList := TStringList.Create;
 366                 try
 367                         // http://kanto.machi.to/bbs/read.cgi/kana/1215253035/l50
 368                         // http://kanto.machi.to/kana/
 369             uriList.Delimiter := '/';
 370             uriList.DelimitedText  := uri.Path;
 371                         URL := uri.Protocol + '://' + uri.Host + '/';
 372             if (uriList.Count >= 4) then begin
 373                 URL := URL + uriList[3] + '/';
 374             end;
 375                         outURL := CreateResultString(URL);
 376                 finally
 377                         uri.Free;
 378             uriList.Free;
 379                 end;
 380         end else begin
 381         outURL := CreateResultString(URL);
 382         end;
 383
 384 end;
 385
 386
 387 // =========================================================================
 388 // TMachiBBSThreadItem
 389 // =========================================================================
 390
 391 // *************************************************************************
 392 // \83R\83\93\83X\83g\83\89\83N\83^
 393 // *************************************************************************
 394 constructor TMachiBBSThreadItem.Create(
 395         inInstance      : DWORD
 396 );
 397 var
 398         uri                                     : TIdURI;
 399         uriList                 : TStringList;
 400         FilePath                : String;
 401 begin
 402
 403         inherited;
 404
 405         OnDownload              := Download;
 406         OnWrite                         := Write;
 407         OnGetRes                        := GetRes;
 408         OnGetDat                        := GetDat;
 409         OnGetHeader             := GetHeader;
 410         OnGetFooter             := GetFooter;
 411         OnGetBoardURL   := GetBoardURL;
 412
 413         //FFilePath                     := '';
 414         FIsTemporary    := False;
 415         FDat                                    := nil;
 416         URL                                             := ReadURL + '&LAST=50';
 417
 418         uri                     := TIdURI.Create( URL );
 419         uriList := TStringList.Create;
 420         try
 421                 // http://hokkaido.machi.to/bbs/read.pl?BBS=hokkaidou&KEY=1061764446&LAST=50
 422                 ExtractHttpFields(
 423                         ['&'], [],
 424                         Copy( uri.Params, AnsiPos( '?', uri.Params ) + 1, Length( uri.Params ) ), uriList );
 425                 FileName        := uriList.Values[ 'KEY' ] + '.dat';
 426                 FilePath        := MyLogFolder + uriList.Values[ 'BBS' ] + '\' + uriList.Values[ 'KEY' ] + '.dat';
 427                 IsLogFile       := FileExists( FilePath );
 428         finally
 429                 uri.Free;
 430                 uriList.Free;
 431         end;
 432
 433 end;
 434
 435 // *************************************************************************
 436 // \83f\83X\83g\83\89\83N\83^
 437 // *************************************************************************
 438 destructor TMachiBBSThreadItem.Destroy;
 439 begin
 440
 441         FreeDat;
 442
 443         // \88ê\8e\9e\83t\83@\83C\83\8b\82Ì\8fê\8d\87\82Í\8dí\8f\9c\82·\82é
 444         if FIsTemporary then
 445                 DeleteFile( FilePath );
 446
 447         inherited;
 448
 449 end;
 450
 451 // *************************************************************************
 452 // \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½
 453 // *************************************************************************
 454 function TMachiBBSThreadItem.Download : TDownloadState;
 455 var
 456         modified                        : Double;
 457         tmp                                             : PChar;
 458         downResult              : TStringList;
 459         content                         : TStringList;
 460         responseCode    : Longint;
 461         logStream                       : TFileStream;
 462         uri                                             : TIdURI;
 463         uriList                         : TStringList;
 464         datURL                          : string;
 465         foundPos                        : Integer;
 466         FilePath                        : String;
 467         procedure       downAndParse;
 468         begin
 469                 responseCode := InternalDownload( PChar( datURL ), modified, tmp, 0 );
 470
 471                 try
 472                         if responseCode = 200 then begin
 473                                 downResult      := TStringList.Create;
 474                                 try
 475                                         downResult.Text := string( tmp );
 476
 477                                         // \83^\83C\83g\83\8b\82Ì\8eæ\93¾
 478                                         foundPos                                := AnsiPos( '<title>', downResult.Text ) + Length( '<title>' );
 479                                         Title                                           := Copy(
 480                                                 downResult.Text,
 481                                                 foundPos,
 482                                                 AnsiPos( '</title>', downResult.Text ) - foundPos );
 483
 484                                         // \83\8c\83X\82Ì\8aJ\8en\88Ê\92u
 485                                         foundPos                                := AnsiPos( '<dt', downResult.Text );
 486                                         downResult.Text := Copy( downResult.Text, foundPos, Length( downResult.Text ) );
 487                                         if foundPos > 0 then begin
 488                                                 // \83\8c\83X\82Ì\8fI\97¹\88Ê\92u
 489                                                 foundPos := AnsiPos( '<table', downResult.Text ) - 1;
 490                                                 if foundPos > 0 then
 491                                                         downResult.Text := Copy( downResult.Text, 1, foundPos );
 492                                                 // \82Ü\82¿BBS\82Í dat \92¼\93Ç\82Ý\82ª\8fo\97\88\82È\82¢\82µ\81Acgi \88È\8aO\82É\8d·\95ª\93Ç\82Ý\8d\9e\82Ý\82Ì\95û\96@\82ª\82 \82é\82í\82¯\82Å\82à\96³\82¢\82Ì\82Å
 493                                                 // \91f\82Ì\82Ü\82Ü\82ð\96³\97\9d\82É\95Û\82Æ\82¤\82Æ\82Í\82¹\82¸\82É 2ch \82Ì dat \8c`\8e®\82É\95Ï\8a·\82µ\82½\82à\82Ì\82ð\95Û\91¶\82µ\82Ä\82µ\82Ü\82¤
 494                                                 To2chDat( downResult, Count + 1 );
 495                                                 content.Text := content.Text + downResult.Text;
 496                                         end;
 497                                 finally
 498                                         downResult.Free;
 499                                 end;
 500                         end else begin
 501                                 Result := dsNotModify;
 502                                 Exit;
 503                         end;
 504                 finally
 505                         DisposeResultString( tmp );
 506                 end;
 507         end;
 508 begin
 509
 510         Result := dsError;
 511
 512         uri                     := TIdURI.Create( URL );
 513         uriList := TStringList.Create;
 514         content := TStringList.Create;
 515         try
 516                 ExtractHttpFields(
 517                         ['&'], [],
 518                         Copy( uri.Params, AnsiPos( '?', uri.Params ) + 1, Length( uri.Params ) ), uriList );
 519                 FileName := uriList.Values[ 'KEY' ] + '.dat';
 520                 if MyLogFolder = '' then begin
 521                         // \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¶
 522                         FilePath                        := TemporaryFile;
 523                         FIsTemporary    := True;
 524                 end else begin
 525                         FilePath        := MyLogFolder + uriList.Values[ 'BBS' ] + '\' + uriList.Values[ 'KEY' ] + '.dat';
 526                         FIsTemporary    := False;
 527                 end;
 528
 529                 // \95Û\91¶\97p\82Ì\83f\83B\83\8c\83N\83g\83\8a\82ð\8c@\82é
 530                 ForceDirectoriesEx( Copy( FilePath, 1, LastDelimiter( '\', FilePath ) ) );
 531
 532                 // \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Í
 533                 // InternalDownload \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
 534                 modified        := LastModified;
 535                 if Count = 0 then
 536                         // 1\81`
 537                         datURL          :=
 538                                 uri.Protocol + '://' + uri.Host + '/bbs/read.cgi?' +
 539                                 'BBS=' + uriList.Values[ 'BBS' ] + '&KEY=' + uriList.Values[ 'KEY' ] +
 540                                 '&START=' + IntToStr( 1 )
 541                 else
 542                         // \90V\92\85\82Ì\82Ý
 543                         datURL          :=
 544                                 uri.Protocol + '://' + uri.Host + '/bbs/read.cgi?' +
 545                                 'BBS=' + uriList.Values[ 'BBS' ] + '&KEY=' + uriList.Values[ 'KEY' ] +
 546                                 '&START=' + IntToStr( Count + 1 ) + '&NOFIRST=TRUE';
 547                 // \83_\83E\83\93\83\8d\81[\83h
 548                 downAndParse;
 549
 550                 if content.Count > 0 then begin
 551                         if Count <= 0 then begin
 552                                 Result := dsComplete;
 553                                 // \90V\8bK\8f\91\82«\8d\9e\82Ý
 554                                 content[ 0 ]    := content[ 0 ] + Title;
 555                                 logStream                       := TFileStream.Create( FilePath, fmCreate or fmShareDenyWrite );
 556                                 try
 557                                         logStream.Position      := logStream.Size;
 558                                         logStream.Write( PChar( content.Text )^, Length( content.Text ) );
 559                                 finally
 560                                         logStream.Free;
 561                                 end;
 562                                 NewReceive      := 1;
 563                                 Count                           := content.Count;
 564                         end else begin
 565                 if (content.Count > 1) or (Trim(content.Text) <> '') then begin
 566                                 Result := dsDiffComplete;
 567                     // \92Ç\8bL
 568                     logStream := TFileStream.Create( FilePath, fmOpenReadWrite or fmShareDenyWrite );
 569                     try
 570                         logStream.Position      := logStream.Size;
 571                         logStream.Write( PChar( content.Text )^, Length( content.Text ) );
 572                     finally
 573                         logStream.Free;
 574                     end;
 575                     NewReceive  := Count + 1;
 576                     Count                               := Count + content.Count;
 577                 end else begin
 578                     Result := dsNotModify;
 579                 end;
 580                         end;
 581             if (Result <> dsNotModify) then begin
 582                         // CGI \82©\82ç\82Í\90³\82µ\82¢\93ú\95t\82ª\93¾\82ç\82ê\82È\82¢\82Ì\82Å\8c»\8dÝ\82É\90Ý\92è
 583                         LastModified    := Now;
 584                         NewResCount             := content.Count;
 585             end;
 586                 end else begin
 587                         Result := dsNotModify;
 588                 end;
 589         finally
 590                 uri.Free;
 591                 uriList.Free;
 592                 content.Free;
 593         end;
 594
 595 end;
 596
 597 // *************************************************************************
 598 // \8f\91\82«\8d\9e\82Ý\82ð\8ew\8e¦\82³\82ê\82½
 599 // *************************************************************************
 600 function        TMachiBBSThreadItem.Write(
 601         inName                          : string;       // \96¼\91O(\83n\83\93\83h\83\8b)
 602         inMail                          : string;       // \83\81\81[\83\8b\83A\83h\83\8c\83X
 603         inMessage                       : string        // \96{\95¶
 604 ) : TDownloadState;                             // \8f\91\82«\8d\9e\82Ý\82ª\90¬\8c÷\82µ\82½\82©\82Ç\82¤\82©
 605 var
 606         postURL                         : string;
 607         postData                        : string;
 608         postResult              : PChar;
 609         uri                                             : TIdURI;
 610         uriList                         : TStringList;
 611 begin
 612
 613         uri                     := TIdURI.Create( URL );
 614         uriList := TStringList.Create;
 615         try
 616                 ExtractHttpFields(
 617                         ['&'], [],
 618                         Copy( uri.Params, AnsiPos( '?', uri.Params ) + 1, Length( uri.Params ) ), uriList );
 619
 620                 postURL         := uri.Protocol + '://' + uri.Host + '/bbs/write.cgi';
 621                 postData        :=
 622                         'NAME='                 + HttpEncode( inName ) +
 623                         '&MAIL='                + HttpEncode( inMail ) +
 624                         '&MESSAGE='     + HttpEncode( inMessage ) +
 625                         '&BBS='                 + uriList.Values[ 'BBS' ] +
 626                         '&KEY='                 + uriList.Values[ 'KEY' ] +
 627                         '&TIME='                + IntToStr( DateTimeToUnix( Now ) ) +
 628                         '&submit='      + HttpEncode( '\8f\91\82«\8d\9e\82Þ' );
 629
 630                 // \93Æ\8e©\82É\92Ê\90M\82µ\82È\82¢\8fê\8d\87\82Í InternalPost \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
 631                 InternalPost( PChar( postURL ), PChar( postData ),PChar(URL), postResult );
 632                 DisposeResultString( postResult );
 633
 634                 Result := dsComplete
 635         finally
 636                 uri.Free;
 637                 uriList.Free;
 638         end;
 639
 640 end;
 641
 642 // *************************************************************************
 643 // \83\8c\83X\94Ô\8d\86 inNo \82É\91Î\82·\82é html \82ð\97v\8b\81\82³\82ê\82½
 644 // *************************************************************************
 645 function TMachiBBSThreadItem.GetRes(
 646         inNo            : Integer               // \97v\8b\81\82³\82ê\82½\83\8c\83X\94Ô\8d\86
 647 ) : string;                                             // \91Î\89\9e\82·\82é HTML
 648 var
 649         res                     : string;
 650         tmp                     : PChar;
 651 begin
 652
 653         // \93Æ\8e©\82É\83t\83B\83\8b\83^\83\8a\83\93\83O\82ð\8ds\82í\82È\82¢\8fê\8d\87\82Í
 654         // InternalAbon \82¨\82æ\82Ñ Dat2HTML \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
 655         LoadDat;
 656         if (FDat = nil) or (inNo - 1 < 0 ) or (inNo - 1 >= FDat.Count) then begin
 657                 // \83\8d\83O\82É\91¶\8dÝ\82µ\82È\82¢\82Ì\82Å\82±\82Ì\82Ü\82Ü\8fI\97¹
 658                 Result := '';
 659                 Exit;
 660         end;
 661         res                     := FDat[ inNo - 1 ];
 662         tmp                     := InternalAbonForOne( PChar( res ), PChar(FilePath), inNo);
 663     try
 664                 Result  := Dat2HTML( string( tmp ), inNo );
 665         finally
 666                 DisposeResultString( tmp );
 667         end;
 668
 669 end;
 670
 671 // *************************************************************************
 672 // \83\8c\83X\94Ô\8d\86 inNo \82É\91Î\82·\82é Dat \82ð\97v\8b\81\82³\82ê\82½
 673 // *************************************************************************
 674 function TMachiBBSThreadItem.GetDat(
 675         inNo            : Integer               // \97v\8b\81\82³\82ê\82½\83\8c\83X\94Ô\8d\86
 676 ) : string;                                             // \82Q\82¿\82á\82ñ\82Ë\82é\82ÌDat\8c`\8e®
 677 var
 678         //res: string;
 679         tmp: PChar;
 680 begin
 681         //Result        := '';
 682         // \93Æ\8e©\82É\83t\83B\83\8b\83^\83\8a\83\93\83O\82ð\8ds\82í\82È\82¢\8fê\8d\87\82Í
 683         LoadDat;
 684         if (FDat = nil) or (inNo - 1 < 0 ) or (inNo - 1 >= FDat.Count)  then begin
 685                 // \83\8d\83O\82É\91¶\8dÝ\82µ\82È\82¢\82Ì\82Å\82±\82Ì\82Ü\82Ü\8fI\97¹
 686                 tmp := CreateResultString('');
 687                 Result := tmp;
 688                 DisposeResultString(tmp);
 689                 Exit;
 690         end;
 691         tmp := CreateResultString(FDat[ inNo - 1]);
 692         try
 693                 Result := string(tmp);
 694         finally
 695                 DisposeResultString(tmp);
 696         end;
 697
 698 end;
 699
 700 // *************************************************************************
 701 // \83X\83\8c\83b\83h\82Ì\83w\83b\83_ html \82ð\97v\8b\81\82³\82ê\82½
 702 // *************************************************************************
 703 function TMachiBBSThreadItem.GetHeader(
 704         inOptionalHeader        : string
 705 ) : string;
 706 begin
 707
 708         // \93Æ\8e©\82É\83t\83B\83\8b\83^\83\8a\83\93\83O\82ð\8ds\82í\82È\82¢\8fê\8d\87\82Í
 709         // InternalHeader \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
 710         Result := InternalHeader(
 711                 '<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">' +
 712                 inOptionalHeader );
 713
 714
 715         // GetRes \82ð\8cÄ\82Î\82ê\82é\82±\82Æ\82ª\97\\91z\82³\82ê\82é\82Ì\82Å FDat \82ð\90¶\90¬\82µ\82Ä\82¨\82
 716         try
 717                 FreeDat;
 718                 LoadDat;
 719         except
 720         end;
 721
 722 end;
 723
 724 // *************************************************************************
 725 // \83X\83\8c\83b\83h\82Ì\83t\83b\83^ html \82ð\97v\8b\81\82³\82ê\82½
 726 // *************************************************************************
 727 function TMachiBBSThreadItem.GetFooter(
 728         inOptionalFooter : string
 729 ) : string;
 730 begin
 731
 732         // \93Æ\8e©\82É\83t\83B\83\8b\83^\83\8a\83\93\83O\82ð\8ds\82í\82È\82¢\8fê\8d\87\82Í
 733         // InternalFooter \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
 734         Result := InternalFooter( inOptionalFooter );
 735
 736         // \82à\82¤ GetRes \82Í\8cÄ\82Î\82ê\82È\82¢\82Æ\8ev\82¤\82Ì\82Å FDat \82ð\8aJ\95ú\82µ\82Ä\82¨\82
 737         try
 738                 FreeDat;
 739         except
 740         end;
 741
 742 end;
 743
 744 // *************************************************************************
 745 // \82±\82Ì ThreadItem \82ª\91®\82·\82é\94Â\82Ì URL \82ð\97v\8b\81\82³\82ê\82½
 746 // *************************************************************************
 747 function        TMachiBBSThreadItem.GetBoardURL : string;
 748 var
 749         uri                                             : TIdURI;
 750         uriList                         : TStringList;
 751         tmp: PChar;
 752 begin
 753     tmp := nil;
 754         if Copy( URL, Length( URL ), 1 ) = '/' then
 755                 uri := TIdURI.Create( URL )
 756         else
 757                 uri := TIdURI.Create( URL + '/' );
 758         uriList := TStringList.Create;
 759         try
 760                 ExtractHttpFields(
 761                         ['&'], [],
 762                         Copy( uri.Params, AnsiPos( '?', uri.Params ) + 1, Length( uri.Params ) ), uriList );
 763                 FileName := uriList.Values[ 'KEY' ] + '.dat';
 764                 // http://hokkaido.machi.to/bbs/read.pl?BBS=hokkaidou&KEY=1061764446
 765                 // http://hokkaido.machi.to/hokkaidou/
 766                 tmp             := CreateResultString(
 767                         uri.Protocol + '://' + uri.Host + '/' + uriList.Values[ 'BBS' ] + '/' );
 768                 Result := string(tmp);
 769         finally
 770                 DisposeResultString(tmp);
 771                 uri.Free;
 772                 uriList.Free;
 773         end;
 774
 775 end;
 776
 777 // *************************************************************************
 778 // \82Ü\82¿BBS\82Ì HTML \82ð 2ch \82Ì dat \8c`\8e®\82É
 779 // *************************************************************************
 780 procedure       TMachiBBSThreadItem.To2chDat(
 781         ioHTML                          : TStringList;
 782         inStartNo                       : Integer = 1
 783 );
 784 var
 785         i, bound                        : Integer;
 786         foundPos,foundPos2                      : Integer;
 787         strTmp                          : string;
 788         res                                             : TStringList;
 789         no                                              : Integer;
 790 const
 791         MAIL_TAG                        = '<a href="mailto:';
 792 begin
 793
 794         //===== 2ch \82Ì dat \8c`\8e®\82É\95Ï\8a·
 795         // \83z\83X\83g\96¼\82Ì\8cã\82Å\89ü\8ds\82³\82ê\82Ä\82¢\82½\82è\82·\82é\82Ì\82Å\89ü\8ds\82ð\82·\82×\82Ä\8eæ\82è\8f\9c\82
 796         ioHTML.Text     := CustomStringReplace( ioHTML.Text, #13#10, '');
 797         //StringReplace( ioHTML.Text, #13#10, '', [rfReplaceAll] );
 798         // \91ã\82í\82è\82É <dt> \82ð\8ds\82Ì\8bæ\90Ø\82è\82É\82·\82é
 799         ioHTML.Text     := CustomStringReplace( ioHTML.Text, '<dt>', #10 );
 800         //StringReplace( ioHTML.Text, '<dt>', #10, [rfReplaceAll] );
 801         // <dt> \82©\82ç\8en\82Ü\82Á\82Ä\82¢\82é\82Ì\82Å\8dÅ\8f\89\82Í\8bó\82Ì\82Í\82¸
 802         if Length( ioHTML[ 0 ] ) = 0 then
 803                 ioHTML.Delete( 0 );
 804
 805         // \8cy\82\82 \82Ú\81[\82ñ\83`\83F\83b\83N
 806         // \81¦\91å\8eG\94c\82¾\82©\82ç\82¿\82á\82ñ\82Æ\8fo\97\88\82Ä\82È\82¢\82©\82à
 807         try
 808                 i                       := 0;
 809                 while i < ioHTML.Count do begin
 810                         foundPos := AnsiPos( ' ', ioHTML[ i ] );
 811                         if foundPos > 0 then begin
 812                                 no := StrToInt( Copy( ioHTML[ i ], 1, foundPos - 1 ) );
 813                                 if inStartNo < no then
 814                                         ioHTML.Insert( i, '<><><><>' );
 815                         end;
 816                         Inc( i );
 817                         Inc( inStartNo );
 818                 end;
 819         except
 820                 // \82 \82Ú\81[\82ñ\83`\83F\83b\83N\82Å\96â\91è\82ª\94\90¶\82µ\82Ä\82à\90æ\82Ö\90i\82ß\82½\82¢\82Ì\82Å
 821         end;
 822
 823
 824         // \83g\83\8a\83b\83v\82Ì\8cã\82Ì '<b> </b>' \82ð\8bó\82É
 825     if AnsiPos('\81\9f</b>', ioHTML.Text) <> 0 then begin
 826         ioHTML.Text     := CustomStringReplace( ioHTML.Text, '<b> </b></font>', '</b></font>', true );
 827         ioHTML.Text     := CustomStringReplace( ioHTML.Text, '<b> </B></a>', '</b></a>', true );
 828     end;
 829         //ioHTML.Text   := CustomStringReplace( ioHTML.Text, '<b> </b>', '', true );
 830         //StringReplace( ioHTML.Text, '<b> </b>', '', [rfReplaceAll, rfIgnoreCase] );
 831         // '<b>' \82Í\83\81\81[\83\8b\82Æ\96¼\91O\82Ì\8bæ\90Ø\82è
 832         ioHTML.Text     := CustomStringReplace( ioHTML.Text, '<b>', '<>', true );
 833         //StringReplace( ioHTML.Text, '<b>', '<>', [rfReplaceAll, rfIgnoreCase] );
 834         // \83\81\81[\83\8b\82Æ\96¼\91O\82É\82Â\82¢\82Ä\82\82é\95Â\82¶\83^\83O\82ð\93\8a\8de\93ú\82Æ\82Ì\8bæ\90Ø\82è\82É
 835         ioHTML.Text     := CustomStringReplace( ioHTML.Text, '</b></a>', '<>', true );
 836         //StringReplace( ioHTML.Text, '</b></a>', '<>', [rfReplaceAll, rfIgnoreCase] );
 837         ioHTML.Text     := CustomStringReplace( ioHTML.Text, '</b>', '<>', true );
 838     ioHTML.Text := CustomStringReplace( ioHTML.Text, '\81\9f<>', '\81\9f</b>', true );
 839         //StringReplace( ioHTML.Text, '</b>', '<>', [rfReplaceAll, rfIgnoreCase] );
 840         // '<dd>' \82ð\96{\95¶\82Æ\82Ì\8bæ\90Ø\82è\82É
 841         ioHTML.Text     := CustomStringReplace( ioHTML.Text, '<dd>', '<>', true );
 842         //StringReplace( ioHTML.Text, '<dd>', '<>', [rfReplaceAll, rfIgnoreCase] );
 843
 844         res := TStringList.Create;
 845         try
 846                 bound := ioHTML.Count - 1;
 847                 for i := 0 to bound do begin
 848             // \83X\83N\83\8a\83v\83g\82ª\8aÜ\82Ü\82ê\82Ä\82¢\82½\82ç\8dí\8f\9c\82·\82é\81i\8dL\8d\90\91Î\8dô\81j
 849                         res.Text := CustomStringReplace( ioHTML[ i ], '<>', #10 );
 850                                                 //StringReplace( ioHTML[ i ], '<>', #10, [rfReplaceAll] );
 851                         if res.Count >= 3 then begin    // 3 \96¢\96\9e\82Í\82 \82è\82¦\82È\82¢\82Æ\8ev\82¤\82¯\82Ç\88À\91S\82Ì\82½\82ß
 852                                 foundPos := AnsiPos( MAIL_TAG, res[ 0 ] );
 853                                 if foundPos > 0 then begin
 854                                         // \83\81\81[\83\8b\83A\83h\83\8c\83X\82ð\94²\82«\8fo\82·
 855                                         foundPos        := foundPos + Length( MAIL_TAG );
 856                                         res[ 0 ]        := Copy( res[ 0 ], foundPos, Length( res[ 0 ] ) );
 857                                         strTmp          := Copy( res[ 0 ], 1, AnsiPos( '">', res[ 0 ] ) - 1 );
 858                                         // \83\81\81[\83\8b\82Æ\96¼\91O\82ª\8bt\82È\82Ì\82Å\82Ð\82Á\82\82è\95Ô\82µ\82Ä\96ß\82·
 859                                         res[ 0 ]        := res[ 1 ];
 860                                         res[ 1 ]        := strTmp;
 861                                 end else begin
 862                                         // \83\81\81[\83\8b\82Æ\96¼\91O\82ª\8bt\82È\82Ì\82Å\82Ð\82Á\82\82è\95Ô\82·
 863                                         res[ 0 ]        := res[ 1 ];
 864                                         res[ 1 ]        := '';
 865                                 end;
 866                                 res[ 2 ] := StringReplace( res[ 2 ], '[', 'IP:', [] );
 867                                 res[ 2 ] := StringReplace( res[ 2 ], ']', '', [] );
 868
 869                 if AnsiPos('</font> \93\8a\8de\93ú\81F', res[ 2 ]) = 1 then begin
 870                         res[ 2 ] := StringReplace( res[ 2 ], '</font> \93\8a\8de\93ú\81F', '', [] );
 871                 end else if AnsiPos(' \93\8a\8de\93ú\81F', res[ 2 ]) = 1 then begin
 872                     res[ 2 ] := StringReplace( res[ 2 ], ' \93\8a\8de\93ú\81F', '', [] );
 873                 end;
 874                         end;
 875                         ioHTML[ i ] := CustomStringReplace( res.Text, #13#10, '<>');
 876             // \8dL\8d\90\83X\83N\83\8a\83v\83g\91Î\8dô
 877             foundPos := Pos( '<script', ioHTML[ i ] );
 878             if foundPos > 0 then begin
 879                 foundPos2 := Pos( '</script>', ioHTML[ i ] );
 880                 if (foundPos2 > foundPos) then begin
 881                     ioHTML[ i ] := Copy(ioHTML[ i ], 1, foundPos-1) +
 882                                    Copy(ioHTML[ i ], foundPos2 + 9, Length(ioHTML[ i ]));
 883                 end;
 884             end;
 885                 end;
 886         finally
 887                 res.Free;
 888         end;
 889
 890 end;
 891
 892 // *************************************************************************
 893 // FDat \82Ì\90¶\90¬
 894 // *************************************************************************
 895 procedure       TMachiBBSThreadItem.LoadDat;
 896 begin
 897
 898         if FDat = nil then begin
 899                 if IsLogFile then begin
 900                         // dat \82Ì\93Ç\82Ý\8d\9e\82Ý
 901                         FDat := TStringList.Create;
 902                         FDat.LoadFromFile( FilePath );
 903                 end;
 904         end;
 905
 906 end;
 907
 908 // *************************************************************************
 909 // FDat \82Ì\8aJ\95ú
 910 // *************************************************************************
 911 procedure       TMachiBBSThreadItem.FreeDat;
 912 begin
 913
 914         if FDat <> nil then begin
 915                 FDat.Free;
 916                 FDat := nil;
 917         end;
 918
 919 end;
 920
 921 // *************************************************************************
 922 // \88À\91S\82È( '/' \82Å\8fI\82í\82é )\93Ç\82Ý\8d\9e\82Ý\82Ì URL
 923 // *************************************************************************
 924 function        TMachiBBSThreadItem.ReadURL : string;
 925 var
 926         uri                             : TIdURI;
 927         uriList         : TStringList;
 928         foundPos        : Integer;
 929 const
 930     THREAD_MARK2= '/bbs/read.cgi';
 931 begin
 932
 933         foundPos := AnsiPos( '?', URL );
 934         if foundPos > 0 then begin
 935                 uri := TIdURI.Create( URL );
 936                 uriList := TStringList.Create;
 937                 try
 938                         ExtractHttpFields( ['&'], [], Copy( URL, foundPos + 1, MaxInt ), uriList );
 939                         Result :=
 940                                 uri.Protocol + '://' + uri.Host + '/bbs/read.pl?' +
 941                                 'BBS=' + uriList.Values[ 'BBS' ] + '&KEY=' + uriList.Values[ 'KEY' ];
 942                 finally
 943                         uri.Free;
 944                         uriList.Free;
 945                 end;
 946         end else begin
 947         // \90V\8c`\8e® ?
 948         foundPos := AnsiPos(THREAD_MARK2, URL);
 949         if (foundPos > 0) then begin
 950             uri := TIdURI.Create( URL );
 951             uriList := TStringList.Create;
 952             try
 953                 uriList.Delimiter := '/';
 954                 uriList.DelimitedText  := uri.Path;
 955                 if (uriList.Count >= 5) then begin
 956                             Result :=
 957                                     uri.Protocol + '://' + uri.Host + '/bbs/read.pl?' +
 958                                     'BBS=' + uriList[3] + '&KEY=' + uriList[4];
 959                 end;
 960             finally
 961                         uri.Free;
 962                         uriList.Free;
 963             end;
 964         end;
 965     end;
 966
 967 end;
 968
 969 // *************************************************************************
 970 // TThreadItem \82ª\90¶\90¬\82³\82ê\82½\8fê\8d\87\82Ì\8f\88\92u(TMachiBBSThreadItem \82ð\90¶\90¬\82·\82é)
 971 // *************************************************************************
 972 procedure ThreadItemOnCreateOfTMachiBBSThreadItem(
 973         inInstance : DWORD
 974 );
 975 var
 976         threadItem : TMachiBBSThreadItem;
 977 begin
 978
 979         threadItem := TMachiBBSThreadItem.Create( inInstance );
 980         ThreadItemSetLong( inInstance, tipContext, DWORD( threadItem ) );
 981
 982 end;
 983
 984 // *************************************************************************
 985 // TThreadItem \82ª\94j\8aü\82³\82ê\82½\8fê\8d\87\82Ì\8f\88\92u(TMachiBBSThreadItem \82ð\94j\8aü\82·\82é)
 986 // *************************************************************************
 987 procedure ThreadItemOnDisposeOfTMachiBBSThreadItem(
 988         inInstance : DWORD
 989 );
 990 var
 991         threadItem : TMachiBBSThreadItem;
 992 begin
 993
 994         threadItem := TMachiBBSThreadItem( ThreadItemGetLong( inInstance, tipContext ) );
 995         threadItem.Free;
 996
 997 end;
 998
 999 // =========================================================================
1000 // TMachiBBSBoardItem
1001 // =========================================================================
1002
1003 // *************************************************************************
1004 // \83R\83\93\83X\83g\83\89\83N\83^
1005 // *************************************************************************
1006 constructor TMachiBBSBoardItem.Create(
1007         inInstance      : DWORD
1008 );
1009 var
1010         uri                                     : TIdURI;
1011         uriList                 : TStringList;
1012 begin
1013
1014         inherited;
1015
1016         OnDownload                                              := Download;
1017         OnCreateThread                          := CreateThread;
1018         OnEnumThread                                    := EnumThread;
1019         OnFileName2ThreadURL    := ToThreadURL;
1020
1021         FilePath                        := '';
1022         FIsTemporary    := False;
1023         FDat                                    := nil;
1024     Is2ch                       := False;
1025
1026         uri                     := TIdURI.Create( SubjectURL );
1027         uriList := TStringList.Create;
1028         try
1029                 ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
1030                 // http://hokkaido.machi.to/hokkaidou/subject.txt
1031                 FilePath        := MyLogFolder + uriList[ 1 ] + '\' + uri.Document;
1032                 IsLogFile       := FileExists( FilePath );
1033         finally
1034                 uri.Free;
1035                 uriList.Free;
1036         end;
1037
1038 end;
1039
1040 // *************************************************************************
1041 // \83f\83X\83g\83\89\83N\83^
1042 // *************************************************************************
1043 destructor TMachiBBSBoardItem.Destroy;
1044 begin
1045
1046         if FDat <> nil then begin
1047                 try
1048                         FDat.Free;
1049                         FDat := nil;
1050                 except
1051                 end;
1052         end;
1053
1054         // \88ê\8e\9e\83t\83@\83C\83\8b\82Ì\8fê\8d\87\82Í\8dí\8f\9c\82·\82é
1055         if FIsTemporary then
1056                 DeleteFile( FilePath );
1057
1058         inherited;
1059
1060 end;
1061
1062 // *************************************************************************
1063 // \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½
1064 // *************************************************************************
1065 function TMachiBBSBoardItem.Download : TDownloadState;
1066 var
1067         modified                        : Double;
1068         downResult              : PChar;
1069         responseCode    : Longint;
1070         uri                                             : TIdURI;
1071         uriList                         : TStringList;
1072 begin
1073
1074         Result := dsError;
1075
1076         if FDat <> nil then begin
1077                 try
1078                         FDat.Free;
1079                         FDat := nil;
1080                 except
1081                 end;
1082         end;
1083         FDat            := TStringList.Create;
1084         uri                     := TIdURI.Create( SubjectURL );
1085         uriList := TStringList.Create;
1086         // \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Í
1087         // InternalDownload \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
1088         modified                        := LastModified;
1089         responseCode    := InternalDownload( PChar( uri.URI ), modified, downResult );
1090         try
1091                 if responseCode = 200 then begin
1092                         try
1093                                 // \83p\83X\82ð\8eZ\8fo
1094                                 ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
1095                                 if MyLogFolder = '' then begin
1096                                         // \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¶
1097                                         FilePath                        := TemporaryFile;
1098                                         FIsTemporary    := True;
1099                                 end else begin
1100                                         FilePath                        := MyLogFolder + uriList[ 1 ] + '\' + uri.Document;
1101                                         FIsTemporary    := False
1102                                 end;
1103
1104                                 // \95Û\91¶\97p\82Ì\83f\83B\83\8c\83N\83g\83\8a\82ð\8c@\82é
1105                                 ForceDirectoriesEx( Copy( FilePath, 1, LastDelimiter( '\', FilePath ) ) );
1106
1107                                 FDat.Text := string( downResult );
1108                                 // \95Û\91¶
1109                                 FDat.SaveToFile( FilePath );
1110
1111                                 IsLogFile                       := True;
1112                                 RoundDate                       := Now;
1113                                 LastModified    := modified;
1114                                 LastGetTime             := Now;
1115                         finally
1116                                 uri.Free;
1117                                 uriList.Free;
1118                         end;
1119                         Result := dsComplete;
1120                 end;
1121         finally
1122                 DisposeResultString( downResult );
1123         end;
1124
1125 end;
1126
1127 // *************************************************************************
1128 // \83X\83\8c\97§\82Ä\82ð\8ew\8e¦\82³\82ê\82½
1129 // *************************************************************************
1130 function        TMachiBBSBoardItem.CreateThread(
1131         inSubject                       : string;       // \83X\83\8c\83^\83C
1132         inName                          : string;       // \96¼\91O(\83n\83\93\83h\83\8b)
1133         inMail                          : string;       // \83\81\81[\83\8b\83A\83h\83\8c\83X
1134         inMessage                       : string        // \96{\95¶
1135 ) : TDownloadState;                             // \8f\91\82«\8d\9e\82Ý\82ª\90¬\8c÷\82µ\82½\82©\82Ç\82¤\82©
1136 var
1137         postURL                         : string;
1138         postData                        : string;
1139         postResult              : PChar;
1140         uri                                             : TIdURI;
1141         uriList                         : TStringList;
1142 begin
1143
1144         uri                     := TIdURI.Create( URL );
1145         uriList := TStringList.Create;
1146         try
1147                 ExtractHttpFields(
1148                         ['&'], [],
1149                         Copy( uri.Params, AnsiPos( '?', uri.Params ) + 1, Length( uri.Params ) ), uriList );
1150
1151                 postURL         := uri.Protocol + '://' + uri.Host + '/bbs/write.cgi';
1152                 postData        :=
1153                         'SUBJECT='      + HttpEncode( inSubject ) +
1154                         '&NAME='                + HttpEncode( inName ) +
1155                         '&MAIL='                + HttpEncode( inMail ) +
1156                         '&MESSAGE='     + HttpEncode( inMessage ) +
1157                         '&BBS='                 + uriList[ 1 ] +
1158                         '&TIME='                + IntToStr( DateTimeToUnix( Now ) ) +
1159                         '&submit='      + HttpEncode( '\90V\8bK\8f\91\82«\8d\9e\82Ý' );
1160
1161                 // \93Æ\8e©\82É\92Ê\90M\82µ\82È\82¢\8fê\8d\87\82Í InternalPost \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
1162                 InternalPost( PChar( postURL ), PChar( postData ),PChar(URL), postResult );
1163                 DisposeResultString( postResult );
1164
1165                 Result := dsComplete
1166         finally
1167                 uri.Free;
1168                 uriList.Free;
1169         end;
1170
1171 end;
1172
1173 // *************************************************************************
1174 // \83X\83\8c\88ê\97\97\82Ì URL \82©\82ç\83X\83\8c\83b\83h\82Ì URL \82ð\93±\82«\8fo\82·
1175 // *************************************************************************
1176 function TMachiBBSBoardItem.ToThreadURL(
1177         inFileName      : string        // \83X\83\8c\83b\83h\83t\83@\83C\83\8b\96¼
1178 ) : string;                                                     // \83X\83\8c\83b\83h\82Ì URL
1179 var
1180         threadURL               : string;
1181         uri                                     : TIdURI;
1182         uriList                 : TStringList;
1183         found                           : Integer;
1184 begin
1185
1186         found := AnsiPos( '.', inFileName );
1187         if found > 0 then
1188                 inFileName := Copy( inFileName, 1, found - 1 );
1189
1190         uri                     := TIdURI.Create( SubjectURL );
1191         uriList := TStringList.Create;
1192         try
1193                 try
1194                         // http://hokkaido.machi.to/hokkaidou/
1195                         // http://hokkaido.machi.to/bbs/read.pl?BBS=hokkaidou&KEY=1061764446&LAST=50
1196                         ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
1197                         threadURL       := uri.Protocol + '://' + uri.Host + '/bbs/read.pl?' +
1198                                 'BBS=' + uriList[ 1 ] + '&KEY=' + inFileName + '&LAST=50';
1199                         Result          := threadURL;
1200                 finally
1201                         uri.Free;
1202                         uriList.Free;
1203                 end;
1204         except
1205                 Result := '';
1206         end;
1207
1208 end;
1209
1210 // *************************************************************************
1211 // \82±\82Ì\94Â\82É\82¢\82\82Â\82Ì\83X\83\8c\82ª\82 \82é\82©\97v\8b\81\82³\82ê\82½
1212 // *************************************************************************
1213 procedure       TMachiBBSBoardItem.EnumThread(
1214         inCallBack      : TBoardItemEnumThreadCallBack
1215 );
1216 var
1217         uri                                     : TIdURI;
1218         uriList                 : TStringList;
1219 begin
1220
1221         try
1222                 if FDat = nil then begin
1223                         FDat := TStringList.Create;
1224
1225                         uri                     := TIdURI.Create( SubjectURL );
1226                         uriList := TStringList.Create;
1227                         try
1228                                 // \83p\83X\82ð\8eZ\8fo
1229                                 ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
1230                                 // http://hokkaido.machi.to/hokkaidou/subject.txt
1231                                 FilePath        := MyLogFolder + uriList[ 1 ] + '\' + uri.Document;
1232                                 if FileExists( FilePath ) then
1233                                         // \93Ç\82Ý\8d\9e\82Ý
1234                                         FDat.LoadFromFile( FilePath );
1235                         finally
1236                                 uri.Free;
1237                                 uriList.Free;
1238                         end;
1239                 end;
1240
1241                 // \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é
1242                 inherited EnumThread( inCallBack, CustomStringReplace( FDat.Text, ',', '<>' ) );
1243         except
1244         end;
1245
1246 end;
1247
1248 // *************************************************************************
1249 // \83X\83\8c\88ê\97\97\82Ì URL \82ð\8b\81\82ß\82é
1250 // *************************************************************************
1251 function        TMachiBBSBoardItem.SubjectURL : string;
1252 var
1253         uri                     : TIdURI;
1254         uriList : TStringList;
1255 begin
1256
1257         uri                     := TIdURI.Create( URL );
1258         uriList := TStringList.Create;
1259         try
1260                 if uri.Document <> SUBJECT_NAME then begin
1261                         if Copy( URL, Length( URL ), 1 ) = '/' then
1262                                 Result := URL + SUBJECT_NAME
1263                         else
1264                                 Result := URL + '/' + SUBJECT_NAME;
1265                 end else begin
1266                         // \82±\82±\82É\82Í\97\88\82È\82¢\82Æ\8ev\82¤\82¯\82Ç
1267                         Result := URL;
1268                 end;
1269         finally
1270                 uri.Free;
1271                 uriList.Free;
1272         end;
1273
1274 end;
1275
1276 // *************************************************************************
1277 // TBoardItem \82ª\90¶\90¬\82³\82ê\82½\8fê\8d\87\82Ì\8f\88\92u(TMachiBBSBoardItem \82ð\90¶\90¬\82·\82é)
1278 // *************************************************************************
1279 procedure BoardItemOnCreateOfTMachiBBSBoardItem(
1280         inInstance : DWORD
1281 );
1282 var
1283         boardItem : TMachiBBSBoardItem;
1284 begin
1285
1286         boardItem := TMachiBBSBoardItem.Create( inInstance );
1287         BoardItemSetLong( inInstance, bipContext, DWORD( boardItem ) );
1288
1289 end;
1290
1291 // *************************************************************************
1292 // TBoardItem \82ª\94j\8aü\82³\82ê\82½\8fê\8d\87\82Ì\8f\88\92u(TMachiBBSBoardItem \82ð\94j\8aü\82·\82é)
1293 // *************************************************************************
1294 procedure BoardItemOnDisposeOfTMachiBBSBoardItem(
1295         inInstance : DWORD
1296 );
1297 var
1298         boardItem : TMachiBBSBoardItem;
1299 begin
1300
1301         boardItem := TMachiBBSBoardItem( BoardItemGetLong( inInstance, bipContext ) );
1302         boardItem.Free;
1303
1304 end;
1305
1306
1307
1308 // =========================================================================
1309 // \83G\83\93\83g\83\8a\83|\83C\83\93\83g
1310 // =========================================================================
1311 procedure DLLEntry(
1312         ul_reason_for_call : DWORD
1313 );
1314 var
1315         module : HMODULE;
1316 begin
1317
1318         case ul_reason_for_call of
1319                 DLL_PROCESS_ATTACH:
1320                 begin
1321                         Randomize;
1322
1323                         module := GetModuleHandle( nil );
1324
1325                         LoadInternalAPI( module );
1326                         LoadInternalFilePathAPI( module );
1327                         LoadInternalThreadItemAPI( module );
1328                         LoadInternalBoardItemAPI( module );
1329
1330                         // ===== \83C\83\93\83X\83^\83\93\83X\82Ì\8eæ\82è\88µ\82¢\82ð TThreadItem \82©\82ç TMachiBBSThreadItem \82É\95Ï\8dX\82·\82é
1331                         ThreadItemOnCreate      := ThreadItemOnCreateOfTMachiBBSThreadItem;
1332                         ThreadItemOnDispose     := ThreadItemOnDisposeOfTMachiBBSThreadItem;
1333                         // ===== \83C\83\93\83X\83^\83\93\83X\82Ì\8eæ\82è\88µ\82¢\82ð TBoardItem \82©\82ç TMachiBBSBoardItem \82É\95Ï\8dX\82·\82é
1334                         BoardItemOnCreate               := BoardItemOnCreateOfTMachiBBSBoardItem;
1335                         BoardItemOnDispose      := BoardItemOnDisposeOfTMachiBBSBoardItem;
1336                 end;
1337                 DLL_PROCESS_DETACH:
1338                         ;
1339                 DLL_THREAD_ATTACH:
1340                         ;
1341                 DLL_THREAD_DETACH:
1342                         ;
1343         end;
1344
1345 end;
1346
1347 exports
1348         OnVersionInfo,
1349         OnAcceptURL,
1350     OnExtractBoardURL;
1351 begin
1352
1353         try
1354                 DllProc := @DLLEntry;
1355                 DLLEntry( DLL_PROCESS_ATTACH );
1356         except end;
1357
1358 end.