OSDN Git Service

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