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