res/ExternalBoardPlugIn/ShitarabaPlugIn.dpr

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