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         \95¶\8e\9a\83R\81[\83h\82Ì\95Ï\8a·\82É PzConv.pas [ http://plaza11.mbn.or.jp/~pz/ ] \82ð\8eg\97p\82µ\82Ä\82¢\82Ü\82·\81B
   7         \83R\83\93\83p\83C\83\8b\91O\82É\81A\93¯\82¶\83f\83B\83\8c\83N\83g\83\8a\82É\92u\82¢\82Ä\82\82¾\82³\82¢\81B
   8 }
   9
  10 uses
  11         Windows,
  12         SysUtils,
  13         Classes,
  14         Math,
  15         IdURI,
  16         YofUtils in '..\..\YofUtils.pas',
  17         PlugInMain in 'PlugInMain.pas',
  18         ThreadItem in 'ThreadItem.pas',
  19         BoardItem in 'BoardItem.pas',
  20         FilePath in 'FilePath.pas';
  21
  22 {$R *.res}
  23
  24 type
  25         // =========================================================================
  26         // TMachiBBSThreadItem
  27         // =========================================================================
  28         TMachiBBSThreadItem = class(TThreadItem)
  29         private
  30                 FIsTemporary    : Boolean;
  31                 FDat                                    : TStringList;
  32
  33         public
  34                 constructor     Create( inInstance : DWORD );
  35                 destructor      Destroy; override;
  36
  37         private
  38                 function        Download : TDownloadState;
  39                 function        GetRes( inNo : Integer ) : string;
  40                 function        GetHeader( inOptionalHeader : string ) : string;
  41                 function        GetFooter( inOptionalFooter : string ) : string;
  42
  43                 procedure       To2chDat( ioHTML : TStringList );
  44         end;
  45
  46         // =========================================================================
  47         // TMachiBBSBoardItem
  48         // =========================================================================
  49         TMachiBBSBoardItem = class(TBoardItem)
  50         private
  51                 FIsTemporary    : Boolean;
  52                 FDat                                    : TStringList;
  53
  54         public
  55                 constructor     Create( inInstance : DWORD );
  56                 destructor      Destroy; override;
  57
  58         private
  59                 function        Download : TDownloadState;
  60                 function        ToThreadURL( inFileName : string ) : string;
  61                 procedure       EnumThread( inCallBack : TBoardItemEnumThreadCallBack );
  62
  63         end;
  64
  65         // =========================================================================
  66         // \83T\83u\83W\83F\83N\83g\83\8c\83R\81[\83h
  67         // =========================================================================
  68         TSubjectRec = record
  69                 FFileName: string;
  70                 FTitle: string;
  71                 FCount: Integer;
  72         end;
  73
  74 const
  75         LOG_DIR                                         = 'MachiBBS\';
  76
  77         PLUGIN_NAME                             = 'MachiBBSPlugIn';
  78         MAJOR_VERSION                   = 1;
  79         MINOR_VERSION                   = 0;
  80         RELEASE_VERSION         = 'develop';
  81         REVISION_VERSION        = 1;
  82
  83 // =========================================================================
  84 // \8eG\97p\8aÖ\90\94
  85 // =========================================================================
  86
  87 // *************************************************************************
  88 // \83e\83\93\83|\83\89\83\8a\82È\83p\83X\82Ì\8eæ\93¾
  89 // *************************************************************************
  90 function TemporaryFile : string;
  91 var
  92         tempPath : array [0..MAX_PATH] of       char;
  93 begin
  94
  95         GetTempPath( SizeOf(tempPath), tempPath );
  96         repeat
  97                 Result := tempPath + IntToStr( Random( $7fffffff ) );
  98         until not FileExists( Result );
  99
 100 end;
 101
 102 // *************************************************************************
 103 // \82Ü\82¿BBS\97p\83\8d\83O\83t\83H\83\8b\83_\8eæ\93¾
 104 // *************************************************************************
 105 function MyLogFolder : string;
 106 var
 107         folder : string;
 108 begin
 109
 110         folder := LogFolder;
 111         if Length( folder ) = 0 then
 112                 Result := ''
 113         else
 114                 Result := folder + LOG_DIR;
 115
 116 end;
 117
 118 (*************************************************************************
 119  *\83f\83B\83\8c\83N\83g\83\8a\82ª\91¶\8dÝ\82·\82é\82©\83`\83F\83b\83N
 120  *************************************************************************)
 121 function DirectoryExistsEx(const Name: string): Boolean;
 122 var
 123         Code: Integer;
 124 begin
 125         Code := GetFileAttributes(PChar(Name));
 126         Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
 127 end;
 128
 129 (*************************************************************************
 130  *\83f\83B\83\8c\83N\83g\83\8a\8dì\90¬\81i\95¡\90\94\8aK\91w\91Î\89\9e\81j
 131  *************************************************************************)
 132 function ForceDirectoriesEx(Dir: string): Boolean;
 133 begin
 134         Result := True;
 135         if Length(Dir) = 0 then
 136                 raise Exception.Create('\83t\83H\83\8b\83_\82ª\8dì\90¬\8fo\97\88\82Ü\82¹\82ñ');
 137         Dir := ExcludeTrailingPathDelimiter(Dir);
 138         if (Length(Dir) < 3) or DirectoryExistsEx(Dir)
 139                 or (ExtractFilePath(Dir) = Dir) then Exit; // avoid 'xyz:\' problem.
 140         Result := ForceDirectoriesEx(ExtractFilePath(Dir)) and CreateDir(Dir);
 141 end;
 142
 143 (*************************************************************************
 144  *\82Ç\82±\82©\82Ì\83T\83C\83g\82©\82ç\82Ì\83p\83N\83\8a
 145  *************************************************************************)
 146 function RemoveToken(var s: string; delimiter: string): string;
 147 var
 148         p: Integer;
 149 begin
 150         p := AnsiPos(delimiter, s);
 151         if p = 0 then
 152                 Result := s
 153         else
 154                 Result := Copy(s, 1, p - 1);
 155         s := Copy(s, Length(Result) + Length(delimiter) + 1, Length(s));
 156 end;
 157
 158 (*************************************************************************
 159  *\82Ç\82±\82©\82Ì\83T\83C\83g\82©\82ç\82Ì\83p\83N\83\8a
 160  *************************************************************************)
 161 function GetTokenIndex(s: string; delimiter: string; index: Integer): string;
 162 var
 163         i: Integer;
 164 begin
 165         Result := '';
 166         for i := 0 to index do
 167                 Result := RemoveToken(s, delimiter);
 168 end;
 169
 170 (*************************************************************************
 171  *\95¶\8e\9a\97ñ\90\94\8e\9a\83`\83F\83b\83N
 172  *************************************************************************)
 173 function IsNumeric(s: string): boolean;
 174 var
 175         e: integer;
 176         v: integer;
 177 begin
 178         Val(s, v, e);
 179         Result := e = 0;
 180 end;
 181
 182 (*************************************************************************
 183  *\83T\83u\83W\83F\83N\83g\88ê\8ds\82ð\95ª\8a\84
 184  *************************************************************************)
 185 function DivideSubject(Line: string): TSubjectRec;
 186 var
 187         i: integer;
 188         ws: WideString;
 189         Delim: string;
 190         LeftK: string;
 191         RightK: string;
 192 begin
 193         Result.FCount := 0;
 194
 195         if Pos('<>', Line) = 0 then
 196                 Delim := ','
 197         else
 198                 Delim := '<>';
 199
 200         Result.FFileName := GetTokenIndex(Line, Delim, 0);
 201         Result.FTitle := GetTokenIndex(Line, Delim, 1);
 202
 203         ws := Trim(Result.FTitle);
 204
 205         if Copy(ws, Length(ws), 1) = ')' then begin
 206                 LeftK := '(';
 207                 RightK := ')';
 208         end else if Copy(ws, Length(ws), 1) = '\81j' then begin
 209                 LeftK := '\81i';
 210                 RightK := '\81j';
 211         end else if Copy(ws, Length(ws), 1) = '<' then begin
 212                 LeftK := '<';
 213                 RightK := '>';
 214         end;
 215
 216         for i := Length(ws) - 1 downto 1 do begin
 217                 if ws[i] = LeftK then begin
 218                         ws := Copy(ws, i + 1, Length(ws) - i - 1);
 219                         if IsNumeric(ws) then
 220                                 Result.FCount := StrToInt(ws);
 221                         Result.FTitle := Trim(StringReplace(Result.FTitle, LeftK + ws + RightK, '', [rfReplaceAll]));
 222                         break;
 223                 end;
 224         end;
 225 end;
 226
 227
 228
 229 // =========================================================================
 230 // PlugIn
 231 // =========================================================================
 232
 233 // *************************************************************************
 234 // \83v\83\89\83O\83C\83\93\82Ì\83o\81[\83W\83\87\83\93\82ð\97v\8b\81\82³\82ê\82½
 235 // *************************************************************************
 236 procedure OnVersionInfo(
 237         var outAgent            : PChar;        // \83o\81[\83W\83\87\83\93\82ð\88ê\90Ø\8aÜ\82Ü\82È\82¢\8f\83\90\88\82È\96¼\8fÌ
 238         var outMajor            : DWORD;        // \83\81\83W\83\83\81[\83o\81[\83W\83\87\83\93
 239         var outMinor            : DWORD;        // \83}\83C\83i\81[\83o\81[\83W\83\87\83\93
 240         var outRelease  : PChar;        // \83\8a\83\8a\81[\83X\92i\8aK\96¼
 241         var outRevision : DWORD         // \83\8a\83r\83W\83\87\83\93\83i\83\93\83o\81[
 242 ); stdcall;
 243 begin
 244
 245         try
 246                 outAgent                := CreateResultString( PChar( PLUGIN_NAME ) );
 247                 outMajor                := MAJOR_VERSION;
 248                 outMinor                := MINOR_VERSION;
 249                 outRelease      := CreateResultString( PChar( RELEASE_VERSION ) );
 250                 outRevision     := REVISION_VERSION;
 251         except
 252                 outAgent                := nil;
 253                 outMajor                := 0;
 254                 outMinor                := 0;
 255                 outRelease      := nil;
 256                 outRevision     := 0;
 257         end;
 258
 259 end;
 260
 261 // *************************************************************************
 262 // \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©
 263 // *************************************************************************
 264 function OnAcceptURL(
 265         inURL : PChar                                           // \94»\92f\82ð\8bÂ\82¢\82Å\82¢\82é URL
 266 ): Boolean; stdcall;                    // \8eó\82¯\95t\82¯\82é\82È\82ç True
 267 var
 268         URI : TIdURI;
 269         foundPos : Integer;
 270 const
 271         BBS_HOST = 'machi.to';
 272 begin
 273
 274         try
 275                 // \97á\82Æ\82µ\82Ä\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é
 276                 URI := TIdURI.Create( inURL );
 277                 try
 278                         foundPos := Pos( BBS_HOST, URI.Host );
 279                         Result := (foundPos > 0) and (Length( URI.Host ) - foundPos + 1 = Length( BBS_HOST ))
 280                 finally
 281                         URI.Free;
 282                 end;
 283         except
 284                 Result := False;
 285         end;
 286
 287 end;
 288
 289
 290
 291 // =========================================================================
 292 // TMachiBBSThreadItem
 293 // =========================================================================
 294
 295 // *************************************************************************
 296 // \83R\83\93\83X\83g\83\89\83N\83^
 297 // *************************************************************************
 298 constructor TMachiBBSThreadItem.Create(
 299         inInstance      : DWORD
 300 );
 301 var
 302         uri                                     : TIdURI;
 303         uriList                 : TStringList;
 304 begin
 305
 306         inherited;
 307
 308         OnDownload              := Download;
 309         OnGetRes                        := GetRes;
 310         OnGetHeader             := GetHeader;
 311         OnGetFooter             := GetFooter;
 312
 313         FilePath                        := '';
 314         FIsTemporary    := False;
 315         FDat                                    := nil;
 316
 317         uri                     := TIdURI.Create( URL );
 318         uriList := TStringList.Create;
 319         try
 320                 // http://hokkaido.machi.to/bbs/read.pl?BBS=hokkaidou&KEY=1061764446&LAST=50
 321                 YofUtils.ExtractHttpFields(
 322                         ['&'], [],
 323                         Copy( uri.Params, Pos( '?', uri.Params ) + 1, Length( uri.Params ) ), uriList );
 324                 FileName        := uriList.Values[ 'KEY' ] + '.dat';
 325                 FilePath        := MyLogFolder + uriList.Values[ 'BBS' ] + '\' + uriList.Values[ 'KEY' ] + '.dat';
 326                 IsLogFile       := FileExists( FilePath );
 327         finally
 328                 uri.Free;
 329                 uriList.Free;
 330         end;
 331
 332 end;
 333
 334 // *************************************************************************
 335 // \83f\83X\83g\83\89\83N\83^
 336 // *************************************************************************
 337 destructor TMachiBBSThreadItem.Destroy;
 338 begin
 339
 340         if FDat <> nil then begin
 341                 try
 342                         FDat.Free;
 343                         FDat := nil;
 344                 except
 345                 end;
 346         end;
 347
 348         // \88ê\8e\9e\83t\83@\83C\83\8b\82Ì\8fê\8d\87\82Í\8dí\8f\9c\82·\82é
 349         if FIsTemporary then
 350                 DeleteFile( FilePath );
 351
 352         inherited;
 353
 354 end;
 355
 356 // *************************************************************************
 357 // \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½
 358 // *************************************************************************
 359 function TMachiBBSThreadItem.Download : TDownloadState;
 360 var
 361         modified                        : Double;
 362         tmp                                             : PChar;
 363         downResult              : TStringList;
 364         responseCode    : Longint;
 365         logStream                       : TFileStream;
 366         uri                                             : TIdURI;
 367         uriList                         : TStringList;
 368         datURL                          : string;
 369         foundPos                        : Integer;
 370 begin
 371
 372         Result := dsError;
 373
 374         uri                     := TIdURI.Create( URL );
 375         uriList := TStringList.Create;
 376         try
 377                 YofUtils.ExtractHttpFields(
 378                         ['&'], [],
 379                         Copy( uri.Params, Pos( '?', uri.Params ) + 1, Length( uri.Params ) ), uriList );
 380                 if MyLogFolder = '' then begin
 381                         // \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¶
 382                         FilePath                        := TemporaryFile;
 383                         FIsTemporary    := True;
 384                 end else begin
 385                         FilePath        := MyLogFolder + uriList.Values[ 'BBS' ] + '\' + uriList.Values[ 'KEY' ] + '.dat';
 386                         FIsTemporary    := False;
 387                 end;
 388
 389                 // \95Û\91¶\97p\82Ì\83f\83B\83\8c\83N\83g\83\8a\82ð\8c@\82é
 390                 ForceDirectoriesEx( Copy( FilePath, 1, LastDelimiter( '\', FilePath ) ) );
 391
 392                 if FileExists( FilePath ) then
 393                         logStream := TFileStream.Create( FilePath, fmOpenReadWrite or fmShareDenyWrite )
 394                 else
 395                         logStream := TFileStream.Create( FilePath, fmCreate or fmShareDenyWrite );
 396                 try
 397                         // \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Í
 398                         // InternalDownload \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
 399                         modified        := LastModified;
 400                         // http://hokkaido.machi.to/bbs/read.pl?BBS=hokkaidou&KEY=1061764446
 401                         // \90V\92\85\82Ì\82Ý\8eæ\93¾\82·\82é\95û\96@\82Í\96³\82µ
 402                         datURL          :=
 403                                 uri.Protocol + '://' + uri.Host + '/bbs/read.pl?' +
 404                                 'BBS=' + uriList.Values[ 'BBS' ] + '&KEY=' + uriList.Values[ 'KEY' ];
 405                         responseCode := InternalDownload( PChar( datURL ), modified, tmp, 0 );
 406
 407                         try
 408                                 if responseCode = 200 then begin
 409                                         downResult := TStringList.Create;
 410                                         try
 411                                                 downResult.Text := string( tmp );
 412
 413                                                 // \83\8c\83X\82Ì\8aJ\8en\88Ê\92u
 414                                                 foundPos                                := Pos( '<dt', downResult.Text );
 415                                                 downResult.Text := Copy( downResult.Text, foundPos, Length( downResult.Text ) );
 416                                                 if foundPos > 0 then begin
 417                                                         // \83\8c\83X\82Ì\8fI\97¹\88Ê\92u
 418                                                         foundPos := Pos( '<table', downResult.Text ) - 1;
 419                                                         if foundPos > 0 then
 420                                                                 downResult.Text := Copy( downResult.Text, 1, foundPos );
 421
 422                                                         // \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Å
 423                                                         // \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¤
 424                                                         To2chDat( downResult );
 425
 426                                                         if downResult.Count > 0 then begin
 427                                                                 logStream.Position      := 0;
 428                                                                 logStream.Write( PChar( downResult.Text )^, Length( downResult.Text ) );
 429                                                                 logStream.Size := Length( downResult.Text );
 430
 431                                                                 if AllResCount <> downResult.Count then begin
 432                                                                         if AllResCount = 0 then
 433                                                                                 Result := dsComplete
 434                                                                         else
 435                                                                                 Result := dsDiffComplete;
 436                                                                         LastModified                            := modified;
 437                                                                         IsLogFile                                               := True;
 438                                                                         NewReceive                                      := Count + 1;
 439                                                                         NewResCount                                     := downResult.Count - Count;
 440                                                                         Count                                                           := downResult.Count;
 441                                                                 end else begin
 442                                                                         Result                                                  := dsNotModify;
 443                                                                 end;
 444                                                         end;
 445                                                 end;
 446                                         finally
 447                                                 downResult.Free;
 448                                         end;
 449                                 end;
 450                         finally
 451                                 DisposeResultString( tmp );
 452                         end;
 453                 finally
 454                         logStream.Free;
 455                 end;
 456         finally
 457                 uri.Free;
 458                 uriList.Free;
 459         end;
 460
 461 end;
 462
 463 // *************************************************************************
 464 // \83\8c\83X\94Ô\8d\86 inNo \82É\91Î\82·\82é html \82ð\97v\8b\81\82³\82ê\82½
 465 // *************************************************************************
 466 function TMachiBBSThreadItem.GetRes(
 467         inNo            : Integer               // \97v\8b\81\82³\82ê\82½\83\8c\83X\94Ô\8d\86
 468 ) : string;                                             // \91Î\89\9e\82·\82é HTML
 469 var
 470         res                     : string;
 471         tmp                     : PChar;
 472 begin
 473
 474         // \93Æ\8e©\82É\83t\83B\83\8b\83^\83\8a\83\93\83O\82ð\8ds\82í\82È\82¢\8fê\8d\87\82Í
 475         // InternalAbon \82¨\82æ\82Ñ Dat2HTML \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
 476         if FDat = nil then begin
 477                 if IsLogFile then begin
 478                         // dat \82Ì\93Ç\82Ý\8d\9e\82Ý
 479                         FDat                    := TStringList.Create;
 480                         FDat.LoadFromFile( FilePath );
 481
 482                         AllResCount := FDat.Count; // \96{\93\96\82Í\82±\82±\82Å\82â\82é\82×\82«\82Å\82Í\82È\82¢\82ª\8eÀ\8c±\82Ì\82½\82ß\82Ì\88ê\8e\9e\93I\82È\82à\82Ì
 483                 end else begin
 484                         // \83\8d\83O\82É\91¶\8dÝ\82µ\82È\82¢\82Ì\82Å\82±\82Ì\82Ü\82Ü\8fI\97¹
 485                         Result := '';
 486                         Exit;
 487                 end;
 488         end;
 489         res                     := FDat[ inNo - 1 ];
 490         tmp                     := InternalAbon( PChar( res ) );
 491         try
 492                 Result  := Dat2HTML( string( tmp ), inNo );
 493         finally
 494                 DisposeResultString( tmp );
 495         end;
 496
 497 end;
 498
 499 // *************************************************************************
 500 // \83X\83\8c\83b\83h\82Ì\83w\83b\83_ html \82ð\97v\8b\81\82³\82ê\82½
 501 // *************************************************************************
 502 function TMachiBBSThreadItem.GetHeader(
 503         inOptionalHeader        : string
 504 ) : string;
 505 begin
 506
 507         // \93Æ\8e©\82É\83t\83B\83\8b\83^\83\8a\83\93\83O\82ð\8ds\82í\82È\82¢\8fê\8d\87\82Í
 508         // InternalHeader \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
 509         Result := InternalHeader(
 510                 '<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">' +
 511                 inOptionalHeader );
 512
 513
 514         // GetRes \82ð\8cÄ\82Î\82ê\82é\82±\82Æ\82ª\97\\91z\82³\82ê\82é\82Ì\82Å FDat \82ð\90¶\90¬\82µ\82Ä\82¨\82
 515         if FDat <> nil then begin
 516                 try
 517                         FDat.Free;
 518                         FDat := nil;
 519                 except
 520                 end;
 521         end;
 522         if IsLogFile then begin
 523                 // dat \82Ì\93Ç\82Ý\8d\9e\82Ý
 524                 FDat                    := TStringList.Create;
 525                 FDat.LoadFromFile( FilePath );
 526         end;
 527
 528 end;
 529
 530 // *************************************************************************
 531 // \83X\83\8c\83b\83h\82Ì\83t\83b\83^ html \82ð\97v\8b\81\82³\82ê\82½
 532 // *************************************************************************
 533 function TMachiBBSThreadItem.GetFooter(
 534         inOptionalFooter : string
 535 ) : string;
 536 begin
 537
 538         // \93Æ\8e©\82É\83t\83B\83\8b\83^\83\8a\83\93\83O\82ð\8ds\82í\82È\82¢\8fê\8d\87\82Í
 539         // InternalFooter \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
 540         Result := InternalFooter( inOptionalFooter );
 541
 542         // \82à\82¤ GetRes \82Í\8cÄ\82Î\82ê\82È\82¢\82Æ\8ev\82¤\82Ì\82Å FDat \82ð\8aJ\95ú\82µ\82Ä\82¨\82
 543         try
 544                 if FDat <> nil then begin
 545                         FDat.Free;
 546                         FDat := nil;
 547                 end;
 548         except
 549         end;
 550
 551 end;
 552
 553 // *************************************************************************
 554 // \82Ü\82¿BBS\82Ì HTML \82ð 2ch \82Ì dat \8c`\8e®\82É
 555 // *************************************************************************
 556 procedure       TMachiBBSThreadItem.To2chDat(
 557         ioHTML                  : TStringList
 558 );
 559 var
 560         i, bound                : Integer;
 561         foundPos                : Integer;
 562         strTmp                  : string;
 563         res                                     : TStringList;
 564 const
 565         MAIL_TAG                = '<a href="mailto:';
 566 begin
 567
 568         //===== 2ch \82Ì dat \8c`\8e®\82É\95Ï\8a·
 569         // \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
 570         ioHTML.Text     := StringReplace( ioHTML.Text, #13#10, '', [rfReplaceAll] );
 571         // \91ã\82í\82è\82É <dt> \82ð\8ds\82Ì\8bæ\90Ø\82è\82É\82·\82é
 572         ioHTML.Text     := StringReplace( ioHTML.Text, '<dt>', #10, [rfReplaceAll] );
 573         // <dt> \82©\82ç\8en\82Ü\82Á\82Ä\82¢\82é\82Ì\82Å\8dÅ\8f\89\82Í\8bó\82Ì\82Í\82¸
 574         if Length( ioHTML[ 0 ] ) = 0 then
 575                 ioHTML.Delete( 0 );
 576         // \83g\83\8a\83b\83v\82Ì\8cã\82Ì '<b> </b>' \82ð\8bó\82É
 577         ioHTML.Text     := StringReplace( ioHTML.Text, '<b> </b>', '', [rfReplaceAll, rfIgnoreCase] );
 578         // '<b>' \82Í\83\81\81[\83\8b\82Æ\96¼\91O\82Ì\8bæ\90Ø\82è
 579         ioHTML.Text     := StringReplace( ioHTML.Text, '<b>', '<>', [rfReplaceAll, rfIgnoreCase] );
 580         // \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É
 581         ioHTML.Text     := StringReplace( ioHTML.Text, '</b></a>', '<>', [rfReplaceAll, rfIgnoreCase] );
 582         ioHTML.Text     := StringReplace( ioHTML.Text, '</b>', '<>', [rfReplaceAll, rfIgnoreCase] );
 583         // '<dd>' \82ð\96{\95¶\82Æ\82Ì\8bæ\90Ø\82è\82É
 584         ioHTML.Text     := StringReplace( ioHTML.Text, '<dd>', '<>', [rfReplaceAll, rfIgnoreCase] );
 585
 586         res := TStringList.Create;
 587         try
 588                 bound := ioHTML.Count - 1;
 589                 for i := 0 to bound do begin
 590                         res.Text := StringReplace( ioHTML[ i ], '<>', #10, [rfReplaceAll] );
 591                         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ß
 592                                 foundPos := Pos( MAIL_TAG, res[ 0 ] );
 593                                 if foundPos > 0 then begin
 594                                         // \83\81\81[\83\8b\83A\83h\83\8c\83X\82ð\94²\82«\8fo\82·
 595                                         foundPos        := foundPos + Length( MAIL_TAG );
 596                                         res[ 0 ]        := Copy( res[ 0 ], foundPos, Length( res[ 0 ] ) );
 597                                         strTmp          := Copy( res[ 0 ], 1, Pos( '">', res[ 0 ] ) - 1 );
 598                                         // \83\81\81[\83\8b\82Æ\96¼\91O\82ª\8bt\82È\82Ì\82Å\82Ð\82Á\82\82è\95Ô\82µ\82Ä\96ß\82·
 599                                         res[ 0 ]        := res[ 1 ];
 600                                         res[ 1 ]        := strTmp;
 601                                 end else begin
 602                                         // \83\81\81[\83\8b\82Æ\96¼\91O\82ª\8bt\82È\82Ì\82Å\82Ð\82Á\82\82è\95Ô\82·
 603                                         res[ 0 ]        := res[ 1 ];
 604                                         res[ 1 ]        := '';
 605                                 end;
 606                                 res[ 2 ] := StringReplace( res[ 2 ], '[', 'ID:', [] );
 607                                 res[ 2 ] := StringReplace( res[ 2 ], ']', '', [] );
 608                         end;
 609                         ioHTML[ i ] := StringReplace( res.Text, #13#10, '<>', [rfReplaceAll] );
 610                 end;
 611         finally
 612                 res.Free;
 613         end;
 614
 615 end;
 616
 617 // *************************************************************************
 618 // TThreadItem \82ª\90¶\90¬\82³\82ê\82½\8fê\8d\87\82Ì\8f\88\92u(TMachiBBSThreadItem \82ð\90¶\90¬\82·\82é)
 619 // *************************************************************************
 620 procedure ThreadItemOnCreateOfTMachiBBSThreadItem(
 621         inInstance : DWORD
 622 );
 623 var
 624         threadItem : TMachiBBSThreadItem;
 625 begin
 626
 627         threadItem := TMachiBBSThreadItem.Create( inInstance );
 628         ThreadItemSetLong( inInstance, tipContext, DWORD( threadItem ) );
 629
 630 end;
 631
 632 // *************************************************************************
 633 // TThreadItem \82ª\94j\8aü\82³\82ê\82½\8fê\8d\87\82Ì\8f\88\92u(TMachiBBSThreadItem \82ð\94j\8aü\82·\82é)
 634 // *************************************************************************
 635 procedure ThreadItemOnDisposeOfTMachiBBSThreadItem(
 636         inInstance : DWORD
 637 );
 638 var
 639         threadItem : TMachiBBSThreadItem;
 640 begin
 641
 642         threadItem := TMachiBBSThreadItem( ThreadItemGetLong( inInstance, tipContext ) );
 643         threadItem.Free;
 644
 645 end;
 646
 647 // =========================================================================
 648 // TMachiBBSBoardItem
 649 // =========================================================================
 650
 651 // *************************************************************************
 652 // \83R\83\93\83X\83g\83\89\83N\83^
 653 // *************************************************************************
 654 constructor TMachiBBSBoardItem.Create(
 655         inInstance      : DWORD
 656 );
 657 var
 658         uri                                     : TIdURI;
 659         uriList                 : TStringList;
 660 begin
 661
 662         inherited;
 663
 664         OnDownload                                              := Download;
 665         OnEnumThread                                    := EnumThread;
 666         OnFileName2ThreadURL    := ToThreadURL;
 667
 668         FilePath                        := '';
 669         FIsTemporary    := False;
 670         FDat                                    := nil;
 671
 672         if Copy( URL, Length( URL ), 1 ) = '/' then
 673                 uri := TIdURI.Create( URL )
 674         else
 675                 uri := TIdURI.Create( URL + '/' );
 676         uriList := TStringList.Create;
 677         try
 678                 YofUtils.ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
 679                 // http://hokkaido.machi.to/hokkaidou/subject.txt
 680                 FilePath        := MyLogFolder + uriList[ 1 ] + '\' + uri.Document;
 681                 IsLogFile       := FileExists( FilePath );
 682         finally
 683                 uri.Free;
 684                 uriList.Free;
 685         end;
 686
 687 end;
 688
 689 // *************************************************************************
 690 // \83f\83X\83g\83\89\83N\83^
 691 // *************************************************************************
 692 destructor TMachiBBSBoardItem.Destroy;
 693 begin
 694
 695         if FDat <> nil then begin
 696                 try
 697                         FDat.Free;
 698                         FDat := nil;
 699                 except
 700                 end;
 701         end;
 702
 703         // \88ê\8e\9e\83t\83@\83C\83\8b\82Ì\8fê\8d\87\82Í\8dí\8f\9c\82·\82é
 704         if FIsTemporary then
 705                 DeleteFile( FilePath );
 706
 707         inherited;
 708
 709 end;
 710
 711 // *************************************************************************
 712 // \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½
 713 // *************************************************************************
 714 function TMachiBBSBoardItem.Download : TDownloadState;
 715 var
 716         modified                        : Double;
 717         downResult              : PChar;
 718         responseCode    : Longint;
 719         uri                                             : TIdURI;
 720         uriList                         : TStringList;
 721 const
 722         SUBJECT_NAME    = 'subject.txt';
 723 begin
 724
 725         Result := dsError;
 726
 727         if Copy( URL, Length( URL ), 1 ) = '/' then
 728                 uri := TIdURI.Create( URL + SUBJECT_NAME )
 729         else
 730                 uri := TIdURI.Create( URL );
 731         uriList := TStringList.Create;
 732         if FDat <> nil then begin
 733                 try
 734                         FDat.Free;
 735                         FDat := nil;
 736                 except
 737                 end;
 738         end;
 739         FDat := TStringList.Create;
 740         // \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Í
 741         // InternalDownload \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
 742         modified := LastModified;
 743         responseCode := InternalDownload( PChar( uri.URI ), modified, downResult );
 744         try
 745                 if responseCode = 200 then begin
 746                         try
 747                                 // \83p\83X\82ð\8eZ\8fo
 748                                 YofUtils.ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
 749                                 if MyLogFolder = '' then begin
 750                                         // \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¶
 751                                         FilePath                        := TemporaryFile;
 752                                         FIsTemporary    := True;
 753                                 end else begin
 754                                         FilePath                        := MyLogFolder + uriList[ 1 ] + '\' + uri.Document;
 755                                         FIsTemporary    := False
 756                                 end;
 757
 758                                 // \95Û\91¶\97p\82Ì\83f\83B\83\8c\83N\83g\83\8a\82ð\8c@\82é
 759                                 ForceDirectoriesEx( Copy( FilePath, 1, LastDelimiter( '\', FilePath ) ) );
 760
 761                                 FDat.Text := string( downResult );
 762                                 // \95Û\91¶
 763                                 FDat.SaveToFile( FilePath );
 764                         finally
 765                                 uri.Free;
 766                                 uriList.Free;
 767                         end;
 768                         Result := dsComplete;
 769                 end;
 770         finally
 771                 DisposeResultString( downResult );
 772         end;
 773
 774 end;
 775
 776 // *************************************************************************
 777 // \83X\83\8c\88ê\97\97\82Ì URL \82©\82ç\83X\83\8c\83b\83h\82Ì URL \82ð\93±\82«\8fo\82·
 778 // *************************************************************************
 779 function TMachiBBSBoardItem.ToThreadURL(
 780         inFileName      : string        // \83X\83\8c\83b\83h\83t\83@\83C\83\8b\96¼
 781 ) : string;                                                     // \83X\83\8c\83b\83h\82Ì URL
 782 var
 783         threadURL               : string;
 784         uri                                     : TIdURI;
 785         uriList                 : TStringList;
 786         found                           : Integer;
 787 begin
 788
 789         found := Pos( '.', inFileName );
 790         if found > 0 then
 791                 inFileName := Copy( inFileName, 1, found - 1 );
 792         if Copy( URL, Length( URL ), 1 ) = '/' then
 793                 uri := TIdURI.Create( URL )
 794         else
 795                 uri := TIdURI.Create( URL + '/' );
 796         uriList := TStringList.Create;
 797
 798         try
 799                 try
 800                         // http://hokkaido.machi.to/hokkaidou/
 801                         // http://hokkaido.machi.to/bbs/read.pl?BBS=hokkaidou&KEY=1061764446&LAST=50
 802                         YofUtils.ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
 803                         threadURL       := uri.Protocol + '://' + uri.Host + '/bbs/read.pl?' +
 804                                 'BBS=' + uriList[ 1 ] + '&KEY=' + inFileName + '&LAST=50';
 805                         Result          := threadURL;
 806                 finally
 807                         uri.Free;
 808                         uriList.Free;
 809                 end;
 810         except
 811                 Result := '';
 812         end;
 813
 814 end;
 815
 816 // *************************************************************************
 817 // \82±\82Ì\94Â\82É\82¢\82\82Â\82Ì\83X\83\8c\82ª\82 \82é\82©\97v\8b\81\82³\82ê\82½
 818 // *************************************************************************
 819 procedure       TMachiBBSBoardItem.EnumThread(
 820         inCallBack      : TBoardItemEnumThreadCallBack
 821 );
 822 var
 823         uri                                     : TIdURI;
 824         uriList                 : TStringList;
 825         rec                                     : TSubjectRec;
 826         i                                               : Integer;
 827         isContinue      : Boolean;
 828 const
 829         SUBJECT_NAME    = 'subject.txt';
 830 begin
 831
 832         try
 833                 if FDat = nil then begin
 834                         FDat := TStringList.Create;
 835
 836                         if Copy( URL, Length( URL ), 1 ) = '/' then
 837                                 uri := TIdURI.Create( URL + SUBJECT_NAME )
 838                         else
 839                                 uri := TIdURI.Create( URL );
 840                         uriList := TStringList.Create;
 841                         try
 842                                 // \83p\83X\82ð\8eZ\8fo
 843                                 YofUtils.ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
 844                                 // http://hokkaido.machi.to/hokkaidou/subject.txt
 845                                 FilePath        := MyLogFolder + uriList[ 1 ] + '\' + uri.Document;
 846                                 if FileExists( FilePath ) then
 847                                         // \93Ç\82Ý\8d\9e\82Ý
 848                                         FDat.LoadFromFile( FilePath );
 849                         finally
 850                                 uri.Free;
 851                                 uriList.Free;
 852                         end;
 853                 end;
 854
 855                 for i := 0 to FDat.Count - 1 do begin
 856                         rec                                             := DivideSubject( FDat[i] );
 857                         rec.FFileName   := Trim(rec.FFileName);
 858                         if (rec.FTitle = '') and (rec.FCount = 0) then
 859                                 Continue;
 860
 861                         isContinue := inCallBack(
 862                                 Instance,
 863                                 PChar( ToThreadURL( rec.FFileName ) ),
 864                                 PChar( rec.FTitle ),
 865                                 DWORD( rec.FCount ) );
 866
 867                         if ( not isContinue ) then
 868                                 Break;
 869                 end;
 870         except
 871         end;
 872
 873 end;
 874
 875 // *************************************************************************
 876 // TBoardItem \82ª\90¶\90¬\82³\82ê\82½\8fê\8d\87\82Ì\8f\88\92u(TMachiBBSBoardItem \82ð\90¶\90¬\82·\82é)
 877 // *************************************************************************
 878 procedure BoardItemOnCreateOfTMachiBBSBoardItem(
 879         inInstance : DWORD
 880 );
 881 var
 882         boardItem : TMachiBBSBoardItem;
 883 begin
 884
 885         boardItem := TMachiBBSBoardItem.Create( inInstance );
 886         BoardItemSetLong( inInstance, bipContext, DWORD( boardItem ) );
 887
 888 end;
 889
 890 // *************************************************************************
 891 // TBoardItem \82ª\94j\8aü\82³\82ê\82½\8fê\8d\87\82Ì\8f\88\92u(TMachiBBSBoardItem \82ð\94j\8aü\82·\82é)
 892 // *************************************************************************
 893 procedure BoardItemOnDisposeOfTMachiBBSBoardItem(
 894         inInstance : DWORD
 895 );
 896 var
 897         boardItem : TMachiBBSBoardItem;
 898 begin
 899
 900         boardItem := TMachiBBSBoardItem( BoardItemGetLong( inInstance, bipContext ) );
 901         boardItem.Free;
 902
 903 end;
 904
 905
 906
 907 // =========================================================================
 908 // \83G\83\93\83g\83\8a\83|\83C\83\93\83g
 909 // =========================================================================
 910 procedure DLLEntry(
 911         ul_reason_for_call : DWORD
 912 );
 913 var
 914         module : HMODULE;
 915 begin
 916
 917         case ul_reason_for_call of
 918                 DLL_PROCESS_ATTACH:
 919                 begin
 920                         Randomize;
 921
 922                         module := GetModuleHandle( nil );
 923
 924                         LoadInternalAPI( module );
 925                         LoadInternalFilePathAPI( module );
 926                         LoadInternalThreadItemAPI( module );
 927                         LoadInternalBoardItemAPI( module );
 928
 929                         // ===== \83C\83\93\83X\83^\83\93\83X\82Ì\8eæ\82è\88µ\82¢\82ð TThreadItem \82©\82ç TMachiBBSThreadItem \82É\95Ï\8dX\82·\82é
 930                         ThreadItemOnCreate      := ThreadItemOnCreateOfTMachiBBSThreadItem;
 931                         ThreadItemOnDispose     := ThreadItemOnDisposeOfTMachiBBSThreadItem;
 932                         // ===== \83C\83\93\83X\83^\83\93\83X\82Ì\8eæ\82è\88µ\82¢\82ð TBoardItem \82©\82ç TMachiBBSBoardItem \82É\95Ï\8dX\82·\82é
 933                         BoardItemOnCreate               := BoardItemOnCreateOfTMachiBBSBoardItem;
 934                         BoardItemOnDispose      := BoardItemOnDisposeOfTMachiBBSBoardItem;
 935                 end;
 936                 DLL_PROCESS_DETACH:
 937                         ;
 938                 DLL_THREAD_ATTACH:
 939                         ;
 940                 DLL_THREAD_DETACH:
 941                         ;
 942         end;
 943
 944 end;
 945
 946 exports
 947         OnVersionInfo,
 948         OnAcceptURL;
 949
 950 begin
 951
 952         try
 953                 DllProc := @DLLEntry;
 954                 DLLEntry( DLL_PROCESS_ATTACH );
 955         except end;
 956
 957 end.