--- /dev/null
+library Be2chPlugIn;
+
+{
+ Be2chPlugIn
+ \82Q\82¿\82á\82ñ\82Ë\82éBe\8f\88\97\9d\83\86\83j\83b\83g
+}
+
+uses
+ Windows,
+ SysUtils,
+ Classes,
+ Math,
+ DateUtils,
+ IdURI,
+ PlugInMain in 'PlugInMain.pas',
+ ThreadItem in 'ThreadItem.pas',
+ BoardItem in 'BoardItem.pas',
+ FilePath in 'FilePath.pas',
+ Y_TextConverter in 'Y_TextConverter.pas',
+ MojuUtils in '..\..\MojuUtils.pas';
+
+{$E dll}
+
+{$R *.res}
+
+type
+ // =========================================================================
+ // TBe2chThreadItem
+ // =========================================================================
+ TBe2chThreadItem = class(TThreadItem)
+ private
+ FIsTemporary : Boolean;
+ FDat : TStringList;
+
+ public
+ constructor Create( inInstance : DWORD );
+ destructor Destroy; override;
+
+ private
+ function Download : TDownloadState;
+ function Write( inName : string; inMail : string; inMessage : string ) : TDownloadState;
+ function GetRes( inNo : Integer ) : string;
+ function GetDat( inNo : Integer ) : string;
+ function GetHeader( inOptionalHeader : string ) : string;
+ function GetFooter( inOptionalFooter : string ) : string;
+ function GetBoardURL : string;
+ procedure LoadDat;
+ procedure FreeDat;
+ function BrowsableURL : string;
+ function ReadURL : string;
+ function WriteURL : string;
+ function AddBeProfileLink( AID : string; ANum: Integer) : string;
+ end;
+
+ // =========================================================================
+ // TBe2chBoardItem
+ // =========================================================================
+ TBe2chBoardItem = class(TBoardItem)
+ private
+ FIsTemporary : Boolean;
+ FDat : TStringList;
+
+ public
+ constructor Create( inInstance : DWORD );
+ destructor Destroy; override;
+
+ private
+ function Download : TDownloadState;
+ function CreateThread( inSubject : string; inName : string; inMail : string; inMessage : string ) : TDownloadState;
+ function ToThreadURL( inFileName : string ) : string;
+ procedure EnumThread( inCallBack : TBoardItemEnumThreadCallBack );
+
+ function SubjectURL : string;
+ end;
+
+const
+ LOG_DIR = 'Be2ch\';
+ SUBJECT_NAME = 'subject.txt';
+
+ PLUGIN_NAME = 'Be2ch';
+ MAJOR_VERSION = 1;
+ MINOR_VERSION = 1;
+ RELEASE_VERSION = 'alpha';
+ REVISION_VERSION = 1;
+
+// =========================================================================
+// \8eG\97p\8aÖ\90\94
+// =========================================================================
+
+// *************************************************************************
+// \83e\83\93\83|\83\89\83\8a\82È\83p\83X\82Ì\8eæ\93¾
+// *************************************************************************
+function TemporaryFile : string;
+var
+ tempPath : array [0..MAX_PATH] of char;
+begin
+
+ GetTempPath( SizeOf(tempPath), tempPath );
+ repeat
+ Result := tempPath + IntToStr( Random( $7fffffff ) );
+ until not FileExists( Result );
+
+end;
+
+// *************************************************************************
+// Be\97p\83\8d\83O\83t\83H\83\8b\83_\8eæ\93¾
+// *************************************************************************
+function MyLogFolder : string;
+var
+ folder : PChar;
+begin
+
+ folder := LogFolder;
+ if Length( folder ) = 0 then
+ Result := ''
+ else
+ Result := folder + LOG_DIR;
+ DisposeResultString(folder);
+
+end;
+
+(*************************************************************************
+ *\83f\83B\83\8c\83N\83g\83\8a\82ª\91¶\8dÝ\82·\82é\82©\83`\83F\83b\83N
+ *************************************************************************)
+function DirectoryExistsEx(const Name: string): Boolean;
+var
+ Code: Integer;
+begin
+ Code := GetFileAttributes(PChar(Name));
+ Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
+end;
+
+(*************************************************************************
+ *\83f\83B\83\8c\83N\83g\83\8a\8dì\90¬\81i\95¡\90\94\8aK\91w\91Î\89\9e\81j
+ *************************************************************************)
+function ForceDirectoriesEx(Dir: string): Boolean;
+begin
+ Result := True;
+ if Length(Dir) = 0 then
+ raise Exception.Create('\83t\83H\83\8b\83_\82ª\8dì\90¬\8fo\97\88\82Ü\82¹\82ñ');
+ Dir := ExcludeTrailingPathDelimiter(Dir);
+ if (Length(Dir) < 3) or DirectoryExistsEx(Dir)
+ or (ExtractFilePath(Dir) = Dir) then Exit; // avoid 'xyz:\' problem.
+ Result := ForceDirectoriesEx(ExtractFilePath(Dir)) and CreateDir(Dir);
+end;
+
+// \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
+procedure ExtractHttpFields(
+ const chrSep : TSysCharSet;
+ const chrWhite : TSysCharSet;
+ const strValue : string;
+ var strResult : TStringList;
+ unknownFlag : boolean = false
+);
+var
+ last, p, strLen : Integer;
+begin
+
+ strLen := Length( strValue );
+ p := 1;
+ last := 1;
+
+ while p <= strLen do
+ begin
+
+ if strValue[ p ] in chrSep then
+ begin
+ strResult.Add( Copy( strValue, last, p - last ) );
+ last := p + 1;
+ end;
+
+ p := p + 1;
+
+ end;
+
+ if last <> p then
+ strResult.Add( Copy( strValue, last, strLen - last + 1 ) );
+
+end;
+
+\rfunction HttpEncode(
+\r const strValue : string
+) : string;
+var
+ i : Integer;
+ strLen : Integer;
+ strResult : string;
+ b : Integer;
+const
+ kHexCode : array [0..15] of char = (
+ '0', '1', '2', '3', '4', '5', '6', '7',
+ '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' );
+begin
+
+ strLen := Length( strValue );
+ i := 1;
+
+ while i <= strLen do
+ begin
+
+ case strValue[ i ] of
+ '0' .. '9', 'a' .. 'z', 'A' .. 'Z', '*', '-', '.', '@', '_':
+ begin
+ strResult := strResult + strValue[ i ];
+ end;
+ else
+ begin
+ b := Integer( strValue[ i ] );
+ strResult := strResult + '%'
+ + kHexCode[ b div $10 ]
+ + kHexCode[ b mod $10 ];
+ end;
+ end;
+
+ i := i + 1;
+
+ end;
+
+ Result := strResult;
+
+end;
+
+
+
+// =========================================================================
+// PlugIn
+// =========================================================================
+// *************************************************************************
+// \83v\83\89\83O\83C\83\93\82Ì\83o\81[\83W\83\87\83\93\82ð\97v\8b\81\82³\82ê\82½
+// *************************************************************************
+procedure OnVersionInfo(
+ var outAgent : PChar; // \83o\81[\83W\83\87\83\93\82ð\88ê\90Ø\8aÜ\82Ü\82È\82¢\8f\83\90\88\82È\96¼\8fÌ
+ var outMajor : DWORD; // \83\81\83W\83\83\81[\83o\81[\83W\83\87\83\93
+ var outMinor : DWORD; // \83}\83C\83i\81[\83o\81[\83W\83\87\83\93
+ var outRelease : PChar; // \83\8a\83\8a\81[\83X\92i\8aK\96¼
+ var outRevision : DWORD // \83\8a\83r\83W\83\87\83\93\83i\83\93\83o\81[
+); stdcall;
+begin
+
+ try
+ outAgent := CreateResultString( PChar( PLUGIN_NAME ) );
+ outMajor := MAJOR_VERSION;
+ outMinor := MINOR_VERSION;
+ outRelease := CreateResultString( PChar( RELEASE_VERSION ) );
+ outRevision := REVISION_VERSION;
+ except
+ outAgent := nil;
+ outMajor := 0;
+ outMinor := 0;
+ outRelease := nil;
+ outRevision := 0;
+ end;
+
+end;
+
+// *************************************************************************
+// \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©
+// *************************************************************************
+function OnAcceptURL(
+ inURL : PChar // \94»\92f\82ð\8bÂ\82¢\82Å\82¢\82é URL
+): TAcceptType; stdcall; // URL \82Ì\8eí\97Þ
+var
+ uri : TIdURI;
+ uriList : TStringList;
+ foundPos : Integer;
+// i : Integer;
+const
+ BBS_HOST = 'be.2ch.net';
+ THREAD_MARK = '/test/read.cgi';
+begin
+
+ try
+ // \83z\83X\83g\96¼\82ª be.2ch.net\82È\82ç\8eó\82¯\95t\82¯\82é
+ uri := TIdURI.Create( inURL );
+ uriList := TStringList.Create;
+ try
+
+ ExtractHttpFields( ['/'], [], uri.Path, uriList );
+ if (AnsiPos( BBS_HOST, uri.Host ) > 0) and (Length( uri.Host ) - AnsiPos( BBS_HOST, uri.Host ) + 1 = Length( BBS_HOST )) then begin
+ foundPos := AnsiPos( THREAD_MARK, inURL );
+
+ if foundPos > 0 then
+ Result := atThread
+ else if (uriList.Count > 2) and (AnsiPos('.html', uri.Document) > 0) then
+ Result := atThread
+ else if uriList.Count = 2 then
+ Result := atBoard
+ else
+ Result := atBBS;
+
+ end else begin
+ Result := atNoAccept;
+ end;
+
+ finally
+ uri.Free;
+ uriList.Free;
+ end;
+ except
+ Result := atNoAccept;
+ end;
+
+end;
+
+function BrowsableURL(
+ inURL : string
+) : string;
+var
+ uri : TIdURI;
+ uriList : TStringList;
+ foundPos : Integer;
+ dir, tmphost : string;
+const
+ THREAD_MARK = '/test/read.cgi';
+ BBS_HOST = 'be.2ch.net';
+begin
+
+ foundPos := AnsiPos( '?', inURL );
+ if foundPos > 0 then begin
+ // \8b\8c\8e®
+ uri := TIdURI.Create( inURL );
+ uriList := TStringList.Create;
+ try
+ ExtractHttpFields( ['/'], [], uri.Path, uriList );
+ dir := uriList[ 1 ];
+
+ tmphost := uri.Host;
+
+ ExtractHttpFields( ['&'], [], Copy( inURL, foundPos + 1, MaxInt ), uriList );
+ Result :=
+ uri.Protocol + '://' + tmphost + THREAD_MARK +
+ dir + '/' + uriList.Values[ 'BBS' ] + '/' + uriList.Values[ 'KEY' ] + '/l100';
+ finally
+ uri.Free;
+ uriList.Free;
+ end;
+ end else begin
+ if Copy( inURL, Length( inURL ), 1 ) = '/' then
+ uri := TIdURI.Create( inURL )
+ else
+ uri := TIdURI.Create( inURL + '/' );
+
+ uriList := TStringList.Create;
+ try
+ ExtractHttpFields( ['/'], [], uri.Path, uriList );
+
+ tmphost := uri.Host;
+
+ if( AnsiPos(THREAD_MARK, inURL) > 0) and (uriList.Count > 4) then begin
+ Result :=
+ uri.Protocol + '://' + tmphost + THREAD_MARK + '/' +
+ uriList[ 3 ] + '/' + uriList[ 4 ] + '/l50';
+
+ end else begin
+ Result := inURL;
+ end;
+ finally
+ uri.Free;
+ uriList.Free;
+ end;
+ end;
+
+end;
+// *************************************************************************
+// \8ew\92è\82µ\82½ URL \82ðBoard\82ÌURL\82É\95Ï\8a·
+// *************************************************************************
+procedure OnExtractBoardURL(
+ inURL : PChar;
+ var outURL : PChar
+); stdcall;
+var
+ uri : TIdURI;
+ uriList : TStringList;
+ tmphost : String;
+ URL : String;
+const
+ THREAD_MARK = '/test/read.cgi';
+ BBS_HOST = 'be.2ch.net';
+begin
+ URL := string(inURL);
+ if (AnsiPos(THREAD_MARK,URL) > 0) then begin
+ URL := BrowsableURL(URL);
+ uri := TIdURI.Create( URL );
+ uriList := TStringList.Create;
+ try
+ ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
+
+ tmphost := uri.Host;
+
+ if uriList.Count > 4 then
+ URL := uri.Protocol + '://' + tmphost + '/' + uriList[ 3 ] + '/';
+ outURL := CreateResultString(URL);
+ finally
+ uri.Free;
+ uriList.Free;
+ end;
+ end else begin
+ outURL := CreateResultString(URL);
+ end;
+
+end;
+
+// =========================================================================
+// TShitarabaThreadItem
+// =========================================================================
+
+// *************************************************************************
+// \83R\83\93\83X\83g\83\89\83N\83^
+// *************************************************************************
+constructor TBe2chThreadItem.Create(
+ inInstance : DWORD
+);
+var
+ uriList : TStringList;
+begin
+
+ inherited;
+
+ OnDownload := Download;
+ OnWrite := Write;
+ OnGetRes := GetRes;
+ OnGetDat := GetDat;
+ OnGetHeader := GetHeader;
+ OnGetFooter := GetFooter;
+ OnGetBoardURL := GetBoardURL;
+
+ FIsTemporary := False;
+ FDat := nil;
+ URL := BrowsableURL;
+
+ uriList := TStringList.Create;
+ try
+ ExtractHttpFields( ['/', '?'], [], URL, uriList );
+
+ FileName := uriList[ 6 ] + '.dat';
+ //FilePath := MyLogFolder + uriList[ 2 ] + '\' + FileName;
+ IsLogFile := FileExists( FilePath );
+ finally
+ uriList.Free;
+ end;
+
+end;
+
+// *************************************************************************
+// \83f\83X\83g\83\89\83N\83^
+// *************************************************************************
+destructor TBe2chThreadItem.Destroy;
+begin
+
+ FreeDat;
+
+ // \88ê\8e\9e\83t\83@\83C\83\8b\82Ì\8fê\8d\87\82Í\8dí\8f\9c\82·\82é
+ if FIsTemporary then
+ DeleteFile( FilePath );
+
+ inherited;
+
+end;
+
+// *************************************************************************
+// \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½
+// *************************************************************************
+function TBe2chThreadItem.Download : TDownloadState;
+var
+ modified : Double;
+ tmp : PChar;
+ downResult : TStringList;
+ responseCode : Longint;
+ logStream : TFileStream;
+ uri : TIdURI;
+ uriList : TStringList;
+ datURL : string;
+ tmpText: string;
+// rangeEnd : Integer;
+ FilePath : string;
+begin
+
+ Result := dsError;
+
+ uri := TIdURI.Create( ReadURL );
+ uriList := TStringList.Create;
+ try
+ ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
+ FileName := uriList[ 4 ] + '.dat';
+
+ if MyLogFolder = '' then begin
+ // \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¶
+ FilePath := TemporaryFile;
+ FIsTemporary := True;
+ end else begin
+ FilePath := MyLogFolder + uriList[ 3 ] + '\' + FileName;
+ FIsTemporary := False;
+ end;
+ //http://be.2ch.net/be/dat/1109901078.dat
+ datURL := 'http://' + uri.Host + '/' + uriList[ 3 ] + '/dat/' + FileName;
+ finally
+ uri.Free;
+ uriList.Free;
+ end;
+
+ // \95Û\91¶\97p\82Ì\83f\83B\83\8c\83N\83g\83\8a\82ð\8c@\82é
+ ForceDirectoriesEx( Copy( FilePath, 1, LastDelimiter( '\', FilePath ) ) );
+
+ // \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Í
+ // InternalDownload \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
+ modified := LastModified;
+ responseCode := InternalDownload( PChar( datURL ), modified, tmp, Size );
+
+ try
+ if (responseCode = 200) or (responseCode = 206) then begin
+ downResult := TStringList.Create;
+ try
+ Size := Size + Length( string( tmp ) );
+
+ tmpText := CustomStringReplace( string( tmp ), '¡÷¡®', ',' );
+ downResult.Text := EUCtoSJIS( tmpText );
+
+ if downResult.Count > 0 then begin
+ if FileExists( FilePath ) then
+ logStream := TFileStream.Create( FilePath, fmOpenReadWrite or fmShareDenyWrite )
+ else
+ logStream := TFileStream.Create( FilePath, fmCreate or fmShareDenyWrite );
+ try
+ logStream.Position := logStream.Size;
+ logStream.Write( PChar( downResult.Text )^, Length( downResult.Text ) );
+ finally
+ logStream.Free;
+ end;
+
+ if Count = 0 then
+ // \90V\8bK
+ Result := dsComplete
+ else
+ // \92Ç\8bL
+ Result := dsDiffComplete;
+
+
+ // CGI \82©\82ç\82Í\90³\82µ\82¢\93ú\95t\82ª\93¾\82ç\82ê\82È\82¢\82Ì\82Å\8c»\8dÝ\82É\90Ý\92è
+ LastModified := Now;
+
+
+
+ NewReceive := Count + 1;
+ Count := Count + downResult.Count;
+ NewResCount := downResult.Count;
+
+
+
+ end else begin
+ Result := dsNotModify;
+ end;
+ finally
+ downResult.Free;
+ end;
+ end else if responseCode = 304 then begin
+ Result := dsNotModify;
+ end;
+ finally
+ DisposeResultString( tmp );
+ end;
+
+end;
+
+// *************************************************************************
+// \8f\91\82«\8d\9e\82Ý\82ð\8ew\8e¦\82³\82ê\82½
+// *************************************************************************
+function TBe2chThreadItem.Write(
+ inName : string; // \96¼\91O(\83n\83\93\83h\83\8b)
+ inMail : string; // \83\81\81[\83\8b\83A\83h\83\8c\83X
+ inMessage : string // \96{\95¶
+) : TDownloadState; // \8f\91\82«\8d\9e\82Ý\82ª\90¬\8c÷\82µ\82½\82©\82Ç\82¤\82©
+var
+ postData : string;
+ postResult : PChar;
+ uri : TIdURI;
+ uriList : TStringList;
+ responseCode : Integer;
+begin
+
+ uri := TIdURI.Create( URL );
+ uriList := TStringList.Create;
+ try
+ ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
+
+ // http://jbbs.livedoor.com/bbs/read.cgi/game/1578/1067968274/l100
+ postData :=
+ 'NAME=' + HttpEncode( SJIStoEUC( inName ) ) +
+ '&MAIL=' + HttpEncode( SJIStoEUC( inMail ) ) +
+ '&MESSAGE=' + HttpEncode( SJIStoEUC( inMessage ) ) +
+ '&BBS=' + uriList[ 4 ] +
+ '&KEY=' + uriList[ 5 ] +
+ '&DIR=' + uriList[ 3 ] +
+ '&TIME=' + IntToStr( DateTimeToUnix( Now ) ) +
+ '&submit=' + HttpEncode( SJIStoEUC( '\8f\91\82«\8d\9e\82Þ' ) );
+
+ // \93Æ\8e©\82É\92Ê\90M\82µ\82È\82¢\8fê\8d\87\82Í InternalPost \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
+ responseCode := InternalPost( PChar( WriteURL ), PChar( postData ), PChar(URL), postResult );
+ try
+ if (responseCode = 200) or
+ ((responseCode = 302) and (Length( Trim( postResult ) ) = 0)) then begin
+ Result := dsComplete
+ end else begin
+ Result := dsError;
+ if Assigned( InternalPrint ) then
+ InternalPrint( postResult );
+ end;
+ finally
+ DisposeResultString( postResult );
+ end;
+ finally
+ uri.Free;
+ uriList.Free;
+ end;
+
+end;
+
+// *************************************************************************
+// \83\8c\83X\94Ô\8d\86 inNo \82É\91Î\82·\82é html \82ð\97v\8b\81\82³\82ê\82½
+// *************************************************************************
+function TBe2chThreadItem.GetRes(
+ inNo : Integer // \97v\8b\81\82³\82ê\82½\83\8c\83X\94Ô\8d\86
+) : string; // \91Î\89\9e\82·\82é HTML
+var
+ res : string;
+ tmp : PChar;
+begin
+
+ // \93Æ\8e©\82É\83t\83B\83\8b\83^\83\8a\83\93\83O\82ð\8ds\82í\82È\82¢\8fê\8d\87\82Í
+ // InternalAbon \82¨\82æ\82Ñ Dat2HTML \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
+ {
+ LoadDat;
+ if FDat = nil then begin
+ // \83\8d\83O\82É\91¶\8dÝ\82µ\82È\82¢\82Ì\82Å\82±\82Ì\82Ü\82Ü\8fI\97¹
+ Result := '';
+ Exit;
+ end;
+ res := Copy( FDat[ inNo - 1 ], AnsiPos( '<>', FDat[ inNo - 1 ] ) + 2, MaxInt );
+ }
+ res := GetDat( inNo );
+ if res = '' then begin
+ Result := '';
+ Exit;
+ end else begin
+ tmp := InternalAbonForOne( PChar( res ), PChar( FilePath ),inNo );
+ try
+ Result := Dat2HTML( string( tmp ), inNo );
+ finally
+ DisposeResultString( tmp );
+ end;
+ end;
+
+end;
+
+// *************************************************************************
+// \83\8c\83X\94Ô\8d\86 inNo \82É\91Î\82·\82é Dat \82ð\97v\8b\81\82³\82ê\82½
+// *************************************************************************
+function TBe2chThreadItem.GetDat(
+ inNo : Integer // \97v\8b\81\82³\82ê\82½\83\8c\83X\94Ô\8d\86
+) : string; // \82Q\82¿\82á\82ñ\82Ë\82é\82ÌDat\8c`\8e®
+var
+ res, tmp : string;
+ AID : string;
+// i : Integer;
+ pTmp : PChar;
+begin
+ pTmp := nil;
+ // \93Æ\8e©\82É\83t\83B\83\8b\83^\83\8a\83\93\83O\82ð\8ds\82í\82È\82¢\8fê\8d\87\82Í
+ // InternalAbon \82¨\82æ\82Ñ Dat2HTML \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
+ LoadDat;
+ if (FDat = nil) or (inNo - 1 < 0 ) or (inNo - 1 >= FDat.Count) then begin
+ // \83\8d\83O\82É\91¶\8dÝ\82µ\82È\82¢\82Ì\82Å\82±\82Ì\82Ü\82Ü\8fI\97¹
+ Result := '';
+ Exit;
+ end;
+ try
+ tmp := FDat[ inNo - 1 ];
+ res := Copy(tmp, 1, AnsiPos('<BE:', tmp) - 1);
+ Delete(tmp, 1, AnsiPos('<BE:', tmp) - 1);
+ AID := Copy(tmp, 1, AnsiPos('>', tmp));
+ Delete(tmp, 1, AnsiPos('>', tmp));
+ res := res + AddBeProfileLink(AID, inNo) + tmp;
+ //<BE:
+ pTmp := CreateResultString(res);
+ Result := string(pTmp);
+ finally
+ DisposeResultString(pTmp);
+ end;
+
+end;
+function TBe2chThreadItem.AddBeProfileLink(
+ AID : string;
+ ANum: Integer
+) : string;
+var
+ p : integer;
+ BNum{, BMark} : string;
+begin
+ //<BE:34600695:4>
+ p := AnsiPos('BE:', AnsiUpperCase(AID));
+ if p > 0 then begin
+ BNum := Copy(AID, p + 3, Length(AID));
+ p := AnsiPos(':', BNum);
+ if p > 0 then begin
+ BNum := Copy(BNum, 1, p - 1);
+ end;
+ BNum := Trim(BNum);
+ Result := ' <a href="BE:' + BNum + '/' + IntToStr(ANum)
+ + '" target=_blank>' + 'BE' + '</a>';
+ end else
+ Result := AID;
+end;
+// *************************************************************************
+// \83X\83\8c\83b\83h\82Ì\83w\83b\83_ html \82ð\97v\8b\81\82³\82ê\82½
+// *************************************************************************
+function TBe2chThreadItem.GetHeader(
+ inOptionalHeader : string
+) : string;
+begin
+
+ // \93Æ\8e©\82É\83t\83B\83\8b\83^\83\8a\83\93\83O\82ð\8ds\82í\82È\82¢\8fê\8d\87\82Í
+ // InternalHeader \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
+ Result := InternalHeader(
+ '<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">' +
+ inOptionalHeader );
+
+
+ // GetRes \82ð\8cÄ\82Î\82ê\82é\82±\82Æ\82ª\97\\91z\82³\82ê\82é\82Ì\82Å FDat \82ð\90¶\90¬\82µ\82Ä\82¨\82
+ try
+ FreeDat;
+ LoadDat;
+ except
+ end;
+
+end;
+
+// *************************************************************************
+// \83X\83\8c\83b\83h\82Ì\83t\83b\83^ html \82ð\97v\8b\81\82³\82ê\82½
+// *************************************************************************
+function TBe2chThreadItem.GetFooter(
+ inOptionalFooter : string
+) : string;
+begin
+
+ // \93Æ\8e©\82É\83t\83B\83\8b\83^\83\8a\83\93\83O\82ð\8ds\82í\82È\82¢\8fê\8d\87\82Í
+ // InternalFooter \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
+ Result := InternalFooter( inOptionalFooter );
+
+ // \82à\82¤ GetRes \82Í\8cÄ\82Î\82ê\82È\82¢\82Æ\8ev\82¤\82Ì\82Å FDat \82ð\8aJ\95ú\82µ\82Ä\82¨\82
+ try
+ FreeDat;
+ except
+ end;
+
+end;
+
+// *************************************************************************
+// \82±\82Ì ThreadItem \82ª\91®\82·\82é\94Â\82Ì URL \82ð\97v\8b\81\82³\82ê\82½
+// *************************************************************************
+function TBe2chThreadItem.GetBoardURL : string;
+var
+ uri : TIdURI;
+ uriList : TStringList;
+ tmphost: String;
+const
+ BBS_HOST = 'be.2ch.net';
+begin
+
+ uri := TIdURI.Create( ReadURL );
+ uriList := TStringList.Create;
+ try
+ ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
+
+ tmphost := uri.Host;
+ if( uriList.Count > 4 ) then begin
+ FileName := uriList[ 4 ] + '.dat';
+ Result := CreateResultString(
+ uri.Protocol + '://' + tmphost + '/' + uriList[ 3 ] + '/' );
+ end;
+ finally
+ uri.Free;
+ uriList.Free;
+ end;
+{
+ URL := string(inURL);
+ if (AnsiPos(THREAD_MARK,URL) > 0) then begin
+ URL := BrowsableURL(URL);
+ uri := TIdURI.Create( URL );
+ uriList := TStringList.Create;
+ try
+ ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
+
+ tmphost := uri.Host;
+
+ if uriList.Count > 4 then
+ URL := uri.Protocol + '://' + tmphost + '/' + uriList[ 3 ] + '/';
+ outURL := CreateResultString(URL);
+ finally
+ uri.Free;
+ uriList.Free;
+ end;
+ end else begin
+ outURL := CreateResultString(URL);
+ end;
+}
+end;
+
+// *************************************************************************
+// FDat \82Ì\90¶\90¬
+// *************************************************************************
+procedure TBe2chThreadItem.LoadDat;
+begin
+
+ if FDat = nil then begin
+ if IsLogFile then begin
+ // dat \82Ì\93Ç\82Ý\8d\9e\82Ý
+ FDat := TStringList.Create;
+ FDat.LoadFromFile( FilePath );
+ end;
+ end;
+
+end;
+
+// *************************************************************************
+// FDat \82Ì\8aJ\95ú
+// *************************************************************************
+procedure TBe2chThreadItem.FreeDat;
+begin
+
+ if FDat <> nil then begin
+ FDat.Free;
+ FDat := nil;
+ end;
+
+end;
+
+// *************************************************************************
+// \88À\91S\82È\83u\83\89\83E\83U\95\\8e¦\97p\82Ì URL
+// *************************************************************************
+function TBe2chThreadItem.BrowsableURL : string;
+var
+ uri : TIdURI;
+ uriList : TStringList;
+ foundPos : Integer;
+ dir, tmphost : string;
+const
+ THREAD_MARK = '/test/read.cgi';
+ BBS_HOST = 'be.2ch.net';
+begin
+
+ foundPos := AnsiPos( '?', URL );
+ if foundPos > 0 then begin
+ // \8b\8c\8e®
+ uri := TIdURI.Create( URL );
+ uriList := TStringList.Create;
+ try
+ ExtractHttpFields( ['/'], [], uri.Path, uriList );
+ dir := uriList[ 1 ];
+
+ tmphost := uri.Host;
+
+ ExtractHttpFields( ['&'], [], Copy( URL, foundPos + 1, MaxInt ), uriList );
+ Result :=
+ uri.Protocol + '://' + tmphost + THREAD_MARK +
+ dir + '/' + uriList.Values[ 'BBS' ] + '/' + uriList.Values[ 'KEY' ] + '/l100';
+ finally
+ uri.Free;
+ uriList.Free;
+ end;
+ end else begin
+ if Copy( URL, Length( URL ), 1 ) = '/' then
+ uri := TIdURI.Create( URL )
+ else
+ uri := TIdURI.Create( URL + '/' );
+
+ uriList := TStringList.Create;
+ try
+ ExtractHttpFields( ['/'], [], uri.Path, uriList );
+
+ tmphost := uri.Host;
+
+ if( AnsiPos(THREAD_MARK, URL) > 0) and (uriList.Count > 4) then begin
+ Result :=
+ uri.Protocol + '://' + tmphost + THREAD_MARK + '/' +
+ uriList[ 3 ] + '/' + uriList[ 4 ] + '/l50';
+
+ end else begin
+ Result := URL;
+ end;
+ finally
+ uri.Free;
+ uriList.Free;
+ end;
+ end;
+
+end;
+
+// *************************************************************************
+// \88À\91S\82È( '/' \82Å\8fI\82í\82é )\93Ç\82Ý\8d\9e\82Ý\82Ì URL
+// *************************************************************************
+function TBe2chThreadItem.ReadURL : string;
+const
+ THREAD_MARK = '/test/read.cgi';
+var
+ uri : TIdURI;
+ uriList : TStringList;
+ foundPos : Integer;
+ dir, tmphost : string;
+begin
+
+ foundPos := AnsiPos( '?', URL );
+ if foundPos > 0 then begin
+ // \8b\8c\8e®
+ uri := TIdURI.Create( URL );
+ uriList := TStringList.Create;
+ try
+ ExtractHttpFields( ['/'], [], uri.Path, uriList );
+ dir := uriList[ 1 ];
+
+ tmphost := uri.Host;
+
+ ExtractHttpFields( ['&'], [], Copy( URL, foundPos + 1, MaxInt ), uriList );
+ // http://jbbs.livedoor.com/bbs/read.cgi?DIR=game&BBS=1578&KEY=1067968274
+ Result :=
+ uri.Protocol + '://' + tmphost + '/bbs/rawmode.cgi/' +
+ dir + '/' + uriList.Values[ 'BBS' ] + '/' + uriList.Values[ 'KEY' ] + '/';
+ finally
+ uri.Free;
+ uriList.Free;
+ end;
+ end else begin
+ Result := URL;
+ end;
+
+end;
+
+// *************************************************************************
+// \88À\91S\82È( '/' \82Å\8fI\82í\82é )\8f\91\82«\8d\9e\82Ý\82Ì URL
+// *************************************************************************
+function TBe2chThreadItem.WriteURL : string;
+//var
+// uri : TIdURI;
+// uriList : TStringList;
+begin
+ {
+ if Copy( URL, Length( URL ), 1 ) = '/' then
+ uri := TIdURI.Create( URL )
+ else
+ uri := TIdURI.Create( URL + '/' );
+ uriList := TStringList.Create;
+ try
+ ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
+ // http://jbbs.livedoor.com/bbs/read.cgi/game/1578/1067968274/l100
+ Result :=
+ uri.Protocol + '://' + uri.Host + '/bbs/write.cgi/' +
+ uriList[ 3 ] + '/' + uriList[ 4 ] + '/' + uriList[ 5 ] + '/';
+
+ finally
+ uri.Free;
+ uriList.Free;
+ end;
+ }
+ Result := URL;
+end;
+
+// *************************************************************************
+// TThreadItem \82ª\90¶\90¬\82³\82ê\82½\8fê\8d\87\82Ì\8f\88\92u(TShitarabaThreadItem \82ð\90¶\90¬\82·\82é)
+// *************************************************************************
+procedure ThreadItemOnCreateOfTBe2chThreadItem(
+ inInstance : DWORD
+);
+var
+ threadItem : TBe2chThreadItem;
+begin
+
+ threadItem := TBe2chThreadItem.Create( inInstance );
+ ThreadItemSetLong( inInstance, tipContext, DWORD( threadItem ) );
+
+end;
+
+// *************************************************************************
+// TThreadItem \82ª\94j\8aü\82³\82ê\82½\8fê\8d\87\82Ì\8f\88\92u(TShitarabaThreadItem \82ð\94j\8aü\82·\82é)
+// *************************************************************************
+procedure ThreadItemOnDisposeOfTBe2chThreadItem(
+ inInstance : DWORD
+);
+var
+ threadItem : TBe2chThreadItem;
+begin
+
+ threadItem := TBe2chThreadItem( ThreadItemGetLong( inInstance, tipContext ) );
+ threadItem.Free;
+
+end;
+
+// =========================================================================
+// TShitarabaBoardItem
+// =========================================================================
+
+// *************************************************************************
+// \83R\83\93\83X\83g\83\89\83N\83^
+// *************************************************************************
+constructor TBe2chBoardItem.Create(
+ inInstance : DWORD
+);
+var
+ uri : TIdURI;
+ uriList : TStringList;
+const
+ BBS_HOST = 'be.2ch.net';
+begin
+
+ inherited;
+
+ OnDownload := Download;
+ OnCreateThread := CreateThread;
+ OnEnumThread := EnumThread;
+ OnFileName2ThreadURL := ToThreadURL;
+
+ FilePath := '';
+ FIsTemporary := False;
+ FDat := nil;
+ Is2ch := True;
+ uri := TIdURI.Create( SubjectURL );
+ uriList := TStringList.Create;
+ try
+ URL := uri.Protocol + '://' + uri.Host + uri.Path;
+
+ ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
+ // http://jbbs.livedoor.com/game/1000/subject.txt
+ FilePath := MyLogFolder + uriList[ 1 ] + '\' + uri.Document;
+ IsLogFile := FileExists( FilePath );
+ finally
+ uri.Free;
+ uriList.Free;
+ end;
+
+end;
+
+// *************************************************************************
+// \83f\83X\83g\83\89\83N\83^
+// *************************************************************************
+destructor TBe2chBoardItem.Destroy;
+begin
+
+ if FDat <> nil then begin
+ try
+ FDat.Free;
+ FDat := nil;
+ except
+ end;
+ end;
+
+ // \88ê\8e\9e\83t\83@\83C\83\8b\82Ì\8fê\8d\87\82Í\8dí\8f\9c\82·\82é
+ if FIsTemporary then
+ DeleteFile( FilePath );
+
+ inherited;
+
+end;
+
+// *************************************************************************
+// \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½
+// *************************************************************************
+function TBe2chBoardItem.Download : TDownloadState;
+var
+ modified : Double;
+ downResult : PChar;
+ responseCode : Longint;
+ uri : TIdURI;
+ uriList : TStringList;
+ tmpText : String;
+begin
+
+ Result := dsError;
+
+ if FDat <> nil then begin
+ try
+ FDat.Free;
+ FDat := nil;
+ except
+ end;
+ end;
+ FDat := TStringList.Create;
+ uri := TIdURI.Create( SubjectURL );
+ uriList := TStringList.Create;
+ // \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Í
+ // InternalDownload \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
+ modified := LastModified;
+ responseCode := InternalDownload( PChar( uri.URI ), modified, downResult );
+ try
+ if responseCode = 200 then begin
+ try
+ // \83p\83X\82ð\8eZ\8fo
+ if MyLogFolder = '' then begin
+ // \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¶
+ FilePath := TemporaryFile;
+ FIsTemporary := True;
+ end else begin
+ FilePath := MyLogFolder + CustomStringReplace(uri.Path, '/', '') + '\' + uri.Document;
+ FIsTemporary := False
+ end;
+
+ // \95Û\91¶\97p\82Ì\83f\83B\83\8c\83N\83g\83\8a\82ð\8c@\82é
+ ForceDirectoriesEx( Copy( FilePath, 1, LastDelimiter( '\', FilePath ) ) );
+
+ // EUC \82ð Shift_JIS \82É
+ tmpText := CustomStringReplace( string( downResult ), '¡÷¡®', ',');
+ FDat.Text := EUCtoSJIS( tmpText );
+ // \95Û\91¶
+ FDat.SaveToFile( FilePath );
+
+ IsLogFile := True;
+ RoundDate := Now;
+ LastModified := modified;
+ LastGetTime := Now;
+ finally
+ uri.Free;
+ uriList.Free;
+ end;
+ Result := dsComplete;
+ end;
+ finally
+ DisposeResultString( downResult );
+ end;
+
+end;
+
+// *************************************************************************
+// \83X\83\8c\97§\82Ä\82ð\8ew\8e¦\82³\82ê\82½
+// *************************************************************************
+function TBe2chBoardItem.CreateThread(
+ inSubject : string; // \83X\83\8c\83^\83C
+ inName : string; // \96¼\91O(\83n\83\93\83h\83\8b)
+ inMail : string; // \83\81\81[\83\8b\83A\83h\83\8c\83X
+ inMessage : string // \96{\95¶
+) : TDownloadState; // \8f\91\82«\8d\9e\82Ý\82ª\90¬\8c÷\82µ\82½\82©\82Ç\82¤\82©
+var
+ postURL : string;
+ postData : string;
+ postResult : PChar;
+ uri : TIdURI;
+ uriList : TStringList;
+ responseCode : Integer;
+begin
+
+ uri := TIdURI.Create( URL );
+ uriList := TStringList.Create;
+ try
+ ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
+
+ // http://jbbs.livedoor.com/bbs/write.cgi/game/1578/new/
+ // http://jbbs.livedoor.com/game/1000/subject.txt
+ postURL :=
+ uri.Protocol + '://' + uri.Host + '/bbs/write.cgi/' +
+ uriList[ 1 ] + '/' + uriList[ 2 ] + '/new/';
+ postData :=
+ 'SUBJECT=' + HttpEncode( SJIStoEUC( inSubject ) ) +
+ '&NAME=' + HttpEncode( SJIStoEUC( inName ) ) +
+ '&MAIL=' + HttpEncode( SJIStoEUC( inMail ) ) +
+ '&MESSAGE=' + HttpEncode( SJIStoEUC( inMessage ) ) +
+ '&BBS=' + uriList[ 4 ] +
+ '&DIR=' + uriList[ 3 ] +
+ '&TIME=' + IntToStr( DateTimeToUnix( Now ) ) +
+ '&submit=' + HttpEncode( SJIStoEUC( '\90V\8bK\8f\91\82«\8d\9e\82Ý' ) );
+
+ // \93Æ\8e©\82É\92Ê\90M\82µ\82È\82¢\8fê\8d\87\82Í InternalPost \82É\94C\82¹\82é\82±\82Æ\82ª\8fo\97\88\82é
+ responseCode := InternalPost( PChar( postURL ), PChar( postData ), PChar(URL), postResult );
+ try
+ if (responseCode = 200) or
+ ((responseCode = 302) and (Length( Trim( postResult ) ) = 0)) then begin
+ Result := dsComplete
+ end else begin
+ Result := dsError;
+ if Assigned( InternalPrint ) then
+ InternalPrint( postResult );
+ end;
+ finally
+ DisposeResultString( postResult );
+ end;
+ finally
+ uri.Free;
+ uriList.Free;
+ end;
+
+end;
+
+// *************************************************************************
+// \83X\83\8c\88ê\97\97\82Ì URL \82©\82ç\83X\83\8c\83b\83h\82Ì URL \82ð\93±\82«\8fo\82·
+// *************************************************************************
+function TBe2chBoardItem.ToThreadURL(
+ inFileName : string // \83X\83\8c\83b\83h\83t\83@\83C\83\8b\96¼
+) : string; // \83X\83\8c\83b\83h\82Ì URL
+var
+ threadURL : string;
+ uri : TIdURI;
+ uriList : TStringList;
+ found : Integer;
+begin
+
+ found := AnsiPos( '.', inFileName );
+ if found > 0 then
+ inFileName := Copy( inFileName, 1, found - 1 );
+
+ uri := TIdURI.Create( SubjectURL );
+ uriList := TStringList.Create;
+ try
+ try
+ ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
+ {threadURL := uri.Protocol + '://' + uri.Host + '/bbs/read.cgi/' +
+ uriList[ 1 ] + '/' + uriList[ 2 ] + '/' + inFileName + '/l100';
+ }
+ threadURL := uri.Protocol + '://' + uri.Host + '/test/read.cgi' +
+ uri.Path + inFileName + '/l50';
+ Result := threadURL;
+ finally
+ uri.Free;
+ uriList.Free;
+ end;
+ except
+ Result := '';
+ end;
+
+end;
+
+// *************************************************************************
+// \82±\82Ì\94Â\82É\82¢\82\82Â\82Ì\83X\83\8c\82ª\82 \82é\82©\97v\8b\81\82³\82ê\82½
+// *************************************************************************
+procedure TBe2chBoardItem.EnumThread(
+ inCallBack : TBoardItemEnumThreadCallBack
+);
+var
+ uri : TIdURI;
+ uriList : TStringList;
+begin
+
+ try
+ if FDat = nil then begin
+ FDat := TStringList.Create;
+ uri := TIdURI.Create( SubjectURL );
+ uriList := TStringList.Create;
+ try
+ // \83p\83X\82ð\8eZ\8fo
+ ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
+ // http://jbbs.livedoor.com/game/1000/subject.txt
+ FilePath := MyLogFolder + uriList[ 1 ] + '\' + uriList[ 2 ] + '\' + uri.Document;
+ if FileExists( FilePath ) then
+ // \93Ç\82Ý\8d\9e\82Ý
+ FDat.LoadFromFile( FilePath );
+ finally
+ uri.Free;
+ uriList.Free;
+ end;
+ end;
+
+ // \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é
+ inherited EnumThread( inCallBack, CustomStringReplace( FDat.Text, ',', '<>' ) );
+ except
+ end;
+
+end;
+
+// *************************************************************************
+// \83X\83\8c\88ê\97\97\82Ì URL \82ð\8b\81\82ß\82é
+// *************************************************************************
+function TBe2chBoardItem.SubjectURL : string;
+begin
+ if AnsiPos(SUBJECT_NAME, URL) > 0 then
+ Result := URL
+ else
+ Result := URL + SUBJECT_NAME;
+end;
+
+// *************************************************************************
+// TBoardItem \82ª\90¶\90¬\82³\82ê\82½\8fê\8d\87\82Ì\8f\88\92u(TShitarabaBoardItem \82ð\90¶\90¬\82·\82é)
+// *************************************************************************
+procedure BoardItemOnCreateOfTBe2chBoardItem(
+ inInstance : DWORD
+);
+var
+ boardItem : TBe2chBoardItem;
+begin
+
+ boardItem := TBe2chBoardItem.Create( inInstance );
+ BoardItemSetLong( inInstance, bipContext, DWORD( boardItem ) );
+
+end;
+
+// *************************************************************************
+// TBoardItem \82ª\94j\8aü\82³\82ê\82½\8fê\8d\87\82Ì\8f\88\92u(TShitarabaBoardItem \82ð\94j\8aü\82·\82é)
+// *************************************************************************
+procedure BoardItemOnDisposeOfTBe2chBoardItem(
+ inInstance : DWORD
+);
+var
+ boardItem : TBe2chBoardItem;
+begin
+
+ boardItem := TBe2chBoardItem( BoardItemGetLong( inInstance, bipContext ) );
+ boardItem.Free;
+
+end;
+
+
+
+// =========================================================================
+// \83G\83\93\83g\83\8a\83|\83C\83\93\83g
+// =========================================================================
+procedure DLLEntry(
+ ul_reason_for_call : DWORD
+);
+var
+ module : HMODULE;
+begin
+
+ case ul_reason_for_call of
+ DLL_PROCESS_ATTACH:
+ begin
+ Randomize;
+
+ module := GetModuleHandle( nil );
+
+ LoadInternalAPI( module );
+ LoadInternalFilePathAPI( module );
+ LoadInternalThreadItemAPI( module );
+ LoadInternalBoardItemAPI( module );
+
+ // ===== \83C\83\93\83X\83^\83\93\83X\82Ì\8eæ\82è\88µ\82¢\82ð TThreadItem \82©\82ç TShitarabaThreadItem \82É\95Ï\8dX\82·\82é
+ ThreadItemOnCreate := ThreadItemOnCreateOfTBe2chThreadItem;
+ ThreadItemOnDispose := ThreadItemOnDisposeOfTBe2chThreadItem;
+ // ===== \83C\83\93\83X\83^\83\93\83X\82Ì\8eæ\82è\88µ\82¢\82ð TBoardItem \82©\82ç TShitarabaBoardItem \82É\95Ï\8dX\82·\82é
+ BoardItemOnCreate := BoardItemOnCreateOfTBe2chBoardItem;
+ BoardItemOnDispose := BoardItemOnDisposeOfTBe2chBoardItem;
+ end;
+ DLL_THREAD_ATTACH:
+ ;
+ DLL_THREAD_DETACH:
+ ;
+ end;
+
+end;
+
+exports
+ OnVersionInfo,
+ OnAcceptURL,
+ OnExtractBoardURL;
+begin
+
+ try
+ DllProc := @DLLEntry;
+ DLLEntry( DLL_PROCESS_ATTACH );
+ except end;
+
+end.
OSDN Git Service
