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