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