library MachiBBSPlugIn;
{
MachiBBSBoardPlugIn
まちBBS処理ユニット
}
uses
Windows, SysUtils, Classes, Math, DateUtils,
IdURI,MojuUtils,
PlugInMain in 'PlugInMain.pas',
ThreadItem in 'ThreadItem.pas',
BoardItem in 'BoardItem.pas',
FilePath in 'FilePath.pas';
{$R *.res}
type
// =========================================================================
// TMachiBBSThreadItem
// =========================================================================
TMachiBBSThreadItem = 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 GetHeader( inOptionalHeader : string ) : string;
function GetFooter( inOptionalFooter : string ) : string;
function GetBoardURL : string;
procedure To2chDat( ioHTML : TStringList; inStartNo : Integer = 1 );
procedure LoadDat;
procedure FreeDat;
end;
// =========================================================================
// TMachiBBSBoardItem
// =========================================================================
TMachiBBSBoardItem = 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;
// =========================================================================
// サブジェクトレコード
// =========================================================================
TSubjectRec = record
FFileName: string;
FTitle: string;
FCount: Integer;
end;
const
LOG_DIR = 'MachiBBS\';
SUBJECT_NAME = 'subject.txt';
PLUGIN_NAME = 'MachiBBSPlugIn';
MAJOR_VERSION = 1;
MINOR_VERSION = 0;
RELEASE_VERSION = 'beta';
REVISION_VERSION = 10;
// =========================================================================
// 雑用関数
// =========================================================================
// *************************************************************************
// テンポラリなパスの取得
// *************************************************************************
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;
// *************************************************************************
// まちBBS用ログフォルダ取得
// *************************************************************************
function MyLogFolder : string;
var
folder : string;
begin
folder := LogFolder;
if Length( folder ) = 0 then
Result := ''
else
Result := folder + LOG_DIR;
end;
(*************************************************************************
*ディレクトリが存在するかチェック
*************************************************************************)
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;
(*************************************************************************
*ディレクトリ作成(複数階層対応)
*************************************************************************)
function ForceDirectoriesEx(Dir: string): Boolean;
begin
Result := True;
if Length(Dir) = 0 then
raise Exception.Create('フォルダが作成出来ません');
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;
// とりあえずの代用品なので chrWhite を考慮していないことに注意!!!
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;
function HttpEncode(
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
// =========================================================================
// *************************************************************************
// プラグインのバージョンを要求された
// *************************************************************************
procedure OnVersionInfo(
var outAgent : PChar; // バージョンを一切含まない純粋な名称
var outMajor : DWORD; // メジャーバージョン
var outMinor : DWORD; // マイナーバージョン
var outRelease : PChar; // リリース段階名
var outRevision : DWORD // リビジョンナンバー
); 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;
// *************************************************************************
// 指定した URL をこのプラグインで受け付けるかどうか
// *************************************************************************
function OnAcceptURL(
inURL : PChar // 判断を仰いでいる URL
): TAcceptType; stdcall; // URL の種類
var
uri : TIdURI;
uriList : TStringList;
foundPos : Integer;
const
BBS_HOST = 'machi.to';
THREAD_MARK = '/bbs/read.pl';
begin
try
// ホスト名が machi.to で終わる場合は受け付けるようにしている
uri := TIdURI.Create( inURL );
uriList := TStringList.Create;
try
ExtractHttpFields( ['/'], [], uri.Path, uriList );
foundPos := Pos( BBS_HOST, uri.Host );
if (foundPos > 0) and (Length( uri.Host ) - foundPos + 1 = Length( BBS_HOST )) then begin
foundPos := Pos( THREAD_MARK, inURL );
if foundPos > 0 then
Result := atThread
else if (uriList.Count > 1) and (uri.Path <> '/') then // 最後が '/' で閉められてるなら 3
Result := atBoard
else
Result := atBBS;
end else begin
Result := atNoAccept;
end;
finally
uri.Free;
uriList.Free;
end;
except
Result := atNoAccept;
end;
end;
// =========================================================================
// TMachiBBSThreadItem
// =========================================================================
// *************************************************************************
// コンストラクタ
// *************************************************************************
constructor TMachiBBSThreadItem.Create(
inInstance : DWORD
);
var
uri : TIdURI;
uriList : TStringList;
begin
inherited;
OnDownload := Download;
OnWrite := Write;
OnGetRes := GetRes;
OnGetHeader := GetHeader;
OnGetFooter := GetFooter;
OnGetBoardURL := GetBoardURL;
FilePath := '';
FIsTemporary := False;
FDat := nil;
uri := TIdURI.Create( URL );
uriList := TStringList.Create;
try
// http://hokkaido.machi.to/bbs/read.pl?BBS=hokkaidou&KEY=1061764446&LAST=50
ExtractHttpFields(
['&'], [],
Copy( uri.Params, Pos( '?', uri.Params ) + 1, Length( uri.Params ) ), uriList );
FileName := uriList.Values[ 'KEY' ] + '.dat';
FilePath := MyLogFolder + uriList.Values[ 'BBS' ] + '\' + uriList.Values[ 'KEY' ] + '.dat';
IsLogFile := FileExists( FilePath );
finally
uri.Free;
uriList.Free;
end;
end;
// *************************************************************************
// デストラクタ
// *************************************************************************
destructor TMachiBBSThreadItem.Destroy;
begin
FreeDat;
// 一時ファイルの場合は削除する
if FIsTemporary then
DeleteFile( FilePath );
inherited;
end;
// *************************************************************************
// 指定した URL のスレッドのダウンロードを指示された
// *************************************************************************
function TMachiBBSThreadItem.Download : TDownloadState;
var
modified : Double;
tmp : PChar;
downResult : TStringList;
content : TStringList;
responseCode : Longint;
logStream : TFileStream;
uri : TIdURI;
uriList : TStringList;
datURL : string;
foundPos : Integer;
procedure downAndParse;
begin
responseCode := InternalDownload( PChar( datURL ), modified, tmp, 0 );
try
if responseCode = 200 then begin
downResult := TStringList.Create;
try
downResult.Text := string( tmp );
// タイトルの取得
foundPos := Pos( '
', downResult.Text ) + Length( '' );
Title := Copy(
downResult.Text,
foundPos,
Pos( '', downResult.Text ) - foundPos );
// レスの開始位置
foundPos := Pos( ' 0 then begin
// レスの終了位置
foundPos := Pos( ' 0 then
downResult.Text := Copy( downResult.Text, 1, foundPos );
// まちBBSは dat 直読みが出来ないし、cgi 以外に差分読み込みの方法があるわけでも無いので
// 素のままを無理に保とうとはせずに 2ch の dat 形式に変換したものを保存してしまう
To2chDat( downResult, Count + 1 );
content.Text := content.Text + downResult.Text;
end;
finally
downResult.Free;
end;
end else begin
Result := dsNotModify;
Exit;
end;
finally
DisposeResultString( tmp );
end;
end;
begin
Result := dsError;
uri := TIdURI.Create( URL );
uriList := TStringList.Create;
content := TStringList.Create;
try
ExtractHttpFields(
['&'], [],
Copy( uri.Params, Pos( '?', uri.Params ) + 1, Length( uri.Params ) ), uriList );
FileName := uriList.Values[ 'KEY' ] + '.dat';
if MyLogFolder = '' then begin
// どこに保存していいのか分からないので一時ファイルに保存
FilePath := TemporaryFile;
FIsTemporary := True;
end else begin
FilePath := MyLogFolder + uriList.Values[ 'BBS' ] + '\' + uriList.Values[ 'KEY' ] + '.dat';
FIsTemporary := False;
end;
// 保存用のディレクトリを掘る
ForceDirectoriesEx( Copy( FilePath, 1, LastDelimiter( '\', FilePath ) ) );
// 独自にダウンロードやフィルタリングを行わない場合は
// InternalDownload に任せることが出来る
modified := LastModified;
if Count = 0 then
// 1〜
datURL :=
uri.Protocol + '://' + uri.Host + '/bbs/read.pl?' +
'BBS=' + uriList.Values[ 'BBS' ] + '&KEY=' + uriList.Values[ 'KEY' ] +
'&START=' + IntToStr( 1 )
else
// 新着のみ
datURL :=
uri.Protocol + '://' + uri.Host + '/bbs/read.pl?' +
'BBS=' + uriList.Values[ 'BBS' ] + '&KEY=' + uriList.Values[ 'KEY' ] +
'&START=' + IntToStr( Count + 1 ) + '&NOFIRST=TRUE';
// ダウンロード
downAndParse;
if content.Count > 0 then begin
if Count <= 0 then begin
Result := dsComplete;
// 新規書き込み
content[ 0 ] := content[ 0 ] + Title;
logStream := TFileStream.Create( FilePath, fmCreate or fmShareDenyWrite );
try
logStream.Position := logStream.Size;
logStream.Write( PChar( content.Text )^, Length( content.Text ) );
finally
logStream.Free;
end;
NewReceive := 1;
Count := content.Count;
end else begin
Result := dsDiffComplete;
// 追記
logStream := TFileStream.Create( FilePath, fmOpenReadWrite or fmShareDenyWrite );
try
logStream.Position := logStream.Size;
logStream.Write( PChar( content.Text )^, Length( content.Text ) );
finally
logStream.Free;
end;
NewReceive := Count + 1;
Count := Count + content.Count;
end;
// CGI からは正しい日付が得られないので現在に設定
LastModified := Now;
NewResCount := content.Count;
end else begin
Result := dsNotModify;
end;
finally
uri.Free;
uriList.Free;
content.Free;
end;
end;
// *************************************************************************
// 書き込みを指示された
// *************************************************************************
function TMachiBBSThreadItem.Write(
inName : string; // 名前(ハンドル)
inMail : string; // メールアドレス
inMessage : string // 本文
) : TDownloadState; // 書き込みが成功したかどうか
var
postURL : string;
postData : string;
postResult : PChar;
uri : TIdURI;
uriList : TStringList;
begin
uri := TIdURI.Create( URL );
uriList := TStringList.Create;
try
ExtractHttpFields(
['&'], [],
Copy( uri.Params, Pos( '?', uri.Params ) + 1, Length( uri.Params ) ), uriList );
postURL := uri.Protocol + '://' + uri.Host + '/bbs/write.cgi';
postData :=
'NAME=' + HttpEncode( inName ) +
'&MAIL=' + HttpEncode( inMail ) +
'&MESSAGE=' + HttpEncode( inMessage ) +
'&BBS=' + uriList.Values[ 'BBS' ] +
'&KEY=' + uriList.Values[ 'KEY' ] +
'&TIME=' + IntToStr( DateTimeToUnix( Now ) ) +
'&submit=' + HttpEncode( '書き込む' );
// 独自に通信しない場合は InternalPost に任せることが出来る
InternalPost( PChar( postURL ), PChar( postData ), postResult );
DisposeResultString( postResult );
Result := dsComplete
finally
uri.Free;
uriList.Free;
end;
end;
// *************************************************************************
// レス番号 inNo に対する html を要求された
// *************************************************************************
function TMachiBBSThreadItem.GetRes(
inNo : Integer // 要求されたレス番号
) : string; // 対応する HTML
var
res : string;
tmp : PChar;
begin
// 独自にフィルタリングを行わない場合は
// InternalAbon および Dat2HTML に任せることが出来る
LoadDat;
if FDat = nil then begin
// ログに存在しないのでこのまま終了
Result := '';
Exit;
end;
res := FDat[ inNo - 1 ];
tmp := InternalAbonForOne( PChar( res ), PChar(FilePath), inNo);
try
Result := Dat2HTML( string( tmp ), inNo );
finally
DisposeResultString( tmp );
end;
end;
// *************************************************************************
// スレッドのヘッダ html を要求された
// *************************************************************************
function TMachiBBSThreadItem.GetHeader(
inOptionalHeader : string
) : string;
begin
// 独自にフィルタリングを行わない場合は
// InternalHeader に任せることが出来る
Result := InternalHeader(
'' +
inOptionalHeader );
// GetRes を呼ばれることが予想されるので FDat を生成しておく
try
FreeDat;
LoadDat;
except
end;
end;
// *************************************************************************
// スレッドのフッタ html を要求された
// *************************************************************************
function TMachiBBSThreadItem.GetFooter(
inOptionalFooter : string
) : string;
begin
// 独自にフィルタリングを行わない場合は
// InternalFooter に任せることが出来る
Result := InternalFooter( inOptionalFooter );
// もう GetRes は呼ばれないと思うので FDat を開放しておく
try
FreeDat;
except
end;
end;
// *************************************************************************
// この ThreadItem が属する板の URL を要求された
// *************************************************************************
function TMachiBBSThreadItem.GetBoardURL : 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(
['&'], [],
Copy( uri.Params, Pos( '?', uri.Params ) + 1, Length( uri.Params ) ), uriList );
FileName := uriList.Values[ 'KEY' ] + '.dat';
// http://hokkaido.machi.to/bbs/read.pl?BBS=hokkaidou&KEY=1061764446
// http://hokkaido.machi.to/hokkaidou/
Result := CreateResultString(
uri.Protocol + '://' + uri.Host + '/' + uriList.Values[ 'BBS' ] + '/' );
finally
uri.Free;
uriList.Free;
end;
end;
// *************************************************************************
// まちBBSの HTML を 2ch の dat 形式に
// *************************************************************************
procedure TMachiBBSThreadItem.To2chDat(
ioHTML : TStringList;
inStartNo : Integer = 1
);
var
i, bound : Integer;
foundPos : Integer;
strTmp : string;
res : TStringList;
const
MAIL_TAG = '', res[ 0 ] ) - 1 );
// メールと名前が逆なのでひっくり返して戻す
res[ 0 ] := res[ 1 ];
res[ 1 ] := strTmp;
end else begin
// メールと名前が逆なのでひっくり返す
res[ 0 ] := res[ 1 ];
res[ 1 ] := '';
end;
res[ 2 ] := StringReplace( res[ 2 ], '[', 'IP:', [] );
res[ 2 ] := StringReplace( res[ 2 ], ']', '', [] );
end;
ioHTML[ i ] := CustomStringReplace( res.Text, #13#10, '<>');
//StringReplace( res.Text, #13#10, '<>', [rfReplaceAll] );
end;
finally
res.Free;
end;
end;
// *************************************************************************
// FDat の生成
// *************************************************************************
procedure TMachiBBSThreadItem.LoadDat;
begin
if FDat = nil then begin
if IsLogFile then begin
// dat の読み込み
FDat := TStringList.Create;
FDat.LoadFromFile( FilePath );
end;
end;
end;
// *************************************************************************
// FDat の開放
// *************************************************************************
procedure TMachiBBSThreadItem.FreeDat;
begin
if FDat <> nil then begin
FDat.Free;
FDat := nil;
end;
end;
// *************************************************************************
// TThreadItem が生成された場合の処置(TMachiBBSThreadItem を生成する)
// *************************************************************************
procedure ThreadItemOnCreateOfTMachiBBSThreadItem(
inInstance : DWORD
);
var
threadItem : TMachiBBSThreadItem;
begin
threadItem := TMachiBBSThreadItem.Create( inInstance );
ThreadItemSetLong( inInstance, tipContext, DWORD( threadItem ) );
end;
// *************************************************************************
// TThreadItem が破棄された場合の処置(TMachiBBSThreadItem を破棄する)
// *************************************************************************
procedure ThreadItemOnDisposeOfTMachiBBSThreadItem(
inInstance : DWORD
);
var
threadItem : TMachiBBSThreadItem;
begin
threadItem := TMachiBBSThreadItem( ThreadItemGetLong( inInstance, tipContext ) );
threadItem.Free;
end;
// =========================================================================
// TMachiBBSBoardItem
// =========================================================================
// *************************************************************************
// コンストラクタ
// *************************************************************************
constructor TMachiBBSBoardItem.Create(
inInstance : DWORD
);
var
uri : TIdURI;
uriList : TStringList;
begin
inherited;
OnDownload := Download;
OnCreateThread := CreateThread;
OnEnumThread := EnumThread;
OnFileName2ThreadURL := ToThreadURL;
FilePath := '';
FIsTemporary := False;
FDat := nil;
uri := TIdURI.Create( SubjectURL );
uriList := TStringList.Create;
try
ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
// http://hokkaido.machi.to/hokkaidou/subject.txt
FilePath := MyLogFolder + uriList[ 1 ] + '\' + uri.Document;
IsLogFile := FileExists( FilePath );
finally
uri.Free;
uriList.Free;
end;
end;
// *************************************************************************
// デストラクタ
// *************************************************************************
destructor TMachiBBSBoardItem.Destroy;
begin
if FDat <> nil then begin
try
FDat.Free;
FDat := nil;
except
end;
end;
// 一時ファイルの場合は削除する
if FIsTemporary then
DeleteFile( FilePath );
inherited;
end;
// *************************************************************************
// 指定したスレ一覧のダウンロードを要求された
// *************************************************************************
function TMachiBBSBoardItem.Download : TDownloadState;
var
modified : Double;
downResult : PChar;
responseCode : Longint;
uri : TIdURI;
uriList : TStringList;
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;
// 独自にダウンロードやフィルタリングを行わない場合は
// InternalDownload に任せることが出来る
modified := LastModified;
responseCode := InternalDownload( PChar( uri.URI ), modified, downResult );
try
if responseCode = 200 then begin
try
// パスを算出
ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
if MyLogFolder = '' then begin
// どこに保存していいのか分からないので一時ファイルに保存
FilePath := TemporaryFile;
FIsTemporary := True;
end else begin
FilePath := MyLogFolder + uriList[ 1 ] + '\' + uri.Document;
FIsTemporary := False
end;
// 保存用のディレクトリを掘る
ForceDirectoriesEx( Copy( FilePath, 1, LastDelimiter( '\', FilePath ) ) );
FDat.Text := string( downResult );
// 保存
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;
// *************************************************************************
// スレ立てを指示された
// *************************************************************************
function TMachiBBSBoardItem.CreateThread(
inSubject : string; // スレタイ
inName : string; // 名前(ハンドル)
inMail : string; // メールアドレス
inMessage : string // 本文
) : TDownloadState; // 書き込みが成功したかどうか
var
postURL : string;
postData : string;
postResult : PChar;
uri : TIdURI;
uriList : TStringList;
begin
uri := TIdURI.Create( URL );
uriList := TStringList.Create;
try
ExtractHttpFields(
['&'], [],
Copy( uri.Params, Pos( '?', uri.Params ) + 1, Length( uri.Params ) ), uriList );
postURL := uri.Protocol + '://' + uri.Host + '/bbs/write.cgi';
postData :=
'SUBJECT=' + HttpEncode( inSubject ) +
'&NAME=' + HttpEncode( inName ) +
'&MAIL=' + HttpEncode( inMail ) +
'&MESSAGE=' + HttpEncode( inMessage ) +
'&BBS=' + uriList[ 1 ] +
'&TIME=' + IntToStr( DateTimeToUnix( Now ) ) +
'&submit=' + HttpEncode( '新規書き込み' );
// 独自に通信しない場合は InternalPost に任せることが出来る
InternalPost( PChar( postURL ), PChar( postData ), postResult );
DisposeResultString( postResult );
Result := dsComplete
finally
uri.Free;
uriList.Free;
end;
end;
// *************************************************************************
// スレ一覧の URL からスレッドの URL を導き出す
// *************************************************************************
function TMachiBBSBoardItem.ToThreadURL(
inFileName : string // スレッドファイル名
) : string; // スレッドの URL
var
threadURL : string;
uri : TIdURI;
uriList : TStringList;
found : Integer;
begin
found := Pos( '.', inFileName );
if found > 0 then
inFileName := Copy( inFileName, 1, found - 1 );
uri := TIdURI.Create( SubjectURL );
uriList := TStringList.Create;
try
try
// http://hokkaido.machi.to/hokkaidou/
// http://hokkaido.machi.to/bbs/read.pl?BBS=hokkaidou&KEY=1061764446&LAST=50
ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
threadURL := uri.Protocol + '://' + uri.Host + '/bbs/read.pl?' +
'BBS=' + uriList[ 1 ] + '&KEY=' + inFileName + '&LAST=50';
Result := threadURL;
finally
uri.Free;
uriList.Free;
end;
except
Result := '';
end;
end;
// *************************************************************************
// この板にいくつのスレがあるか要求された
// *************************************************************************
procedure TMachiBBSBoardItem.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
// パスを算出
ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
// http://hokkaido.machi.to/hokkaidou/subject.txt
FilePath := MyLogFolder + uriList[ 1 ] + '\' + uri.Document;
if FileExists( FilePath ) then
// 読み込み
FDat.LoadFromFile( FilePath );
finally
uri.Free;
uriList.Free;
end;
end;
// 独自にフィルタリングを行わない場合は EnumThread に任せることが出来る
inherited EnumThread( inCallBack, FDat.Text );
except
end;
end;
// *************************************************************************
// スレ一覧の URL を求める
// *************************************************************************
function TMachiBBSBoardItem.SubjectURL : string;
var
uri : TIdURI;
uriList : TStringList;
begin
uri := TIdURI.Create( URL );
uriList := TStringList.Create;
try
if uri.Document <> SUBJECT_NAME then begin
if Copy( URL, Length( URL ), 1 ) = '/' then
Result := URL + SUBJECT_NAME
else
Result := URL + '/' + SUBJECT_NAME;
end else begin
// ここには来ないと思うけど
Result := URL;
end;
finally
uri.Free;
uriList.Free;
end;
end;
// *************************************************************************
// TBoardItem が生成された場合の処置(TMachiBBSBoardItem を生成する)
// *************************************************************************
procedure BoardItemOnCreateOfTMachiBBSBoardItem(
inInstance : DWORD
);
var
boardItem : TMachiBBSBoardItem;
begin
boardItem := TMachiBBSBoardItem.Create( inInstance );
BoardItemSetLong( inInstance, bipContext, DWORD( boardItem ) );
end;
// *************************************************************************
// TBoardItem が破棄された場合の処置(TMachiBBSBoardItem を破棄する)
// *************************************************************************
procedure BoardItemOnDisposeOfTMachiBBSBoardItem(
inInstance : DWORD
);
var
boardItem : TMachiBBSBoardItem;
begin
boardItem := TMachiBBSBoardItem( BoardItemGetLong( inInstance, bipContext ) );
boardItem.Free;
end;
// =========================================================================
// エントリポイント
// =========================================================================
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 );
// ===== インスタンスの取り扱いを TThreadItem から TMachiBBSThreadItem に変更する
ThreadItemOnCreate := ThreadItemOnCreateOfTMachiBBSThreadItem;
ThreadItemOnDispose := ThreadItemOnDisposeOfTMachiBBSThreadItem;
// ===== インスタンスの取り扱いを TBoardItem から TMachiBBSBoardItem に変更する
BoardItemOnCreate := BoardItemOnCreateOfTMachiBBSBoardItem;
BoardItemOnDispose := BoardItemOnDisposeOfTMachiBBSBoardItem;
end;
DLL_PROCESS_DETACH:
;
DLL_THREAD_ATTACH:
;
DLL_THREAD_DETACH:
;
end;
end;
exports
OnVersionInfo,
OnAcceptURL;
begin
try
DllProc := @DLLEntry;
DLLEntry( DLL_PROCESS_ATTACH );
except end;
end.