• R/O
  • HTTP
  • SSH
  • HTTPS

提交

标签
No Tags

Frequently used words (click to add to your profile)

javac++androidlinuxc#objective-cqtwindows誰得cocoapythonphprubygameguibathyscaphec翻訳omegat計画中(planning stage)frameworktwittertestdomvb.netdirectxbtronarduinopreviewerゲームエンジン

ギコナビ


Commit MetaInfo

修订版0156befce0601e9998fc83c7ce6cbb3314557f2f (tree)
时间2005-12-28 02:12:54
作者cvs2git <cvs2git>
Commitercvs2git

Log Message

This commit was manufactured by cvs2svn to create branch 'Bb51'.

更改概述

  • delete: res/ExternalBoardPlugIn/BePlugIn.dpr

差异

--- a/res/ExternalBoardPlugIn/BePlugIn.dpr
+++ /dev/null
@@ -1,1578 +0,0 @@
1-library BePlugIn;
2-
3-{
4- BePlugIn
5- 2‚¿‚á‚ñ‚Ë‚éBEˆ—ƒ†ƒjƒbƒg
6-
7-}
8-
9-uses
10- Windows,
11- SysUtils,
12- Classes,
13- Math,
14- DateUtils,
15- Dialogs,
16- IdURI,
17- PlugInMain in 'PlugInMain.pas',
18- ThreadItem in 'ThreadItem.pas',
19- BoardItem in 'BoardItem.pas',
20- FilePath in 'FilePath.pas',
21- Y_TextConverter in 'Y_TextConverter.pas',
22- MojuUtils in '..\..\MojuUtils.pas';
23-
24-{$R *.res}
25-
26-type
27- // =========================================================================
28- // TBeThreadItem
29- // =========================================================================
30- TBeThreadItem = class(TThreadItem)
31- private
32- FIsTemporary : Boolean;
33- FDat : TStringList;
34-
35- public
36- constructor Create( inInstance : DWORD );
37- destructor Destroy; override;
38-
39- private
40- function Download : TDownloadState;
41- function StorageDownload(AURL : string) : TDownloadState;
42- function Write( inName : string; inMail : string; inMessage : string ) : TDownloadState;
43- function GetRes( inNo : Integer ) : string;
44- function GetDat( inNo : Integer ) : string;
45- function GetHeader( inOptionalHeader : string ) : string;
46- function GetFooter( inOptionalFooter : string ) : string;
47- function GetBoardURL : string;
48- procedure ArrangeDownloadData( start: Integer;var Data: TStringList);
49- procedure LoadDat;
50- procedure FreeDat;
51- function BrowsableURL : string;
52- function ReadURL : string;
53- function WriteURL : string;
54- end;
55-
56- // =========================================================================
57- // TBeBoardItem
58- // =========================================================================
59- TBeBoardItem = class(TBoardItem)
60- private
61- FIsTemporary : Boolean;
62- FDat : TStringList;
63-
64- public
65- constructor Create( inInstance : DWORD );
66- destructor Destroy; override;
67-
68- private
69- function Download : TDownloadState;
70- function CreateThread( inSubject : string; inName : string; inMail : string; inMessage : string ) : TDownloadState;
71- function ToThreadURL( inFileName : string ) : string;
72- procedure EnumThread( inCallBack : TBoardItemEnumThreadCallBack );
73-
74- function SubjectURL : string;
75- end;
76-
77-const
78- LOG_DIR = 'Be\';
79- SUBJECT_NAME = 'subject.txt';
80-
81- PLUGIN_NAME = 'Be';
82- MAJOR_VERSION = 1;
83- MINOR_VERSION = 1;
84- RELEASE_VERSION = 'alpha';
85- REVISION_VERSION = 1;
86-
87-//var
88-// SyncronizeMenu : HMENU;
89-
90-// =========================================================================
91-// ŽG—pŠÖ”
92-// =========================================================================
93-
94-// *************************************************************************
95-// ƒeƒ“ƒ|ƒ‰ƒŠ‚ȃpƒX‚̎擾
96-// *************************************************************************
97-function TemporaryFile : string;
98-var
99- tempPath : array [0..MAX_PATH] of char;
100-begin
101-
102- GetTempPath( SizeOf(tempPath), tempPath );
103- repeat
104- Result := tempPath + IntToStr( Random( $7fffffff ) );
105- until not FileExists( Result );
106-
107-end;
108-
109-// *************************************************************************
110-// BeƒƒOƒtƒHƒ‹ƒ_Žæ“¾
111-// *************************************************************************
112-function MyLogFolder : string;
113-var
114- folder : PChar;
115-begin
116-
117- folder := LogFolder;
118- if Length( folder ) = 0 then
119- Result := ''
120- else
121- Result := folder + LOG_DIR;
122- DisposeResultString(folder);
123-
124-end;
125-
126-(*************************************************************************
127- *ƒfƒBƒŒƒNƒgƒŠ‚ª‘¶Ý‚·‚é‚©ƒ`ƒFƒbƒN
128- *************************************************************************)
129-function DirectoryExistsEx(const Name: string): Boolean;
130-var
131- Code: Integer;
132-begin
133- Code := GetFileAttributes(PChar(Name));
134- Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
135-end;
136-
137-(*************************************************************************
138- *ƒfƒBƒŒƒNƒgƒŠì¬i•¡”ŠK‘w‘Ήžj
139- *************************************************************************)
140-function ForceDirectoriesEx(Dir: string): Boolean;
141-begin
142- Result := True;
143- if Length(Dir) = 0 then
144- raise Exception.Create('ƒtƒHƒ‹ƒ_‚ªì¬o—ˆ‚Ü‚¹‚ñ');
145- Dir := ExcludeTrailingPathDelimiter(Dir);
146- if (Length(Dir) < 3) or DirectoryExistsEx(Dir)
147- or (ExtractFilePath(Dir) = Dir) then Exit; // avoid 'xyz:\' problem.
148- Result := ForceDirectoriesEx(ExtractFilePath(Dir)) and CreateDir(Dir);
149-end;
150-
151-// ‚Æ‚è‚ ‚¦‚¸‚Ì‘ã—p•i‚È‚Ì‚Å chrWhite ‚ðl—¶‚µ‚Ä‚¢‚È‚¢‚±‚Æ‚É’ˆÓIII
152-procedure ExtractHttpFields(
153- const chrSep : TSysCharSet;
154- const chrWhite : TSysCharSet;
155- const strValue : string;
156- var strResult : TStringList;
157- unknownFlag : boolean = false
158-);
159-var
160- last, p, strLen : Integer;
161-begin
162-
163- strLen := Length( strValue );
164- p := 1;
165- last := 1;
166-
167- while p <= strLen do
168- begin
169-
170- if strValue[ p ] in chrSep then
171- begin
172- strResult.Add( Copy( strValue, last, p - last ) );
173- last := p + 1;
174- end;
175-
176- p := p + 1;
177-
178- end;
179-
180- if last <> p then
181- strResult.Add( Copy( strValue, last, strLen - last + 1 ) );
182-
183-end;
184-
185- function HttpEncode(
186- const strValue : string
187-) : string;
188-var
189- i : Integer;
190- strLen : Integer;
191- strResult : string;
192- b : Integer;
193-const
194- kHexCode : array [0..15] of char = (
195- '0', '1', '2', '3', '4', '5', '6', '7',
196- '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' );
197-begin
198-
199- strLen := Length( strValue );
200- i := 1;
201-
202- while i <= strLen do
203- begin
204-
205- case strValue[ i ] of
206- '0' .. '9', 'a' .. 'z', 'A' .. 'Z', '*', '-', '.', '@', '_':
207- begin
208- strResult := strResult + strValue[ i ];
209- end;
210- else
211- begin
212- b := Integer( strValue[ i ] );
213- strResult := strResult + '%'
214- + kHexCode[ b div $10 ]
215- + kHexCode[ b mod $10 ];
216- end;
217- end;
218-
219- i := i + 1;
220-
221- end;
222-
223- Result := strResult;
224-
225-end;
226-
227-
228-
229-// =========================================================================
230-// PlugIn
231-// =========================================================================
232-
233-// *************************************************************************
234-// ƒvƒ‰ƒOƒCƒ“‚ª(³‚µ‚­)ƒ[ƒh‚³‚ꂽ
235-// *************************************************************************
236-procedure OnLoad(
237- inInstance : DWORD // ƒvƒ‰ƒOƒCƒ“‚̃Cƒ“ƒXƒ^ƒ“ƒX
238-); stdcall;
239-begin
240-end;
241-
242-// *************************************************************************
243-// ƒvƒ‰ƒOƒCƒ“‚̃o[ƒWƒ‡ƒ“‚ð—v‹‚³‚ꂽ
244-// *************************************************************************
245-procedure OnVersionInfo(
246- var outAgent : PChar; // ƒo[ƒWƒ‡ƒ“‚ðˆêØŠÜ‚Ü‚È‚¢ƒˆ‚È–¼Ì
247- var outMajor : DWORD; // ƒƒWƒƒ[ƒo[ƒWƒ‡ƒ“
248- var outMinor : DWORD; // ƒ}ƒCƒi[ƒo[ƒWƒ‡ƒ“
249- var outRelease : PChar; // ƒŠƒŠ[ƒX’iŠK–¼
250- var outRevision : DWORD // ƒŠƒrƒWƒ‡ƒ“ƒiƒ“ƒo[
251-); stdcall;
252-begin
253-
254- try
255- outAgent := CreateResultString( PChar( PLUGIN_NAME ) );
256- outMajor := MAJOR_VERSION;
257- outMinor := MINOR_VERSION;
258- outRelease := CreateResultString( PChar( RELEASE_VERSION ) );
259- outRevision := REVISION_VERSION;
260- except
261- outAgent := nil;
262- outMajor := 0;
263- outMinor := 0;
264- outRelease := nil;
265- outRevision := 0;
266- end;
267-
268-end;
269-
270-// *************************************************************************
271-// Žw’肵‚½ URL ‚ð‚±‚Ìƒvƒ‰ƒOƒCƒ“‚Ŏ󂯕t‚¯‚é‚©‚Ç‚¤‚©
272-// *************************************************************************
273-function OnAcceptURL(
274- inURL : PChar // ”»’f‚ð‹Â‚¢‚Å‚¢‚é URL
275-): TAcceptType; stdcall; // URL ‚ÌŽí—Þ
276-var
277- uri : TIdURI;
278- uriList : TStringList;
279- foundPos : Integer;
280-// i : Integer;
281-const
282- BBS_HOST = 'be.2ch.net';
283- THREAD_MARK = '/test/read.cgi';
284-begin
285-
286- try
287- // ƒzƒXƒg–¼‚ª be.2ch.net ‚ŏI‚í‚éê‡‚͎󂯕t‚¯‚é‚悤‚É‚µ‚Ä‚¢‚é
288- uri := TIdURI.Create( inURL );
289- uriList := TStringList.Create;
290- try
291- ExtractHttpFields( ['/'], [], uri.Path, uriList );
292- if (BBS_HOST = uri.Host ) then begin
293- foundPos := AnsiPos( THREAD_MARK, inURL );
294-
295- if foundPos > 0 then
296- Result := atThread
297- //else if (uriList.Count > 2) and (AnsiPos('.html', uri.Document) > 0) then
298- // Result := atThread
299- else if uriList.Count > 2 then // ÅŒã‚ª '/' ‚ŕ‚߂ç‚ê‚Ä‚é‚È‚ç 4
300- Result := atBoard
301- else
302- Result := atBBS;
303-
304- end else begin
305- Result := atNoAccept;
306- end;
307-
308- finally
309- uri.Free;
310- uriList.Free;
311- end;
312- except
313- Result := atNoAccept;
314- end;
315-
316-end;
317-
318-// =========================================================================
319-// TBeThreadItem
320-// =========================================================================
321-
322-// *************************************************************************
323-// ƒRƒ“ƒXƒgƒ‰ƒNƒ^
324-// *************************************************************************
325-constructor TBeThreadItem.Create(
326- inInstance : DWORD
327-);
328-var
329- uri : TIdURI;
330- uriList : TStringList;
331-begin
332-
333- inherited;
334-
335- OnDownload := Download;
336- OnWrite := Write;
337- OnGetRes := GetRes;
338- OnGetDat := GetDat;
339- OnGetHeader := GetHeader;
340- OnGetFooter := GetFooter;
341- OnGetBoardURL := GetBoardURL;
342-
343- FilePath := '';
344- FIsTemporary := False;
345- FDat := nil;
346- URL := BrowsableURL;
347-
348- uri := TIdURI.Create( ReadURL );
349- uriList := TStringList.Create;
350- try
351- ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
352- if uriList[ 5 ] = 'l50' then begin
353- FileName := uriList[ 4 ] + '.dat';
354- FilePath := MyLogFolder + uriList[ 2 ] + '\' + uriList[ 3 ] + '\' + uriList[ 4 ] + '.dat';
355- IsLogFile := FileExists( FilePath );
356- end else begin
357- FileName := uriList[ 5 ] + '.dat';
358- FilePath := MyLogFolder + uriList[ 3 ] + '\' + uriList[ 4 ] + '\' + uriList[ 5 ] + '.dat';
359- IsLogFile := FileExists( FilePath );
360- end;
361- finally
362- uri.Free;
363- uriList.Free;
364- end;
365-
366-end;
367-
368-// *************************************************************************
369-// ƒfƒXƒgƒ‰ƒNƒ^
370-// *************************************************************************
371-destructor TBeThreadItem.Destroy;
372-begin
373-
374- FreeDat;
375-
376- // ˆêŽžƒtƒ@ƒCƒ‹‚̏ꍇ‚͍폜‚·‚é
377- if FIsTemporary then
378- DeleteFile( FilePath );
379-
380- inherited;
381-
382-end;
383-
384-// *************************************************************************
385-// Žw’肵‚½ URL ‚̃XƒŒƒbƒh‚̃_ƒEƒ“ƒ[ƒh‚ðŽwŽ¦‚³‚ꂽ
386-// *************************************************************************
387-function TBeThreadItem.Download : TDownloadState;
388-var
389- modified : Double;
390- tmp : PChar;
391- downResult : TStringList;
392- responseCode : Longint;
393- logStream : TFileStream;
394- uri : TIdURI;
395- uriList : TStringList;
396- datURL, tmpURL : string;
397- tmpText: string;
398-begin
399-
400- Result := dsError;
401-
402- uri := TIdURI.Create( ReadURL );
403- uriList := TStringList.Create;
404- try
405- ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
406- FileName := uriList[ 5 ] + '.dat';
407- // http://jbbs.livedoor.com/bbs/rawmode.cgi/game/1578/1067968274/l100
408- // protocol://host/1/2/3/4/5/uriList.Count - 1
409- if MyLogFolder = '' then begin
410- // ‚Ç‚±‚É•Û‘¶‚µ‚Ä‚¢‚¢‚Ì‚©•ª‚©‚ç‚È‚¢‚̂ňꎞƒtƒ@ƒCƒ‹‚É•Û‘¶
411- FilePath := TemporaryFile;
412- FIsTemporary := True;
413- end else begin
414- FilePath := MyLogFolder + uriList[ 3 ] + '\' + uriList[ 4 ] + '\' + uriList[ 5 ] + '.dat';
415- FIsTemporary := False;
416- end;
417- finally
418- uri.Free;
419- uriList.Free;
420- end;
421-
422- // •Û‘¶—p‚̃fƒBƒŒƒNƒgƒŠ‚ðŒ@‚é
423- ForceDirectoriesEx( Copy( FilePath, 1, LastDelimiter( '\', FilePath ) ) );
424-
425- // “ÆŽ©‚Ƀ_ƒEƒ“ƒ[ƒh‚âƒtƒBƒ‹ƒ^ƒŠƒ“ƒO‚ðs‚í‚È‚¢ê‡‚Í
426- // InternalDownload ‚É”C‚¹‚邱‚Æ‚ªo—ˆ‚é
427- modified := LastModified;
428- datURL := ReadURL + IntToStr( Count + 1 ) + '-'; // V’…‚Ì‚Ý
429- responseCode := InternalDownload( PChar( datURL ), modified, tmp, 0 );
430-
431- try
432- if (responseCode = 200) or (responseCode = 206) then begin
433- downResult := TStringList.Create;
434- try
435- tmpText := CustomStringReplace( string( tmp ), '¡÷¡®', ',' );
436- downResult.Text := EUCtoSJIS( tmpText );
437- ArrangeDownloadData(Count, downResult);
438- if downResult.Count > 0 then begin
439- if FileExists( FilePath ) then
440- logStream := TFileStream.Create( FilePath, fmOpenReadWrite or fmShareDenyWrite )
441- else
442- logStream := TFileStream.Create( FilePath, fmCreate or fmShareDenyWrite );
443- try
444- logStream.Position := logStream.Size;
445- logStream.Write( PChar( downResult.Text )^, Length( downResult.Text ) );
446- finally
447- logStream.Free;
448- end;
449-
450- if Count = 0 then
451- // V‹K
452- Result := dsComplete
453- else
454- // ’Ç‹L
455- Result := dsDiffComplete;
456-
457- Size := Size + Length( downResult.Text );
458- // CGI ‚©‚ç‚͐³‚µ‚¢“ú•t‚ª“¾‚ç‚ê‚È‚¢‚Ì‚ÅŒ»Ý‚ɐݒè
459- LastModified := Now;
460-
461-
462-
463- NewReceive := Count + 1;
464- Count := Count + downResult.Count;
465- NewResCount := downResult.Count;
466-
467-
468-
469- end else begin
470- Result := dsNotModify;
471- end;
472- finally
473- downResult.Free;
474- end;
475- end else if responseCode = 302 then begin
476- //http://jbbs.shitaraba.com/bbs/read.cgi/game/3477/1077473358/
477- //http://jbbs.shitaraba.com/game/bbs/read.cgi?BBS=3477&KEY=1077473358
478- //http://jbbs.shitaraba.com/game/3477/storage/1077473358.html
479- //‰ß‹ŽƒƒO
480- //tmpURL := URL;
481- if Assigned( InternalPrint ) then
482- InternalPrint( '‰ß‹ŽƒƒO‘qŒÉ“ü‚è' );
483- uri := TIdURI.Create( ReadURL );
484- uriList := TStringList.Create;
485- try
486- ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
487- tmpURL := uri.Protocol + '://' + uri.Host +
488- '/' + uriList[3] + '/' + uriList[4] + '/storage/' + uriList[ 5 ] + '.html';
489- finally
490- uriList.Free;
491- uri.Free;
492- end;
493- Result := StorageDownload(tmpURL);
494- end else if responseCode = 304 then begin
495- Result := dsNotModify;
496- end;
497- finally
498- DisposeResultString( tmp );
499- end;
500-
501-end;
502-// *************************************************************************
503-// download‚µ‚Ä‚«‚½Dat‚Ì‚ ‚ځ[‚ñ‚³‚ꂽ•ª‚ð•â[‚µ‚āA
504-// ƒŒƒX”‚ƈê’v‚·‚é‚悤‚É‚·‚é
505-// *************************************************************************
506-procedure TBeThreadItem.ArrangeDownloadData(
507- start: Integer; // V‹KF‚O@’Ç‹LF‘O‰ñ‚܂ł̎擾”
508- var Data: TStringList //Dat‚̃f[ƒ^
509-);
510-var
511- i: Integer;
512- n: Integer;
513- tmp: string;
514-begin
515- i := start;
516- while i < Data.count + start do begin
517- try
518- tmp := Copy(Data[i - start], 1 , AnsiPos('<>', Data[ i - start ] )-1 );
519- try
520- n := StrToInt(tmp);
521- if n > i + 1 then begin
522- Data.Insert(i - start, Format('%d<><><><><><>', [i+1]));
523- end;
524- Inc(i);
525- except
526- Inc(i);
527- end;
528- except
529-
530- end;
531- end;
532-
533-end;
534-// *************************************************************************
535-// ‰ß‹ŽƒƒO—pDownloadŠÖ”
536-// *************************************************************************
537-function TBeThreadItem.StorageDownload(
538- AURL : string
539-) : TDownloadState;
540-var
541- modified : Double;
542- tmp : PChar;
543- uri : TIdURI;
544- uriList : TStringList;
545- downResult : TStringList;
546- responseCode : Longint;
547- logStream : TFileStream;
548- tmpText, tmpLine, tmpTitle: string;
549- tmpHTML: TStringList;
550-
551- i, j, tS, tE: Integer;
552- tmpDatToken : array[0..6] of string;
553-begin
554-
555- Result := dsError;
556- uri := TIdURI.Create( ReadURL );
557- uriList := TStringList.Create;
558- try
559- ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
560- FileName := uriList[ 5 ] + '.dat';
561- // http://jbbs.livedoor.com/bbs/rawmode.cgi/game/1578/1067968274/l100
562- // protocol://host/1/2/3/4/5/uriList.Count - 1
563- if MyLogFolder = '' then begin
564- // ‚Ç‚±‚É•Û‘¶‚µ‚Ä‚¢‚¢‚Ì‚©•ª‚©‚ç‚È‚¢‚̂ňꎞƒtƒ@ƒCƒ‹‚É•Û‘¶
565- FilePath := TemporaryFile;
566- FIsTemporary := True;
567- end else begin
568- FilePath := MyLogFolder + uriList[ 3 ] + '\' + uriList[ 4 ] + '\' + uriList[ 5 ] + '.dat';
569- FIsTemporary := False;
570- end;
571- finally
572- uri.Free;
573- uriList.Free;
574- end;
575-
576- // •Û‘¶—p‚̃fƒBƒŒƒNƒgƒŠ‚ðŒ@‚é
577- ForceDirectoriesEx( Copy( FilePath, 1, LastDelimiter( '\', FilePath ) ) );
578-
579-
580-
581- // “ÆŽ©‚Ƀ_ƒEƒ“ƒ[ƒh‚âƒtƒBƒ‹ƒ^ƒŠƒ“ƒO‚ðs‚í‚È‚¢ê‡‚Í
582- // InternalDownload ‚É”C‚¹‚邱‚Æ‚ªo—ˆ‚é
583- modified := LastModified;
584-
585- responseCode := InternalDownload( PChar( AURL ), modified, tmp, 0 );
586-
587- try
588- if (responseCode = 200) or (responseCode = 206) then begin
589- downResult := TStringList.Create;
590- try
591- tmpText := CustomStringReplace( string( tmp ), '¡÷¡®', ',' );
592-
593-
594-
595- //**‚±‚±‚ÅHTMLƒtƒ@ƒCƒ‹‚ð‚µ‚½‚ç‚ÎJBBS‚ÌdatŒ`Ž®‚É•ÏŠ·‚·‚é
596- tmpHTML := TStringList.Create;
597-
598- try
599- tmpHTML.Text := EUCtoSJIS( tmpText );
600- //Title‚̎擾
601- for i := 0 to tmpHTML.Count - 1 do begin
602- tmpLine := AnsiLowerCase(tmpHTML[i]);
603- tS := AnsiPos('<title>', tmpLine);
604- tE := AnsiPos('</title>', tmpLine);
605-
606- if tS > 0 then begin
607- if tE - tS = 1 then begin
608- tmpTitle := '';
609- end else begin
610- tmpTitle := Copy(tmpHTML[i], ts + 7, Length(tmpHTML[i]));
611- tmpLine := AnsiLowerCase(tmpTitle);
612- tE := AnsiPos('</title>', tmpLine);
613-
614- if tE > 0 then begin
615- tmpTitle := Copy(tmpTitle, 1, tE - 1);
616- end else begin
617- j := i + 1;
618- tmpLine := AnsiLowerCase(tmpHTML[j]);
619- tE := AnsiPos('</title>', tmpLine);
620- tmpTitle := tmpTitle + tmpHTML[j];
621- while( tE = 0 ) do begin
622- j := i + 1;
623- if j = tmpHTML.Count then break;
624- tmpLine := AnsiLowerCase(tmpHTML[j]);
625- tE := AnsiPos('</title>', tmpLine);
626- tmpTitle := tmpTitle + tmpHTML[j];
627- end;
628- if tE = 0 then tmpTitle := ''
629- else begin
630- tmpLine := AnsiLowerCase(tmpTitle);
631- tE := AnsiPos('</title>', tmpLine);
632- tmpTitle := Copy(tmpTitle, 1, tE - 1);
633- end;
634- end;
635- end;
636- end;
637- end;
638- //Title := tmpTitle;
639- //tS := 0; tE := 0;
640- //–{•¶‚̎擾 <DL>‚ÌŽŸ‚̍s‚©‚ç</DL>‚Ì‘O‚̍s‚Ü‚Å
641- for i := tmpHTML.Count - 1 downto 0 do begin
642- tmpLine := AnsiLowerCase(tmpHTML[i]);
643- tE := AnsiPos('</dl>', tmpLine);
644- if tE > 0 then begin
645- tmpHTML[i] := COpy(tmpHTML[i], 1, tE -1);
646- break;
647- end;
648- tmpHTML.Delete(i);
649- end;
650- j := 0;
651- for i := 0 to tmpHTML.Count - 1 do begin
652- tmpLine := AnsiLowerCase(tmpHTML[i]);
653- tS := AnsiPos('<dl>', tmpLine);
654- if tS > 0 then begin
655- j := i + 1;
656- break;
657- end;
658- end;
659- for i := j downto 0 do
660- tmpHTML.Delete(i);
661-
662- //<DD><DT>‚»‚ꂼ‚êˆês‚É•ÏŠ·‚·‚é
663- for i := tmpHTML.Count - 1 downto 1 do begin
664- tmpLine := AnsiLowerCase(tmpHTML[i]);
665- if (AnsiPos('<dd>', tmpLine) = 0) and (AnsiPos('<dt>', tmpLine) = 0) then begin
666- tmpLine := CustomStringReplace(tmpHTML[i-1], #13#10, '') +
667- CustomStringReplace(tmpHTML[i], #13#10, '');
668- tmpHTML.Insert(i-1, tmpLine);
669- tmpHTML.Delete(i + 1);
670- tmpHTML.Delete(i);
671- end;
672- end;
673- //ã‚܂ł̏ˆ—‚ňȉº‚̂悤‚ÈŒ`‚É‚È‚Á‚Ä‚é
674- //<dt><a name="958">958 </a> –¼‘OF<font color="#008800"><b> –¼‚à–³‚«ŒRŽt </b></font> “Še“úF 2004/06/30(…) 15:17 [ r1FsjJhA ]<br><dd>``
675- //<dt><a name="951">951 </a> –¼‘OF<a href="mailto:sage"><b> –¼‚à–³‚«ŒRŽt </B></a> “Še“úF 2004/06/30(…) 12:31 [ .oGr0rtc ]<br><dd>``
676- //ã‚̂悤‚È‚Ì‚ð‰º‚Ì‚æ‚¤‚Èdat‚ÌŒ`Ž®‚É•ÏŠ·‚·‚é
677- //ƒŒƒX”ԍ†<><font color=#FF0000>HN</font><>ƒƒ‹—“<>“ú•tŽž<>–{•¶<>ƒ^ƒCƒgƒ‹i‚P‚̂݁j<>ID
678- //2<>–¼‚à–³‚«ŒRŽt<>sage<>2004/06/22(‰Î) 09:05<>‚Q‚°‚Ɓ[<><>26bmLAzg
679- for i := 0 to tmpHTML.Count - 1 do begin
680- tmpDatToken[0] := ''; tmpDatToken[1] := ''; tmpDatToken[2] := '';
681- tmpDatToken[3] := ''; tmpDatToken[4] := ''; tmpDatToken[6] := '';
682- //==‚Ü‚¸‚Í–{•¶‚ðŽæ“¾==//
683- tmpLine := AnsiLowerCase(tmpHTML[i]);
684- tS := AnsiPos('<dd>', tmpLine);
685- if tS > 0 then begin
686- tmpDatToken[4] := Copy(tmpHTML[i], tS + 4, Length(tmpHTML[i]));
687- tmpHTML[i] := Copy(tmpHTML[i], 1, tS -1);
688- end else
689- tmpDatToken[4] := '';
690- //====================//
691- //==ƒŒƒX”ԍ†Žæ“¾==//
692- tmpLine := AnsiLowerCase(tmpHTML[i]);
693- tS := AnsiPos('">', tmpLine);
694- tE := AnsiPos('</a>', tmpLine);
695- if tE > tS then begin
696- tmpDatToken[0] := Copy(tmpHTML[i], tS + 2, tE - (tS + 2) - 1);
697- tmpDatToken[0] := Trim(tmpDatToken[0]);
698- tmpHTML[i] := Copy(tmpHTML[i], tE + 4, Length(tmpHTML[i]));
699- end else
700- tmpDatToken[0] := IntToStr(i);
701- tS := AnsiPos('<', tmpHTML[i]);
702- if tS > 0 then begin
703- tmpHTML[i] := Copy(tmpHTML[i], tS, Length(tmpHTML[i]));
704- end;
705- //====================//
706- //==ƒƒ‹—“Žæ“¾==//
707- tmpLine := AnsiLowerCase(tmpHTML[i]);
708- tS := AnsiPos('<a href="mailto:', tmpLine);
709- if tS > 0 then begin //ƒƒ‹—“ƒAƒŠ
710- tE := AnsiPos('">', tmpLine);
711- tmpDatToken[2] := Copy(tmpHTML[i], tS + 16, tE - (tS + 16));
712- tmpHTML[i] := Copy(tmpHTML[i], tE + 5, Length(tmpHTML[i]));
713- tmpHTML[i] := CustomStringReplace(tmpHTML[i], '</a>', '', true);
714- end else begin //ƒƒ‹—“–³‚µ
715- tmpDatToken[2] := '';
716- end;
717- //====================//
718- //==HNŽæ“¾==//
719- tmpLine := AnsiLowerCase(tmpHTML[i]);
720- tE := AnsiPos('“Še“úF', tmpLine);
721- if tE > 0 then begin
722- tmpDatToken[1] := Trim(Copy(tmpHTML[i], 1, tE - 1 ));
723- tmpDatToken[1] := CustomStringReplace(tmpDatToken[1], '<b>', '', true);
724- tmpDatToken[1] := CustomStringReplace(tmpDatToken[1], '</b>', '', true);
725- tmpHTML[i] := Copy(tmpHTML[i], tE + 8, Length(tmpHTML[i]));
726- end else begin
727- tmpDatToken[1] := '';
728- end;
729- //====================//
730- //==“ú•tŽž‚̎擾==//
731- tmpLine := AnsiLowerCase(tmpHTML[i]);
732- tE := AnsiPos('[', tmpLine);
733- if tE > 0 then begin
734- tmpDatToken[3] := Trim(Copy(tmpHTML[i], 1, tE - 1 ));
735- tmpHTML[i] := Copy(tmpHTML[i], tE + 1, Length(tmpHTML[i]));
736- end else begin
737- tmpDatToken[3] := '';
738- end;
739- //====================//
740- //==ID‚̎擾==//
741- tmpLine := AnsiLowerCase(tmpHTML[i]);
742- tE := AnsiPos(']', tmpLine);
743- if tE > 0 then begin
744- tmpDatToken[6] := Trim(Copy(tmpHTML[i], 1, tE - 1 ));
745- end else begin
746- tmpDatToken[6] := '';
747- end;
748- //====================//
749- tS := StrToIntDef(tmpDatToken[0], -1);
750- if tS = 1 then
751- tmpLine := tmpDatToken[0] + '<>' + tmpDatToken[1] + '<>' + tmpDatToken[2] + '<>' +
752- tmpDatToken[3] + '<>' + tmpDatToken[4] + '<>' + tmpTitle + '<>' + tmpDatToken[6]
753- else
754- tmpLine := tmpDatToken[0] + '<>' + tmpDatToken[1] + '<>' +tmpDatToken[2] + '<>' +
755- tmpDatToken[3] + '<>' + tmpDatToken[4] + '<><>' + tmpDatToken[6];
756- tmpHTML[i] := tmpLine;
757- end;
758-
759-
760-
761-
762- downResult.Text := tmpHTML.Text;
763- finally
764- tmpHTML.free;
765- end;
766-
767- ArrangeDownloadData(Count, downResult);
768-
769- if downResult.Count > 0 then begin
770- if FileExists( FilePath ) then
771- DeleteFile(FilePath);
772-
773- logStream := TFileStream.Create( FilePath, fmCreate or fmShareDenyWrite );
774- try
775- logStream.Position := 0;
776- logStream.Write( PChar( downResult.Text )^, Length( downResult.Text ) );
777- finally
778- logStream.Free;
779- end;
780-
781- // V‹K
782- Result := dsComplete;
783-
784- Size := Length( downResult.Text );
785- // CGI ‚©‚ç‚͐³‚µ‚¢“ú•t‚ª“¾‚ç‚ê‚È‚¢‚Ì‚ÅŒ»Ý‚ɐݒè
786- LastModified := Now;
787-
788-
789-
790- NewReceive := 1;
791- Count := downResult.Count;
792- NewResCount := downResult.Count;
793- //http://jbbs.livedoor.com/bbs/read.cgi/game/1578/1086710948/l100
794- //http://jbbs.livedoor.com/game/1578/storage/1086710948.html
795- //URL := 'http://jbbs.livedoor.com/bbs/read.cgi' +
796- // CustomStringReplace(Path, '/storage', '')
797- // + FileName;
798- DownloadHost := 'storage';
799- end else begin
800- Result := dsNotModify;
801- end;
802- finally
803- downResult.Free;
804- end;
805- end else if responseCode = 304 then begin
806- Result := dsNotModify;
807- end;
808- finally
809- DisposeResultString( tmp );
810- end;
811-
812-end;
813-
814-// *************************************************************************
815-// ‘‚«ž‚Ý‚ðŽwŽ¦‚³‚ꂽ
816-// *************************************************************************
817-function TBeThreadItem.Write(
818- inName : string; // –¼‘O(ƒnƒ“ƒhƒ‹)
819- inMail : string; // ƒ[ƒ‹ƒAƒhƒŒƒX
820- inMessage : string // –{•¶
821-) : TDownloadState; // ‘‚«ž‚Ý‚ª¬Œ÷‚µ‚½‚©‚Ç‚¤‚©
822-var
823- postData : string;
824- postResult : PChar;
825- uri : TIdURI;
826- uriList : TStringList;
827- responseCode : Integer;
828-begin
829-
830- uri := TIdURI.Create( URL );
831- uriList := TStringList.Create;
832- try
833- ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
834-
835- // http://jbbs.livedoor.com/bbs/read.cgi/game/1578/1067968274/l100
836- postData :=
837- 'NAME=' + HttpEncode( SJIStoEUC( inName ) ) +
838- '&MAIL=' + HttpEncode( SJIStoEUC( inMail ) ) +
839- '&MESSAGE=' + HttpEncode( SJIStoEUC( inMessage ) ) +
840- '&BBS=' + uriList[ 4 ] +
841- '&KEY=' + uriList[ 5 ] +
842- '&DIR=' + uriList[ 3 ] +
843- '&TIME=' + IntToStr( DateTimeToUnix( Now ) ) +
844- '&submit=' + HttpEncode( SJIStoEUC( '‘‚«ž‚Þ' ) );
845-
846- // “ÆŽ©‚ɒʐM‚µ‚È‚¢ê‡‚Í InternalPost ‚É”C‚¹‚邱‚Æ‚ªo—ˆ‚é
847- responseCode := InternalPost( PChar( WriteURL ), PChar( postData ), postResult );
848- try
849- if (responseCode = 200) or
850- ((responseCode = 302) and (Length( Trim( postResult ) ) = 0)) then begin
851- Result := dsComplete
852- end else begin
853- Result := dsError;
854- if Assigned( InternalPrint ) then
855- InternalPrint( postResult );
856- end;
857- finally
858- DisposeResultString( postResult );
859- end;
860- finally
861- uri.Free;
862- uriList.Free;
863- end;
864-
865-end;
866-
867-// *************************************************************************
868-// ƒŒƒX”ԍ† inNo ‚ɑ΂·‚é html ‚ð—v‹‚³‚ꂽ
869-// *************************************************************************
870-function TBeThreadItem.GetRes(
871- inNo : Integer // —v‹‚³‚ꂽƒŒƒX”ԍ†
872-) : string; // ‘Ήž‚·‚é HTML
873-var
874- res : string;
875- tmp : PChar;
876-begin
877-
878- // “ÆŽ©‚ɃtƒBƒ‹ƒ^ƒŠƒ“ƒO‚ðs‚í‚È‚¢ê‡‚Í
879- // InternalAbon ‚¨‚æ‚Ñ Dat2HTML ‚É”C‚¹‚邱‚Æ‚ªo—ˆ‚é
880- {
881- LoadDat;
882- if FDat = nil then begin
883- // ƒƒO‚É‘¶Ý‚µ‚È‚¢‚Ì‚Å‚±‚̂܂܏I—¹
884- Result := '';
885- Exit;
886- end;
887- res := Copy( FDat[ inNo - 1 ], AnsiPos( '<>', FDat[ inNo - 1 ] ) + 2, MaxInt );
888- }
889- res := GetDat( inNo );
890- if res = '' then begin
891- Result := '';
892- Exit;
893- end else begin
894- tmp := InternalAbonForOne( PChar( res ), PChar( FilePath ),inNo );
895- try
896- Result := Dat2HTML( string( tmp ), inNo );
897- finally
898- DisposeResultString( tmp );
899- end;
900- end;
901-
902-end;
903-
904-// *************************************************************************
905-// ƒŒƒX”ԍ† inNo ‚ɑ΂·‚é Dat ‚ð—v‹‚³‚ꂽ
906-// *************************************************************************
907-function TBeThreadItem.GetDat(
908- inNo : Integer // —v‹‚³‚ꂽƒŒƒX”ԍ†
909-) : string; // ‚Q‚¿‚á‚ñ‚Ë‚é‚ÌDatŒ`Ž®
910-var
911- res : string;
912- tmp : array[1..5] of string;
913- i : Integer;
914- pTmp : PChar;
915-begin
916- pTmp := nil;
917- // “ÆŽ©‚ɃtƒBƒ‹ƒ^ƒŠƒ“ƒO‚ðs‚í‚È‚¢ê‡‚Í
918- // InternalAbon ‚¨‚æ‚Ñ Dat2HTML ‚É”C‚¹‚邱‚Æ‚ªo—ˆ‚é
919- LoadDat;
920- if (FDat = nil) or (inNo - 1 < 0 ) or (inNo - 1 >= FDat.Count) then begin
921- // ƒƒO‚É‘¶Ý‚µ‚È‚¢‚Ì‚Å‚±‚̂܂܏I—¹
922- Result := '';
923- Exit;
924- end;
925- try
926- res := Copy( FDat[ inNo - 1 ], AnsiPos( '<>', FDat[ inNo - 1 ] ) + 2, MaxInt );
927- //––”ö‚ÉID‚ª•\Ž¦‚³‚ê‚Ä‚¢‚é‚Ì‚Å‚»‚ê‚𓊍e“ú‚Ì‚Æ‚±‚ë‚É“ü‚ê‚é
928- // –¼‘O<>ƒ[ƒ‹<>“ú•t<>–{•¶<>ƒXƒŒƒ^ƒC<>ID
929- for i := 0 to 4 do begin
930- tmp[ i + 1 ] := Copy( res, 1, AnsiPos('<>', res) - 1 );
931- Delete( res, 1, AnsiPos('<>', res) + 1 );
932- end;
933- // –¼‘O<>ƒ[ƒ‹<>“ú•tID<>–{•¶<>ƒXƒŒƒ^ƒC
934- pTmp := CreateResultString(tmp[1] + '<>' + tmp[2] + '<>' + tmp[3] + ' ' + res + '<>'+ tmp[4] + '<>' +tmp[5]);
935- Result := string(pTmp);
936- finally
937- DisposeResultString(pTmp);
938- end;
939-
940-end;
941-
942-// *************************************************************************
943-// ƒXƒŒƒbƒh‚̃wƒbƒ_ html ‚ð—v‹‚³‚ꂽ
944-// *************************************************************************
945-function TBeThreadItem.GetHeader(
946- inOptionalHeader : string
947-) : string;
948-begin
949-
950- // “ÆŽ©‚ɃtƒBƒ‹ƒ^ƒŠƒ“ƒO‚ðs‚í‚È‚¢ê‡‚Í
951- // InternalHeader ‚É”C‚¹‚邱‚Æ‚ªo—ˆ‚é
952- Result := InternalHeader(
953- '<meta http-equiv="Content-type" content="text/html; charset=Shift_JIS">' +
954- inOptionalHeader );
955-
956-
957- // GetRes ‚ðŒÄ‚΂ê‚邱‚Æ‚ª—\‘z‚³‚ê‚é‚Ì‚Å FDat ‚𐶐¬‚µ‚Ä‚¨‚­
958- try
959- FreeDat;
960- LoadDat;
961- except
962- end;
963-
964-end;
965-
966-// *************************************************************************
967-// ƒXƒŒƒbƒh‚̃tƒbƒ^ html ‚ð—v‹‚³‚ꂽ
968-// *************************************************************************
969-function TBeThreadItem.GetFooter(
970- inOptionalFooter : string
971-) : string;
972-begin
973-
974- // “ÆŽ©‚ɃtƒBƒ‹ƒ^ƒŠƒ“ƒO‚ðs‚í‚È‚¢ê‡‚Í
975- // InternalFooter ‚É”C‚¹‚邱‚Æ‚ªo—ˆ‚é
976- Result := InternalFooter( inOptionalFooter );
977-
978- // ‚à‚¤ GetRes ‚͌Ă΂ê‚È‚¢‚ÆŽv‚¤‚Ì‚Å FDat ‚ðŠJ•ú‚µ‚Ä‚¨‚­
979- try
980- FreeDat;
981- except
982- end;
983-
984-end;
985-
986-// *************************************************************************
987-// ‚±‚Ì ThreadItem ‚ª‘®‚·‚é”Â‚Ì URL ‚ð—v‹‚³‚ꂽ
988-// *************************************************************************
989-function TBeThreadItem.GetBoardURL : string;
990-var
991- uri : TIdURI;
992- uriList : TStringList;
993- tmphost: String;
994-const
995- BBS_HOST = 'be.2ch.net';
996-begin
997-
998- uri := TIdURI.Create( ReadURL );
999- uriList := TStringList.Create;
1000- try
1001- ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
1002- FileName := uriList[ 4 ] + '.dat';
1003- Result := CreateResultString(
1004- uri.Protocol + '://' + uri.host + '/' + uriList[ 3 ] + '/' );
1005- finally
1006- uri.Free;
1007- uriList.Free;
1008- end;
1009-
1010-end;
1011-
1012-// *************************************************************************
1013-// FDat ‚̐¶¬
1014-// *************************************************************************
1015-procedure TBeThreadItem.LoadDat;
1016-begin
1017-
1018- if FDat = nil then begin
1019- if IsLogFile then begin
1020- // dat ‚̓ǂݍž‚Ý
1021- FDat := TStringList.Create;
1022- FDat.LoadFromFile( FilePath );
1023- end;
1024- end;
1025-
1026-end;
1027-
1028-// *************************************************************************
1029-// FDat ‚ÌŠJ•ú
1030-// *************************************************************************
1031-procedure TBeThreadItem.FreeDat;
1032-begin
1033-
1034- if FDat <> nil then begin
1035- FDat.Free;
1036- FDat := nil;
1037- end;
1038-
1039-end;
1040-
1041-// *************************************************************************
1042-// ˆÀ‘S‚ȃuƒ‰ƒEƒU•\Ž¦—p‚Ì URL
1043-// *************************************************************************
1044-function TBeThreadItem.BrowsableURL : string;
1045-var
1046- uri : TIdURI;
1047- uriList : TStringList;
1048- foundPos : Integer;
1049- dir, tmphost : string;
1050-const
1051- THREAD_MARK = '/test/read.cgi';
1052- BBS_HOST = 'be.2ch.net';
1053-begin
1054- if Copy( URL, Length( URL ), 1 ) = '/' then
1055- uri := TIdURI.Create( URL )
1056- else
1057- uri := TIdURI.Create( URL + '/' );
1058-
1059- uriList := TStringList.Create;
1060- try
1061- ExtractHttpFields( ['/'], [], uri.Path, uriList );
1062-
1063- if( AnsiPos(THREAD_MARK, URL) > 0) and (uriList.Count > 4) then begin
1064- Result :=
1065- uri.Protocol + '://' + uri.host + THREAD_MARK + '/' +
1066- uriList[ 3 ] + '/' + uriList[ 4 ] + '/l50';
1067-
1068- end else if AnsiPos(THREAD_MARK, URL) = 0 then begin
1069- {
1070- //ƒRƒR‚ʼnߋŽƒƒO‚©‚Ç‚¤‚©ƒ`ƒFƒbƒNH
1071- if(AnsiPos('.html/', uri.Path) > 0) then begin
1072- Result := uri.Protocol + '://' + url.host + THREAD_MARK +
1073- CustomStringReplace(CustomStringReplace(uri.Path, '/storage', ''), '.html/', '/') + 'l100';
1074- end else
1075- }
1076- Result := URL;
1077- end;
1078- finally
1079- uri.Free;
1080- uriList.Free;
1081- end;
1082-
1083-end;
1084-
1085-// *************************************************************************
1086-// ˆÀ‘S‚È( '/' ‚ŏI‚í‚é )“ǂݍž‚Ý‚Ì URL
1087-// *************************************************************************
1088-function TBeThreadItem.ReadURL : string;
1089-var
1090- uri : TIdURI;
1091- uriList : TStringList;
1092- foundPos : Integer;
1093- dir, tmphost : string;
1094-const
1095- THREAD_MARK = '/test/read.cgi';
1096- BBS_HOST = 'be.2ch.net';
1097-begin
1098-
1099- if Copy( URL, Length( URL ), 1 ) = '/' then
1100- uri := TIdURI.Create( URL )
1101- else
1102- uri := TIdURI.Create( URL + '/' );
1103- uriList := TStringList.Create;
1104- try
1105- ExtractHttpFields( ['/'], [], uri.Path, uriList );
1106-
1107- if( AnsiPos(THREAD_MARK, URL) > 0) and (uriList.Count > 4) then begin
1108- Result :=
1109- uri.Protocol + '://' + uri.Host + THREAD_MARK +
1110- uriList[ 3 ] + '/' + uriList[ 4 ] + '/';
1111- end;
1112- finally
1113- uri.Free;
1114- uriList.Free;
1115- end;
1116-end;
1117-
1118-// *************************************************************************
1119-// ˆÀ‘S‚È( '/' ‚ŏI‚í‚é )‘‚«ž‚Ý‚Ì URL
1120-// *************************************************************************
1121-function TBeThreadItem.WriteURL : string;
1122-var
1123- uri : TIdURI;
1124- uriList : TStringList;
1125-begin
1126-
1127- if Copy( URL, Length( URL ), 1 ) = '/' then
1128- uri := TIdURI.Create( URL )
1129- else
1130- uri := TIdURI.Create( URL + '/' );
1131- uriList := TStringList.Create;
1132- try
1133- ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
1134- // http://jbbs.livedoor.com/bbs/read.cgi/game/1578/1067968274/l100
1135- Result :=
1136- uri.Protocol + '://' + uri.Host + '/bbs/write.cgi/' +
1137- uriList[ 3 ] + '/' + uriList[ 4 ] + '/' + uriList[ 5 ] + '/';
1138- finally
1139- uri.Free;
1140- uriList.Free;
1141- end;
1142-
1143-end;
1144-
1145-// *************************************************************************
1146-// TThreadItem ‚ª¶¬‚³‚ꂽê‡‚̏ˆ’u(TBeThreadItem ‚𐶐¬‚·‚é)
1147-// *************************************************************************
1148-procedure ThreadItemOnCreateOfTBeThreadItem(
1149- inInstance : DWORD
1150-);
1151-var
1152- threadItem : TBeThreadItem;
1153-begin
1154-
1155- threadItem := TBeThreadItem.Create( inInstance );
1156- ThreadItemSetLong( inInstance, tipContext, DWORD( threadItem ) );
1157-
1158-end;
1159-
1160-// *************************************************************************
1161-// TThreadItem ‚ª”jŠü‚³‚ꂽê‡‚̏ˆ’u(TBeThreadItem ‚ð”jŠü‚·‚é)
1162-// *************************************************************************
1163-procedure ThreadItemOnDisposeOfTBeThreadItem(
1164- inInstance : DWORD
1165-);
1166-var
1167- threadItem : TBeThreadItem;
1168-begin
1169-
1170- threadItem := TBeThreadItem( ThreadItemGetLong( inInstance, tipContext ) );
1171- threadItem.Free;
1172-
1173-end;
1174-
1175-// =========================================================================
1176-// TBeBoardItem
1177-// =========================================================================
1178-
1179-// *************************************************************************
1180-// ƒRƒ“ƒXƒgƒ‰ƒNƒ^
1181-// *************************************************************************
1182-constructor TBeBoardItem.Create(
1183- inInstance : DWORD
1184-);
1185-var
1186- uri : TIdURI;
1187- uriList : TStringList;
1188-const
1189- BBS_HOST = 'be.2ch.net';
1190-begin
1191-
1192- inherited;
1193-
1194- OnDownload := Download;
1195- OnCreateThread := CreateThread;
1196- OnEnumThread := EnumThread;
1197- OnFileName2ThreadURL := ToThreadURL;
1198-
1199- FilePath := '';
1200- FIsTemporary := False;
1201- FDat := nil;
1202-
1203- uri := TIdURI.Create( SubjectURL );
1204- uriList := TStringList.Create;
1205- try
1206- URL := uri.Protocol + '://' + uri.Host + uri.Path;
1207-
1208- ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
1209- // http://jbbs.livedoor.com/game/1000/subject.txt
1210- FilePath := MyLogFolder + uriList[ 1 ] + '\' + uriList[ 2 ] + '\' + uri.Document;
1211- IsLogFile := FileExists( FilePath );
1212- finally
1213- uri.Free;
1214- uriList.Free;
1215- end;
1216-
1217-end;
1218-
1219-// *************************************************************************
1220-// ƒfƒXƒgƒ‰ƒNƒ^
1221-// *************************************************************************
1222-destructor TBeBoardItem.Destroy;
1223-begin
1224-
1225- if FDat <> nil then begin
1226- try
1227- FDat.Free;
1228- FDat := nil;
1229- except
1230- end;
1231- end;
1232-
1233- // ˆêŽžƒtƒ@ƒCƒ‹‚̏ꍇ‚͍폜‚·‚é
1234- if FIsTemporary then
1235- DeleteFile( FilePath );
1236-
1237- inherited;
1238-
1239-end;
1240-
1241-// *************************************************************************
1242-// Žw’肵‚½ƒXƒŒˆê——‚̃_ƒEƒ“ƒ[ƒh‚ð—v‹‚³‚ꂽ
1243-// *************************************************************************
1244-function TBeBoardItem.Download : TDownloadState;
1245-var
1246- modified : Double;
1247- downResult : PChar;
1248- responseCode : Longint;
1249- uri : TIdURI;
1250- uriList : TStringList;
1251- i : Integer;
1252- tmpText : String;
1253-begin
1254-
1255- Result := dsError;
1256-
1257- if FDat <> nil then begin
1258- try
1259- FDat.Free;
1260- FDat := nil;
1261- except
1262- end;
1263- end;
1264- FDat := TStringList.Create;
1265- uri := TIdURI.Create( SubjectURL );
1266- uriList := TStringList.Create;
1267- // “ÆŽ©‚Ƀ_ƒEƒ“ƒ[ƒh‚âƒtƒBƒ‹ƒ^ƒŠƒ“ƒO‚ðs‚í‚È‚¢ê‡‚Í
1268- // InternalDownload ‚É”C‚¹‚邱‚Æ‚ªo—ˆ‚é
1269- modified := LastModified;
1270- responseCode := InternalDownload( PChar( uri.URI ), modified, downResult );
1271- try
1272- if responseCode = 200 then begin
1273- try
1274- // ƒpƒX‚ðŽZo
1275- ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
1276- if MyLogFolder = '' then begin
1277- // ‚Ç‚±‚É•Û‘¶‚µ‚Ä‚¢‚¢‚Ì‚©•ª‚©‚ç‚È‚¢‚̂ňꎞƒtƒ@ƒCƒ‹‚É•Û‘¶
1278- FilePath := TemporaryFile;
1279- FIsTemporary := True;
1280- end else begin
1281- FilePath := MyLogFolder + uriList[ 1 ] + '\' + uriList[ 2 ] + '\' + uri.Document;
1282- FIsTemporary := False
1283- end;
1284-
1285- // •Û‘¶—p‚̃fƒBƒŒƒNƒgƒŠ‚ðŒ@‚é
1286- ForceDirectoriesEx( Copy( FilePath, 1, LastDelimiter( '\', FilePath ) ) );
1287-
1288- // EUC ‚ð Shift_JIS ‚É
1289- tmpText := CustomStringReplace( string( downResult ), '¡÷¡®', ',');
1290- FDat.Text := EUCtoSJIS( tmpText );
1291- // •Û‘¶
1292- FDat.SaveToFile( FilePath );
1293-
1294- IsLogFile := True;
1295- RoundDate := Now;
1296- LastModified := modified;
1297- LastGetTime := Now;
1298- finally
1299- uri.Free;
1300- uriList.Free;
1301- end;
1302- Result := dsComplete;
1303- end;
1304- finally
1305- DisposeResultString( downResult );
1306- end;
1307-
1308-end;
1309-
1310-// *************************************************************************
1311-// ƒXƒŒ—§‚Ä‚ðŽwŽ¦‚³‚ꂽ
1312-// *************************************************************************
1313-function TBeBoardItem.CreateThread(
1314- inSubject : string; // ƒXƒŒƒ^ƒC
1315- inName : string; // –¼‘O(ƒnƒ“ƒhƒ‹)
1316- inMail : string; // ƒ[ƒ‹ƒAƒhƒŒƒX
1317- inMessage : string // –{•¶
1318-) : TDownloadState; // ‘‚«ž‚Ý‚ª¬Œ÷‚µ‚½‚©‚Ç‚¤‚©
1319-var
1320- postURL : string;
1321- postData : string;
1322- postResult : PChar;
1323- uri : TIdURI;
1324- uriList : TStringList;
1325- responseCode : Integer;
1326-begin
1327-
1328- uri := TIdURI.Create( URL );
1329- uriList := TStringList.Create;
1330- try
1331- ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
1332-
1333- postURL :=
1334- uri.Protocol + '://' + uri.Host + '/bbs.cgi';
1335- postData :=
1336- 'subject=&'
1337- + 'FROM=' + HttpEncode(SJIStoEUC(inName)) + '&'
1338- + 'mail=' + HttpEncode(SJIStoEUC(inMail)) + '&'
1339- + 'MESSAGE=' + HttpEncode(SJIStoEUC(inMessage)) + '&'
1340- + 'bbs=' + uriList[4] + '&'
1341- + 'time=' + IntToStr(DateTimeToUnix( Now )) + '&'
1342- + 'subject=' + HttpEncode(SJIStoEUC(inSubject)) + '&'
1343- + 'submit=' + HttpEncode(SJIStoEUC('‘SÓ”C‚𕉂¤‚±‚Æ‚ð³‘ø‚µ‚ď‘‚«ž‚Þ')) + #13#10;
1344- //s := s + 'subject=' + HttpEncode(TitleEdit.Text) + '&';
1345- //s := s + 'submit=' + HttpEncode('‘SÓ”C‚𕉂¤‚±‚Æ‚ð³‘ø‚µ‚ď‘‚«ž‚Þ') + #13#10;
1346-
1347- {postData :=
1348- 'SUBJECT=' + HttpEncode( SJIStoEUC( inSubject ) ) +
1349- '&NAME=' + HttpEncode( SJIStoEUC( inName ) ) +
1350- '&MAIL=' + HttpEncode( SJIStoEUC( inMail ) ) +
1351- '&MESSAGE=' + HttpEncode( SJIStoEUC( inMessage ) ) +
1352- '&BBS=' + uriList[ 4 ] +
1353- '&TIME=' + IntToStr( DateTimeToUnix( Now ) ) +
1354- '&submit=' + HttpEncode( SJIStoEUC( 'V‹K‘‚«ž‚Ý' ) );
1355- }
1356-{
1357- s := s + 'subject=&'
1358- + 'FROM=' + HttpEncode(NameComboBox.Text) + '&'
1359- + 'mail=' + HttpEncode(MailComboBox.Text) + '&'
1360- + 'MESSAGE=' + HttpEncode(body) + '&'
1361- + 'bbs=' + Board.BBSID + '&'
1362- + 'time=' + IntToStr(SendTime) + '&';
1363- if FThreadItem = nil then begin
1364- s := s + 'subject=' + HttpEncode(TitleEdit.Text) + '&';
1365- s := s + 'submit=' + HttpEncode('‘SÓ”C‚𕉂¤‚±‚Æ‚ð³‘ø‚µ‚ď‘‚«ž‚Þ') + #13#10;
1366- end else begin
1367- s := s + 'key=' + ChangeFileExt(FThreadItem.FileName, '') + '&';
1368- s := s + 'submit=' + HttpEncode('‘‚«ž‚Þ') + #13#10;
1369- end;
1370-
1371-}
1372- // “ÆŽ©‚ɒʐM‚µ‚È‚¢ê‡‚Í InternalPost ‚É”C‚¹‚邱‚Æ‚ªo—ˆ‚é
1373- responseCode := InternalPost( PChar( postURL ), PChar( postData ), postResult );
1374- try
1375- if (responseCode = 200) or
1376- ((responseCode = 302) and (Length( Trim( postResult ) ) = 0)) then begin
1377- Result := dsComplete
1378- end else begin
1379- Result := dsError;
1380- if Assigned( InternalPrint ) then
1381- InternalPrint( postResult );
1382- end;
1383- finally
1384- DisposeResultString( postResult );
1385- end;
1386- finally
1387- uri.Free;
1388- uriList.Free;
1389- end;
1390-
1391-end;
1392-
1393-// *************************************************************************
1394-// ƒXƒŒˆê——‚Ì URL ‚©‚çƒXƒŒƒbƒh‚Ì URL ‚𓱂«o‚·
1395-// *************************************************************************
1396-function TBeBoardItem.ToThreadURL(
1397- inFileName : string // ƒXƒŒƒbƒhƒtƒ@ƒCƒ‹–¼
1398-) : string; // ƒXƒŒƒbƒh‚Ì URL
1399-var
1400- threadURL : string;
1401- uri : TIdURI;
1402- uriList : TStringList;
1403- found : Integer;
1404-begin
1405-
1406- found := AnsiPos( '.', inFileName );
1407- if found > 0 then
1408- inFileName := Copy( inFileName, 1, found - 1 );
1409-
1410- uri := TIdURI.Create( SubjectURL );
1411- uriList := TStringList.Create;
1412- try
1413- try
1414- ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
1415- threadURL := uri.Protocol + '://' + uri.Host + '/test/read.cgi/' +
1416- uriList[ 1 ] + '/' + inFileName + '/l50';
1417- Result := threadURL;
1418- finally
1419- uri.Free;
1420- uriList.Free;
1421- end;
1422- except
1423- Result := '';
1424- end;
1425-
1426-end;
1427-
1428-// *************************************************************************
1429-// ‚±‚̔‚ɂ¢‚­‚‚̃XƒŒ‚ª‚ ‚é‚©—v‹‚³‚ꂽ
1430-// *************************************************************************
1431-procedure TBeBoardItem.EnumThread(
1432- inCallBack : TBoardItemEnumThreadCallBack
1433-);
1434-var
1435- uri : TIdURI;
1436- uriList : TStringList;
1437-begin
1438-
1439- try
1440- if FDat = nil then begin
1441- FDat := TStringList.Create;
1442- uri := TIdURI.Create( SubjectURL );
1443- uriList := TStringList.Create;
1444- try
1445- // ƒpƒX‚ðŽZo
1446- ExtractHttpFields( ['/', '?'], [], uri.Path, uriList );
1447- // http://jbbs.livedoor.com/game/1000/subject.txt
1448- FilePath := MyLogFolder + uriList[ 1 ] + '\' + uriList[ 2 ] + '\' + uri.Document;
1449- if FileExists( FilePath ) then
1450- // “ǂݍž‚Ý
1451- FDat.LoadFromFile( FilePath );
1452- finally
1453- uri.Free;
1454- uriList.Free;
1455- end;
1456- end;
1457-
1458- // “ÆŽ©‚ɃtƒBƒ‹ƒ^ƒŠƒ“ƒO‚ðs‚í‚È‚¢ê‡‚Í EnumThread ‚É”C‚¹‚邱‚Æ‚ªo—ˆ‚é
1459- inherited EnumThread( inCallBack, CustomStringReplace( FDat.Text, ',', '<>' ) );
1460- except
1461- end;
1462-
1463-end;
1464-
1465-// *************************************************************************
1466-// ƒXƒŒˆê——‚Ì URL ‚ð‹‚ß‚é
1467-// *************************************************************************
1468-function TBeBoardItem.SubjectURL : string;
1469-var
1470- uri : TIdURI;
1471- uriList : TStringList;
1472-begin
1473-
1474- uri := TIdURI.Create( URL );
1475- uriList := TStringList.Create;
1476- try
1477- if uri.Document <> SUBJECT_NAME then begin
1478- if Copy( URL, Length( URL ), 1 ) = '/' then
1479- Result := URL + SUBJECT_NAME
1480- else
1481- Result := URL + '/' + SUBJECT_NAME;
1482- end else begin
1483- // ‚±‚±‚É‚Í—ˆ‚È‚¢‚ÆŽv‚¤‚¯‚Ç
1484- Result := URL;
1485- end;
1486- finally
1487- uri.Free;
1488- uriList.Free;
1489- end;
1490-
1491-end;
1492-
1493-// *************************************************************************
1494-// TBoardItem ‚ª¶¬‚³‚ꂽê‡‚̏ˆ’u(TBeBoardItem ‚𐶐¬‚·‚é)
1495-// *************************************************************************
1496-procedure BoardItemOnCreateOfTBeBoardItem(
1497- inInstance : DWORD
1498-);
1499-var
1500- boardItem : TBeBoardItem;
1501-begin
1502-
1503- boardItem := TBeBoardItem.Create( inInstance );
1504- BoardItemSetLong( inInstance, bipContext, DWORD( boardItem ) );
1505-
1506-end;
1507-
1508-// *************************************************************************
1509-// TBoardItem ‚ª”jŠü‚³‚ꂽê‡‚̏ˆ’u(TBeBoardItem ‚ð”jŠü‚·‚é)
1510-// *************************************************************************
1511-procedure BoardItemOnDisposeOfTBeBoardItem(
1512- inInstance : DWORD
1513-);
1514-var
1515- boardItem : TBeBoardItem;
1516-begin
1517-
1518- boardItem := TBeBoardItem( BoardItemGetLong( inInstance, bipContext ) );
1519- boardItem.Free;
1520-
1521-end;
1522-
1523-
1524-
1525-// =========================================================================
1526-// ƒGƒ“ƒgƒŠƒ|ƒCƒ“ƒg
1527-// =========================================================================
1528-procedure DLLEntry(
1529- ul_reason_for_call : DWORD
1530-);
1531-var
1532- module : HMODULE;
1533-begin
1534-
1535- case ul_reason_for_call of
1536- DLL_PROCESS_ATTACH:
1537- begin
1538- Randomize;
1539-
1540- module := GetModuleHandle( nil );
1541-
1542- LoadInternalAPI( module );
1543- LoadInternalFilePathAPI( module );
1544- LoadInternalThreadItemAPI( module );
1545- LoadInternalBoardItemAPI( module );
1546-
1547- // ===== ƒCƒ“ƒXƒ^ƒ“ƒX‚ÌŽæ‚舵‚¢‚ð TThreadItem ‚©‚ç TBeThreadItem ‚ɕύX‚·‚é
1548- ThreadItemOnCreate := ThreadItemOnCreateOfTBeThreadItem;
1549- ThreadItemOnDispose := ThreadItemOnDisposeOfTBeThreadItem;
1550- // ===== ƒCƒ“ƒXƒ^ƒ“ƒX‚ÌŽæ‚舵‚¢‚ð TBoardItem ‚©‚ç TBeBoardItem ‚ɕύX‚·‚é
1551- BoardItemOnCreate := BoardItemOnCreateOfTBeBoardItem;
1552- BoardItemOnDispose := BoardItemOnDisposeOfTBeBoardItem;
1553- end;
1554- //DLL_PROCESS_DETACH:
1555- //begin
1556- // RemovePlugInMenu( SyncronizeMenu );
1557- //end;
1558- DLL_THREAD_ATTACH:
1559- ;
1560- DLL_THREAD_DETACH:
1561- ;
1562- end;
1563-
1564-end;
1565-
1566-exports
1567- OnLoad,
1568- OnVersionInfo,
1569- OnAcceptURL;
1570-
1571-begin
1572-
1573- try
1574- DllProc := @DLLEntry;
1575- DLLEntry( DLL_PROCESS_ATTACH );
1576- except end;
1577-
1578-end.