res/ExternalBoardPlugIn/MachiBBSPlugIn.dpr

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