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