res/ExternalBoardPlugIn/ShitarabaJBBSPlugIn.dpr

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