• R/O
  • HTTP
  • SSH
  • HTTPS

winbottle: Commit

SSTP Bottle Client 本体


Commit MetaInfo

Revision98b83a79eb7962776e63ea29d44aff093070f99e (tree)
Time2004-03-26 21:26:12
Authornaru <bottle@mika...>
Commiternaru

Log Message

This commit was manufactured by cvs2svn to create tag 'YASAGURE1-10'.

Change Summary

  • delete: sakurasuite/DirectSstp.dcr
  • delete: sakurasuite/DirectSstp.pas
  • delete: sakurasuite/IdSLPP20.dcr
  • delete: sakurasuite/IdSLPP20.pas
  • delete: sakurasuite/Sakura.pas
  • delete: sakurasuite/SakuraAPI.pas
  • delete: sakurasuite/SakuraScriptFountain.dcr
  • delete: sakurasuite/SakuraScriptFountain.pas
  • delete: sakurasuite/SakuraSeeker.dcr
  • delete: sakurasuite/SakuraSeeker.pas
  • delete: sakurasuite/SakuraSuite.dpk
  • delete: sakurasuite/SakuraSuite.res
  • delete: sakurasuite/SsParser.pas
  • delete: sakurasuite/SsPlayTime.dcr
  • delete: sakurasuite/SsPlayTime.pas
  • delete: sakurasuite/manual/directsstp.html
  • delete: sakurasuite/manual/index.html
  • delete: sakurasuite/manual/sakuraprocess.html
  • delete: sakurasuite/manual/sakurascriptfountain.html
  • delete: sakurasuite/manual/sakuraseeker.html
  • delete: sakurasuite/manual/sakurasuite.css
  • delete: sakurasuite/manual/slpp20.html
  • delete: sakurasuite/manual/ssparser.html
  • delete: sakurasuite/manual/ssplaytime.html
  • delete: sakurasuite/sample_editor/Project1.dpr
  • delete: sakurasuite/sample_editor/Project1.res
  • delete: sakurasuite/sample_editor/Unit1.dfm
  • delete: sakurasuite/sample_editor/Unit1.pas
  • delete: sakurasuite/sample_parser/Project1.dpr
  • delete: sakurasuite/sample_parser/Project1.res
  • delete: sakurasuite/sample_parser/Unit1.dfm
  • delete: sakurasuite/sample_parser/Unit1.pas
  • delete: sakurasuite/sample_parser/pattern.txt
  • delete: sakurasuite/sample_seeker/Project1.dpr
  • delete: sakurasuite/sample_seeker/Project1.res
  • delete: sakurasuite/sample_seeker/Unit1.dfm
  • delete: sakurasuite/sample_seeker/Unit1.pas
  • delete: sakurasuite/ssparser.dcr
  • delete: sakurasuite/ssparser.html

Incremental Difference

Binary files a/sakurasuite/DirectSstp.dcr and /dev/null differ
--- a/sakurasuite/DirectSstp.pas
+++ /dev/null
@@ -1,626 +0,0 @@
1-{********************************************************}
2-{ DirectSstp - SSTP Client using DirectSSTP method }
3-{ }
4-{ Copyright (c) 2001-2003 naruto/CANO-Lab }
5-{********************************************************}
6-
7-
8-unit DirectSstp;
9-
10-interface
11-
12-uses
13- Windows, Messages, SysUtils, Classes, Dialogs, ExtCtrls, Forms;
14-
15-type
16- //エラーコード
17- TSstpResult = (
18- srOk,
19- srNoContent,
20- srBreak,
21- srBadRequest,
22- srRequestTimeout,
23- srConflict,
24- srRefuse,
25- srNotImplemented,
26- srServiceUnavailable,
27- srNotLocalIP,
28- srInBlackList,
29- srUnknownError
30- );
31-
32- TGiveType = (gtDocument, gtSongname);
33-
34- TSstpSendOption = (soNoTranslate, soNoDescript);
35- TSstpSendOptions = set of TSstpSendOption;
36-
37- //再送キュー用
38- TSendScript = class(TObject)
39- private
40- FScript: String;
41- FOption: TSstpSendOptions;
42- FID: integer;
43- FGhost: String;
44- procedure SetOption(const Value: TSstpSendOptions);
45- procedure SetScript(const Value: String);
46- procedure SetGhost(const Value: String);
47- public
48- constructor Create(const AScript: String; const AOption: TSstpSendOptions;
49- const AGhost: String; const ID: integer);
50- property Script: String read FScript write SetScript;
51- property Option: TSstpSendOptions read FOption write SetOption;
52- property Ghost: String read FGhost write SetGhost;
53- property ID: integer read FID;
54- end;
55-
56- TSstpResendEvent = procedure (Sender: TObject; ID: integer;
57- const Script: String) of Object;
58-
59- TDirectSstp = class(TComponent)
60- private
61- FStatusCode: Integer;
62- FSstpSender: String;
63- FSentLog: TStringList;
64- FRecvLog: TStringList;
65- FRecvLogString: String;
66- FNextCueID: integer;
67- FSendCue: TList;
68- FTimer: TTimer;
69- FInterval: integer;
70- FOnResendResend: TSstpResendEvent;
71- FOnResendTrying: TSstpResendEvent;
72- FOnResendEnd: TSstpResendEvent;
73- FOnResendCountChange: TNotifyEvent;
74- FSleep: boolean;
75- FOnAfterConnection: TNotifyEvent;
76- FWindowHandle: THandle;
77- FDirectSstpResult: String;
78- FTargetHWnd: THandle;//DirectSSTP
79- FBusy: boolean;
80- FTimeOut: integer; //接続中は別の接続要求を受け付けない
81- procedure SetSStpSender(const Value: String);
82- function GetRecvLog: String;
83- function GetSentLog: String;
84- procedure SetInterval(const Value: integer);
85- procedure SetOnResendResend(const Value: TSstpResendEvent);
86- procedure SetOnResendEnd(const Value: TSstpResendEvent);
87- procedure SetOnResendTrying(const Value: TSstpResendEvent);
88- function GetCueCount: integer;
89- procedure SetOnResendCountChange(const Value: TNotifyEvent);
90- procedure SetSleep(const Value: boolean);
91- procedure SetOnAfterConnection(const Value: TNotifyEvent);
92- procedure WndProc(var Msg: TMessage);
93- procedure SetTargetHWnd(const Value: THandle);
94- procedure SetTimeOut(const Value: integer); //DirectSSTP用
95- protected
96- function ExtractCode(const CodeStr: String): integer;
97- function CodeToStatus(const Code: integer): TSstpResult;
98- function GetLastStatus: TSstpResult;
99- procedure FlushLog;
100- procedure ResendTimerEvent(Sender: TObject);
101- procedure Loaded; override;
102- public
103- function ConnectSstp(Source: TStrings): TSstpResult;
104- property StatusCode: Integer read FStatusCode;
105- property LastStatus: TSstpResult read GetLastStatus;
106- property SentLog: String read GetSentLog;
107- property RecvLog: String read GetRecvLog;
108- constructor Create(AOwner: TComponent); override;
109- destructor Destroy; override;
110- function SstpGIVE(const Document: String): TSstpResult;
111- function SstpGIVE1_1(const Data: String;
112- const DataType: TGiveType = gtDocument): TSstpResult;
113- function SstpCOMMUNICATE(const Sentence: String;
114- const Port: integer = 0): TSstpResult;
115- function SstpSEND(const Script: String;
116- const Option: TSstpSendOptions = [];
117- const Ghost: String = ''): TSstpResult; overload;
118- function SstpSEND(const Script: TStrings;
119- const Option: TSstpSendOptions = [];
120- const Handle: HWND = 0;
121- const Ghost: String = ''): TSstpResult; overload;
122- function SstpEXECUTE(const Command: String): String;
123- function SstpExGetName: String;
124- function SstpExSetCookie(const Key, Value: String): TSstpResult;
125- function SstpExGetCookie(const Key: String): String;
126- function SstpExGetVersion: String;
127- function SstpExQuiet(const Quiet: boolean): TSstpResult;
128- function SstpSENDCue(const Script: String;
129- const HighPriority: boolean = false;
130- const Option: TSstpSendOptions = [];
131- const Ghost: String = ''): integer;
132- property CueCount: integer read GetCueCount;
133- property Handle: THandle read FWindowHandle;
134- procedure ClearCue;
135- published
136- property TimeOut: integer read FTimeOut write SetTimeOut default 2000;
137- property SstpSender: String read FSStpSender write SetSStpSender;
138- property Interval: integer read FInterval write SetInterval default 5000;
139- property Sleep: boolean read FSleep write SetSleep;
140- property TargetHWnd: THandle read FTargetHWnd write SetTargetHWnd;
141- property OnResendTrying: TSstpResendEvent read FOnResendTrying write SetOnResendTrying;
142- property OnResendEnd: TSstpResendEvent read FOnResendEnd write SetOnResendEnd;
143- property OnResendResend: TSstpResendEvent read FOnResendResend write SetOnResendResend;
144- property OnResendCountChange: TNotifyEvent read FOnResendCountChange write SetOnResendCountChange;
145- property OnAfterConnection: TNotifyEvent read FOnAfterConnection write SetOnAfterConnection;
146- end;
147-
148-const
149- //このエラーは、SSTPサーバがステータスを返さずに切断したときなどに返る
150- UnknownError = -1000;
151-
152- //リトライを行わないステータスコード
153- NotResendList: set of TSstpResult = [
154- srOk,
155- srNoContent,
156- srBreak,
157- srBadRequest,
158- srRequestTimeout,
159- srRefuse,
160- srNotImplemented,
161- srServiceUnavailable,
162- srNotLocalIP,
163- srInBlackList
164- ];
165-
166-procedure Register;
167-
168-implementation
169-
170-{ TDirectSstp }
171-
172-function TDirectSstp.CodeToStatus(const Code: integer): TSstpResult;
173-begin
174- case Code of
175- 200: Result := srOk;
176- 204: Result := srNoContent;
177- 210: Result := srBreak;
178- 400: Result := srBadRequest;
179- 408: Result := srRequestTimeout;
180- 409: Result := srConflict;
181- 420: Result := srRefuse;
182- 501: Result := srNotImplemented;
183- 503: Result := srServiceUnavailable;
184- 504: Result := srNotLocalIP;
185- 541: Result := srInBlackList;
186- else
187- Result := srUnknownError;
188- end;
189-end;
190-
191-function TDirectSstp.ConnectSstp(Source: TStrings): TSstpResult;
192-var Mes: TCopyDataStruct;
193- MesStr: String;
194- Dummy: DWORD; //SendMessageTimeout用
195-begin
196- FlushLog;
197- Result := srUnknownError;
198- if FBusy then Exit;
199- FBusy := true;
200- FTimer.Enabled := false;
201-
202- if TargetHWnd <> 0 then begin
203- MesStr := Source.Text;
204- Mes.dwData := 9801;
205- Mes.cbData := Length(MesStr);
206- Mes.lpData := PChar(MesStr);
207- FDirectSstpResult := '';
208- FSentLog.Text := MesStr;
209- //SendMessage(TargetHWnd, WM_COPYDATA, FWindowHandle, LPARAM(@Mes));
210- SendMessageTimeout(TargetHWnd, WM_COPYDATA, FWindowHandle, LPARAM(@Mes),
211- SMTO_ABORTIFHUNG or SMTO_NORMAL, TimeOut, Dummy);
212- FRecvLog.Text := FDirectSstpResult;
213- if FRecvLog.Count > 0 then
214- FStatusCode := ExtractCode(FRecvLog[0])
215- else
216- FStatusCode := UnknownError;
217- Result := CodeToStatus(FStatusCode);
218- end;
219-
220- FTimer.Enabled := not FSleep;
221- if Assigned(FOnAfterConnection) then FOnAfterConnection(Self);
222- FBusy := false;
223-end;
224-
225-constructor TDirectSstp.Create;
226-begin
227- inherited;
228- TimeOut := 2000;
229- FInterval := 5000;
230- SstpSender := 'My Program';
231- FSentLog := TStringList.Create;
232- FRecvLog := TStringList.Create;
233- FSendCue := TList.Create;
234- FTimer := TTimer.Create(Self);
235- FTimer.OnTimer := ResendTimerEvent;
236- FWindowHandle := AllocateHWnd(WndProc);
237-end;
238-
239-destructor TDirectSstp.Destroy;
240-var i: integer;
241-begin
242- inherited;
243- FSentLog.Free;
244- FRecvLog.Free;
245- for i := FSendCue.Count-1 downto 0 do
246- TSendScript(FSendCue[i]).Free;
247- FSendCue.Free;
248- DeallocateHWnd(FWindowHandle);
249-end;
250-
251-function TDirectSstp.ExtractCode(const CodeStr: String): integer;
252-var i, l: integer;
253- s, p: String;
254-begin
255- if CodeStr = '' then begin
256- Result := UnknownError;
257- Exit;
258- end;
259- i := 1;
260- l := length(CodeStr);
261- while (CodeStr[i] <> ' ') and (i<=l) do begin
262- p := p + CodeStr[i];
263- Inc(i);
264- end;
265- Inc(i);
266- while (CodeStr[i] in ['0'..'9']) and (i<=l) do begin
267- s := s + CodeStr[i];
268- Inc(i);
269- end;
270- try
271- Result := StrToInt(s);
272- except
273- on EConvertError do Result := UnknownError;
274- end;
275-end;
276-
277-procedure TDirectSstp.FlushLog;
278-begin
279- if FSentLog <> nil then FSentLog.Clear;
280- if FRecvLog <> nil then FRecvLog.Clear;
281- FRecvLogString := '';
282-end;
283-
284-function TDirectSstp.GetLastStatus: TSstpResult;
285-begin
286- Result := CodeToStatus(FStatusCode);
287-end;
288-
289-
290-function TDirectSstp.GetRecvLog: String;
291-begin
292- Result := FRecvLog.Text;
293-end;
294-
295-function TDirectSstp.GetSentLog: String;
296-begin
297- Result := FSentLog.Text;
298-end;
299-
300-procedure TDirectSstp.Loaded;
301-begin
302- inherited;
303- FTimer.Interval := FInterval;
304- FTimer.Enabled := not FSleep;
305- if Assigned(FOnResendCountChange) then FOnResendCountChange(Self);
306-end;
307-
308-procedure TDirectSstp.ResendTimerEvent(Sender: TObject);
309-var Scr: TSendScript;
310- Res: TSstpResult;
311-begin
312- if FSendCue.Count = 0 then Exit;
313- Scr := TSendScript(FSendCue[0]);
314- if Assigned(FOnResendTrying) then FOnResendTrying(Self, Scr.ID, Scr.Script);
315- Res := SstpSEND(Scr.Script, Scr.Option, Scr.Ghost);
316- if Res in NotResendList then begin
317- if Assigned(FOnResendEnd) then FOnResendEnd(Self, Scr.ID, Scr.Script);
318- FSendCue.Delete(0);
319- if Assigned(FOnResendCountChange) then FOnResendCountChange(Self);
320- Scr.Free;
321- end else begin
322- if Assigned(FOnResendResend) then FOnResendResend(Self, Scr.ID, Scr.Script);
323- end;
324-end;
325-
326-procedure TDirectSstp.SetInterval(const Value: integer);
327-begin
328- FInterval := Value;
329- FTimer.Interval := Value;
330-end;
331-
332-procedure TDirectSstp.SetOnResendResend(const Value: TSstpResendEvent);
333-begin
334- FOnResendResend := Value;
335-end;
336-
337-procedure TDirectSstp.SetOnResendEnd(const Value: TSstpResendEvent);
338-begin
339- FOnResendEnd := Value;
340-end;
341-
342-procedure TDirectSstp.SetOnResendTrying(const Value: TSstpResendEvent);
343-begin
344- FOnResendTrying := Value;
345-end;
346-
347-procedure TDirectSstp.SetSstpSender(const Value: String);
348-begin
349- FSStpSender := Value;
350-end;
351-
352-function TDirectSstp.SstpCOMMUNICATE(const Sentence: String;
353- const Port: integer): TSstpResult;
354-var Source: TStringList;
355-begin
356- Source := nil;
357- try
358- Source := TStringList.Create;
359- Source.Add('COMMUNICATE SSTP/1.2');
360- Source.Add('Sender: ' + FSstpSender);
361- if Port <> 0 then Source.Add('Port: ' + IntToStr(Port));
362- Source.Add('Sentence: ' + Sentence);
363- Source.Add('CharSet: Shift_JIS');
364- Source.Add('HWnd: ' + IntToStr(FWindowHandle));
365- ConnectSstp(Source);
366- finally
367- Source.Free;
368- end;
369- Result := LastStatus;
370-end;
371-
372-function TDirectSstp.SstpEXECUTE(const Command: String): String;
373-var S: String;
374- Source: TStringList;
375-begin
376- Source := nil;
377- try
378- Source := TStringList.Create;
379- Source.Add('EXECUTE SSTP/1.1');
380- Source.Add('Sender: ' + FSstpSender);
381- Source.Add('Command: ' + Command);
382- Source.Add('CharSet: Shift_JIS');
383- Source.Add('HWnd: ' + IntToStr(FWindowHandle));
384- ConnectSstp(Source);
385- finally
386- Source.Free;
387- end;
388- if FRecvLog.Count > 1 then begin
389- s := FRecvLog[0];
390- FRecvLog.Delete(0);
391- Result := FRecvLog.Text;
392- FRecvLog.Insert(0, s);
393- end else Result := '';
394-end;
395-
396-function TDirectSstp.SstpExGetName: String;
397-begin
398- Result := SstpEXECUTE('getname');
399- Result := StringReplace(Result, #13#10, '', [rfReplaceAll]);
400-end;
401-
402-function TDirectSstp.SstpGIVE(const Document: String): TSstpResult;
403-begin
404- Result := SstpGIVE1_1(Document, gtDocument);
405-end;
406-
407-function TDirectSstp.SstpGIVE1_1(const Data: String;
408- const DataType: TGiveType): TSstpResult;
409-var Source: TStringList;
410-begin
411- Source := nil;
412- try
413- Source := TStringList.Create;
414- Source.Add('GIVE SSTP/1.1');
415- Source.Add('Sender: ' + FSstpSender);
416- Source.Add('CharSet: Shift_JIS');
417- case DataType of
418- gtSongname:
419- Source.Add('Songname: ' + Data);
420- else
421- Source.Add('Document: ' + Data);
422- end;
423- Source.Add('HWnd: ' + IntToStr(FWindowHandle));
424- ConnectSstp(Source);
425- finally
426- Source.Free;
427- end;
428- Result := LastStatus;
429-end;
430-
431-function TDirectSstp.SstpSEND(const Script: String;
432- const Option: TSstpSendOptions = [];
433- const Ghost: String = ''): TSstpResult;
434-var Source: TStringList;
435-begin
436- Source := nil;
437- try
438- Source := TStringList.Create;
439- Source.Text := Script;
440- Result := SstpSEND(Source, Option, 0, Ghost);
441- finally
442- Source.Free;
443- end;
444-end;
445-
446-function TDirectSstp.SstpSEND(const Script: TStrings;
447- const Option: TSstpSendOptions;
448- const Handle: HWND;
449- const Ghost: String): TSstpResult;
450-var Opt: String;
451- i: integer;
452- Source: TStringList;
453-begin
454- if soNoTranslate in Option then begin
455- Opt := 'notranslate';
456- end;
457- if soNoDescript in Option then begin
458- if Opt <> '' then Opt := Opt + ',';
459- Opt := Opt + 'nodescript';
460- end;
461- Source := nil;
462- try
463- Source := TStringList.Create;
464- Source.Add('SEND SSTP/1.4');
465- Source.Add('Sender: ' + FSstpSender);
466- Source.Add('Charset: Shift_JIS');
467- if Ghost <> '' then Source.Add('IfGhost: '+Ghost);
468- for i := 0 to Script.Count -1 do begin
469- if i = 0 then begin
470- Source.Add('Script: ' + Script[i]);
471- end else begin
472- Source.Add('Entry: ' + Script[i]);
473- end;
474- end;
475- Source.Add('Option: ' + Opt);
476- if Handle <> 0 then
477- Source.Add('HWnd: ' + IntToStr(Handle))
478- else
479- Source.Add('HWnd: ' + IntToStr(FWindowHandle));
480- Source.Add(''); //空行が終了を示す
481- ConnectSstp(Source);
482- finally
483- Source.Free;
484- end;
485- Result := LastStatus;
486-end;
487-
488-function TDirectSstp.SstpSENDCue(const Script: String;
489- const HighPriority: boolean; const Option: TSstpSendOptions;
490- const Ghost: String): integer;
491-var NewScript: TSendScript;
492-begin
493- Inc(FNextCueID);
494- NewScript := TSendScript.Create(Script, Option, Ghost, FNextCueID);
495- if HighPriority then begin
496- FSendCue.Insert(0, NewScript);
497- ResendTimerEvent(Self);
498- end else FSendCue.Add(NewScript);
499- if Assigned(FOnResendCountChange) then FOnResendCountChange(Self);
500- Result := FNextCueID;
501-end;
502-
503-function TDirectSstp.GetCueCount: integer;
504-begin
505- Result := FSendCue.Count;
506-end;
507-
508-procedure TDirectSstp.SetOnResendCountChange(const Value: TNotifyEvent);
509-begin
510- FOnResendCountChange := Value;
511-end;
512-
513-procedure TDirectSstp.SetSleep(const Value: boolean);
514-begin
515- FSleep := Value;
516- FTimer.Enabled := false; //いったんタイマーを破棄する
517- FTimer.Enabled := not Value;
518-end;
519-
520-procedure TDirectSstp.SetOnAfterConnection(const Value: TNotifyEvent);
521-begin
522- FOnAfterConnection := Value;
523-end;
524-
525-procedure TDirectSstp.ClearCue;
526-var i: integer;
527-begin
528- for i := FSendCue.Count-1 downto 0 do
529- TSendScript(FSendCue[i]).Free;
530- FSendCue.Clear;
531- if Assigned(FOnResendCountChange) then FOnResendCountChange(Self);
532-end;
533-
534-function TDirectSstp.SstpExGetCookie(const Key: String): String;
535-begin
536- Result := SstpEXECUTE('GetCookie[' + Key + ']');
537- Result := StringReplace(Result, #13#10, '', [rfReplaceAll]);
538-end;
539-
540-function TDirectSstp.SstpExSetCookie(const Key, Value: String): TSstpResult;
541-begin
542- SstpEXECUTE('SetCookie[' +
543- StringReplace(Key, #13#10, '', [rfReplaceAll]) +
544- ',' +
545- StringReplace(Value, #13#10, '', [rfReplaceAll])
546- + ']');
547- Result := GetLastStatus;
548-end;
549-
550-function TDirectSstp.SstpExGetVersion: String;
551-begin
552- Result := SstpEXECUTE('getversion');
553- Result := StringReplace(Result, #13#10, '', [rfReplaceAll]);
554-end;
555-
556-function TDirectSstp.SstpExQuiet(const Quiet: boolean): TSstpResult;
557-begin
558- if Quiet then
559- SstpEXECUTE('Quiet')
560- else
561- SstpEXECUTE('Restore');
562- Result := GetLastStatus;
563-end;
564-
565-procedure TDirectSstp.WndProc(var Msg: TMessage);
566-var Dat: TWMCopyData;
567-begin
568- if Msg.Msg = WM_COPYDATA then begin
569- Dat := TWMCopyData(Msg);
570- FDirectSstpResult := PChar(Dat.CopyDataStruct^.lpData);
571- end else begin
572- Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);
573- end;
574-end;
575-
576-procedure TDirectSstp.SetTargetHWnd(const Value: THandle);
577-begin
578- FTargetHWnd := Value;
579-end;
580-
581-procedure TDirectSstp.SetTimeOut(const Value: integer);
582-begin
583- FTimeOut := Value;
584-end;
585-
586-{ TSendScript }
587-
588-constructor TSendScript.Create(const AScript: String;
589- const AOption: TSstpSendOptions; const AGhost: String; const ID: integer);
590-begin
591- FScript := AScript;
592- FOption := AOption;
593- FGhost := AGhost;
594- FID := ID;
595-end;
596-
597-procedure TSendScript.SetGhost(const Value: String);
598-begin
599- FGhost := Value;
600-end;
601-
602-procedure TSendScript.SetOption(const Value: TSstpSendOptions);
603-begin
604- FOption := Value;
605-end;
606-
607-procedure TSendScript.SetScript(const Value: String);
608-begin
609- FScript := Value;
610-end;
611-
612-//-------------------------------------
613-
614-procedure Register;
615-begin
616- RegisterComponents('Miscellaneous', [TDirectSstp]);
617-end;
618-
619-end.
620-
621-
622-
623-
624-
625-
626-
Binary files a/sakurasuite/IdSLPP20.dcr and /dev/null differ
--- a/sakurasuite/IdSLPP20.pas
+++ /dev/null
@@ -1,307 +0,0 @@
1-{*******************************************************}
2-{ IdSLPP20 - Indy Client for SLPP Connection }
3-{ }
4-{ Copyright (c) 2002-2003 naruto/CANO-Lab }
5-{*******************************************************}
6-
7-unit IdSLPP20;
8-
9-interface
10-
11-uses
12- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
13- IdTCPClient, IdGlobal, IdException;
14-
15-const
16- SLPP_PORT = 9871;
17- SLPP_HOST = 'bottle.mikage.to';
18-
19-type
20- TIdSLPPEventType = (etConnectOk, etScript, etMemberCount, etChannelCount,
21- etChannelList, etUnicast, etForceBroadcast, etCloseChannel,
22- etForceBroadcastInformation, etBroadcastInformation);
23- TIdSLPPEvent = procedure (Sender: TObject;
24- EventType: TIdSlppEventType; const Param: String) of Object;
25-
26- TIdSLPP20 = class;
27-
28- TIdSLPP20ReadThread = class(TThread)
29- private
30- protected
31- FClient: TIdSLPP20;
32- FRecvData: TStringList;
33- FEvent: TIdSLPPEventType; // SLPP Command
34- FParam: String; // SLPP Command Parameter
35- FReceivedLog: TStringList;
36- function Parse: boolean;
37- procedure Execute; override;
38- public
39- constructor Create(AClient: TIdSLPP20); reintroduce;
40- property Client: TIdSLPP20 read FClient;
41- end;
42-
43- TIdSLPP20 = class(TIdTCPClient)
44- private
45- FSLPPThread: TIdSLPP20ReadThread;
46- FDebugMode: boolean;
47- FProxyMode: boolean;
48- FLUID: String;
49- FOnSlppEvent: TIdSlppEvent;
50- FOnConnect: TNotifyEvent;
51- FOnDisconnect: TNotifyEvent;
52- FLastReadTime: Int64;
53- FTimeout: Integer;
54- FOnConnectFailed: TNotifyEvent;
55- procedure SetDebugMode(const Value: boolean);
56- procedure SetLUID(const Value: String);
57- procedure SetOnSlppEvent(const Value: TIdSlppEvent);
58- procedure SetProxyMode(const Value: boolean);
59- procedure SetOnConnect(const Value: TNotifyEvent);
60- procedure SetOnDisconnect(const Value: TNotifyEvent);
61- function GetLastReadTimeInterval: integer;
62- procedure SetLastReadTime(const Value: Int64);
63- procedure SetOnConnectFailed(const Value: TNotifyEvent);
64- public
65- constructor Create(AOwner: TComponent); override;
66- destructor Destroy; override;
67- procedure Connect(const ATimeout: Integer = IdTimeoutDefault); override;
68- procedure ConnectServer(const ATimeout: Integer = IdTimeoutDefault);
69- procedure Disconnect; override;
70- procedure DoOnSlppEvent;
71- procedure DoOnConnect;
72- procedure DoOnConnectFailed;
73- property SLPP20ReadThread: TIdSLPP20ReadThread read FSLPPThread;
74- property LastReadTime: Int64 read FLastReadTime write SetLastReadTime;
75- property LastReadTimeInterval: integer read GetLastReadTimeInterval;
76- published
77- property LUID: String read FLUID write SetLUID;
78- property Port default SLPP_PORT;
79- property DebugMode: boolean read FDebugMode write SetDebugMode;
80- property ProxyMode: boolean read FProxyMode write SetProxyMode;
81- property OnConnect: TNotifyEvent read FOnConnect write SetOnConnect;
82- property OnConnectFailed: TNotifyEvent read FOnConnectFailed write SetOnConnectFailed;
83- property OnDisconnect: TNotifyEvent read FOnDisconnect write SetOnDisconnect;
84- property OnSLPPEvent: TIdSlppEvent read FOnSlppEvent write SetOnSlppEvent;
85- {ProxyMode = trueのときは、Host, Portにプロキシ名を}
86- end;
87-
88- EIdSlppError = class(EIdException);
89- EIdSlppClientConnectError = class(EIdSlppError);
90-
91-procedure Register;
92-
93-implementation
94-
95-procedure Register;
96-begin
97- RegisterComponents('Indy Clients', [TIdSLPP20]);
98-end;
99-
100-{ TIdSLPP20 }
101-
102-procedure TIdSLPP20.Connect(const ATimeout: Integer);
103-begin
104- inherited Connect(ATimeout);
105-end;
106-
107-procedure TIdSLPP20.ConnectServer;
108-begin
109- try
110- FTimeout := ATimeout;
111- FSLPPThread := TIdSLPP20ReadThread.Create(self);
112- except on E: EIdSocketError do
113- raise EIdSlppClientConnectError.Create('Connection Failed');
114- end;
115-end;
116-
117-constructor TIdSLPP20.Create(AOwner: TComponent);
118-begin
119- inherited Create(AOwner);
120- Port := SLPP_PORT;
121- Host := SLPP_HOST;
122-end;
123-
124-destructor TIdSLPP20.Destroy;
125-begin
126- inherited;
127-end;
128-
129-procedure TIdSLPP20.Disconnect;
130-begin
131- inherited Disconnect;
132- if Assigned(FSLPPThread) then begin
133- FSLPPThread.Terminate;
134- // FSLPPThread.WaitFor;
135- FSLPPThread := nil;
136- end;
137- if Assigned(FOnDisconnect) then begin
138- OnDisconnect(self);
139- end;
140-end;
141-
142-procedure TIdSLPP20.DoOnConnect;
143-begin
144- if Assigned(FOnConnect) then
145- FOnConnect(self);
146-end;
147-
148-procedure TIdSLPP20.DoOnConnectFailed;
149-begin
150- if Assigned(FOnConnectFailed) then
151- FOnConnectFailed(self);
152-end;
153-
154-procedure TIdSLPP20.DoOnSlppEvent;
155-begin
156- try
157- FOnSlppEvent(self, FSLPPThread.FEvent, FSLPPThread.FParam);
158- except
159- on E: Exception do
160- ShowMessage('Exception occured in OnSlppEvent: '#13#10 + E.Message);
161- end;
162-end;
163-
164-function TIdSLPP20.GetLastReadTimeInterval: integer;
165-begin
166- Result := 0;
167- if Connected then Result := GetTickCount - FLastReadTime;
168-end;
169-
170-procedure TIdSLPP20.SetDebugMode(const Value: boolean);
171-begin
172- FDebugMode := Value;
173-end;
174-
175-procedure TIdSLPP20.SetLastReadTime(const Value: Int64);
176-begin
177- FLastReadTime := Value;
178-end;
179-
180-procedure TIdSLPP20.SetLUID(const Value: String);
181-begin
182- FLUID := Value;
183-end;
184-
185-procedure TIdSLPP20.SetOnConnect(const Value: TNotifyEvent);
186-begin
187- FOnConnect := Value;
188-end;
189-
190-procedure TIdSLPP20.SetOnConnectFailed(const Value: TNotifyEvent);
191-begin
192- FOnConnectFailed := Value;
193-end;
194-
195-procedure TIdSLPP20.SetOnDisconnect(const Value: TNotifyEvent);
196-begin
197- FOnDisconnect := Value;
198-end;
199-
200-procedure TIdSLPP20.SetOnSlppEvent(const Value: TIdSlppEvent);
201-begin
202- FOnSlppEvent := Value;
203-end;
204-
205-procedure TIdSLPP20.SetProxyMode(const Value: boolean);
206-begin
207- FProxyMode := Value;
208-end;
209-
210-{ TIdSLPP20ReadThread }
211-
212-constructor TIdSLPP20ReadThread.Create(AClient: TIdSLPP20);
213-begin
214- inherited Create(true);
215- FClient := AClient;
216- FreeOnTerminate := true;
217- Resume;
218-end;
219-
220-procedure TIdSLPP20ReadThread.Execute;
221-var Line: String;
222-begin
223- try
224- FClient.Connect(FClient.FTimeout);
225- if Assigned(FClient.OnConnect) then begin
226- Synchronize(FClient.DoOnConnect);
227- end;
228- except
229- Synchronize(FClient.DoOnConnectFailed);
230- Exit;
231- end;
232-
233- FRecvData := TStringList.Create;
234- FReceivedLog := TStringList.Create;
235- if FClient.ProxyMode then begin
236- FClient.Writeln('POST http://bottle.mikage.to:9871/ HTTP/1.0');
237- FClient.Writeln('Content-Length: ' + IntToStr(Length(FClient.LUID)));
238- FClient.Writeln('Connection: close');
239- FClient.Writeln;
240- FClient.Writeln(FClient.LUID);
241- end else begin
242- FClient.WriteLn('POST / HTTP/1.0');
243- FClient.WriteLn;
244- FClient.WriteLn(FClient.LUID);
245- end;
246- while not Terminated do begin
247- try
248- FClient.CheckForDisconnect;
249- Line := FClient.ReadLn(EOL);
250- if FClient.DebugMode then begin
251- FReceivedLog.Add(Line);
252- FReceivedLog.SaveToFile(ExtractFilePath(Application.ExeName)+'slpp20_debug.log');
253- end;
254- if not FClient.ReadLnTimedOut then FClient.LastReadTime := getTickCount;
255- if Length(Line) = 0 then begin
256- if FRecvData.Count > 0 then begin
257- while Parse do begin
258- Synchronize(FClient.DoOnSlppEvent);
259- end;
260- FRecvData.Clear;
261- end;
262- end else begin
263- FRecvData.Add(Line);
264- end;
265- except
266- on EIdException do begin
267- Synchronize(self.Terminate);
268- end;
269- end;
270- end;
271- FreeAndNil(FReceivedLog);
272- FreeAndNil(FRecvData);
273-end;
274-
275-function TIdSLPP20ReadThread.Parse: boolean;
276-var
277- command: String;
278-begin
279- command := FRecvData[0];
280- FRecvData.Delete(0);
281- FParam := FRecvData.Text;
282-
283- Result := true;
284- if command = 'broadcastMessage' then begin
285- FEvent := etScript;
286- end else if command = 'allUsers' then begin
287- FEvent := etMemberCount;
288- end else if command = 'channelUsers' then begin
289- FEvent := etChannelCount;
290- end else if command = 'channelList' then begin
291- FEvent := etChannelList;
292- end else if (command = 'HTTP/1.0 200 OK') or (command = 'HTTP/1.1 200 OK') then begin
293- FEvent := etConnectOk;
294- end else if command = 'forceBroadcastMessage' then begin
295- FEvent := etForceBroadcast;
296- end else if command = 'forceBroadcastInformation' then begin
297- FEvent := etForceBroadcastInformation;
298- end else if command = 'BroadcastInformation' then begin
299- FEvent := etBroadcastInformation;
300- end else if command = 'closeChannel' then begin
301- FEvent := etCloseChannel;
302- end else if command = 'unicastMessage' then begin
303- FEvent := etUnicast;
304- end else Result := false;
305-end;
306-
307-end.
--- a/sakurasuite/Sakura.pas
+++ /dev/null
@@ -1,51 +0,0 @@
1-(********************************
2-
3-Sakura API Const Unit
4-implemented by naruto/CANO-Lab
5-
6-********************************)
7-
8-unit Sakura;
9-
10-interface
11-
12-const
13-
14-(*
15- 以下のデータは
16- phase "inverse" 46.60
17- ドキュメントデータを元に作成しています。
18-*)
19-
20-{EXECUTE}
21-SA_EXECUTEREMAKEMENU = 0;
22-SA_EXECUTEREWRITEFMO = 1;
23-
24-{GET}
25-SA_GETHEADCOLLISIONRECTSAKURA = 128;
26-SA_GETFACECOLLISIONRECTSAKURA = 129;
27-SA_GETBUSTCOLLISIONRECTSAKURA = 130;
28-SA_GETCENTERPOINTSAKURA = 131;
29-SA_GETABSOLUTEKINOKOFIELDCENTERPOINTSAKURA = 132;
30-SA_GETHEADCOLLISIONRECTKERO = 133;
31-SA_GETFACECOLLISIONRECTKERO = 134;
32-SA_GETBUSTCOLLISIONRECTKERO = 135;
33-SA_GETCENTERPOINTKERO = 136;
34-SA_GETABSOLUTEKINOKOFIELDCENTERPOINTKERO = 137;
35-SA_GETPROCESSID = 138;
36-SA_GETSHAREDMEMORY = 139;
37-SA_GETGHOSTSTATE = 140;
38-
39-{NOTIFY}
40-SA_NOTIFYEVENT = 256;
41-
42-{Talking State}
43-GS_NONE = 0; //待機中
44-GS_TALKING = 1; //何か喋っている
45-GS_TIMECRITICALSESSION = 2; //タイムクリティカルセッション
46-
47-
48-implementation
49-
50-end.
51-
\ No newline at end of file
--- a/sakurasuite/SakuraAPI.pas
+++ /dev/null
@@ -1,202 +0,0 @@
1-unit SakuraAPI;
2-
3-interface
4-
5-uses
6- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7- Sakura;
8-
9-type
10- TSakuraAPI = class(TComponent)
11- private
12- { Private 宣言 }
13- FMes: integer;
14- FTargetHWnd: THandle;
15- FOnRegisterAPI: TNotifyEvent;
16- procedure SetTargetHWnd(const Value: THandle);
17- procedure SetOnRegisterAPI(const Value: TNotifyEvent);
18- protected
19- { Protected 宣言 }
20- public
21- { Public 宣言 }
22- constructor Create(AOwner: TComponent); override;
23- destructor Destroy; override;
24- procedure Loaded; override;
25- //
26- function SendAPI(Mes: cardinal; wParam: integer; lParam: integer): integer;
27- function ExecuteRemakeMenu: integer;
28- function ExecuteRewriteFMO: integer;
29- function GetHeadCollisionRectSakura: TRect;
30- function GetFaceCollisionRectSakura: TRect;
31- function GetBustCollisionRectSakura: TRect;
32- function GetCenterPointSakura: TPoint;
33- function GetHeadCollisionRectKero: TRect;
34- function GetFaceCollisionRectKero: TRect;
35- function GetBustCollisionRectKero: TRect;
36- function GetCenterPointKero: TPoint;
37- function GetGhostState: integer;
38- function GetAbsoluteKinokoFieldCenterPointSakura: TPoint;
39- function GetAbsoluteKinokoFieldCenterPointKero: TPoint;
40- function GetProcessID: Cardinal;
41- function GetSharedMemory(const Slot: integer = -1): pointer;
42- function NotifyEvent: integer;
43- published
44- { Published 宣言 }
45- property WM_SAKURAAPI: integer read FMes;
46- property TargetHWnd: THandle read FTargetHWnd write SetTargetHWnd;
47- property OnRegisterAPI: TNotifyEvent read FOnRegisterAPI write SetOnRegisterAPI;
48- end;
49-
50-procedure Register;
51-
52-implementation
53-
54-procedure Register;
55-begin
56- RegisterComponents('Samples', [TSakuraAPI]);
57-end;
58-
59-{ TSakuraAPI }
60-
61-constructor TSakuraAPI.Create;
62-begin
63- inherited;
64-end;
65-
66-destructor TSakuraAPI.Destroy;
67-begin
68- inherited;
69- //
70-end;
71-
72-function TSakuraAPI.ExecuteRemakeMenu: integer;
73-begin
74- Result := SendAPI(SA_EXECUTEREMAKEMENU, 0, 0);
75-end;
76-
77-function TSakuraAPI.ExecuteRewriteFMO: integer;
78-begin
79- Result := SendAPI(SA_EXECUTEREWRITEFMO, 1, 0);
80-end;
81-
82-function TSakuraAPI.GetAbsoluteKinokoFieldCenterPointKero: TPoint;
83-begin
84- Result.X := SendAPI(SA_GETABSOLUTEKINOKOFIELDCENTERPOINTKERO, 137, 0);
85- Result.Y := SendAPI(SA_GETABSOLUTEKINOKOFIELDCENTERPOINTKERO, 137, 1);
86-end;
87-
88-function TSakuraAPI.GetAbsoluteKinokoFieldCenterPointSakura: TPoint;
89-begin
90- Result.X := SendAPI(SA_GETABSOLUTEKINOKOFIELDCENTERPOINTSAKURA, 132, 0);
91- Result.Y := SendAPI(SA_GETABSOLUTEKINOKOFIELDCENTERPOINTSAKURA, 132, 1);
92-end;
93-
94-function TSakuraAPI.GetBustCollisionRectKero: TRect;
95-begin
96- Result.Left := SendAPI(SA_GETBUSTCOLLISIONRECTKERO, 135, 0);
97- Result.Top := SendAPI(SA_GETBUSTCOLLISIONRECTKERO, 135, 1);
98- Result.Right := SendAPI(SA_GETBUSTCOLLISIONRECTKERO, 135, 2);
99- Result.Bottom := SendAPI(SA_GETBUSTCOLLISIONRECTKERO, 135, 3);
100-end;
101-
102-function TSakuraAPI.GetBustCollisionRectSakura: TRect;
103-begin
104- Result.Left := SendAPI(SA_GETBUSTCOLLISIONRECTSAKURA, 130, 0);
105- Result.Top := SendAPI(SA_GETBUSTCOLLISIONRECTSAKURA, 130, 1);
106- Result.Right := SendAPI(SA_GETBUSTCOLLISIONRECTSAKURA, 130, 2);
107- Result.Bottom := SendAPI(SA_GETBUSTCOLLISIONRECTSAKURA, 130, 3);
108-end;
109-
110-function TSakuraAPI.GetCenterPointKero: TPoint;
111-begin
112- Result.X := SendAPI(SA_GETCENTERPOINTKERO, 136, 0);
113- Result.Y := SendAPI(SA_GETCENTERPOINTKERO, 136, 1);
114-end;
115-
116-function TSakuraAPI.GetCenterPointSakura: TPoint;
117-begin
118- Result.X := SendAPI(SA_GETCENTERPOINTSAKURA, 131, 0);
119- Result.Y := SendAPI(SA_GETCENTERPOINTSAKURA, 131, 1);
120-end;
121-
122-function TSakuraAPI.GetFaceCollisionRectKero: TRect;
123-begin
124- Result.Left := SendAPI(SA_GETFACECOLLISIONRECTKERO, 134, 0);
125- Result.Top := SendAPI(SA_GETFACECOLLISIONRECTKERO, 134, 1);
126- Result.Right := SendAPI(SA_GETFACECOLLISIONRECTKERO, 134, 2);
127- Result.Bottom := SendAPI(SA_GETFACECOLLISIONRECTKERO, 134, 3);
128-end;
129-
130-function TSakuraAPI.GetFaceCollisionRectSakura: TRect;
131-begin
132- Result.Left := SendAPI(SA_GETFACECOLLISIONRECTSAKURA, 129, 0);
133- Result.Top := SendAPI(SA_GETFACECOLLISIONRECTSAKURA, 129, 1);
134- Result.Right := SendAPI(SA_GETFACECOLLISIONRECTSAKURA, 129, 2);
135- Result.Bottom := SendAPI(SA_GETFACECOLLISIONRECTSAKURA, 129, 3);
136-end;
137-
138-function TSakuraAPI.GetHeadCollisionRectKero: TRect;
139-begin
140- Result.Left := SendAPI(SA_GETHEADCOLLISIONRECTKERO, 133, 0);
141- Result.Top := SendAPI(SA_GETHEADCOLLISIONRECTKERO, 133, 1);
142- Result.Right := SendAPI(SA_GETHEADCOLLISIONRECTKERO, 133, 2);
143- Result.Bottom := SendAPI(SA_GETHEADCOLLISIONRECTKERO, 133, 3);
144-end;
145-
146-function TSakuraAPI.GetHeadCollisionRectSakura: TRect;
147-begin
148- Result.Left := SendAPI(SA_GETHEADCOLLISIONRECTSAKURA, 128, 0);
149- Result.Top := SendAPI(SA_GETHEADCOLLISIONRECTSAKURA, 128, 1);
150- Result.Right := SendAPI(SA_GETHEADCOLLISIONRECTSAKURA, 128, 2);
151- Result.Bottom := SendAPI(SA_GETHEADCOLLISIONRECTSAKURA, 128, 3);
152-end;
153-
154-function TSakuraAPI.GetGhostState: integer;
155-begin
156- Result := SendAPI(SA_GETGHOSTSTATE, 140, 0);
157-end;
158-
159-function TSakuraAPI.GetProcessID: Cardinal;
160-begin
161- Result := SendAPI(SA_GETPROCESSID, 138, 0);
162-end;
163-
164-function TSakuraAPI.GetSharedMemory(const Slot: integer = -1): pointer;
165-begin
166- Result := pointer(SendAPI(SA_GETSHAREDMEMORY, 139, Slot));
167-end;
168-
169-function TSakuraAPI.SendAPI(Mes: cardinal; wParam: integer;
170- lParam: integer): integer;
171-begin
172- Result := SendMessage(TargetHWnd, Mes, wParam, lParam);
173-end;
174-
175-procedure TSakuraAPI.SetTargetHWnd(const Value: THandle);
176-begin
177- FTargetHWnd := Value;
178-end;
179-
180-function TSakuraAPI.NotifyEvent: integer;
181-begin
182- Result := SendAPI(SA_NOTIFYEVENT, 256, 0);
183-end;
184-
185-procedure TSakuraAPI.SetOnRegisterAPI(const Value: TNotifyEvent);
186-begin
187- FOnRegisterAPI := Value;
188-end;
189-
190-procedure TSakuraAPI.Loaded;
191-begin
192- inherited;
193- if csDesigning in ComponentState then Exit;
194- FMes := RegisterWindowMessage('Sakura');
195- if FMes = 0 then
196- raise Exception.Create('RegisterWindowMessageに失敗しました')
197- else
198- if Assigned(FOnRegisterAPI) then
199- FOnRegisterAPI(Self);
200-end;
201-
202-end.
Binary files a/sakurasuite/SakuraScriptFountain.dcr and /dev/null differ
--- a/sakurasuite/SakuraScriptFountain.pas
+++ /dev/null
@@ -1,361 +0,0 @@
1-{*******************************************************}
2-{ TSakuraScriptFountain - TEditor Fountain Parser }
3-{ }
4-{ Copyright (c) 2003 naruto/CANO-Lab }
5-{*******************************************************}
6-
7-unit SakuraScriptFountain;
8-
9-interface
10-
11-uses
12- SysUtils, Classes, heClasses, heFountain, heRaStrings, SsParser;
13-
14-type
15- TSakuraScriptFountainParser = class(TFountainParser)
16- protected
17- function GetTalkToken: char;
18- procedure InitMethodTable; override;
19- procedure TagProc;
20- procedure MetaProc;
21- procedure SymbolProc; override;
22- function SsParser: TSsParser;
23- function IsScope0ChangeTag(const Tag: String): boolean; virtual;
24- function IsScope1ChangeTag(const Tag: String): boolean; virtual;
25- public
26- function NextToken: Char; override;
27- function TokenToFountainColor: TFountainColor; override;
28- end;
29-
30- TSakuraScriptFountain = class(TFountain)
31- private
32- FScope0Color: TFountainColor;
33- FScope1Color: TFountainColor;
34- FTagColor: TFountainColor;
35- FMetaWordColor: TFountainColor;
36- FTagErrorColor: TFountainColor;
37- FSynchronizedColor: TFountainColor;
38- FSakuraScriptParser: TSsParser;
39- FProcessSync: boolean;
40- FChangeScopeByHU: boolean;
41- FChangeScopeBy01: boolean;
42- procedure SetMetaWordColor(const Value: TFountainColor);
43- procedure SetScope0Color(const Value: TFountainColor);
44- procedure SetScope1Color(const Value: TFountainColor);
45- procedure SetTagColor(const Value: TFountainColor);
46- procedure SetTagErrorColor(const Value: TFountainColor);
47- procedure SetSynchronizedColor(const Value: TFountainColor);
48- procedure SetSakuraScriptParser(const Value: TSsParser);
49- procedure SetChangeScopeBy01(const Value: boolean);
50- procedure SetChangeScopeByHU(const Value: boolean);
51- procedure SetProcessSync(const Value: boolean);
52- { Private 宣言 }
53- protected
54- { Protected 宣言 }
55- procedure CreateFountainColors; override;
56- function GetParserClass: TFountainParserClass; override;
57- public
58- constructor Create(AOwner: TComponent); override;
59- destructor Destroy; override;
60- published
61- property Scope0Color: TFountainColor read FScope0Color write SetScope0Color;
62- property Scope1Color: TFountainColor read FScope1Color write SetScope1Color;
63- property TagColor: TFountainColor read FTagColor write SetTagColor;
64- property TagErrorColor: TFountainColor read FTagErrorColor write SetTagErrorColor;
65- property MetaWordColor: TFountainColor read FMetaWordColor write SetMetaWordColor;
66- property SynchronizedColor: TFountainColor read FSynchronizedColor write SetSynchronizedColor;
67- property SakuraScriptParser: TSsParser read FSakuraScriptParser write SetSakuraScriptParser;
68- property ChangeScopeBy01: boolean read FChangeScopeBy01 write SetChangeScopeBy01 default true;
69- property ChangeScopeByHU: boolean read FChangeScopeByHU write SetChangeScopeByHU default true;
70- property ProcessSync: boolean read FProcessSync write SetProcessSync default true;
71- published
72- { Published 宣言 }
73- end;
74-
75-procedure Register;
76-
77-implementation
78-
79-const
80- { トークンの種類を表す定数(列挙型だとこうやって増やせないからね) }
81- toScope0 = char(50); //スコープ0文字列
82- toScope1 = char(51); //スコープ1文字列
83- toTag = char(52); //タグ
84- toTagError = char(53); //タグ表記エラー
85- toMetaWord = char(54); //メタ文字列
86- toSynchronized = char(55); //シンクロナイズドセッション
87-
88- InScope1 = $1;
89- InSynchronized = $2;
90-
91-{ TSakuraScriptFountain }
92-
93-constructor TSakuraScriptFountain.Create(AOwner: TComponent);
94-begin
95- inherited;
96- FChangeScopeByHU := true;
97- FChangeScopeBy01 := true;
98- FProcessSync := true;
99-end;
100-
101-procedure TSakuraScriptFountain.CreateFountainColors;
102-begin
103- inherited;
104- FScope0Color := CreateFountainColor;
105- FScope1Color := CreateFountainColor;
106- FTagColor := CreateFountainColor;
107- FTagErrorColor := CreateFountainColor;
108- FMetaWordColor := CreateFountainColor;
109- FSynchronizedColor := CreateFountainColor;
110-end;
111-
112-destructor TSakuraScriptFountain.Destroy;
113-begin
114- FScope0Color.Free;
115- FScope1Color.Free;
116- FTagColor.Free;
117- FTagErrorColor.Free;
118- FMetaWordColor.Free;
119- FSynchronizedColor.Free;
120- inherited;
121-end;
122-
123-function TSakuraScriptFountain.GetParserClass: TFountainParserClass;
124-begin
125- Result := TSakuraScriptFountainParser;
126-end;
127-
128-procedure TSakuraScriptFountain.SetChangeScopeBy01(const Value: boolean);
129-begin
130- FChangeScopeBy01 := Value;
131-end;
132-
133-procedure TSakuraScriptFountain.SetChangeScopeByHU(const Value: boolean);
134-begin
135- FChangeScopeByHU := Value;
136-end;
137-
138-procedure TSakuraScriptFountain.SetMetaWordColor(
139- const Value: TFountainColor);
140-begin
141- FMetaWordColor.Assign(Value);
142-end;
143-
144-procedure TSakuraScriptFountain.SetProcessSync(const Value: boolean);
145-begin
146- FProcessSync := Value;
147-end;
148-
149-procedure TSakuraScriptFountain.SetSakuraScriptParser(
150- const Value: TSsParser);
151-begin
152- FSakuraScriptParser := Value;
153-end;
154-
155-procedure TSakuraScriptFountain.SetScope0Color(
156- const Value: TFountainColor);
157-begin
158- FScope0Color.Assign(Value);
159-end;
160-
161-procedure TSakuraScriptFountain.SetScope1Color(
162- const Value: TFountainColor);
163-begin
164- FScope1Color.Assign(Value);
165-end;
166-
167-procedure TSakuraScriptFountain.SetSynchronizedColor(
168- const Value: TFountainColor);
169-begin
170- FSynchronizedColor.Assign(Value);
171-end;
172-
173-procedure TSakuraScriptFountain.SetTagColor(const Value: TFountainColor);
174-begin
175- FTagColor.Assign(Value);
176-end;
177-
178-procedure TSakuraScriptFountain.SetTagErrorColor(
179- const Value: TFountainColor);
180-begin
181- FTagErrorColor.Assign(Value);
182-end;
183-
184-{ TSakuraScriptFountainParser }
185-
186-function TSakuraScriptFountainParser.GetTalkToken: char;
187-begin
188- if (FElementIndex or InSynchronized) > 0 then
189- Result := toSynchronized
190- else if (FElementIndex or InScope1) > 0 then
191- Result := toScope1
192- else
193- Result := toScope0;
194-end;
195-
196-procedure TSakuraScriptFountainParser.InitMethodTable;
197-begin
198- inherited;
199- FMethodTable['\'] := TagProc;
200- FMethodTable['%'] := MetaProc;
201-end;
202-
203-
204-function TSakuraScriptFountainParser.IsScope0ChangeTag(
205- const Tag: String): boolean;
206-begin
207- Result := false;
208- if (Self.FFountain as TSakuraScriptFountain).ChangeScopeBy01 then
209- if Tag = '\0' then
210- Result := true;
211- if (Self.FFountain as TSakuraScriptFountain).ChangeScopeByHU then
212- if Tag = '\h' then
213- Result := true;
214-end;
215-
216-function TSakuraScriptFountainParser.IsScope1ChangeTag(
217- const Tag: String): boolean;
218-begin
219- Result := false;
220- if (Self.FFountain as TSakuraScriptFountain).ChangeScopeBy01 then
221- if Tag = '\1' then
222- Result := true;
223- if (Self.FFountain as TSakuraScriptFountain).ChangeScopeByHU then
224- if Tag = '\u' then
225- Result := true;
226-end;
227-
228-procedure TSakuraScriptFountainParser.MetaProc;
229-var i, Le: integer;
230-begin
231- Inc(FP);
232- for i := 0 to SsParser.MetaPattern.Count-1 do
233- begin
234- Le := SsParser.MatchP(FP, PChar(SsParser.MetaPattern[i]));
235- if Le > 0 then
236- begin
237- FToken := toMetaWord;
238- Inc(FP, Le);
239- Exit; // めでたくメタ文字として解析完了
240- end else
241- end;
242- SymbolProc; // 単純に文字として扱う
243-end;
244-
245-function TSakuraScriptFountainParser.NextToken: Char;
246-begin
247- // このクラスのキモ。
248- // toIntegerやらtoDBSymbolやらのトークンは不要で、
249- // 代わりにそのセリフがどちらのスコープなのかが必要なので、
250- // トークンを上書きする
251- inherited NextToken;
252- if FToken = toTag then
253- begin
254- if IsScope1ChangeTag(TokenString) then
255- FElementIndex := FElementIndex or InScope1
256- else if IsScope0ChangeTag(TokenString) then
257- FElementIndex := FElementIndex and not InScope1
258- else if (FFountain as TSakuraScriptFountain).ProcessSync and
259- (TokenString = '\_s') then
260- FElementIndex := FElementIndex xor InSynchronized;
261- end else
262- begin
263- if FToken in [toSymbol..toFloat, toAnk, toDBSymbol..toKana, toHex] then
264- begin
265- if (FElementIndex and InSynchronized) > 0 then
266- FToken := toSynchronized
267- else if (FElementIndex and InScope1) > 0 then
268- FToken := toScope1
269- else
270- FToken := toScope0;
271- end;
272- end;
273- Result := FToken;
274-end;
275-
276-procedure TSakuraScriptFountainParser.SymbolProc;
277-// '\'と'%'以外は豪快に読み飛ばす。要らない。
278-// ダブルバイト文字もシングルバイト文字も併せて単なるシンボルとして扱う。
279-begin
280- FToken := toSymbol;
281- if not (FP^ in [#0, #9, #10, #13, '\', '%']) then
282- if FP^ in LeadBytes then
283- Inc(FP, 2)
284- else
285- Inc(FP);
286-end;
287-
288-function TSakuraScriptFountainParser.SsParser: TSsParser;
289-begin
290- Result := (FFountain as TSakuraScriptFountain).SakuraScriptParser;
291- if Result = nil then raise Exception.Create('SakuraScriptParser property is nil');
292-end;
293-
294-procedure TSakuraScriptFountainParser.TagProc;
295-var i, Le: integer;
296- IsErr: boolean;
297- Pat: String;
298-begin
299- Inc(FP);
300- if (FP^ in [#0, #13, #10]) then
301- begin
302- FToken := toTagError;
303- Exit;
304- end else if (FP^ = '\') or (FP^ = '%') then // '\\', '\%'形式のエスケープ
305- begin
306- Inc(FP);
307- SymbolProc;
308- end else
309- begin
310- for i := 0 to SsParser.TagPattern.Count-1 do
311- begin
312- Pat := SsParser.TagPattern[i];
313- if Length(Pat) < 2 then Continue;
314- IsErr := Pat[1] = '!';
315- Le := SsParser.MatchP(FP, @Pat[2]);
316- if Le > 0 then
317- begin
318- Inc(FP, Le);
319- if IsErr then
320- FToken := toTagError
321- else
322- FToken := toTag;
323- Exit; // めでたくパターンマッチ成功の場合
324- end;
325- end;
326- // 以下はパターン取得失敗の場合
327- FToken := toTagError;
328- if FP^ in LeadBytes then
329- Inc(FP, 2)
330- else
331- Inc(FP);
332- end;
333-end;
334-
335-function TSakuraScriptFountainParser.TokenToFountainColor: TFountainColor;
336-begin
337- with TSakuraScriptFountain(FFountain) do
338- case FToken of
339- toScope0:
340- Result := FScope0Color;
341- toScope1:
342- Result := FScope1Color;
343- toTag:
344- Result := FTagColor;
345- toTagError:
346- Result := FTagErrorColor;
347- toMetaWord:
348- Result := FMetaWordColor;
349- toSynchronized:
350- Result := FSynchronizedColor;
351- else
352- Result := nil;
353- end;
354-end;
355-
356-procedure Register;
357-begin
358- RegisterComponents('TEditor', [TSakuraScriptFountain]);
359-end;
360-
361-end.
Binary files a/sakurasuite/SakuraSeeker.dcr and /dev/null differ
--- a/sakurasuite/SakuraSeeker.pas
+++ /dev/null
@@ -1,473 +0,0 @@
1-{********************************************************}
2-{ SakuraSeeker Component - Listups Existing SSTP Servers }
3-{ }
4-{ Copyright (c) 2001-2003 naruto/CANO-Lab }
5-{********************************************************}
6-
7-unit SakuraSeeker;
8-
9-interface
10-
11-uses
12- Windows, SysUtils, Classes, Contnrs;
13-
14-type
15- ESakuraSeekerError = class(Exception);
16-
17- TSakuraSeeker = class;
18-
19- TSakuraSeekerGetMutexNameEvent = procedure (Sender: TObject;
20- var Name: String) of object;
21-
22- TSakuraProcess = class(TObject)
23- private
24- FHash: TStringList;
25- FProcessID: String;
26- FFMOName: String;
27- FOwner: TSakuraSeeker;
28- procedure SetProcessID(const Value: String);
29- function GetHWnd: THandle;
30- function GetName: String;
31- function GetData(Key: String): String;
32- function GetKeroName: String;
33- function GetSetName: String;
34- procedure SetFMOName(const Value: String);
35- function GetDataAt(Index: integer): String;
36- function GetCount: integer;
37- function GetKeyAt(Index: integer): String;
38- protected
39- procedure AppendData(const Key, Value: String);
40- public
41- constructor Create(AOwner: TSakuraSeeker);
42- destructor Destroy; override;
43- property ProcessID: String read FProcessID write SetProcessID;
44- property FMOName: String read FFMOName write SetFMOName;
45- property HWnd: THandle read GetHWnd;
46- property Name: String read GetName;
47- property KeroName: String read GetKeroName;
48- property SetName: String read GetSetName;
49- property Data[Key: String]: String read GetData;
50- property Count: integer read GetCount;
51- property DataAt[Index: integer]: String read GetDataAt;
52- property KeyAt[Index: integer]: String read GetKeyAt;
53- end;
54-
55- TSakuraSeeker = class(TComponent)
56- private
57- { Private 宣言 }
58- FList: TObjectList;
59- FAutoDetect: boolean;
60- FOnAfterDetection: TNotifyEvent;
61- FLastSeekResult: String; //前回の取得結果。比較用
62- FSourceResult: String; //今回の取得結果。比較用
63- FOnDetectResultChanged: TNotifyEvent;
64- FFileMappingTarget: TStrings;
65- FOnGetMutexName: TSakuraSeekerGetMutexNameEvent;
66- FMutexPool: TStringList;
67- function GetProcess(Index: integer): TSakuraProcess;
68- procedure SetAutoDetect(const Value: boolean);
69- function GetProcessByName(Name: String): TSakuraProcess;
70- function GetProcessByID(ID: String): TSakuraProcess;
71- function GetCount: integer;
72- procedure SetOnAfterDetection(const Value: TNotifyEvent);
73- procedure SetOnDetectResultChanged(const Value: TNotifyEvent);
74- procedure SetFileMappingTarget(const Value: TStrings);
75- function GetProcessBySetName(Name: String): TSakuraProcess;
76- procedure SetOnGetMutexName(
77- const Value: TSakuraSeekerGetMutexNameEvent);
78- protected
79- { Protected 宣言 }
80- procedure Loaded; override;
81- procedure ClearList;
82- procedure BeginDetectOne(const Target: String);
83- function GetMutexName(const Target: String): String;
84- function GetMutex(const Name: String): THandle;
85- public
86- { Public 宣言 }
87- procedure BeginDetect;
88- property Count: integer read GetCount;
89- property Process[Index: integer]: TSakuraProcess read GetProcess; default;
90- property ProcessByName[Name: String]: TSakuraProcess read GetProcessByName;
91- property ProcessBySetName[Name: String]: TSakuraProcess read GetProcessBySetName;
92- property ProcessByID[ID: String]: TSakuraProcess read GetProcessByID;
93- function KillFMO(const TargetFMOName, TargetID: String): boolean;
94- constructor Create(AOwner: TComponent); override;
95- destructor Destroy; override;
96- published
97- { Published 宣言 }
98- property AutoDetect: boolean read FAutoDetect write SetAutoDetect default true;
99- property OnAfterDetection: TNotifyEvent read FOnAfterDetection write SetOnAfterDetection;
100- property OnDetectResultChanged: TNotifyEvent read FOnDetectResultChanged write SetOnDetectResultChanged;
101- property FileMappingTarget: TStrings read FFileMappingTarget write SetFileMappingTarget;
102- property OnGetMutexName: TSakuraSeekerGetMutexNameEvent read FOnGetMutexName write SetOnGetMutexName;
103- end;
104-
105-procedure Register;
106-
107-implementation
108-
109-procedure Register;
110-begin
111- RegisterComponents('Samples', [TSakuraSeeker]);
112-end;
113-
114-{ TSakuraProcess }
115-
116-procedure TSakuraProcess.AppendData(const Key, Value: String);
117-begin
118- FHash.Values[Key] := Value;
119-end;
120-
121-constructor TSakuraProcess.Create(AOwner: TSakuraSeeker);
122-begin
123- FHash := TStringList.Create;
124- FOwner := AOwner;
125-end;
126-
127-destructor TSakuraProcess.Destroy;
128-begin
129- inherited;
130- FHash.Free;
131-end;
132-
133-function TSakuraProcess.GetCount: integer;
134-begin
135- Result := FHash.Count;
136-end;
137-
138-function TSakuraProcess.GetData(Key: String): String;
139-begin
140- Result := FHash.Values[Key];
141-end;
142-
143-function TSakuraProcess.GetDataAt(Index: integer): String;
144-begin
145- if Index >= 0 then
146- Result := Copy(FHash[Index], Length(FHash.Names[Index]) + 2, High(integer))
147- else
148- Result := '';
149-end;
150-
151-function TSakuraProcess.GetHWnd: THandle;
152-begin
153- Result := StrToIntDef(GetData('hwnd'), 0);
154-end;
155-
156-function TSakuraProcess.GetKeroName: String;
157-begin
158- Result := GetData('keroname');
159-end;
160-
161-function TSakuraProcess.GetKeyAt(Index: integer): String;
162-begin
163- Result := FHash.Names[Index];
164-end;
165-
166-function TSakuraProcess.GetName: String;
167-begin
168- Result := GetData('name');
169-end;
170-
171-
172-function TSakuraProcess.GetSetName: String;
173-begin
174- Result := GetName + ',' + GetKeroName;
175-end;
176-
177-procedure TSakuraProcess.SetFMOName(const Value: String);
178-begin
179- FFMOName := Value;
180-end;
181-
182-procedure TSakuraProcess.SetProcessID(const Value: String);
183-begin
184- FProcessID := Value;
185-end;
186-
187-{ TSakuraSeeker }
188-
189-procedure TSakuraSeeker.BeginDetect;
190-var i: integer;
191-begin
192- if [csDesigning, csLoading] * ComponentState <> [] then Exit;
193- ClearList;
194-
195- FSourceResult := '';
196- for i := 0 to FFileMappingTarget.Count-1 do begin
197- BeginDetectOne(FFileMappingTarget[i]); //1つのFile-mapping Objectを取得
198- end;
199-
200- if Assigned(OnDetectResultChanged) and (FLastSeekResult <> FSourceResult) then begin
201- FLastSeekResult := FSourceResult;
202- OnDetectResultChanged(Self);
203- end else begin
204- FLastSeekResult := FSourceResult;
205- end;
206-
207- if Assigned(OnAfterDetection) then OnAfterDetection(Self);
208-end;
209-
210-procedure TSakuraSeeker.BeginDetectOne(const Target: String);
211-var MappingHandle, Mutex: THandle;
212- P, PSaved: pointer;
213- SourceStr, ID, Entry, Data: String;
214- Size: integer;
215- Strs: TStringList;
216- Pro: TSakuraProcess;
217- i, j: integer;
218-begin
219- //ファイルマッピングオブジェクトの取得
220- PSaved := nil;
221- Strs := nil;
222- MappingHandle := 0;
223-
224- Mutex := GetMutex(GetMutexName(Target));
225- if Mutex = 0 then
226- raise ESakuraSeekerError.Create('Mutexハンドルを取得できませんでした');
227- if WaitForSingleObject(Mutex, 3000) = WAIT_TIMEOUT then
228- raise ESakuraSeekerError.Create('Mutex同期タイムアウト');
229- try
230- MappingHandle := OpenFileMapping(FILE_MAP_READ, false, PChar(Target));
231- try
232- if MappingHandle = 0 then begin
233- SourceStr := '';
234- end else begin
235- PSaved := MapViewOfFile(MappingHandle, FILE_MAP_READ, 0, 0, 0);
236- P := PSaved;
237- if P <> nil then begin
238- CopyMemory(@Size, P, SizeOf(integer));
239- Inc(PChar(P), SizeOf(integer));
240- SourceStr := PChar(P);
241- if Length(SourceStr) > Size then
242- raise ESakuraSeekerError.Create('FMOを取得できませんでした');
243- end;
244- end;
245- finally
246- //オブジェクトの破棄
247- if PSaved <> nil then UnmapViewOfFile(PSaved);
248- end;
249- finally
250- if MappingHandle <> 0 then CloseHandle(MappingHandle);
251- ReleaseMutex(Mutex);
252- end;
253-
254- //データを解析
255- try
256- try
257- Strs := TStringList.Create;
258- Strs.Text := SourceStr;
259- for i := 0 to Strs.Count-1 do begin
260- j := Pos('.', Strs[i]);
261- ID := Copy(Strs[i], 1, j-1);
262- Entry := Copy(Strs[i], j+1, Pos(#1, Strs[i])-j-1);
263- Data := Copy(Strs[i], Pos(#1, Strs[i])+1, High(integer));
264- Pro := GetProcessByID(ID);
265- if Pro = nil then begin
266- Pro := TSakuraProcess.Create(self);
267- Pro.ProcessID := ID;
268- Pro.FMOName := Target; // FMO識別名
269- FList.Add(Pro);
270- end;
271- Pro.AppendData(Entry, Data);
272- end;
273- except
274- end;
275- finally
276- Strs.Free;
277- end;
278- FSourceResult := FSourceResult + SourceStr;
279-end;
280-
281-procedure TSakuraSeeker.ClearList;
282-begin
283- FList.Clear;
284-end;
285-
286-constructor TSakuraSeeker.Create(AOwner: TComponent);
287-begin
288- inherited;
289- FAutoDetect := true;
290- FList := TObjectList.Create;
291- FFileMappingTarget := TStringList.Create;
292- FFileMappingTarget.Add('Sakura');
293- FMutexPool := TStringList.Create;
294-end;
295-
296-destructor TSakuraSeeker.Destroy;
297-var i: integer;
298-begin
299- ClearList;
300- FList.Free;
301- FFileMappingTarget.Free;
302- for i := 0 to FMutexPool.Count-1 do
303- begin
304- CloseHandle(StrToInt(Copy(FMutexPool[i], Pos('=', FMutexPool[i])+1, High(integer))));
305- end;
306- FreeAndNil(FMutexPool);
307-end;
308-
309-function TSakuraSeeker.GetCount: integer;
310-begin
311- Result := FList.Count;
312-end;
313-
314-function TSakuraSeeker.GetMutex(const Name: String): THandle;
315-begin
316- if FMutexPool.Values[Name] <> '' then
317- begin
318- Result := THandle(StrToInt(FMutexPool.Values[Name]));
319- end else
320- begin
321- Result := CreateMutex(nil, false, PChar(Name));
322- if Result <> 0 then
323- FMutexPool.Values[Name] := IntToStr(Result);
324- end;
325-end;
326-
327-function TSakuraSeeker.GetMutexName(const Target: String): String;
328-begin
329- if Assigned(FOnGetMutexName) then
330- begin
331- Result := Target;
332- FOnGetMutexName(self, Result);
333- end else
334- Result := Target + 'FMO';
335-end;
336-
337-function TSakuraSeeker.GetProcess(Index: integer): TSakuraProcess;
338-begin
339- Result := FList[Index] as TSakuraProcess;
340-end;
341-
342-function TSakuraSeeker.GetProcessByID(ID: String): TSakuraProcess;
343-var i: integer;
344-begin
345- Result := nil;
346- for i := 0 to FList.Count-1 do begin
347- if TSakuraProcess(FList[i]).ProcessID = ID then begin
348- Result := FList[i] as TSakuraProcess;
349- Exit;
350- end;
351- end;
352-end;
353-
354-function TSakuraSeeker.GetProcessByName(Name: String): TSakuraProcess;
355-var i: integer;
356-begin
357- Result := nil;
358- for i := 0 to FList.Count-1 do begin
359- if (FList[i] as TSakuraProcess).Name = Name then begin
360- Result := FList[i] as TSakuraProcess;
361- Exit;
362- end;
363- end;
364-end;
365-
366-function TSakuraSeeker.GetProcessBySetName(Name: String): TSakuraProcess;
367-var i: integer;
368-begin
369- Result := nil;
370- for i := 0 to FList.Count-1 do begin
371- if (FList[i] as TSakuraProcess).SetName = Name then begin
372- Result := FList[i] as TSakuraProcess;
373- Exit;
374- end;
375- end;
376-end;
377-
378-function TSakuraSeeker.KillFMO(const TargetFMOName, TargetID: String): boolean;
379-var MappingHandle, Mutex: THandle;
380- P: pointer;
381- SourceStr, ID: String;
382- Size: integer;
383- Strs: TStringList;
384- i, j: integer;
385-begin
386- //ファイルマッピングオブジェクトの取得
387- Result := false;
388- P := nil;
389- Mutex := GetMutex(GetMutexName(TargetFMOName));
390- if Mutex = 0 then
391- raise ESakuraSeekerError.Create('Mutexハンドルを取得できませんでした');
392- if WaitForSingleObject(Mutex, 3000) = WAIT_TIMEOUT then
393- raise ESakuraSeekerError.Create('Mutex同期タイムアウト');
394- try
395- MappingHandle := OpenFileMapping(FILE_MAP_WRITE, false, PChar(TargetFMOName));
396- if MappingHandle = 0 then Exit;
397- try
398- SourceStr := '';
399- P := MapViewOfFile(MappingHandle, FILE_MAP_WRITE, 0, 0, 0);
400- if P <> nil then begin
401- CopyMemory(@Size, P, SizeOf(integer));
402- Inc(PChar(P), SizeOf(integer));
403- SourceStr := PChar(P);
404- if Length(SourceStr) > Size then
405- raise ESakuraSeekerError.Create('FMOを取得できませんでした');
406- end;
407-
408- //データを解析
409- Strs := TStringList.Create;
410- try
411- Strs.Text := SourceStr;
412- for i := Strs.Count-1 downto 0 do begin
413- j := Pos('.', Strs[i]);
414- ID := Copy(Strs[i], 1, j-1);
415- if ID = TargetID then begin
416- Strs.Delete(i); // 要らないエントリを削除
417- Result := true;
418- end;
419- end;
420- SourceStr := Strs.Text;
421- finally
422- Strs.Free;
423- end;
424-
425- if Result then begin
426- CopyMemory(P, PChar(SourceStr), Length(SourceStr)+1);
427- Dec(PChar(P), SizeOf(integer));
428- end;
429- finally
430- //オブジェクトの破棄
431- if P <> nil then UnmapViewOfFile(P);
432- CloseHandle(MappingHandle);
433- end;
434- finally
435- ReleaseMutex(Mutex);
436- end;
437-end;
438-
439-procedure TSakuraSeeker.Loaded;
440-begin
441- inherited;
442- if FAutoDetect and not (csDesigning in ComponentState) then BeginDetect;
443-end;
444-
445-procedure TSakuraSeeker.SetAutoDetect(const Value: boolean);
446-begin
447- FAutoDetect := Value;
448-end;
449-
450-procedure TSakuraSeeker.SetFileMappingTarget(const Value: TStrings);
451-begin
452- FFileMappingTarget.Assign(Value);
453-end;
454-
455-procedure TSakuraSeeker.SetOnAfterDetection(const Value: TNotifyEvent);
456-begin
457- FOnAfterDetection := Value;
458-end;
459-
460-procedure TSakuraSeeker.SetOnDetectResultChanged(
461- const Value: TNotifyEvent);
462-begin
463- FOnDetectResultChanged := Value;
464-end;
465-
466-procedure TSakuraSeeker.SetOnGetMutexName(
467- const Value: TSakuraSeekerGetMutexNameEvent);
468-begin
469- FOnGetMutexName := Value;
470-end;
471-
472-end.
473-
\ No newline at end of file
--- a/sakurasuite/SakuraSuite.dpk
+++ /dev/null
@@ -1,50 +0,0 @@
1-package SakuraSuite;
2-
3-{$R *.res}
4-{$R 'SakuraSeeker.dcr'}
5-{$R 'SsParser.dcr'}
6-{$R 'IdSLPP20.dcr'}
7-{$R 'DirectSstp.dcr'}
8-{$R 'SakuraScriptFountain.dcr'}
9-{$R 'SsPlayTime.dcr'}
10-{$ALIGN 8}
11-{$ASSERTIONS ON}
12-{$BOOLEVAL OFF}
13-{$DEBUGINFO ON}
14-{$EXTENDEDSYNTAX ON}
15-{$IMPORTEDDATA ON}
16-{$IOCHECKS ON}
17-{$LOCALSYMBOLS ON}
18-{$LONGSTRINGS ON}
19-{$OPENSTRINGS ON}
20-{$OPTIMIZATION ON}
21-{$OVERFLOWCHECKS OFF}
22-{$RANGECHECKS OFF}
23-{$REFERENCEINFO ON}
24-{$SAFEDIVIDE OFF}
25-{$STACKFRAMES OFF}
26-{$TYPEDADDRESS OFF}
27-{$VARSTRINGCHECKS ON}
28-{$WRITEABLECONST ON}
29-{$MINENUMSIZE 1}
30-{$IMAGEBASE $400000}
31-{$DESCRIPTION 'Sakura Component Suite by naruto/CANO-Lab'}
32-{$IMPLICITBUILD OFF}
33-
34-requires
35- vcl,
36- rtl;
37-
38-// require節には、TEditとIndy??の2つのパッケージが、
39-// Delphiによって自動的に追加されるはず。
40-// 追加するかどうか尋ねるダイアログが出た場合にはOKすること。
41-
42-contains
43- SakuraSeeker in 'SakuraSeeker.pas',
44- SsParser in 'SsParser.pas',
45- IdSLPP20 in 'IdSLPP20.pas',
46- DirectSstp in 'DirectSstp.pas',
47- SakuraScriptFountain in 'SakuraScriptFountain.pas',
48- SsPlayTime in 'SsPlayTime.pas';
49-
50-end.
Binary files a/sakurasuite/SakuraSuite.res and /dev/null differ
--- a/sakurasuite/SsParser.pas
+++ /dev/null
@@ -1,653 +0,0 @@
1-{********************************************************}
2-{ TSsParser Component - Parser for Sakura Script }
3-{ }
4-{ Copyright (c) 2001-2003 naruto/CANO-Lab }
5-{********************************************************}
6-
7-unit SsParser;
8-
9-interface
10-
11-uses
12- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
13-
14-type
15- // Kind of the Markup
16- // mtTag: Tag. (begins with \)
17- // mtMeta: Meta expression. (begins with %)
18- // mtTagErr: Seems to be a markup error
19- // mtStr: Other normal talk string
20- TSsMarkUpType = (mtTag, mtMeta, mtTagErr, mtStr);
21-
22- // Intercepting the parsing
23- TSsParseEvent = procedure (Sender: TObject; const Script: String;
24- var Len: integer; var MarkType: TSsMarkUpType; var Extra: String) of object;
25-
26- // Exception class
27- ESsParserError = class(Exception);
28-
29- TSsMarkUp = class(TObject)
30- private
31- FPos: integer;
32- FExtra: String;
33- FStr: String;
34- FMarkUpType: TSsMarkUpType;
35- procedure SetExtra(const Value: String);
36- public
37- constructor Create(Pos: integer; MarkUpType: TSsMarkUpType; Str: String; Extra: String = '');
38- property Pos: integer read FPos; //This markup is Pos'th character in InputString
39- property MarkUpType: TSsMarkUpType read FMarkUpType;
40- property Str: String read FStr;
41- property Extra: String read FExtra write SetExtra;
42- end;
43-
44- TSsParser = class(TComponent)
45- private
46- FTagPattern: TStrings; //SakuraScript tag pattern string
47- FMetaPattern: TStrings; //SakuraScript meta expression pattern string
48- FInputString: String;
49- FMarkUpList: TList;
50- FLeaveEscape: boolean;
51- FEscapeInvalidMeta: boolean;
52- FOnParse: TSsParseEvent;
53- procedure SetInputString(const Value: String);
54- function GetCount: integer;
55- function GetExtra(Index: integer): String;
56- function GetMarkUpType(Index: integer): TSsMarkUpType;
57- function GetStr(Index: integer): String;
58- procedure SetExtra(Index: integer; const Value: String);
59- procedure ClearList;
60- procedure SetMetaPattern(const Value: TStrings);
61- procedure SetTagPattern(const Value: TStrings);
62- procedure SetOnParse(const Value: TSsParseEvent);
63- function GetFirstChar(const Str: String): String;
64- function ChopFirstChar(var Str: String): String;
65- function GetPosition(Index: integer): integer;
66- protected
67- procedure BeginParse;
68- public
69- constructor Create(AOwner: TComponent); override;
70- destructor Destroy; override;
71- function MatchP(PStr, PPattern: PChar): integer;
72- function Match(Str, Pattern: String): integer;
73- function GetParam(Tag: String; const Index: integer): String;
74- function EscapeParam(const Param: String): String;
75- function MarkUpAt(const Pos: integer): integer;
76-
77- property Count: integer read GetCount;
78- property MarkUpType[Index: integer]: TSsMarkUpType read GetMarkUpType;
79- property Str[Index: integer]: String read GetStr; default;
80- property Extra[Index: integer]: String read GetExtra write SetExtra;
81- property Position[Index: integer]: integer read GetPosition;
82- property InputString: String read FInputString write SetInputString;
83- published
84- // Script parsing patterns.
85- property TagPattern: TStrings read FTagPattern write SetTagPattern;
86- property MetaPattern: TStrings read FMetaPattern write SetMetaPattern;
87- // Whether to leave escape sequence "\\" and "\%" in mtStr elements
88- property LeaveEscape: boolean read FLeaveEscape write FLeaveEscape
89- default true;
90- // Replace '%' to '\%' if sequence follwing the '%' could not
91- // be parsed as a meta expression
92- property EscapeInvalidMeta: boolean read FEscapeInvalidMeta
93- write FEscapeInvalidMeta default false;
94- // Component users can intercept and handle part of the parsing using this event.
95- property OnParse: TSsParseEvent read FOnParse write SetOnParse;
96- end;
97-
98-procedure Register;
99-
100-implementation
101-
102-resourcestring
103- CElementTypeError = '正しいエレメントタイプを返してください';
104- CTagPatternSyntaxError = 'TagPattern表記ミス %d 行目';
105- CMarkupIndexOutofRange = 'インデックスが範囲をこえています';
106-
107-{
108- // English error message
109- CElementTypeError = 'Returned element type is invalid in OnParse.';
110- CTagPatternSyntaxError = 'TagPattern syntax error at line %d.';
111- CMarkupIndexOutofRange = 'Markup index if out of range.';
112-}
113-
114-
115-procedure Register;
116-begin
117- RegisterComponents('Samples', [TSsParser]);
118-end;
119-
120-{ TSsParser }
121-
122-procedure TSsParser.BeginParse;
123-var Str, Talk, T, Ex: String;
124- i, Le: integer;
125- IsErr: boolean;
126- Mt: TSsMarkUpType;
127- PStr: PChar;
128-begin
129- ClearList;
130- Str := FInputString; // The string to be parsed from now
131- // This is to avoid access violation if `Str` is terminated
132- // with DBCS leadbyte. (Such string is invalid from the beginning of course)
133- Str := Str + #0#0;
134- if Length(Str) = 0 then Exit;
135- PStr := PChar(Str);
136- Talk := '';
137- while PStr^ <> #0 do begin
138- if PStr^ = '\' then begin
139- Inc(PStr);
140- if PStr^ = '\' then
141- begin
142- // Escaped sequence "\\"
143- if FLeaveEscape then
144- Talk := Talk + '\\'
145- else
146- Talk := Talk + '\';
147- Inc(PStr);
148- Continue;
149- end else if PStr^ = '%' then
150- begin
151- // Escaped sequence "\%"
152- if FLeaveEscape then
153- Talk := Talk + '\%'
154- else
155- Talk := Talk + '%';
156- Inc(PStr);
157- Continue;
158- end else
159- begin
160- Dec(PStr);
161- // might be a tag
162- // Generate OnParser event
163- Le := 0;
164- Ex := '';
165- IsErr := false;
166- if Assigned(FOnParse) then begin
167- FOnParse(Self, String(PStr), Le, Mt, Ex);
168- if Le > 0 then begin
169- if (Mt <> mtTag) and (Mt <> mtTagErr) then begin
170- raise ESsParserError.Create(CElementTypeError);
171- Exit;
172- end;
173- if Mt = mtTagErr then IsErr := true;
174- end;
175- end;
176- if Le <= 0 then begin
177- for i := 0 to FTagPattern.Count-1 do begin
178- T := FTagPattern[i];
179- if Length(T) = 0 then Continue;
180- IsErr := false;
181- if T[1] = '!' then begin
182- IsErr := true;
183- T[1] := '\';
184- end else if T[1] <> '\' then
185- raise ESsParserError.CreateFmt(CTagPatternSyntaxError, [i+1]);
186- Le := MatchP(PStr, PChar(T));
187- if Le > 0 then Break;
188- end;
189- end;
190- if Length(Talk) > 0 then begin
191- FMarkUpList.Add(TSsMarkUp.Create(PStr-PChar(Str)-Length(Talk), mtStr, Talk));
192- Talk := '';
193- end;
194- if Le > 0 then begin
195- // Parsed as a correct tag
196- T := Copy(String(PStr), 1, Le);
197- if IsErr then
198- FMarkUpList.Add(TSsMarkUp.Create(PStr-PChar(Str), mtTagErr, T, Ex))
199- else
200- FMarkUpList.Add(TSsMarkUp.Create(PStr-PChar(Str), mtTag, T, Ex));
201- Inc(PStr, Le);
202- end else begin
203- // Parsing failed; The character '\' and the next one character is
204- // marked as a tag error.
205- Inc(PStr); // Skip '\'
206- if PStr^ in LeadBytes then
207- begin
208- T := '\' + Copy(String(PStr), 1, 2);
209- FMarkUpList.Add(TSsMarkUp.Create(PStr-PChar(Str)-1, mtTagErr, T));
210- Inc(PStr, 2);
211- end else
212- begin
213- T := '\' + PStr^;
214- FMarkUpList.Add(TSsMarkUp.Create(PStr-PChar(Str)-1, mtTagErr, T));
215- Inc(PStr);
216- end;
217- end;
218- end;
219- end else if (PStr^ = '%') then begin
220- Le := 0; Ex := '';
221- if Assigned(FOnParse) then begin
222- FOnParse(Self, String(PStr), Le, Mt, Ex);
223- if Le > 0 then begin
224- if Mt <> mtMeta then begin
225- raise ESsParserError.Create(CElementTypeError);
226- Exit;
227- end;
228- Dec(Le);
229- end;
230- end;
231- Inc(PStr); // Skip '%'
232- if Le <= 0 then
233- begin
234- for i := 0 to FMetaPattern.Count-1 do
235- begin
236- if Length(FMetaPattern[i]) = 0 then
237- Continue;
238- Le := MatchP(PStr, PChar(FMetaPattern[i]));
239- if Le > 0 then
240- Break;
241- end;
242- end;
243- if Le > 0 then
244- begin
245- if Length(Talk) > 0 then
246- begin
247- FMarkUpList.Add(TSsMarkUp.Create(PStr-PChar(Str)-Length(Talk), mtStr, Talk));
248- Talk := '';
249- end;
250- T := Copy(String(PStr), 1, Le);
251- FMarkUpList.Add(TSsMarkUp.Create(PStr-PChar(Str)-1, mtMeta, '%' + T, Ex));
252- Inc(PStr, Le);
253- end else
254- begin
255- // in case this %??? sequence seems NOT be a meta expression
256- if FEscapeInvalidMeta then
257- Talk := Talk + '\%'
258- else
259- Talk := Talk + '%';
260- Continue;
261- end;
262- end else begin
263- if PStr^ in LeadBytes then
264- begin
265- Talk := Talk + Copy(String(PStr), 1, 2);
266- Inc(PStr, 2);
267- end else
268- begin
269- Talk := Talk + PStr^;
270- Inc(PStr);
271- end;
272- end;
273- end; // of while
274- if Length(Talk) > 0 then FMarkUpList.Add(TSsMarkUp.Create(PStr-PChar(Str)-Length(Talk), mtStr, Talk));
275-end;
276-
277-function TSsParser.ChopFirstChar(var Str: String): String;
278-begin
279- Result := GetFirstChar(Str);
280- Delete(Str, 1, Length(Result));
281-end;
282-
283-procedure TSsParser.ClearList;
284-var i: integer;
285-begin
286- for i := FMarkUpList.Count-1 downto 0 do begin
287- TSsMarkUp(FMarkUpList[i]).Free;
288- end;
289- FMarkUpList.Free;
290- FMarkUpList := TList.Create;
291-end;
292-
293-constructor TSsParser.Create(AOwner: TComponent);
294-begin
295- inherited;
296- FTagPattern := TStringList.Create;
297- FMetaPattern := TStringList.Create;
298- FMarkUpList := TList.Create;
299- FLeaveEscape := true;
300-end;
301-
302-destructor TSsParser.Destroy;
303-begin
304- inherited;
305- FTagPattern.Free;
306- FMetaPattern.Free;
307- ClearList;
308- FMarkUpList.Free;
309-end;
310-
311-function TSsParser.EscapeParam(const Param: String): String;
312-begin
313- //StringReplace supports DBCS
314- Result := StringReplace(Param, '\', '\\', [rfReplaceAll]);
315- Result := StringReplace(Param, ']', '\]', [rfReplaceAll]);
316-end;
317-
318-function TSsParser.GetCount: integer;
319-begin
320- Result := FMarkUpList.Count;
321-end;
322-
323-function TSsParser.GetExtra(Index: integer): String;
324-begin
325- if (Index >= 0) and (Index <= FMarkUpList.Count-1) then
326- Result := TSsMarkUp(FMarkUpList[Index]).Extra
327- else
328- Result := '';
329-end;
330-
331-function TSsParser.GetFirstChar(const Str: String): String;
332-begin
333- // Get the first character of the given string. Supports DBCS
334- if Length(Str) <= 1 then begin
335- Result := Str;
336- end else begin
337- if Str[1] in LeadBytes then begin
338- Result := Str[1] + Str[2];
339- end else begin
340- Result := Str[1];
341- end;
342- end;
343-end;
344-
345-function TSsParser.GetMarkUpType(Index: integer): TSsMarkUpType;
346-begin
347- if (Index >= 0) and (Index <= FMarkUpList.Count-1) then
348- Result := TSsMarkUp(FMarkUpList[Index]).MarkUpType
349- else
350- raise ESsParserError.Create(CMarkupIndexOutOfRange);
351-end;
352-
353-function TSsParser.GetParam(Tag: String;
354- const Index: integer): String;
355-var ParamCount: integer;
356- First, Param: String;
357- Escape, Inside: boolean;
358-begin
359- if Index <= 0 then Exit;
360- Inside := false;
361- ParamCount := 0;
362- Escape := false;
363- repeat
364- First := ChopFirstChar(Tag);
365- if Inside then begin
366- if Escape then begin
367- if First = '\' then Param := Param + '\'
368- else if First = ']' then Param := Param + ']'
369- else Param := Param + '\' + First;
370- Escape := false;
371- end else if First = '\' then
372- Escape := true
373- else if First = ']' then
374- Inside := false
375- else begin
376- Escape := false;
377- Param := Param + First;
378- end;
379- end else if First = '[' then begin
380- Inside := true;
381- Escape := false;
382- Param := '';
383- Inc(ParamCount);
384- end;
385- until (First = '') or ((ParamCount = Index) and not Inside);
386- if ((ParamCount = Index) and not Inside) then
387- Result := Param
388- else
389- Result := '';
390-end;
391-
392-function TSsParser.GetPosition(Index: integer): integer;
393-begin
394- if (Index >= 0) and (Index <= FMarkUpList.Count-1) then
395- Result := TSsMarkUp(FMarkUpList[Index]).Pos
396- else
397- Result := 0;
398-end;
399-
400-function TSsParser.GetStr(Index: integer): String;
401-begin
402- if (Index >= 0) and (Index <= FMarkUpList.Count-1) then
403- Result := TSsMarkUp(FMarkUpList[Index]).Str
404- else
405- Result := '';
406-end;
407-
408-function TSsParser.MarkUpAt(const Pos: integer): integer;
409-var i, lo, hi: integer;
410-begin
411- if FMarkUpList.Count = 0 then
412- Result := -1
413- else begin
414- lo := 0;
415- hi := FMarkUpList.Count-2;
416- i := (hi-lo) div 2 + lo;
417- while (hi > lo) do
418- begin
419- i := (hi-lo) div 2 + lo;
420- if (TSsMarkUp(FMarkUpList[i]).Pos >= Pos) and
421- (TSsMarkUp(FMarkUpList[i+1]).Pos < Pos) then
422- begin
423- Result := i;
424- Exit;
425- end else if TSsMarkUp(FMarkUpList[i]).Pos > Pos then
426- hi := i
427- else
428- lo := i;
429- end;
430- Result := i;
431- end;
432-end;
433-
434-function TSsParser.Match(Str, Pattern: String): integer;
435-begin
436- if (Length(Str) = 0) or (Length(Pattern) = 0) then
437- Result := 0
438- else
439- Result := MatchP(@Str[1], @Pattern[1]);
440-end;
441-
442-function TSsParser.MatchP(PStr, PPattern: PChar): integer;
443-var Matched, F, Escape: boolean;
444-begin
445- Matched := true;
446- Result := 0;
447- while Matched and (PPattern^ <> #0) do begin
448- if PPattern^ = '%' then
449- begin
450- if PStr^ = #0 then
451- begin
452- Matched := false;
453- Break;
454- end;
455- Inc(PPattern);
456- case PPattern^ of
457- '%':
458- begin
459- if PStr^ = '%' then
460- begin
461- Inc(Result);
462- Inc(PStr);
463- Inc(PPattern);
464- end else
465- begin
466- Matched := false;
467- Break;
468- end;
469- end;
470- 'd':
471- begin
472- if PStr^ in ['0' .. '9'] then
473- begin
474- Inc(Result);
475- Inc(PStr);
476- Inc(PPattern);
477- end else
478- Matched := false;
479- end;
480- 'D':
481- begin
482- if PStr^ in ['0' .. '9'] then
483- begin
484- while PStr^ in ['0' .. '9'] do
485- begin
486- Inc(Result);
487- Inc(PStr);
488- end;
489- Inc(PPattern);
490- end else
491- Matched := false;
492- end;
493- 'b': //String enclosed by '[' and ']'. The content may be an empty string.
494- begin
495- if PStr^ <> '[' then
496- begin
497- Matched := false;
498- end else
499- begin
500- F := false;
501- Escape := false; //After escape character
502- Inc(PStr); // '['
503- Inc(Result); // '['
504- repeat
505- if Escape then
506- begin
507- Escape := false;
508- end else
509- begin
510- if PStr^ = '\' then Escape := true;
511- if PStr^ = ']' then F := true;
512- end;
513- if PStr^ in LeadBytes then
514- begin
515- Inc(Result, 2);
516- Inc(PStr, 2);
517- end else
518- begin
519- Inc(Result);
520- Inc(PStr);
521- end;
522- until (PStr^ = #0) or F;
523- if not F then
524- Matched := false;
525- end;
526- Inc(PPattern);
527- end;
528- 'c': // String which can be the argument content enclosed by '[' and ']'
529- begin
530- Inc(PPattern);
531- if not (PStr^ = ']') then
532- begin
533- Escape := false;
534- repeat
535- if Escape then
536- Escape := false
537- else if PStr^ = ']' then
538- Break
539- else
540- if PStr^ = '\' then Escape := true;
541- if PStr^ in LeadBytes then
542- begin
543- Inc(Result, 2);
544- Inc(PStr, 2);
545- end else
546- begin
547- Inc(Result);
548- Inc(PStr);
549- end;
550- until (PStr^ = #0);
551- end else
552- Matched := false;
553- end;
554- 'm':
555- begin
556- if not (PStr^ in LeadBytes) then
557- begin
558- Inc(PPattern);
559- Inc(PStr);
560- Inc(Result);
561- end else Matched := false;
562- end;
563- 'M':
564- begin
565- if (PStr^ in LeadBytes) then
566- begin
567- Inc(PPattern);
568- Inc(PStr, 2);
569- Inc(Result, 2);
570- end else Matched := false;
571- end;
572- '.':
573- if (PStr^ in LeadBytes) then
574- begin
575- Inc(PPattern);
576- Inc(PStr, 2);
577- Inc(Result, 2);
578- end else
579- begin
580- Inc(PPattern);
581- Inc(PStr);
582- Inc(Result);
583- end;
584- else
585- if PStr^ = '%' then
586- begin
587- Inc(PStr);
588- Inc(Result);
589- end else
590- begin
591- Matched := false;
592- end;
593- end // of case
594- end else
595- begin
596- if PStr^ <> PPattern^ then
597- Matched := false
598- else
599- begin
600- Inc(Result);
601- Inc(PStr);
602- Inc(PPattern);
603- end;
604- end;
605- end; //of while
606- if not Matched then Result := 0;
607-end;
608-
609-procedure TSsParser.SetExtra(Index: integer; const Value: String);
610-begin
611- if (Index >= 0) and (Index <= FMarkUpList.Count-1) then
612- TSsMarkUp(FMarkUpList[Index]).Extra := Value
613- else
614- raise ESsParserError.Create(CMarkupIndexOutOfRange);
615-end;
616-
617-procedure TSsParser.SetInputString(const Value: String);
618-begin
619- FInputString := Value;
620- BeginParse;
621-end;
622-
623-procedure TSsParser.SetMetaPattern(const Value: TStrings);
624-begin
625- FMetaPattern.Assign(Value);
626-end;
627-
628-procedure TSsParser.SetOnParse(const Value: TSsParseEvent);
629-begin
630- FOnParse := Value;
631-end;
632-
633-procedure TSsParser.SetTagPattern(const Value: TStrings);
634-begin
635- FTagPattern.Assign(Value);
636-end;
637-
638-{ TSsMarkUp }
639-
640-constructor TSsMarkUp.Create(Pos: integer; MarkUpType: TSsMarkUpType; Str: String; Extra: String = '');
641-begin
642- FPos := Pos;
643- FMarkUpType := MarkUpType;
644- FStr := Str;
645- FExtra := Extra;
646-end;
647-
648-procedure TSsMarkUp.SetExtra(const Value: String);
649-begin
650- FExtra := Value;
651-end;
652-
653-end.
Binary files a/sakurasuite/SsPlayTime.dcr and /dev/null differ
--- a/sakurasuite/SsPlayTime.pas
+++ /dev/null
@@ -1,384 +0,0 @@
1-{*************************************************************}
2-{ TSsPlayTime Component - Estimates SakuraScript playing time }
3-{ }
4-{ Copyright (c) 2001-2003 naruto/CANO-Lab }
5-{*************************************************************}
6-
7-unit SsPlayTime;
8-
9-interface
10-
11-uses
12- Windows, SysUtils, Classes, SsParser;
13-
14-type
15- TSsPlayTimeException = class(Exception);
16- TSsPlayTimeInitException = class(TSsPlayTimeException);
17-
18- TSsPlayTimeSpecialChar = class(TCollectionItem)
19- private
20- FWait: integer;
21- FChar: String;
22- procedure SetChar(const Value: String);
23- procedure SetWait(const Value: integer);
24- protected
25- function GetDisplayName: String; override;
26- public
27- procedure Assign(Source: TPersistent); override;
28- function DisplayChar: String;
29- published
30- property Char: String read FChar write SetChar;
31- property Wait: integer read FWait write SetWait;
32- end;
33-
34- TSsPlayTimeSpecialChars = class(TCollection)
35- end;
36-
37- TSsPlayTimeParams = class(TComponent)
38- private
39- FCostWait: integer;
40- FCostDBChar: integer;
41- FCostChar: integer;
42- FCostConst: integer;
43- FCostHiResWait: integer;
44- FCostSurface: integer;
45- FCostQuickChar: integer;
46- FProfileName: String;
47- FSpecialChars: TSsPlayTimeSpecialChars;
48- procedure SetCostChar(const Value: integer);
49- procedure SetCostConst(const Value: integer);
50- procedure SetCostDBChar(const Value: integer);
51- procedure SetCostWait(const Value: integer);
52- procedure SetCostHiResWait(const Value: integer);
53- procedure SetCostSurface(const Value: integer);
54- procedure SetCostQuickChar(const Value: integer);
55- procedure SetProfileName(const Value: String);
56- procedure SetSpecialChars(const Value: TSsPlayTimeSpecialChars);
57- public
58- constructor Create(AOwner: TComponent); override;
59- destructor Destroy; override;
60- procedure Assign(Source: TPersistent); override;
61- published
62- property ProfileName: String read FProfileName write SetProfileName;
63- property CostConst: integer read FCostConst write SetCostConst default 0;
64- property CostWait: integer read FCostWait write SetCostWait default 50;
65- property CostHiResWait: integer read FCostHiResWait write SetCostHiResWait default 1;
66- property CostSurface: integer read FCostSurface write SetCostSurface default 5;
67- property CostChar: integer read FCostChar write SetCostChar default 50;
68- property CostDBChar: integer read FCostDBChar write SetCostDBChar default 50;
69- property CostQuickChar: integer read FCostQuickChar write SetCostQuickChar default 0;
70- property SpecialChars: TSsPlayTimeSpecialChars read FSpecialChars write SetSpecialChars;
71- end;
72-
73- TSsPlayTimeCount = record
74- Wait: integer;
75- HiResWait: integer;
76- Surface: integer;
77- Char: integer;
78- DBChar: integer;
79- QuickChar: integer;
80- Specials: integer;
81- end;
82-
83- TSsPlayTime = class(TComponent)
84- private
85- FPlayTimeParams: TSsPlayTimeParams;
86- FSsParser: TSsParser;
87- FCounts: TSsPlayTimeCount;
88- procedure SetPlayTimeParams(const Value: TSsPlayTimeParams);
89- procedure SetSsParser(const Value: TSsParser);
90- protected
91- procedure CountElements;
92- procedure CountCharacterType(const Str: String; out SB, DB,
93- SPNum, SPWait: integer);
94- public
95- function PlayTime(const Script: String): integer;
96- property Counts: TSsPlayTimeCount read FCounts;
97- published
98- property PlayTimeParams: TSsPlayTimeParams read FPlayTimeParams write SetPlayTimeParams;
99- property SsParser: TSsParser read FSsParser write SetSsParser;
100- end;
101-
102-procedure Register;
103-
104-implementation
105-
106-const
107- CDBWhiteSpace = #129 + #64; // Shift_JIS DB White Space;
108-
109-procedure Register;
110-begin
111- RegisterComponents('Samples', [TSsPlayTime, TSsPlayTimeParams]);
112-end;
113-
114-{ TSsPlayTimeParams }
115-
116-procedure TSsPlayTimeParams.Assign(Source: TPersistent);
117-var
118- Src: TSsPlayTimeParams;
119-begin
120- if not (Source is TSsPlayTimeParams) then
121- inherited
122- else
123- begin
124- Src := Source as TSsPlayTimeParams;
125- FCostConst := Src.FCostConst;
126- FCostWait := Src.FCostWait;
127- FCostHiResWait := Src.FCostHiResWait;
128- FCostSurface := Src.FCostSurface;
129- FCostChar := Src.FCostChar;
130- FCostDBChar := Src.FCostDBChar;
131- FCostQuickChar := Src.FCostQuickChar;
132- FProfileName := Src.FProfileName;
133- FSpecialChars.Assign(Src.SpecialChars);
134- end;
135-end;
136-
137-constructor TSsPlayTimeParams.Create(AOwner: TComponent);
138-begin
139- inherited;
140- FCostConst := 0;
141- FCostWait := 50;
142- FCostHiResWait := 1;
143- FCostSurface := 5;
144- FCostChar := 50;
145- FCostDBChar := 50;
146- FCostQuickChar := 0;
147- FSpecialChars := TSsPlayTimeSpecialChars.Create(TSsPlayTimeSpecialChar);
148-end;
149-
150-destructor TSsPlayTimeParams.Destroy;
151-begin
152- FSpecialChars.Free;
153- inherited;
154-end;
155-
156-procedure TSsPlayTimeParams.SetCostChar(const Value: integer);
157-begin
158- FCostChar := Value;
159-end;
160-
161-procedure TSsPlayTimeParams.SetCostConst(const Value: integer);
162-begin
163- FCostConst := Value;
164-end;
165-
166-procedure TSsPlayTimeParams.SetCostDBChar(const Value: integer);
167-begin
168- FCostDBChar := Value;
169-end;
170-
171-procedure TSsPlayTimeParams.SetCostHiResWait(const Value: integer);
172-begin
173- FCostHiResWait := Value;
174-end;
175-
176-procedure TSsPlayTimeParams.SetCostQuickChar(const Value: integer);
177-begin
178- FCostQuickChar := Value;
179-end;
180-
181-procedure TSsPlayTimeParams.SetCostSurface(const Value: integer);
182-begin
183- FCostSurface := Value;
184-end;
185-
186-procedure TSsPlayTimeParams.SetCostWait(const Value: integer);
187-begin
188- FCostWait := Value;
189-end;
190-
191-procedure TSsPlayTimeParams.SetProfileName(const Value: String);
192-begin
193- FProfileName := Value;
194-end;
195-
196-procedure TSsPlayTimeParams.SetSpecialChars(
197- const Value: TSsPlayTimeSpecialChars);
198-begin
199- FSpecialChars.Assign(Value);
200-end;
201-
202-{ TSsPlayTime }
203-
204-procedure TSsPlayTime.CountCharacterType(const Str: String; out SB,
205- DB, SPNum, SPWait: integer);
206-var
207- i, j: integer;
208- InLeadByte, Flag: boolean;
209- AChar: TSsPlayTimeSpecialChar;
210-begin
211- SB := 0;
212- DB := 0;
213- SPNum := 0;
214- SPWait := 0;
215- InLeadByte := false;
216- for i := 1 to Length(Str) do
217- begin
218- if InLeadByte then
219- begin
220- Inc(DB);
221- InLeadByte := false;
222- end
223- else
224- begin
225- Flag := false;
226- for j := 0 to PlayTimeParams.SpecialChars.Count-1 do
227- begin
228- AChar := PlayTimeParams.SpecialChars.Items[j] as TSsPlayTimeSpecialChar;
229- if Length(AChar.Char) = 2 then
230- begin
231- if Str[i] + Str[i+1] = AChar.Char then
232- begin
233- Inc(SPWait, AChar.Wait);
234- Inc(SPNum);
235- Dec(DB);
236- Flag := true;
237- InLeadByte := true;
238- Break;
239- end;
240- end else
241- begin
242- if Str[i] = AChar.Char then
243- begin
244- Inc(SPWait, AChar.Wait);
245- Inc(SPNum);
246- Flag := true;
247- Break;
248- end;
249- end;
250- end;
251- if not Flag then
252- begin
253- if Str[i] in LeadBytes then
254- InLeadByte := true
255- else
256- Inc(SB);
257- end;
258- end;
259- end;
260-end;
261-
262-procedure TSsPlayTime.CountElements;
263-var
264- i, SB, DB, SPNum, SPWait: integer;
265- Mark: String;
266- InQuick: boolean;
267-begin
268- ZeroMemory(@FCounts, sizeof(FCounts));
269- InQuick := false;
270- with SsParser do
271- begin
272- for i := 0 to SsParser.Count-1 do
273- begin
274- Mark := Str[i];
275- case MarkUpType[i] of
276- mtTag:
277- begin
278- if Mark = '\_q' then
279- InQuick := not InQuick
280- else if Match(Mark, '\w%d') = 3 then
281- FCounts.Wait := FCounts.Wait + Ord(Mark[3]) - Ord('0')
282- else if Match(Mark, '\_w[%D]') > 0 then
283- Inc(FCounts.HiResWait, StrToInt(GetParam(Mark, 0)))
284- else if Match(Mark, '\s%d') = 3 then
285- Inc(FCounts.Surface)
286- else if Match(Mark, '\s%b') > 0 then
287- Inc(FCounts.Surface)
288- end;
289- mtMeta, mtStr:
290- begin
291- if InQuick then
292- begin
293- CountCharacterType(Mark, SB, DB, SPNum, SPWait);
294- Inc(FCounts.QuickChar, SB + DB + SPNum);
295- end else
296- begin
297- CountCharacterType(Mark, SB, DB, SPNum, SPWait);
298- Inc(FCounts.Char, SB);
299- Inc(FCounts.DBChar, DB);
300- Inc(FCounts.Specials, SPWait);
301- end;
302- end;
303- // Ignore all tag errors
304- end;
305- end;
306- end;
307-end;
308-
309-function TSsPlayTime.PlayTime(const Script: String): integer;
310-begin
311- Result := 0;
312- if FSsParser = nil then
313- raise TSsPlayTimeInitException.Create('SsParser is not set');
314- if FPlayTimeParams = nil then
315- raise TSsPlayTimeInitException.Create('PlayTimeParams is not set');
316- SsParser.InputString := Script;
317- CountElements;
318- with PlayTimeParams do
319- Result := CostConst + CostWait * FCounts.Wait + CostSurface * FCounts.Surface +
320- CostHiResWait * FCounts.HiResWait + CostChar * FCounts.Char +
321- CostDBChar * FCounts.DBChar + FCounts.Specials +
322- CostQuickChar * FCounts.QuickChar;
323-end;
324-
325-procedure TSsPlayTime.SetPlayTimeParams(const Value: TSsPlayTimeParams);
326-begin
327- FPlayTimeParams := Value;
328-end;
329-
330-procedure TSsPlayTime.SetSsParser(const Value: TSsParser);
331-begin
332- FSsParser := Value;
333-end;
334-
335-{ TSsPlayTimeSpecialChar }
336-
337-procedure TSsPlayTimeSpecialChar.Assign(Source: TPersistent);
338-begin
339- if not(Source is TSsPlayTimeSpecialChar) then
340- inherited
341- else
342- begin
343- Self.FChar := (Source as TSsPlayTimeSpecialChar).FChar;
344- Self.FWait := (Source as TSsPlayTimeSpecialChar).FWait;
345- end;
346-end;
347-
348-function TSsPlayTimeSpecialChar.DisplayChar: String;
349-begin
350- if FChar = ' ' then
351- Result := '(SP)'
352- else if FChar = CDBWhiteSpace then
353- Result := '(DB SP)'
354- else
355- Result := FChar;
356-end;
357-
358-function TSsPlayTimeSpecialChar.GetDisplayName: String;
359-begin
360- Result := Format('"%s" = %d', [DisplayChar, FWait]);
361-end;
362-
363-procedure TSsPlayTimeSpecialChar.SetChar(const Value: String);
364-begin
365- if Value = '' then
366- FChar := Value
367- else
368- begin
369- if (Value[1] in LeadBytes) then
370- begin
371- if Length(Value) = 2 then
372- FChar := Value;
373- end else if Length(Value) = 1 then
374- FChar := Value;
375- end;
376-end;
377-
378-procedure TSsPlayTimeSpecialChar.SetWait(const Value: integer);
379-begin
380- FWait := Value;
381-end;
382-
383-end.
384-
\ No newline at end of file
--- a/sakurasuite/manual/directsstp.html
+++ /dev/null
@@ -1,144 +0,0 @@
1-<html>
2-
3-<head>
4-<meta http-equiv="Content-Type" content="text/html; charset=shift_jis">
5-<meta name="GENERATOR" content="Microsoft FrontPage 4.0">
6-<meta name="ProgId" content="FrontPage.Editor.Document">
7-<title>TDirectSSTP</title>
8-<link rel="stylesheet" type="text/css" href="sakurasuite.css">
9-</head>
10-
11-<body>
12-
13-<dl>
14-</dl>
15-<h1>TDirectSSTP</h1>
16-<h2>概要</h2>
17-<p>さくらスクリプト通信プロトコル(SSTP)を使って、ローカルホスト上のSSTPサーバと通信するコンポーネントです。</p>
18-<p>DirectSSTPにのみ対応しています。</p>
19-<h2>リファレンス - プロパティ</h2>
20-<h3><code>SenderName: String [読/書][設/実]</code></h3>
21-<p>SSTPのSenderヘッダ文字列を設定します。つまり送り手のアプリケーション(Delphi側)のアプリケーション名です。自分が開発しているアプリケーションの名前を入れてください。デフォルトは「My
22-Program」ですが、必ず変更する必要があります。</p>
23-<h3><code>StatusCode: Integer [読のみ][実のみ]</code></h3>
24-<p>最後に発行したSSTPリクエストによって帰ってきた、ステータスコードの数値が入ります。OKなら200番台、それ以外ならエラーです。詳しくは、SSTP仕様書をご覧ください。</p>
25-<ul>
26- <li>UnknownError(=-1000)定数がStatusCodeに入ることがあります。これはサーバが落ちていたなどの理由で応答がまったく得られなかったときの数値です。</li>
27-</ul>
28-<h3><code>SentLog: String [読のみ][実のみ]</code></h3>
29-<p>最後に発行したSSTP文がそのまま入っています。チェックにどうぞ。再送の直後にも再送のときに発行した文が入っています。</p>
30-<h3><code>RecvLog: String [読のみ][実のみ]</code></h3>
31-<p>最後に行った通信による、SSTPサーバからのレスポンスが全部記録されています。再送の直後にも再送のときのレスポンスが入っています。</p>
32-<h3><code>LastStatus: TSstpResult; [読のみ][実のみ]</code></h3>
33-<p>最後のSSTPサーバからのレスポンスが、TSstpResult型(コード参照)で入っています。</p>
34-<ul>
35- <li>srUnknownErrorは、何らかの事情でSSTPサーバからの応答がまったく得られなかった場合のエラーです。これは、TDirectSSTP側のタイムアウト、あるいはSSTPサーバのビジー状態(Conflictとは違う)などが原因で発生します。</li>
36-</ul>
37-<h3><code>CueCount: integer; [読のみ][実のみ]</code></h3>
38-<p>再送キューに現在入っているSENDメッセージの数を返します。</p>
39-<h3><code>Interval: integer; [読/書][設/実]</code></h3>
40-<p>再送キューから再送を行う間隔をミリ秒で指定します。1000より小さい値も設定できますが、SSTPサーバに過負荷を与える可能性がありますので、できるだけ設定しないようにしてください。</p>
41-<h3><code>Sleep: boolean; [読/書][設/実]</code></h3>
42-<p>再送キューからの再送を一時停止します。Sleep = trueの間は、SstpSENDCueメソッドによってメッセージが入力されても、コンポーネント内部で記憶されるだけで、実際にはSSTPサーバには送信されません。Sleep
43-= falseになったときに、送信され始めます。</p>
44-<h3><code>TargetHWnd: THandle; [読/書][設/実]</code><span class="direct">[DirectSSTP]</span></h3>
45-<p>ターゲットウィンドウハンドルを設定します。</p>
46-<h3><code>Handle: THandle; [読のみ][実のみ]</code><span class="direct">[DirectSSTP]</span></h3>
47-<p>FastSSTPは、内部でウィンドウハンドルを1つ作成し、これを使ってSSTPサーバとDirectSSTP通信を行います。<br>
48-このプロパティは、そのウィンドウハンドルを返します。DirectSSTPでSSTP文のHWndに設定させれるハンドルです。<br>
49-独自のSSTP文を作りたいのでない限り、直接利用することはあまりないと思います。</p>
50-<h2>メソッド</h2>
51-<h3><code>function TFastSstp.SstpSEND(const Script: String;<br>
52-const Option: TSstpSendOptions = []): TSstpResult; overload;</code></h3>
53-<h3><code>function SstpSEND(const Script: TStrings;<br>
54-const Option: TSstpSendOptions = [];<br>
55-const Handle: HWND = 0): TSstpResult; overload;</code></h3>
56-<p>SENDリクエストをすぐに送信します。自動的にSSTPサーバと接続し、SENDリクエストを送信し、ステータスコードを受け取ります。Scriptには、認識可能なさくらスクリプト本文を、Optionには、set
57-of (soNoDescript, soNoTranslate)を渡します。</p>
58-<p>オーバーロード関数ですので、引数によって適切な方が呼ばれます。</p>
59-<p>第1の呼び出しは、引数にString型を取る、SSTP/1.1相当の単純なSENDリクエストを送信します。</p>
60-<p>第2の呼び出しは、SSTP/1.2および1.3に対応します。引数にTStrings型を取ります。Script:
61-TStringsはメソッド内部では解放されませんので自前で解放処理してください。Scriptの1行目(Script[0])がScriptエントリに、2行目以降はEntryエントリに変換されて送信されます。</p>
62-<p><span class="tcpip">[TCP/IP]</span> TCP/IPで送信する場合、Handleに0以外の値を設定すると、HWndエントリが送信されます。不要ならHandle=0としてください。</p>
63-<p><span class="direct">[DirectSSTP]</span> DirectSSTPモードでは、Handleの値が優先されますが、これが省略された場合でも、デフォルトのHWndエントリが送信されます(当然)。</p>
64-<p>戻り値はTSstpResult列挙型の値です。ステータスコードの数値自体で結果を知りたい場合はStatusCodeプロパティを使用してください。</p>
65-<ul>
66- <li>第1の呼び出しの場合、引数のString型変数に改行文字(#13#10)を含めないでください。
67- <li>第2の呼び出しの場合、引数のTString型の各行の文字列に改行文字を含めないでください。
68- <li><span class="tcpip">[TCP/IP]</span> SSTP/1.2以降の呼び出しを行う場合は、<em>タイムアウト時間に注意してください。</em>デフォルトのタイムアウト時間は1500msですので、この時間を過ぎるとSSTPサーバからのレスポンスを待たず、自分から通信を切断してしまうことになります(ステータスコードはUnknownErrorとなります)。選択肢のあるSendリクエストの前にタイムアウト時間を十分長いもの(最低10秒以上)に設定してください。
69- <li>選択肢を含むスクリプトを、materiaとの組み合わせで使用する場合、materiaが反応を返さないことがあります。(CROW,
70- SSPを初めとしたその他のSSTPサーバではそのようなことはありません)<br>
71- この問題を避けるためには、選択肢を含むスクリプトをmateriaで再生しないようにしてください。(問題の修正には送信部のスレッド化が必要です)</li>
72-</ul>
73-<h3><code>function TFastSstp.SstpSENDCue(const Script: String;<br>
74-const HighPriority: boolean = false;<br>
75-const Option: TSstpSendOptions = []): integer;</code></h3>
76-<p>SENDリクエストを、再送モードで送信します。このメソッドで呼び出された場合、そのスクリプトはすぐには送信されず、再送キュー(FSendCue)に入ります。再送キューに送られたスクリプトは、Intervalミリ秒間隔で、自動的にSSTPサーバに送信されます。Intervalプロパティも参照してください。</p>
77-<p>HighPriority = trueの場合、キューの先頭に配置されますので、すぐに送信されます。falseの場合は、キューの後ろ側に付け足されます。</p>
78-<p>キューが空だった場合を除き、すぐに送信されるわけではないので、戻り値はTSstpResult型ではありません。代わりに、そのメッセージを識別するinteger値がIDとして生成され、返されます。再送に関係する各種イベントは、メッセージの再送のときに、このIDをパラメータとして渡しますので、IDを記憶しておく事で、メッセージを同定することが可能です。</p>
79-<h3><code>function TFastSstp.SstpEXECUTE(const Command: String): String;</code></h3>
80-<p>EXECUTEリクエストを送信します。自動的にSSTPサーバと接続し、EXECUTEリクエストを送信し、ステータスコードと追加データを受け取ったあと切断します。</p>
81-<p>追加データはString変数に入っています。</p>
82-<p>関数呼び出しが成功したかどうかについては、LastStatusプロパティで参照してください。</p>
83-<h3><code>function TFastSstp.SstpCOMMUNICATE(const Sentence: String<br>
84-&nbsp; const Port: integer = 0): TSstpResult;</code></h3>
85-<p>COMMUNICATE/1.2リクエストを送信します。Portに0を指定する(引数を省略すれば自動的に0になります)場合、COMMUNICATE/1.1相当のリクエストとなります。Portに0以外の値を指定すれば、COMMUNICATE/1.2相当のリクエストとなります。</p>
86-<ul>
87- <li>FastSSTPはSSTPクライアントコンポーネントであり、サーバ機能は提供していません。したがって、COMMUNIATE/1.2を実際に有効に使うには、現状では、他の方法でSSTPサーバを作成するしかありません。SSTPサーバ機能提供は未定です。</li>
88-</ul>
89-<h3><code>function TFastSstp.SstpGIVE(const Document: String): TSstpResult;</code></h3>
90-<p>GIVE/1.0リクエストを送信します。内部でSstpGIVE1_1メソッドを呼び出します。互換性のために残っていますが、使っても差し支えありません。</p>
91-<h3><code>function TFastSstp.SstpGIVE1_1(const Data: String;<br>
92-const DataType: TGiveType = gtDocument): TSstpResult;</code></h3>
93-<p>GIVE/1.1リクエストを送信します。DataTypeには、gtDocumentまたはgtSongnameを渡します。<br>
94-Dataパラメータに、それに応じたデータを渡してください。</p>
95-<p>戻り値はサーバからの応答です。</p>
96-<h3><code>function TFastSstp.SstpExGetName: String;</code></h3>
97-<p>EXECUTEメソッドでgetnameコマンドを発行し、その結果の文字列を返します。</p>
98-<h3><code>function TFastSstp.SstpExSetCookie(const Key, Value: String):
99-TSstpResult;</code></h3>
100-<p>EXECUTEメソッドでSetCookieコマンドを発行します。<br>
101-複数行のデータには対応しません(つまり、#13#10が含まれるデータの改行は自動的に消します)</p>
102-<h3><code>function TFastSstp.SstpExGetCookie(const Key: String): String;</code></h3>
103-<p>EXECUTEメソッドでGetCookieコマンドを発行し、その結果の文字列を返します。<br>
104-複数行のデータには対応しません(つまり、#13#10が含まれるデータの改行は自動的に消します)</p>
105-<h3><code>function TFastSstp.SstpExGetVersion: String;</code></h3>
106-<p>EXECUTEメソッドでGetVersionを発行し、ステータスコードを返します。</p>
107-<h3><code>function TFastSstp.SstpExQuiet(const Quiet: boolean): TSstpResult;</code></h3>
108-<p>EXECUTEメソッドでQuietまたはRestoreを発行し、ステータスコードを返します。<br>
109-Quiet = trueでQuiet, Quiet = falseでRestoreを発行です。</p>
110-<h3><code>procedure ClearCue;</code></h3>
111-<p>再送キューに入っているメッセージを全部削除します。</p>
112-<h2>イベント</h2>
113-<h3><code>OnResendResend</code></h3>
114-<p>再送キューのメッセージの送信に失敗し、そのメッセージをもう一度後で送りなおすと決定されたときに発生します。<br>
115-このイベントハンドラの中で、LastStatus, StatusCodeにアクセスできます。</p>
116-<h3><code>OnResendEnd</code></h3>
117-<p>再送キューのメッセージの送信に成功し、そのメッセージを再送キューから削除するときに発生します。<br>
118-このイベントハンドラの中で、LastStatus, StatusCodeにアクセスできます。</p>
119-<h3><code>OnResendTrying</code></h3>
120-<p>再送キューのメッセージの送信直前に発生します。</p>
121-<h3><code>OnResendCountChange</code></h3>
122-<p>再送キューの登録数が変わった直後に発生します。登録数は、CueCountプロパティで参照してください。</p>
123-<h3><code>OnAfterConnection</code></h3>
124-<p>全てのSSTPリクエストが送信し終わった直後に発生します。RecvLog,
125-SentLog, LastStatus, StatusCodeの各プロパティにアクセスできます。SSTP文の発行回数のカウントくらいには使えるかもしれません。<br>
126-内部処理が違うので、SstpExTimeOutの場合には発生しません。</p>
127-<h2>例</h2>
128-<p>新規アプリケーションを1つ作成し、フォームにTFastSstpを1つ配置します。SenderNameプロパティに、適当な名前を付けてあげてください。フォームのOnCreateイベントに次のように書きます。</p>
129-<pre><code>procedure TForm1.Form1OnCreate(Sender: TObject);
130-begin
131- FastSstp1.SstpSEND('\s0\hテストプログラムが起動したよ。\e', [soNoDescript]);
132-end;</code></pre>
133-<p>あとはこのアプリケーションを実行するだけです。</p>
134-<h2>再送についての全般的注意</h2>
135-<ul>
136- <li>Intervalを小さな値にしすぎないように気をつけてください。
137- <li>再送が行われたとき、RecvLog, SentLog, LastStatus, StatusCodeの各プロパティは変化します。したがって、SstpSENDCueメソッドと、他のSSTPメソッドを併用する場合は、これらのプロパティにアクセスする前に再送が始まらないように注意してください。例えば、ボタンのOnClickイベントでSstpCOMMUNICATEメソッドを利用した場合は、LastStatus等のプロパティには、そのOnClickイベント内でのみアクセスするか、これらのプロパティの値が必要なくなるまで、Sleep
138- := trueにするようにします。(再送機能を一切行わない場合は気にする必要はありません)
139- <li>再送機能を使った場合、順番は保持されます。つまり、あとから送ったメッセージは必ず先に送ったメッセージより後に届きます。が、SstpSENDCueを使って送信したメッセージとメッセージの間に、他のSSTP対応ソフトや、このコンポーネント自身からの、別のメッセージが挟まって届く可能性は十分ありますので注意してください。Quietを併用する手もありますが。</li>
140-</ul>
141-
142-</body>
143-
144-</html>
--- a/sakurasuite/manual/index.html
+++ /dev/null
@@ -1,48 +0,0 @@
1-<html>
2-
3-<head>
4-<meta http-equiv="Content-Language" content="ja">
5-<meta name="GENERATOR" content="Microsoft FrontPage 5.0">
6-<meta name="ProgId" content="FrontPage.Editor.Document">
7-<link rel="stylesheet" type="text/css" href="sakurasuite.css">
8-</head>
9-
10-<body>
11-
12-<h1>Sakura Component Suite</h1>
13-<p>
14-このコンポーネント集は、伺か、CROW、SSP等のキャラクタエージェントソフト(以下、これらのアプリケーションを「伺か互換ベースウェア」と呼びます)関連のユーティリティ的な動作を実現するコンポーネント集です。また、SSTP
15-Bottle ( <a href="http://bottle.mikage.to">http://bottle.mikage.to</a>
16-)用のコンポーネントも含まれています。</p>
17-<p>かなり雑多です。</p>
18-<h2>コンポーネント一覧</h2>
19-<h3><a href="sakuraseeker.html">TSakuraSeeker</a></h3>
20-<p>TSakuraSeekerは、FMOを取得して、既存の伺か互換システムのプロセスを発見します。</p>
21-<h3><a href="ssparser.html">TSsParser</a></h3>
22-<p>TSsParserは、さくらスクリプト解析用のパーサコンポーネントです。さくらスクリプトを高速に解析します。</p>
23-<h3><a href="ssplaytime.html">TSsPlayTime, TSsPlayTimeParams</a></h3>
24-<p>これらのコンポーネントによって、さくらスクリプトの再生にかかる時間を予測することが可能です。</p>
25-<h3><a href="sakurascriptfountain.html">TSakuraScriptFountain</a></h3>
26-<p>TSakuraScriptFountainは、本田勝彦氏作のコンポーネント、TEditor用の文字列解析パーサ(TFountain)です。</p>
27-<p>TEditorおよびTSsParserと組み合わせて使うことで、さくらスクリプトを瞬間に色分け・構文協調して表示するエディタを、コードレスで実現できます。</p>
28-<p>RichEditを利用して自分で描画するよりダントツで高速です。</p>
29-<h3><a href="directsstp.html">TDirectSSTP</a></h3>
30-<p>TDirectSSTPは、DirectSSTP通信を行います。</p>
31-<h3><a href="slpp20.html">TIdSLPP20</a></h3>
32-<p>SSTP Bottle サービスに接続するSLPPコンポーネントです。</p>
33-<h2>制作環境</h2>
34-<p>Borland Delphi Studio 7 Professional</p>
35-<p>こちらでコンパイルできることを確認しているのはBorland Delphi 6 Personal版です。Delphi 5でも多分動くと思います。</p>
36-<h2>ライセンス</h2>
37-<p>このアーカイブに含まれるすべてのソースコード、およびドキュメントはフリーソフトウェアとします。</p>
38-<p>
39-ソースコード形式・バイナリ形式によるあらゆる利用・再配布・改造・再パッケージング・再ライセンス・販売は、改変の有無に関わらず、以下の条件のもとで行ってください。</p>
40-<ul>
41- <li>
42- すべては現状のまま配布されるものであり、動作した、あるいは動作しなかった結果による、物質的・人的・電子的・経済的・その他一切の破損・損害・損失について原作者(naruto/CANO-Lab)は何らの責任を負いません。</li>
43-</ul>
44-<p>作者はサポート・バグの修正などを、可能なら行いますが義務ではありません。</p>
45-
46-</body>
47-
48-</html>
\ No newline at end of file
--- a/sakurasuite/manual/sakuraprocess.html
+++ /dev/null
@@ -1,52 +0,0 @@
1-<html>
2-
3-<head>
4-<meta http-equiv="Content-Language" content="ja">
5-<meta name="GENERATOR" content="Microsoft FrontPage 4.0">
6-<meta name="ProgId" content="FrontPage.Editor.Document">
7-<meta http-equiv="Content-Type" content="text/html; charset=shift_jis">
8-<title>新しいページ 0</title>
9-<link rel="stylesheet" type="text/css" href="sakurasuite.css">
10-</head>
11-
12-<body>
13-
14-<h1>TSakuraProcess</h1>
15-<h2>概要</h2>
16-<p>TSakuraSeekerの、プロセスを取得するプロパティが返すもので、単一の伺か互換システムのプロセスを表現します。</p>
17-<p>TSakuraSeekerによって自動的に管理されますので、Create, Freeしないでください。</p>
18-<h2>継承</h2>
19-<p>TObject - TSakuraProcess</p>
20-<h2>参照</h2>
21-<p><a href="sakuraseeker.html">TSakuraSeeker</a></p>
22-<h2>簡単な使用例</h2>
23-<p><a href="sakuraseeker.html">TSakuraSeeker</a>参照</p>
24-<h2>リファレンス - プロパティ</h2>
25-<dl>
26- <dt>property ProcessID: String</dt>
27- <dd>プロセスIDです。ただし、当初の仕様ではプロセスハンドルのMD5値ですが、Materia以外の多ゴースト対応環境SSTPサーバでは拡張されています。要するにゴースト(プロセスではなく)ごとにユニークである何らかの文字列値が入っている、と考えてください。<br>
28- ユーザが代入はできますがそうすることに意味はありません。</dd>
29- <dt>property FMOName: String</dt>
30- <dd>FMO識別名です。基本的に「Sakura」が入りますが、他のFMOからプロセスを読み取った場合にはそれが入ります。<code>TSakuraSeeker.FileMappingTarget</code>
31- プロパティを参照してください。</dd>
32- <dt>property HWnd: THandle</dt>
33- <dd>プロセスのウィンドウハンドルです。現在の多くのSSTPサーバの環境では1つのウィンドウハンドルで多数のゴーストのSSTPを受信することが可能になっていますので、これをキーに値を検索するような実装は行わないでください。</dd>
34- <dt>property Name: String</dt>
35- <dd>ゴーストの本体側(スコープ0側)の名前です。<code>Data['name']</code> と同等です。<br>
36- ユーザが書き込みはできますがそうする意味はまずありません。</dd>
37- <dt>property KeroName: String</dt>
38- <dd>ゴーストのうにゅう側(スコープ1側)の名前です。<code>Data['keroname']</code> と同等です。<br>
39- ユーザが書き込みはできますがそうする意味はまずありません。</dd>
40- <dt>property SetName: String</dt>
41- <dd>本体側とうにゅう側の名前をコンマで結合したものを返します。</dd>
42- <dt>property Data[Key: String]: String</dt>
43- <dd>プロセスのエントリ名から直接値を取得します。</dd>
44- <dt>property Count: integer read GetCount;<br>
45- property DataAt[Index: integer]: String<br>
46- property KeyAt[Index: integer]: String</dt>
47- <dd>これらは、すべてのエントリ名を順番に走査したい場合に使用できます。それぞれ読んで字のごとくです。読み取り専用プロパティです。</dd>
48-</dl>
49-
50-</body>
51-
52-</html>
--- a/sakurasuite/manual/sakurascriptfountain.html
+++ /dev/null
@@ -1,80 +0,0 @@
1-<html>
2-
3-<head>
4-<meta http-equiv="Content-Language" content="ja">
5-<meta name="GENERATOR" content="Microsoft FrontPage 5.0">
6-<meta name="ProgId" content="FrontPage.Editor.Document">
7-<meta http-equiv="Content-Type" content="text/html; charset=shift_jis">
8-<title>TSakuraScriptFountain</title>
9-<link rel="stylesheet" type="text/css" href="sakurasuite.css">
10-</head>
11-
12-<body>
13-
14-<h1>TSakuraScriptFountain</h1>
15-<h2>概要</h2>
16-<p><code>TSsParser</code>と協調して動く、<code>TEditor</code>用文字列解析パーサです。</p>
17-<p><code>TEditor</code>は本田勝彦氏作成のエディタコンポーネントで、たとえばDelphiのソースコードエディタ部分のようなものが簡単に実装できます。詳細は
18-<a href="http://member.nifty.ne.jp/~katsuhiko/">
19-http://member.nifty.ne.jp/~katsuhiko/</a> を参照してください。</p>
20-<p><code>TSakuraScriptFountain</code>
21-を使うと、自動で構文が強調表示されるさくらスクリプトエディタが、簡単に実装できます。</p>
22-<p>
23-各種の栞の実装においてユーザが利用する、様々なさくらスクリプト仕様外のマークアップには対応していません。(適当にこのコンポーネントを継承して使う必要があります)</p>
24-<h2>基本的な使い方</h2>
25-<p><code>TSsParser</code>をフォームに貼り付けます。最低限、<code>MetaPattern</code>,
26-<code>TagPattern</code>の両方を定義する必要があります。<code>EscapeInvalidMeta,
27-LeaveEscape</code>の各プロパティの設定は、どのようにしていても問題ありません。</p>
28-<p><code>TSakuraScriptFountain</code>をフォームに貼り付けます。オブジェクトインスペクタで、<code>SsParser</code>プロパティに、先ほど貼り付けた<code>SsParser</code>を選択します。また、色やフォントに関する各種プロパティを編集します。</p>
29-<p><code>TEditor</code>をフォームに貼り付けます。オブジェクトインスペクタで、<code>Fountain</code>プロパティに、先ほど貼り付けた<code>SakuraScriptFountain</code>を選択します。</p>
30-<p>アプリケーションを実行します。</p>
31-<h2>注意</h2>
32-<p><code>TSsParser</code>を内部で利用しますが、<code>InputString</code>などの中身は変更されません。他の目的でフォームに
33-<code>TSsParser</code> を貼り付けて利用している場合には、<code>TEditor.Fountain</code>
34-としてそれを参照しても、既存のコードへの影響はありません。</p>
35-<p><code>SakuraScriptFountain</code>のタグの解釈は<code>TSsParser</code>に依存します。<code>TagPattern</code>をろくに設定せず、\hや\uが含まれていない、といった状況のままでは一切の色分けがされません。</p>
36-<h3>\_sタグ周りについて</h3>
37-<p><code>TSakuraScriptFountain</code>では、<code>\_s</code>タグは「囲むタグ」であると解釈しており、<code>\_s</code>によるシンクロナイズセッションは、<code>\0</code>や<code>\1</code>によるスコープより優先順位が高く
38-、かつ独立した一種の状態である、と解釈します。つまり、シンクロナイズセッション状態は、<code>\0</code>や<code>\1</code>では解除されず、また\_s内において<code>\0</code>や<code>\1</code>タグが存在した場合、それらは単純に「シンクロナイズセッションを出た後のスコープを決定する」だけです。</p>
39-<p>この解釈は2003年6月現在のmateria、SSP、CROW(と、他の多くのSakuraScript処理系)の各最新版に準拠となっていますが、一部の古い処理系では、<code>\0</code>や<code>\1</code>によってシンクロナイズセッションの状態に影響を与える挙動をしているものがあります。</p>
40-<p>また、2003年6月現在最新版であるmateria583では、シンクロナイズセッション中に<code>\0</code>や<code>\1</code>が現れた場合に誤動作する、シンクロナイズセッションの明示的な解除後にスコープが不定となる、といったバグが存在します。(これらは明らかにバグと思われる挙動であるため<code>TSakuraScriptFountain</code>でこれらの動作を再現する予定はありません)</p>
41-<h2>リファレンス - プロパティ</h2>
42-<dl>
43- <dt>property Scope0Color: TFountainColor read FScope0Color write
44- SetScope0Color;<br>
45- property Scope1Color: TFountainColor read FScope1Color write SetScope1Color;</dt>
46- <dd>
47-それぞれ、スコープ0(本体側;\h側;\0側)、スコープ1(うにゅう側;\u側;\1側)での会話文字列の色を指定します。
48-
49- </dd>
50- <dt>property TagColor: TFountainColor read FTagColor write SetTagColor;</dt>
51- <dd>タグの色を指定します</dd>
52- <dt>property TagErrorColor: TFountainColor read FTagErrorColor write
53- SetTagErrorColor;</dt>
54- <dd>タグエラーと判断された場合の色を指定します</dd>
55- <dt>property MetaWordColor: TFountainColor read FMetaWordColor write
56- SetMetaWordColor;</dt>
57- <dd>メタ文字列の色を指定します</dd>
58- <dt>property SynchronizedColor: TFountainColor read FSynchronizedColor write
59- SetSynchronizedColor;</dt>
60- <dd>シンクロナイズドセッション(\_s)中の色を指定します</dd>
61- <dt>property SakuraScriptParser: TSsParser read FSakuraScriptParser write
62- SetSakuraScriptParser;</dt>
63- <dd>SsParserのインスタンスを指定します。この指定は、正しくスクリプトを解釈させるために必須です。</dd>
64- <dt>property ChangeScopeBy01: boolean read FChangeScopeBy01 write
65- SetChangeScopeBy01 default true;</dt>
66- <dd>\0, \1タグをスコープの変更命令と解釈し、色分けを行うかどうかを指定します。デフォルトではtrueです。(「何か(仮)」時代
67- の古いスクリプト仕様では、これらのタグが全く別の意味を持つ命令であったことを念のため考慮してください)</dd>
68- <dt>property ChangeScopeByHU: boolean read FChangeScopeByHU write
69- SetChangeScopeByHU default true;</dt>
70- <dd>\h, \uタグをスコープの変更命令と解釈し、色分けを行うかどうかを指定します。デフォルトではtrueです。(現在は原則として\0,
71- \1を代わりに使用することになっているので、遠い将来にこれらのマークアップを現在の意味で理解しないプログラムが出現するかもしれないことを念のため考慮してください)</dd>
72- <dt>property ProcessSync: boolean read FProcessSync write SetProcessSync
73- default true;</dt>
74- <dd>\_sタグをシンクロナイズセッションに入る/出るための文字列と解釈し、色分けを行うかどうかを指定します。<br>
75- falseの場合はシンクロナイズセッションを考慮しません。</dd>
76-</dl>
77-
78-</body>
79-
80-</html>
\ No newline at end of file
--- a/sakurasuite/manual/sakuraseeker.html
+++ /dev/null
@@ -1,119 +0,0 @@
1-<html>
2-
3-<head>
4-<meta http-equiv="Content-Language" content="ja">
5-<meta name="GENERATOR" content="Microsoft FrontPage 4.0">
6-<meta name="ProgId" content="FrontPage.Editor.Document">
7-<meta http-equiv="Content-Type" content="text/html; charset=shift_jis">
8-<title>TSakuraSeeker</title>
9-<link rel="stylesheet" type="text/css" href="sakurasuite.css">
10-</head>
11-
12-<body>
13-
14-<h1>TSakuraSeeker</h1>
15-<h2>概要</h2>
16-<p>伺か互換システムのFile-mapping Object(通称FMO)を利用して、現在のローカルマシンで起動している伺か互換システムの情報を取得します。</p>
17-<p>2003/04 より、'SakuraFMO'のミューテックスオブジェクトによる、FMO同時アクセスのブロックに対応し、安全性が増しています。</p>
18-<p>2003年04月現在でこの'SakuraFMO'によるシンクロナイゼーションに対応している伺か関連ソフトウェアは、</p>
19-<ul>
20- <li>CROW</li>
21- <li>SSP</li>
22- <li>BBC</li>
23- <li>SSSB</li>
24- <li>SSTP-Viewer</li>
25- <li>SSTP Bottle Client</li>
26-</ul>
27-<p>です。</p>
28-<p>このコンポーネントは、取得したHWNDに対して、<code>TDirectSSTP</code>と併せて使うとより効果があります。</p>
29-<p>&quot;Sakura&quot;以外のFMOを読み取る機能があります。</p>
30-<p>SakuraSeekerはFMO先頭4バイトに定義されているFMOサイズを正しく解釈します(任意のサイズのFMOが扱えます)。</p>
31-<h2>継承</h2>
32-<p><code>TObject</code> - <code>TPersistent</code> - <code>TComponent</code> -
33-<code>TSakuraSeeker</code></p>
34-<h2>参照</h2>
35-<p>
36-<a href="file:///C:/Documents%20and%20Settings/naruto/My%20Documents/dpr/dpk%20SakuraSuite/manual/sakuraprocess.html">
37-TSakuraProcess</a></p>
38-<h2>参考URL</h2>
39-<p>TSakuraSeekerはこれらの仕様を参考にして設計されています。</p>
40-<p>伺か…メモリオブジェクト<br>
41-<a href="http://sakura.wondernet.tv/objects.html">
42-http://sakura.wondernet.tv/objects.html</a></p>
43-<p>SSP技術資料…FMO関連の資料<br>
44-<a href="http://ssp.shillest.net/docs/fmo.html">
45-http://ssp.shillest.net/docs/fmo.html</a></p>
46-<h2>基本の使い方</h2>
47-<h3>起動中のゴースト名を列挙する</h3>
48-<p><code>procedure Button1Click(Sender: TObject);<br>
49-var i: integer;<br>
50-begin<br>
51-&nbsp; with SakuraSeeker1 do<br>
52-&nbsp; begin<br>
53-&nbsp;&nbsp;&nbsp; BeginDetect;<br>
54-&nbsp;&nbsp;&nbsp; for i := 0 to Count-1 do<br>
55-&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ShowMessage('Name:' + Process[i].SetName + #13#10
56-+<br>
57-&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 'HWND:'+ IntToStr(Process[i].HWnd));<br>
58-&nbsp; end;<br>
59-end;</code></p>
60-<h3>「さくら」という名前のゴーストを検索してウィンドウハンドル(DirectSSTP用)を得る</h3>
61-<p><code>with SakuraSeeker1 do<br>
62-begin<br>
63-&nbsp; BeginDetect;<br>
64-&nbsp; if ProcessByName['さくら'] &lt;&gt; nil then<br>
65-&nbsp;&nbsp;&nbsp; Handle := ProcessByName['さくら'].HWnd;<br>
66-end;</code></p>
67-<h2>リファレンス-メソッド</h2>
68-<dl>
69- <dt>procedure BeginDetect;</dt>
70- <dd>最新のFMOにアクセスして中身を解析し、状態を保持します。<code>Count</code>プロパティが更新されます。<br>
71- 最新のFMO状態が必要なとき、直前に呼んでください。ただしFMOは時に100KB超に達することもありますので、あまり頻繁に呼びすぎるのも考え物です。</dd>
72- <dt>function KillFMO(const TargetFMOName, TargetID: String): boolean;</dt>
73- <dd>FMOから指定のプロセスIDを持つすべてのエントリを削除します。Mutexオブジェクトによる排他制御の問題に対応しています。<br>
74- <code>TargetFMOName</code>にはFMO識別名(通常は「Sakura」)を、<code>TargetID</code>にはプロセスID(MD5値など)を渡します。<br>
75- エントリを削除した場合にtrueが返ります。指定したものが存在しない場合や、その他のエラーが発生した場合にはfalseが返ります。</dd>
76-</dl>
77-<h2>リファレンス-プロパティ</h2>
78-<dl>
79- <dt>property Count: integer;</dt>
80- <dd>実行時のみ、読み取り専用です。<code>BeginDetect</code>の後に意味を持ちます。発見されたプロセスの数を取得します。<code>Process</code>プロパティにアクセスする場合の添え字の上限として使用します。</dd>
81- <dt>property Process[Index: integer]: <a href="sakuraprocess.html">
82- TSakuraProcess</a>; default;</dt>
83- <dd>実行時のみ、読み取り専用です。見つかった順に<code>TSakuraProcess</code>のインスタンスを返します。</dd>
84- <dt>property ProcessByName[Name: String]: <a href="sakuraprocess.html">
85- TSakuraProcess</a>;<br>
86- property ProcessBySetName[Name: String]: <a href="sakuraprocess.html">
87- TSakuraProcess</a>;<br>
88- property ProcessByID[ID: String]: <a href="sakuraprocess.html">TSakuraProcess</a>;</dt>
89- <dd>実行時のみ、読み取り専用です。それぞれ、<code>TSakuraProcess</code>のインスタンスを検索して返します。<br>
90- <code>ProcessByName</code>はnameをキーに検索します(例「さくら」)。同じ名前のものが2つ以上ある場合には最初に見つかったものが返ります。<br>
91- <code>ProcessBySetName</code>はname,keronameの組をキーにします。コンマで区切ります(例「さくら,うにゅう」)。同じ名前のものが2つ以上ある場合には最初に見つかったものが返ります。<br>
92- <code>ProcessByID</code>はプロセスIDをキーにします。(本来の仕様ではMD5値ですが、何らかのユニークな文字列が入ります)</dd>
93- <dt>property AutoDetect: boolean;</dt>
94- <dd>コンポーネントの生成時に自動的に<code>BeginDetect</code>するかどうかを設定します。</dd>
95- <dt>property FileMappingTarget: TStrings;</dt>
96- <dd>FMO識別名を設定します。デフォルトは「Sakura」です。複数の識別名を列挙することがで、その場合には<code>BeginDetect</code>ですべてが順に解析されます。</dd>
97-</dl>
98-<h2>リファレンス-イベント</h2>
99-<dl>
100- <dt>property OnGetMutexName: TSakuraSeekerGetMutexNameEvent;</dt>
101- <dd><code>TSakuraSeekerGetMutexNameEvent = procedure (Sender: TObject; var
102- Name: String) of object;</code><br>
103- 排他制御用のミューテックスオブジェクトの名前をカスタマイズするためのイベントです。<code>Name</code>パラメータに、これから解析しようとするFMOの識別名が入っているので(<code>FileMappingTarget</code>をカスタマイズしない限りは「Sakura」です)、そのFMOを保護するためのMutex識別名を、Nameに代入して終了してください(基本的には「SakuraFMO」)。このイベントを指定しない場合は、「SakuraFMO」というように、FMO識別名に「FMO」が付いたものをMutex識別名として利用します(標準の動作です)。<br>
104- 一応イベントとして実装してありますが、これをカスタマイズすると、Mutexを利用する意味自体がなくなりますので、本当に意味が分かっていて、必要がある場合のみ定義してください。</dd>
105- <dt>property OnAfterDetection: TNotifyEvent;</dt>
106- <dd><code>BeginDetect</code>終了後に呼ばれます。</dd>
107- <dt>property OnDetectResultChanged: TNotifyEvent;</dt>
108- <dd><code>BeginDetect</code>の後、その解析結果が前回の結果と違っていた場合に呼ばれます。このイベントに応じて、アプリケーションのコントロールを書き換えたり、ユーザにプロセスの起動・終了を通知したりすることができます。<br>
109- <code>FileMappingTarget</code>で指定されるいずれかのFMOの中身が1バイトでも変わっていた場合に呼ばれることに注意してください。サーフィス番号を毎秒のようにFMOに登録するアプリケーションがありますので、プロセスの数や起動しているゴーストに全く変化がなくてもこれが呼ばれることがあります。</dd>
110-</dl>
111-<h2>改版履歴</h2>
112-<dl>
113- <dt>2003/04/18</dt>
114- <dd>Mutexオブジェクトによる、FMOの同時アクセス排他制御。</dd>
115-</dl>
116-
117-</body>
118-
119-</html>
--- a/sakurasuite/manual/sakurasuite.css
+++ /dev/null
@@ -1,12 +0,0 @@
1-body { background-color: white; margin-left: 2em; font-family: monospace; }
2-p { font-size: 10.5pt; margin-top: 0.5em; margin-bottom: 0.5em; }
3-li, dd, dt, td, th { font-size: 10.5pt; }
4-dt { font-weight: bolder; margin-top: 1em; margin-bottom: 0.3em; }
5-h1 { text-align: center; }
6-h2 { color: navy; text-decoration: underline; margin-left: -1em; }
7-h3 { color: navy; margin-left: -1em;}
8-
9-code { color: green; font-size: 100%; }
10-
11-strong { color: red; text-decoration: underline; font-weight: bolder; }
12-em { color: red; font-style: normal;}
\ No newline at end of file
--- a/sakurasuite/manual/slpp20.html
+++ /dev/null
@@ -1,27 +0,0 @@
1-<html>
2-
3-<head>
4-<meta http-equiv="Content-Language" content="ja">
5-<meta http-equiv="Content-Type" content="text/html; charset=shift_jis">
6-<meta name="GENERATOR" content="Microsoft FrontPage 4.0">
7-<meta name="ProgId" content="FrontPage.Editor.Document">
8-<title>新しいページ 1</title>
9-<link rel="stylesheet" type="text/css" href="sakurasuite.css">
10-</head>
11-
12-<body>
13-
14-<h1>TIdSlpp20</h1>
15-<h2>概要</h2>
16-
17-<p>SSTP Bottleサービス(http://bottle.mikage.to/)に接続してメッセージを受信するためのコンポーネントです。</p>
18-
19-<p>SLPP/2.0プロトコルに対応しています。</p>
20-
21-<p>ただしSSTP Bottleサービスは、メッセージを受信するための接続(永続的なSLPP/2.0)と、クライアント側からコマンドを送信するための接続(断続的な、単なるHTTP)の2種類からなりますので、このコンポーネント単体での接続はできません。</p>
22-
23-<p>SSTP Bottleの仕様詳細については、公式サイトの仕様書ページをご覧ください。</p>
24-
25-</body>
26-
27-</html>
--- a/sakurasuite/manual/ssparser.html
+++ /dev/null
@@ -1,298 +0,0 @@
1-<html>
2-
3-<head>
4-<meta http-equiv="Content-Language" content="ja">
5-<meta name="GENERATOR" content="Microsoft FrontPage 5.0">
6-<meta name="ProgId" content="FrontPage.Editor.Document">
7-<meta http-equiv="Content-Type" content="text/html; charset=shift_jis">
8-<title>新しいページ 0</title>
9-<link rel="stylesheet" type="text/css" href="sakurasuite.css">
10-</head>
11-
12-<body>
13-
14-<h1>TSsParser</h1>
15-<h2>概要</h2>
16-<p>
17-「さくらスクリプト」の多機能パーサ機能を持つ非ビジュアルコンポーネントです。単一行のさくらスクリプトを処理します。つまり典型的には\tから始まり\eで終わる、1行のスクリプトです。Entryなどが絡んだ複数行スクリプトには対応していませんが、補助としては使えます。</p>
18-<ul>
19- <li>独自のSSTPサーバを構築する場合の補助</li>
20- <li>さくらスクリプトのエディタ作成のための補助(色分け、タグチェック、etc...)</li>
21-</ul>
22-<p>といった用途の両方に使えるよう設計されています。また、タグのパターンについては完全にカスタマイズが可能です。</p>
23-<h2>基本的な使い方</h2>
24-<p><code>TagPattern</code>, <code>MetaPattern</code>プロパティに、さくらスクリプトの解析の基準となるパターンを指定します。添付されているテキストファイルをコピーすれば一応OKです。</p>
25-<p><code>InputString</code>プロパティに、スクリプトを指定すれば、スクリプトが解析され、<code>Count</code>,
26-<code>MarkUpType</code>, <code>Str</code>の各プロパティを通してアクセスできます。</p>
27-<p>例えば、「<code>\t\s[0]いらっしゃい%ませ、%usernameさん、\s[5]\\300のお\買い上げになりますね\e</code>」という文字列を<code>InputString</code>に入れた場合には、Count=10となり、<code>MarkUpType</code>,
28-<code>Str</code>プロパティには以下のような値が入ります。</p>
29-<p><code>TSsParser</code>では、<code>Index</code>で区別されるスクリプト素片、つまり下の表における各行を<strong>「マークアップ」</strong>と呼ぶことにします。(本来、タグやメタ文字以外の文字列までマークアップと呼ぶのは変ですが…)</p>
30-<table border="1">
31- <tr>
32- <th>Index</th>
33- <th>Str[Index]</th>
34- <th>MarkUpType[Index]</th>
35- </tr>
36- <tr>
37- <td>0</td>
38- <td>\t</td>
39- <td>mtTag</td>
40- </tr>
41- <tr>
42- <td>1</td>
43- <td>\s[0]</td>
44- <td>mtTag</td>
45- </tr>
46- <tr>
47- <td>2</td>
48- <td>いらっしゃい%ませ、<em><sup>※</sup></em></td>
49- <td>mtStr</td>
50- </tr>
51- <tr>
52- <td>3</td>
53- <td>%username</td>
54- <td>mtMeta</td>
55- </tr>
56- <tr>
57- <td>4</td>
58- <td>さん、</td>
59- <td>mtStr</td>
60- </tr>
61- <tr>
62- <td>5</td>
63- <td>\s[5]</td>
64- <td>mtTag</td>
65- </tr>
66- <tr>
67- <td>6</td>
68- <td>\\300のお<em><sup>※</sup></em></td>
69- <td>mtStr</td>
70- </tr>
71- <tr>
72- <td>7</td>
73- <td>\買</td>
74- <td>mtTagErr</td>
75- </tr>
76- <tr>
77- <td>8</td>
78- <td>い上げになりますね</td>
79- <td>mtStr</td>
80- </tr>
81- <tr>
82- <td>9</td>
83- <td>\e</td>
84- <td>mtTag</td>
85- </tr>
86-</table>
87-<ul>
88- <li>
89- これはデフォルトのパターンを使用した典型的な解析の結果であり、解析結果はパターンによって変化します。極端に言えば、\w8をタグとして認識しない、ということも可能です。</li>
90- <li><code>Str[2]</code>については、<code>EscapeInvalidMeta</code> =
91- falseの場合の結果です。trueの場合は、「いらっしゃい\%ませ」となります。</li>
92- <li><code>Str[6</code>]については、<code>LeaveEscape</code> =
93- trueの場合の結果です。falseの場合は、「\300のお」となります。</li>
94-</ul>
95-<h2>リファレンス-プロパティ</h2>
96-<dl>
97- <dt>LeaveEscape: boolean [実/設][読/書]</dt>
98- <dd>デフォルトはtrueです。mtStrで切り出された通常文字列に含まれる、<code>\\</code> や <code>\%</code>
99- の文字列を変換せずに残すかどうか設定します。falseにすることで、<code>\\</code> や <code>\%</code> は1文字に変換されてmtStrマークアップに代入されます。<br>
100- TSsParserをスクリプトの色分けや、危険タグチェックなどに使用する場合は、文字列長やスクリプトそのものが変わらないようにtrueにします。独自SSTPサーバ開発の場合などは、falseにすることで変換の手間を省けます。<br>
101- 変更した場合、その結果は次回の解析から反映されます。</dd>
102- <dt>EscapeInvalidMeta: boolean [実/設][読/書]</dt>
103- <dd>デフォルトはfalseです。<code>MetaPattern</code>によって、%文字以降がメタ文字列と判断できない場合、%文字を「\%」にエスケープするかどうか設定します。<br>
104- <code>TSsParser</code>をスクリプトの色分けなどに使用する場合は、文字列長が変わらないようにfalseにします。堅牢なスクリプト作成のための文法チェックのためにはtrueにします。<br>
105- 変更した場合、その結果は次回の解析から反映されます。</dd>
106- <dt>TagPattern: TStrings [実/設][読/書]<br>
107- MetaPattern: TStrings [実/設][読/書]</dt>
108- <dd>
109- それぞれ、タグ切り出しのためのパターン、メタ文字列切り出しのためのパターンです。別項「パターンについて」参照。変更した場合、その結果は次回の解析から反映されます。</dd>
110- <dt>InputString: String [実のみ][読/書]</dt>
111- <dd>このプロパティに書き込んで、解析すべきスクリプトを設定します。読み出しの場合は最後に解析したスクリプトが入っています。</dd>
112- <dt>Count: integer [実のみ][読のみ]</dt>
113- <dd>スクリプト解析後のマークアップ総数を返します。スクリプトマークアップをループ処理する場合の上限値として使用します。</dd>
114- <dt>Str[Index: integer]: String [実のみ][読のみ]</dt>
115- <dd>解析後の文字列を返します。最初のマークアップは<code>Str[0]</code>、最後のマークアップは<code>Str[Count-1]</code>です。<code>LeaveExcape</code>,
116- <code>EscapeInavlidMeta</code>の両プロパティの影響を受けます。</dd>
117- <dt>Extra[Index: integer]: String [実のみ][読/書]</dt>
118- <dd>ご自由にお使いください、の文字列です。解析結果にメモをつけたりする用途にどうぞ。</dd>
119- <dt>MarkUpType[Index: integer]: TSsMarkUpType [実のみ][読のみ]</dt>
120- <dd><code>type TSsMarkUpType = (mtTag, mtMeta, mtTagErr, mtStr);<br>
121- </code>マークアップの種類を返します。最初のマークアップはMarkUpType[0]、最後のマークアップはMarkUpType[Count-1]です。</dd>
122-</dl>
123-<h2>リファレンス-イベント</h2>
124-<dl>
125- <dt>OnSsParse: TSsParseEvent</dt>
126- <dd>
127- <p><code>TSsParseEvent = procedure (Sender: TObject; const Script:
128- String;<br>
129- var Len: integer; var MarkType: TSsMarkUpType; var Extra: String) of object;<br>
130- </code>タグまたはメタ文字列のパターンマッチ試行の前に呼び出されます。このイベントを使用すると、<code>TagPattern</code>,
131- <code>MetaPattern</code>の仕様では切り出せないマークアップが将来できた場合に、スクリプトからのタグやメタ文字列の切り出しを自由にコーディングできます。<br>
132- <code>Script</code>は解析途中のスクリプトです。1文字目は必ず「\」または「%」となっています。<code>Len</code>は呼び出し時には0が代入されています。<br>
133- このイベントハンドラ内で、<code>Script</code>の先頭から始まる部分を解析します。マークアップを解釈できた場合はそのマークアップの長さ(バイト数)を<code>Len</code>(&gt;2)に、タイプを<code>MarkType</code>に、必要ならExtraに文字列を入れて、イベントハンドラを終了してください。解釈できない場合はLen=0のまま終了すれば、そのまま通常のパターンマッチ試行に入ります。<br>
134- 要は、文字列先頭からここまでがタグ(メタ文字列)だよ、というのを見つけて返してくれ、ということです。<br>
135- <code>Len&gt;1</code>であっても、<code>Script</code>の1文字目が\なのに<code>MarkUpType</code>が<code>mtTag</code>でも<code>mtTagErr</code>でもない場合、あるいはScriptの1文字目が%なのにMarkUpTypeがmtMetaでない場合は例外が発生します。</dd>
136-</dl>
137-<h2>リファレンス-メソッド</h2>
138-<dl>
139- <dt>function Match(Str, Pattern: String): integer;</dt>
140- <dd>SSTP解析用のパターンマッチングを行います。<code>Str</code>の先頭部分、<code>Pattern</code>で示されるパターンが存在すれば、マッチした部分のバイト数(文字数ではない)を返します。マッチングが失敗した場合は0を返します。<br>
141- 例えば、<code><br>
142- Match('ABC', 'AB') = 2<br>
143- Match('ABC', 'A%.%.') = 3<br>
144- Match('A20BC', 'A%D') = 3<br>
145- Match('\s[20]', '\s%b') = 6<br>
146- Match('\s2', '\s%b') = 0</code></dd>
147- <dt>function MatchP(PStr, PPattern: PChar): integer;</dt>
148- <dd>
149- Matchと基本的に同機能ですが、引数に文字ポインタを使用します。不必要な文字列のコピーが避けられるため、繰り返し呼ぶ場合や、とある文字列の途中から解析したりする場合には高速です。</dd>
150- <dt>function MarkUpAt(const Pos: integer): integer;</dt>
151- <dd>Posバイト目(Pos文字目ではありません)にあるマークアップのインデックスを返します。</dd>
152- <dt>function GetParam(Tag: String; const Index: integer): String;</dt>
153- <dd><code>\s[3]</code> や <code>\_c[こんにちは]</code> , <code>\q1[#cancel][キャンセル]</code>
154- といったマークアップから、スクウェアブラケットに囲まれたパラメータを取り出します。Tagは取り出したいタグ全体、<code>Index</code>は何番目のパラメータを取り出すか、で、1から始まります。<code>\\</code>
155- や <code>\]</code> によるエスケープに対応し、これらのエスケープは自動的に元の形に戻されます。<br>
156- Indexがゼロ以下の場合、パラメータが取り出せなかった場合などには、空文字列が返ります。<code><br>
157- GetParam('\s[3]', 1) = '3';<br>
158- GetParam('\s[3]', 2) = '';<br>
159- GetParam('\j[http://www.yahoo.co.jp/index[1\].html]', 1) = 'http://www.yahoo.co.jp/index[1].html'</code></dd>
160- <dt>function EscapeParam(const Param: String): String;</dt>
161- <dd>\j[] の中に安全に代入できるように、<code>\</code> を <code>\\</code> に、<code>]</code> を
162- <code>\]</code> に変換した文字列を返します。堅牢なスクリプト作成のためには是非利用するようにしてください。</dd>
163-</dl>
164-<h2>パターンについて</h2>
165-<p><code>TagPattern</code>, <code>MetaPattern</code>プロパティに、さくらスクリプトを解析するときのパターンを指定します。</p>
166-<p>
167-アーカイブ同梱のテキストファイルからコピーすることもできますが、将来のタグ拡張等のためにこの仕様が存在します。このパターンリスト自身をテキストファイルなどから読み込むようにすることで、実行ファイルを更新せずにタグ解析部のみを更新することも可能です。</p>
168-<p>「タグが\で始まる」「メタ文字列が%で始まる」「\\や\%はエスケープ」などといった基本的な仕様が変更にならない限り、タグの通常の増減に関しては、<code>Pattern</code>プロパティを変更することで、大抵対応できると思います。特殊な書き方の場合、イベントを利用する方法もあります。</p>
169-<h3>パターンの書き方概略</h3>
170-<p><code>TagPattern</code>の各行が、1つのタグに応答するパターンです。例えば、「<code>\e</code>」という行を<code>TagPattern</code>プロパティに追加することで、「<code>\e</code>」というタグに反応できるようになり、「<code>!_c</code>」という行を追加すれば、「<code>\_c</code>」というタグはエラーである、と解析するようになります。</p>
171-<p>
172-(このようにエラーになったタグを無視するのか、あるいはどう処理するのかどうかなどについては、解析者の実装にかかっています。TSsParserでは、そのタグをエラーとして属性づけるだけです。)</p>
173-<p>パターンは上から順番に試行され、マッチした時点で試行を中止します。</p>
174-<p><code>TagPattern</code>の各行は、<code>\</code>記号または<code>!</code>記号で始めてください。<code>\</code>記号で始まるパターンは、マッチした場合それを正当なタグをして処理します。<code>!</code>記号で始まるパターンは、マッチした場合それをタグのエラーとして処理します。</p>
175-<p>例えば、「<code>\w</code>」タグの処理のためには、</p>
176-<blockquote>
177- <p><code>\w%d<br>
178- !w%.</code></p>
179-</blockquote>
180-<p>という2行をTagPatternに加えるとよいでしょう。これで、<code>\w9</code> 等は正当なタグで、数字以外がwの後にきた場合は
181-<code>\wあ</code> といった全体をタグエラーとして処理する、という意味になります。</p>
182-<p><code>MetaPattern</code>の各行が、1つのメタ文字列に応答するパターンです。例えば「selfname」という行をMetaPatternプロパティに追加することで、「<code>%selfname</code>」というメタ文字列に反応します。<code>MetaPattern</code>の場合は、<code>%</code>以降に続く文字列をそのまま記述するような格好で大丈夫です。(パターンも使えます)</p>
183-<p>マッチ試行はパターンリストの上から順番に行われるため、<code>MetaPattern</code>プロパティで、例えば <code>selfname2</code>
184-という行は <code>selfname</code> より上に配置される必要があります。</p>
185-<h3>パターンの記述方法</h3>
186-<p>正規表現みたいなものですが、そこまで高機能ではありません。逆に正規表現では表現しづらい表記に対応してたりもしますが。</p>
187-<ul>
188- <li><code>%d</code> は任意の整数1文字にマッチします。<code>\s%d</code> というパターンは、<code>\s0</code>
189- や <code>\s3</code> にマッチします。</li>
190- <li><code>%D</code> は任意の整数列に最長マッチします。<code>\s[%D]</code> というパターンは、<code>\s[0]</code>
191- や <code>\s[10]</code> にマッチします。</li>
192- <li><code>%b</code> は[]で囲まれた文字列にマッチします。<code>\]</code> や <code>\\</code>
193- によるエスケープに対応します。<code>\j%b</code> というパターンは、 <code>\j[http://www.a.com/index[1\].html]</code>
194- にマッチします。</li>
195- <li><code>%.</code> は任意の1文字(シングルバイト・マルチバイト問わず)にマッチします。</li>
196- <li><code>%m</code> は任意のシングルバイト文字にマッチします。</li>
197- <li><code>%M</code> は任意のマルチバイト文字にマッチします。</li>
198- <li><code>%%</code> は「%」記号そのものにマッチします。使用しないといけない機会はおそらく将来もありません。</li>
199- <li>%の直後が、上記のいずれでもない文字である場合、とりあえず <code>%%</code> として解釈しますが、このような使い方はしないでください。</li>
200- <li>それ以外の文字はすべてその文字そのものにマッチします。\も含め。</li>
201-</ul>
202-<h3>マッチング詳細</h3>
203-<p>マッチングは以下のように行われます。</p>
204-<ol>
205- <li>
206- マークアップと思われる「\」または「%」を先頭から探します。「\\」や「\%」はエスケープですので読み飛ばされます。その部分までは、マークアップではない通常の文字列です。</li>
207- <li>
208- <p>
209- 「%」を見つけた場合はメタ文字列の可能性があるので、マッチングを開始します。%以下が有効なメタ文字列として解釈できない場合は、「%」は意味をなさない通常の%文字列として、\%にエスケープされて(<code>EscapeInvalidMeta</code>で制御可能)前の<code>mtStr</code>マークアップにくっつきます。</li>
210- <li>「\」を見つけた場合のマッチングを開始します。\以下が正規のタグとして解釈できた場合は<code>mtTag</code>タイプとして、エラータグとなった場合はmtTagErrとして切り出します。<code>TagPattern</code>のどの行にもマッチしなかった場合は、\の次の1文字を含めて、エラータグとして切り出します。</li>
211- <li>最初に戻ります。</li>
212-</ol>
213-<h2>使用例</h2>
214-<h3>SSTPサーバ</h3>
215-<p>独自SSTPサーバ構築補助に利用する場合は、<code>LeaveEscape := false; EscapeInvalidMeta := false;</code>
216-とすると簡単です。</p>
217-<p><code>SsParser1.InputString := Edit1.Text;<br>
218-for i := 0 to SsParser1.Count-1 do begin<br>
219-&nbsp; case SsParser.MarkUpType[i] of<br>
220-&nbsp;&nbsp;&nbsp; mtStr: Memo1.Lines.Add(SsParser.Str[i]);<br>
221-&nbsp;&nbsp;&nbsp; mtTag: {タグ関連の処理}<br>
222-&nbsp;&nbsp;&nbsp; mtTagErr: Memo1.Lines.Add(SsParser.Str[i]); //処理せずにそのまま表示<br>
223-&nbsp;&nbsp;&nbsp; mtMeta: {メタ文字列変換語表示}<br>
224-&nbsp; end;<br>
225-end;</code></p>
226-<h3>スクリプト色分けHTML作成</h3>
227-<p>色分けが目的の場合、スクリプトが変わる心配のないよう、<code>LeaveEscape := true; EscapeInvalidMeta :=
228-false;</code> とします。</p>
229-<p>以下は、タグ部分に色を設定するHTMLマークアップです。</p>
230-<p><code>var Html: String;<br>
231-//<br>
232-SsParser1.InputString := Edit1.Text;<br>
233-for i := 0 to SsParser1.Count-1 do begin<br>
234-&nbsp; case SsParser.MarkUpType[i] of<br>
235-&nbsp;&nbsp;&nbsp; mtStr:&nbsp;&nbsp;&nbsp; Html := Html + SsParser.Str[i];<br>
236-&nbsp;&nbsp;&nbsp; mtTag:&nbsp;&nbsp;&nbsp; Html := Html + '&lt;font
237-color=&quot;green&quot;&gt;' + SsParser.Str[i] + '&lt;/font&gt;';<br>
238-&nbsp;&nbsp;&nbsp; mtTagErr: Html := Html + '&lt;font color=&quot;red&quot;&gt;' +
239-SsParser.Str[i] + '&lt;/font&gt;';<br>
240-&nbsp;&nbsp;&nbsp; mtMeta:&nbsp;&nbsp; Html := Html + '&lt;font color=&quot;blue&quot;&gt;' +
241-SsParser.Str[i] + '&lt;/font&gt;';<br>
242-&nbsp; end;<br>
243-end;<br>
244-Edit2.Text := Html;</code></p>
245-<h3>OnSsParse使用例</h3>
246-<p>以下は、OnSsParseイベントの使用例です。もっとも単純に、\uタグを判定します。TagPatternの1行目に <code>\u</code>
247-と書いた場合と同じ動作となります。</p>
248-<p><code>procedure TForm1.SsParser1SsParse(Sender: TObject; const Script:
249-String;<br>
250-&nbsp; var Len: integer; var MarkType: TSsMarkUpType; var Extra: String)<br>
251-begin<br>
252-&nbsp; if Pos('\u', Script) = 1 then begin<br>
253-&nbsp;&nbsp;&nbsp; Len := Length('\u');<br>
254-&nbsp;&nbsp;&nbsp; MarkType := mtTag;<br>
255-&nbsp; end;<br>
256-end;</code></p>
257-<h2>使用例 - サーフィス判定</h2>
258-<p>一番最後のサーフィスが何になるかを判定します。ただし本来は、\0,
259-\1によるスコープ切り替え処理や、\_sによるシンクロナイズドセッションの処理が必要でしょう。</p>
260-<p><code>var Last: integer;<br>
261-//<br>
262-SsParser1.InputString := Edit1.Text;<br>
263-for i := 0 to SsParser1.Count-1 do begin<br>
264-&nbsp; if SsParser.Match(SsParser.Str[i], '\s%b') &gt; 0 then begin<br>
265-&nbsp;&nbsp;&nbsp; try<br>
266-&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Last := StrToInt(SsParser.GetParam(SsParser.Str[i]));<br>
267-&nbsp;&nbsp;&nbsp; except<br>
268-&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; on EConvertError do<br>
269-&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ;<br>
270-&nbsp;&nbsp;&nbsp; end;<br>
271-&nbsp; end;<br>
272-end;</code></p>
273-<h2>諸注意</h2>
274-<h3>再解析について</h3>
275-<p><code>with SsParser1 do InputString := InputString;</code></p>
276-<p>とすることで、<code>EscapeInvalidMeta</code>等の解析オプションや、<code>MetaPattern</code>等の解析パターンが変化したときに再解析を行えます。変な書き方ですが。</p>
277-<h3>改行文字について</h3>
278-<p><code>InputString</code>に改行文字やその他の空白文字が含まれていた場合、通常の文字と同じように扱います。つまり、改行文字だからといって特に何らかの処理が行われたり、逆に処理の邪魔になったりすることはありません。改行を
279-<code>\n</code> に変更したい、などの場合はあらかじめ StringReplace などを利用して自分で変換してください。</p>
280-<h3>タグエラーの利用について</h3>
281-<p><code>TagPattern</code>で行頭が <code>!</code> で始まるパターンを指定することや、OnSsParseイベントで<code>mtTagErr</code>マークアップを返す事で、\で始まる任意の文字列をタグエラーと見なすことができます。また、<code>TagPattern</code>でマッチしなかった場合は、\記号の次の1文字までを含めてタグエラーとして2文字分切り出します。この利用方法ですが、</p>
282-<ul>
283- <li>スクリプトのチェックに利用する場合、<code>TagPattern</code>を変更する事で、SSTP権限で動かないタグのチェックを行うことができます。</li>
284- <li>
285- SSTPサーバ構築の場合、エラータグはそのままセリフと同じ形で出力するようにすれば、タグのマークアップエラーに関して柔軟な復帰ができます(上の例参照)。</li>
286-</ul>
287-<h2>改版履歴</h2>
288-<dl>
289- <dt>2003/04/01</dt>
290- <dd>内部を書き直して、10倍〜100倍ほど高速化。開発マシン(PentiumIII
291- 1GHz)では、2KBの長文スクリプトを0.01秒以内に解析するようになりました。</dd>
292- <dt>2003/04/03</dt>
293- <dd><code>Position</code>、<code>MarkUpAt</code>を追加。</dd>
294-</dl>
295-
296-</body>
297-
298-</html>
--- a/sakurasuite/manual/ssplaytime.html
+++ /dev/null
@@ -1,74 +0,0 @@
1-<html>
2-
3-<head>
4-<meta http-equiv="Content-Language" content="ja">
5-<meta name="GENERATOR" content="Microsoft FrontPage 5.0">
6-<meta name="ProgId" content="FrontPage.Editor.Document">
7-<meta http-equiv="Content-Type" content="text/html; charset=shift_jis">
8-<title>新しいページ 0</title>
9-<link rel="stylesheet" type="text/css" href="sakurasuite.css">
10-</head>
11-
12-<body>
13-
14-<h1>TSsPlayTime, TSsPlayTimeParams</h1>
15-<h2>概要</h2>
16-<p>さくらスクリプトの再生時間を予測します。文字数が多い場合や、ウェイトタグが多い場合には再生時間が長くなります。</p>
17-<p>ベースウェアや再生環境、またその設定によっては再生時間にばらつきが生じます。それらの定数はTSsPlayTimeParamsコンポーネントが保持します。TSsPlayTimeParamsを複数配置して適宜切り替えることで、いろいろな再生環境での再生時間を予測可能です。</p>
18-<h2>基本の使い方</h2>
19-<p>TSsPlayTimeとTSsPlayTimeParams、そしてTSsParserの各コンポーネントを1個ずつフォームに配置します。</p>
20-<p>TSsParserの説明を参考に、正しくSsParserのMetaPattern, TagPatternを設定します。</p>
21-<p>オブジェクトインスペクタより、TSsPlayTimeのSsParserプロパティとPlayTimeParamsプロパティに、それぞれ今置いたコンポーネントを設定します。</p>
22-<p>SsPlayTime.PlayTime 関数にスクリプトを渡すことで、再生時間を計算して、ミリ秒単位で返します。</p>
23-<h2>継承</h2>
24-<p>TObject - TPersistent - TComponent - TSsPlayTime<br>
25-TObject - TPersistent - TComponent - TSsPlayTimeParams</p>
26-<h2>リファレンス - TSsPlayTimeのメソッドとプロパティ</h2>
27-<dl>
28- <dt>property PlayTimeParams: TSsPlayTimeParams</dt>
29- <dd>計算に使用するTSsPlayTimeParamsコンポーネントを関連づけます。</dd>
30- <dt>property SsParser: TSsParser</dt>
31- <dd>
32- さくらスクリプトパーサを関連づけます。PlayTimeメソッドに渡る可能性のあるスクリプトを正しく解釈できるように、MetaPattern、TagPatternを設定してください。また、このSsParser<strong>コンポーネントの内容はTSsPlayTimeによって書き換えられます。</strong></dd>
33- <dt>function PlayTime(const Script: String): integer;</dt>
34- <dd>関連づけられたSsParserとPlayTimeParamsを使って、渡されたスクリプトの再生時間(ミリ秒)を予測して返します。スクリプトを解析してウェイトの数、サーフィス変更の数などをカウントし、SsPlayTimeParamsの各設定項目を係数とした単純な1次結合(線形結合)によって再生時間を予測します。</dd>
35- <h2>リファレンス - TSsPlayTimeParamsのプロパティ</h2>
36- <p>時間を指定する場合は、単位はすべてミリ秒(1/1000秒)です。</p>
37- <dl>
38- <dt>property ProfileName: String;</dt>
39- <dd>
40- このパラメータのセットに任意の名前を付けることができます。「materia標準速度」など、わかりやすい名前を付けてください。コンポーネント自体の動作に影響はありません。</dd>
41- <dt>property CostConst: integer;</dt>
42- <dd>
43- 単純にスクリプト再生予測時間に足される定数値です。例えば実際の1文字目の再生開始までにかなりの遅延が生じるような場合に、正の値を指定しておくと、TSsPlayTime.PlayTimeの戻り値にその値が加わります。デフォルトでは0です。</dd>
44- <dt>property CostWait: integer read FCostWait;</dt>
45- <dd>
46- ウェイトタグ(\w1〜\w9)について、\w1の1個分のウェイト量を指定します。本来の定義では\w1は50msのウェイトと定義されていますが、再生環境や設定によって、ウェイト量は異なります。なお、\w2〜\w9は、それぞれ\w1の正確に2〜9倍のウェイト量であると仮定されています。</dd>
47- <dt>property CostHiResWait: integer;</dt>
48- <dd>高精度ウェイト\_w[1]のウェイト量です。\_w[n]は\_w[1]のn倍のウェイト量となります。定義からして1msになると思いますが念のため用意されています。</dd>
49- <dt>property CostSurface: integer;</dt>
50- <dd>
51- サーフィスの1個の切り替えにかかる時間です。なお、シンクロナイズドセクションの場合、2つのサーフィスが同時に切り替わることになりますが、それは考慮されません。またこの値は、再生するマシンの環境によって最も大きく左右されがちなパラメータですので、慎重に決定してください(サーフィスの変更が激しい長文スクリプトでない限り最終結果に大きな影響はないかもしれませんが)</dd>
52- <dt>property CostChar: integer;</dt>
53- <dd>半角文字1文字分の再生(SpecialCharsに指定されているものを除く)にかかる時間です。</dd>
54- <dt>property CostDBChar: integer;</dt>
55- <dd>全角文字1文字分の再生(SpecialCharsに指定されているものを除く)にかかる時間です。現在のところ、この値をCostCharと同じとするべき再生環境と、CostDBCharの2倍の再生時間をかける再生環境が存在しているようです。前者のような再生環境では、英文等の再生が比較的遅く見えることになります。</dd>
56- <dt>property CostQuickChar: integer;</dt>
57- <dd>
58- クイックセクションの場合に1文字の再生にかける時間です。これは全角・半角を区別しません。理想的にはクイックセクション内での文字再生時間はゼロですが、環境によっては小さな正の値を指定することで、予測精度が高まることがあります。</dd>
59- <dt>property SpecialChars: TSsPlayTimeSpecialChars;</dt>
60- <dd>
61- 上記の半角文字・全角文字の予測の例外を指定します。いくつかの再生環境では、句読点に自動的に長めのウェイトをとるものが存在しますので、そのようなものをここで指定してください。設定するのは、TSsPlayTimeSpecialChar型のコレクションであり、Charに文字を、Waitにその文字を再生する場合の時間を指定します。Charは1文字(ダブルバイト文字可)で指定してください。</dd>
62- </dl>
63-</dl>
64-<h2>注意</h2>
65-<h3>ベースウェアによる再生時間調整の方針</h3>
66-<p>(記述は、2003年8月現在の状況を元にしています)</p>
67-<p>
68-ほとんどの再生環境では、スクリプトは実時間とは同期せずに再生されます。例えばPCの負荷が高まったため、1文字表示する間に数秒のラグが生じた、という場合でも、その遅れを取り戻すような処理はなく、淡々と、1文字表示しては規定のウェイト分待ち、1回サーフィスを切り替えて、1文字表示しては規定のウェイト分待ち…というように再生されています。</p>
69-<p>それに対して、materia互換ベースウェアの一つであるSSPでは、理想のタイムラインより遅れた場合に、その遅れを取り戻すような処理が組み込まれています。理想のタイムラインは、クイックセクションやサーフィス変更のコストをゼロとし、ウェイトタグと通常の発話でのみ時間が進むものとして計算されています。MIDIプレーヤーが全てのノートのタイミングを制御してテンポがずれないのと同様に、SSPではそれぞれの発話の文字出現時刻は完全に制御されています。</p>
70-<p>TSsPlayTimeの再生時刻予測は、SSPのような方針で実装されている再生環境については、理論上100%正確なものにすることが可能です。逆に、その他多くの再生環境においては、サーフィス変更のタグが実行されることで平均どの程度の時間を使うのか、クイックセクションでは1文字表示するのに平均どの程度かかっているのか、などを実測に基づいて決定することで、TSsPlayTimeParamsの各プロパティを決定していく必要があり、PC環境の差などを考慮する必要もあるため、ある程度の誤差が発生します。</p>
71-
72-</body>
73-
74-</html>
--- a/sakurasuite/sample_editor/Project1.dpr
+++ /dev/null
@@ -1,13 +0,0 @@
1-program Project1;
2-
3-uses
4- Forms,
5- Unit1 in 'Unit1.pas' {Form1};
6-
7-{$R *.res}
8-
9-begin
10- Application.Initialize;
11- Application.CreateForm(TForm1, Form1);
12- Application.Run;
13-end.
Binary files a/sakurasuite/sample_editor/Project1.res and /dev/null differ
--- a/sakurasuite/sample_editor/Unit1.dfm
+++ /dev/null
@@ -1,478 +0,0 @@
1-object Form1: TForm1
2- Left = 281
3- Top = 541
4- Width = 531
5- Height = 418
6- Caption = 'SakuraScript Editor Test'
7- Color = clBtnFace
8- Font.Charset = SHIFTJIS_CHARSET
9- Font.Color = clWindowText
10- Font.Height = -12
11- Font.Name = #65325#65331' '#65328#12468#12471#12483#12463
12- Font.Style = []
13- OldCreateOrder = False
14- Position = poDesktopCenter
15- OnResize = FormResize
16- PixelsPerInch = 96
17- TextHeight = 12
18- object Editor1: TEditor
19- Left = 0
20- Top = 0
21- Width = 338
22- Height = 391
23- Cursor = crIBeam
24- Align = alClient
25- Caret.AutoCursor = True
26- Caret.AutoIndent = False
27- Caret.BackSpaceUnIndent = True
28- Caret.Cursors.DefaultCursor = crIBeam
29- Caret.Cursors.DragSelCursor = crDrag
30- Caret.Cursors.DragSelCopyCursor = 2
31- Caret.Cursors.InSelCursor = crDefault
32- Caret.Cursors.LeftMarginCursor = 1
33- Caret.Cursors.TopMarginCursor = crDefault
34- Caret.FreeCaret = False
35- Caret.FreeRow = False
36- Caret.InTab = False
37- Caret.KeepCaret = True
38- Caret.LockScroll = False
39- Caret.NextLine = True
40- Caret.PrevSpaceIndent = False
41- Caret.RowSelect = True
42- Caret.SelDragMode = dmAutomatic
43- Caret.SelMove = True
44- Caret.SoftTab = True
45- Caret.Style = csDefault
46- Caret.TabIndent = False
47- Caret.TabSpaceCount = 8
48- Color = clWindow
49- Fountain = SakuraScriptFountain1
50- Font.Charset = SHIFTJIS_CHARSET
51- Font.Color = clBlack
52- Font.Height = -12
53- Font.Name = #65325#65331' '#12468#12471#12483#12463
54- Font.Style = []
55- HitStyle = hsSelect
56- Imagebar.DigitWidth = 8
57- Imagebar.LeftMargin = 2
58- Imagebar.MarkWidth = 0
59- Imagebar.RightMargin = 2
60- Imagebar.Visible = False
61- Lines.Strings = (
62- '\t\h\s[5]\_s'#12362#12399#12424#12358#12394#65374#12290'<br>\e')
63- Marks.EofMark.Color = clGray
64- Marks.EofMark.Visible = False
65- Marks.RetMark.Color = clGray
66- Marks.RetMark.Visible = False
67- Marks.WrapMark.Color = clGray
68- Marks.WrapMark.Visible = False
69- Marks.HideMark.Color = clGray
70- Marks.HideMark.Visible = False
71- Marks.Underline.Color = clGray
72- Marks.Underline.Visible = False
73- Margin.Character = 0
74- Margin.Left = 2
75- Margin.Line = 0
76- Margin.Top = 2
77- Leftbar.BkColor = clSilver
78- Leftbar.Color = clBlack
79- Leftbar.Column = 1
80- Leftbar.Edge = True
81- Leftbar.LeftMargin = 2
82- Leftbar.RightMargin = 2
83- Leftbar.ShowNumber = True
84- Leftbar.ShowNumberMode = nmRow
85- Leftbar.Visible = False
86- Leftbar.ZeroBase = False
87- Leftbar.ZeroLead = True
88- ReadOnly = False
89- Ruler.BkColor = clSilver
90- Ruler.Color = clBlack
91- Ruler.Edge = True
92- Ruler.GaugeRange = 10
93- Ruler.MarkColor = clBlack
94- Ruler.Visible = True
95- ScrollBars = ssBoth
96- Speed.CaretVerticalAc = 2
97- Speed.InitBracketsFull = False
98- Speed.PageVerticalRange = 2
99- Speed.PageVerticalRangeAc = 2
100- TabOrder = 0
101- UndoListMax = 64
102- View.Brackets = <>
103- View.Colors.Ank.BkColor = clNone
104- View.Colors.Ank.Color = clNone
105- View.Colors.Ank.Style = []
106- View.Colors.Comment.BkColor = clNone
107- View.Colors.Comment.Color = clNone
108- View.Colors.Comment.Style = []
109- View.Colors.DBCS.BkColor = clNone
110- View.Colors.DBCS.Color = clNone
111- View.Colors.DBCS.Style = []
112- View.Colors.Hit.BkColor = clNone
113- View.Colors.Hit.Color = clNone
114- View.Colors.Hit.Style = []
115- View.Colors.Int.BkColor = clNone
116- View.Colors.Int.Color = clNone
117- View.Colors.Int.Style = []
118- View.Colors.Mail.BkColor = clNone
119- View.Colors.Mail.Color = clNone
120- View.Colors.Mail.Style = []
121- View.Colors.Reserve.BkColor = clNone
122- View.Colors.Reserve.Color = clNone
123- View.Colors.Reserve.Style = []
124- View.Colors.Select.BkColor = clNavy
125- View.Colors.Select.Color = clWhite
126- View.Colors.Select.Style = []
127- View.Colors.Str.BkColor = clNone
128- View.Colors.Str.Color = clNone
129- View.Colors.Str.Style = []
130- View.Colors.Symbol.BkColor = clNone
131- View.Colors.Symbol.Color = clNone
132- View.Colors.Symbol.Style = []
133- View.Colors.Url.BkColor = clNone
134- View.Colors.Url.Color = clNone
135- View.Colors.Url.Style = []
136- View.ControlCode = False
137- View.Mail = False
138- View.Url = False
139- WantReturns = True
140- WantTabs = True
141- WordWrap = True
142- WrapOption.FollowRetMark = False
143- WrapOption.FollowPunctuation = False
144- WrapOption.FollowStr = #12289#12290#65292#65294#12539#65311#65281#12443#12444#12541#12542#12445#12446#12293#12540#65289#65341#65373#12301#12303'!),.:;?]}'#65377#65379#65380#65381#65392#65438#65439
145- WrapOption.Leading = False
146- WrapOption.LeadStr = #65288#65339#65371#12300#12302'([{'#65378
147- WrapOption.PunctuationStr = #12289#12290#65292#65294',.'#65377#65380
148- WrapOption.WordBreak = False
149- WrapOption.WrapByte = 40
150- end
151- object Memo1: TMemo
152- Left = 338
153- Top = 0
154- Width = 185
155- Height = 391
156- Align = alRight
157- Lines.Strings = (
158- 'Memo1')
159- TabOrder = 1
160- OnClick = Memo1Click
161- end
162- object SakuraScriptFountain1: TSakuraScriptFountain
163- Brackets = <>
164- Reserve.BkColor = clNone
165- Reserve.Color = clNone
166- Reserve.Style = []
167- Scope0Color.BkColor = clNone
168- Scope0Color.Color = clNavy
169- Scope0Color.Style = []
170- Scope1Color.BkColor = clNone
171- Scope1Color.Color = clOlive
172- Scope1Color.Style = []
173- TagColor.BkColor = clNone
174- TagColor.Color = clLime
175- TagColor.Style = []
176- TagErrorColor.BkColor = clNone
177- TagErrorColor.Color = clRed
178- TagErrorColor.Style = [fsBold]
179- MetaWordColor.BkColor = clNone
180- MetaWordColor.Color = clBlue
181- MetaWordColor.Style = [fsBold]
182- SynchronizedColor.BkColor = clNone
183- SynchronizedColor.Color = clFuchsia
184- SynchronizedColor.Style = []
185- SakuraScriptParser = SsParser1
186- Left = 16
187- Top = 320
188- end
189- object SsParser1: TSsParser
190- TagPattern.Strings = (
191- '\h'
192- '\u'
193- '\s[%D]'
194- '\s[-%D]'
195- '\s%d'
196- '!s%b'
197- '!s%.'
198- '!b%b'
199- '!b%.'
200- '!f%b'
201- '\n[half]'
202- '!n%b'
203- '\n'
204- '\w%d'
205- '!w%.'
206- '\e'
207- '\t'
208- '\_s'
209- '\_q'
210- '!j%b'
211- '!j'
212- '\c'
213- '\URL%b%b%b%b%b%b%b%b%b%b%b%b%b%b%b'
214- '\URL%b%b%b%b%b%b%b%b%b%b%b%b%b'
215- '\URL%b%b%b%b%b%b%b%b%b%b%b'
216- '\URL%b%b%b%b%b%b%b%b%b'
217- '\URL%b%b%b%b%b%b%b'
218- '\URL%b%b%b%b%b'
219- '\URL%b%b%b'
220- '\URL%b'
221- '!x'
222- '!l%b'
223- '!q%d%b%b'
224- '!q%d%b'
225- '!q%d'
226- '!z'
227- '!y'
228- '!*'
229- '!v'
230- '!_v%b'
231- '!_V'
232- '!8%b'
233- '!8'
234- '!m%b'
235- '!m'
236- '!i[%D]'
237- '!i%.'
238- '!_i'
239- '!a'
240- '!_c%b'
241- '!_c'
242- '!__c'
243- '!__t'
244- '!-'
245- '!+'
246- '!_b%b'
247- '!1'
248- '!2'
249- '!3'
250- '!4'
251- '!5'
252- '!6'
253- '!7'
254- '!|'
255- '!_w%b'
256- '!_+')
257- MetaPattern.Strings = (
258- 'selfname2'
259- 'selfname'
260- 'keroname'
261- 'username'
262- 'screenwidth'
263- 'screenheight'
264- 'month'
265- 'day'
266- 'hour'
267- 'minute'
268- 'second'
269- 'wronghour'
270- 'songname'
271- 'j%b'
272- 'exh'
273- 'by'
274- 'bm'
275- 'bd'
276- 'et'
277- 'ms'
278- 'mz'
279- 'ml'
280- 'mc'
281- 'mh'
282- 'mt'
283- 'me'
284- 'mp'
285- 'm?'
286- 'dms'
287- 'c'
288- '0'
289- '1')
290- Left = 16
291- Top = 288
292- end
293- object HTMLFountain1: THTMLFountain
294- FileExtList.Strings = (
295- '.htm'
296- '.html')
297- Brackets = <
298- item
299- ItemColor.BkColor = clNone
300- ItemColor.Color = clPurple
301- ItemColor.Style = []
302- LeftBracket = '<!--'
303- RightBracket = '-->'
304- end>
305- Reserve.BkColor = clNone
306- Reserve.Color = clNone
307- Reserve.Style = []
308- Ampersand.BkColor = clNone
309- Ampersand.Color = clNone
310- Ampersand.Style = []
311- Mail.BkColor = clNone
312- Mail.Color = clGray
313- Mail.Style = []
314- Str.BkColor = clNone
315- Str.Color = clNone
316- Str.Style = []
317- TagAttribute.BkColor = clNone
318- TagAttribute.Color = clFuchsia
319- TagAttribute.Style = []
320- TagAttributeValue.BkColor = clNone
321- TagAttributeValue.Color = clYellow
322- TagAttributeValue.Style = []
323- TagColor.BkColor = clNone
324- TagColor.Color = clOlive
325- TagColor.Style = []
326- TagElement.BkColor = clNone
327- TagElement.Color = clGreen
328- TagElement.Style = [fsBold]
329- Url.BkColor = clNone
330- Url.Color = clNone
331- Url.Style = []
332- Left = 16
333- Top = 216
334- end
335- object DelphiFountain1: TDelphiFountain
336- FileExtList.Strings = (
337- '.dpr'
338- '.inc'
339- '.pas')
340- Brackets = <
341- item
342- ItemColor.BkColor = clNone
343- ItemColor.Color = clOlive
344- ItemColor.Style = []
345- LeftBracket = '{'
346- RightBracket = '}'
347- end
348- item
349- ItemColor.BkColor = clNone
350- ItemColor.Color = clOlive
351- ItemColor.Style = []
352- LeftBracket = '(*'
353- RightBracket = '*)'
354- end>
355- Reserve.BkColor = clNone
356- Reserve.Color = clBlue
357- Reserve.Style = [fsBold]
358- ReserveWordList.Strings = (
359- 'absolute'
360- 'abstract'
361- 'and'
362- 'array'
363- 'as'
364- 'asm'
365- 'assembler'
366- 'automated'
367- 'begin'
368- 'case'
369- 'cdecl'
370- 'class'
371- 'const'
372- 'constructor'
373- 'default'
374- 'destructor'
375- 'dispid'
376- 'dispinterface'
377- 'div'
378- 'do'
379- 'downto'
380- 'dynamic'
381- 'else'
382- 'end'
383- 'except'
384- 'export'
385- 'exports'
386- 'external'
387- 'far'
388- 'file'
389- 'finalization'
390- 'finally'
391- 'for'
392- 'forward'
393- 'function'
394- 'goto'
395- 'if'
396- 'implementation'
397- 'in'
398- 'inherited'
399- 'initialization'
400- 'inline'
401- 'interface'
402- 'is'
403- 'label'
404- 'library'
405- 'message'
406- 'mod'
407- 'near'
408- 'nil'
409- 'nodefault'
410- 'not'
411- 'object'
412- 'of'
413- 'or'
414- 'out'
415- 'overload'
416- 'override'
417- 'packed'
418- 'pascal'
419- 'private'
420- 'procedure'
421- 'program'
422- 'property'
423- 'protected'
424- 'public'
425- 'published'
426- 'raise'
427- 'readonly'
428- 'record'
429- 'register'
430- 'repeat'
431- 'resident'
432- 'resourcestring'
433- 'safecall'
434- 'set'
435- 'shl'
436- 'shr'
437- 'stdcall'
438- 'stored'
439- 'string'
440- 'then'
441- 'threadvar'
442- 'to'
443- 'try'
444- 'type'
445- 'unit'
446- 'until'
447- 'uses'
448- 'var'
449- 'virtual'
450- 'while'
451- 'with'
452- 'writeonly'
453- 'xor')
454- Ank.BkColor = clNone
455- Ank.Color = clBlack
456- Ank.Style = []
457- AsmBlock.BkColor = clNone
458- AsmBlock.Color = clNone
459- AsmBlock.Style = []
460- Comment.BkColor = clNone
461- Comment.Color = clOlive
462- Comment.Style = []
463- DBCS.BkColor = clNone
464- DBCS.Color = clNone
465- DBCS.Style = []
466- Int.BkColor = clNone
467- Int.Color = clNone
468- Int.Style = []
469- Str.BkColor = clNone
470- Str.Color = clNone
471- Str.Style = []
472- Symbol.BkColor = clNone
473- Symbol.Color = clNone
474- Symbol.Style = []
475- Left = 16
476- Top = 248
477- end
478-end
--- a/sakurasuite/sample_editor/Unit1.pas
+++ /dev/null
@@ -1,43 +0,0 @@
1-unit Unit1;
2-
3-interface
4-
5-uses
6- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7- Dialogs, heClasses, heFountain, SakuraScriptFountain, HEditor, SsParser,
8- HTMLFountain, StdCtrls, DelphiFountain;
9-
10-type
11- TForm1 = class(TForm)
12- Editor1: TEditor;
13- SakuraScriptFountain1: TSakuraScriptFountain;
14- SsParser1: TSsParser;
15- HTMLFountain1: THTMLFountain;
16- Memo1: TMemo;
17- DelphiFountain1: TDelphiFountain;
18- procedure Memo1Click(Sender: TObject);
19- procedure FormResize(Sender: TObject);
20- private
21- { Private 宣言 }
22- public
23- { Public 宣言 }
24- end;
25-
26-var
27- Form1: TForm1;
28-
29-implementation
30-
31-{$R *.dfm}
32-
33-procedure TForm1.Memo1Click(Sender: TObject);
34-begin
35- Memo1.Lines.Clear;
36-end;
37-
38-procedure TForm1.FormResize(Sender: TObject);
39-begin
40- Editor1.WrapOption.WrapByte := (Editor1.Width - 30) div 6;
41-end;
42-
43-end.
--- a/sakurasuite/sample_parser/Project1.dpr
+++ /dev/null
@@ -1,13 +0,0 @@
1-program Project1;
2-
3-uses
4- Forms,
5- Unit1 in 'Unit1.pas' {Form1};
6-
7-{$R *.RES}
8-
9-begin
10- Application.Initialize;
11- Application.CreateForm(TForm1, Form1);
12- Application.Run;
13-end.
Binary files a/sakurasuite/sample_parser/Project1.res and /dev/null differ
--- a/sakurasuite/sample_parser/Unit1.dfm
+++ /dev/null
@@ -1,200 +0,0 @@
1-object Form1: TForm1
2- Left = 228
3- Top = 248
4- Width = 467
5- Height = 360
6- Caption = 'Test'
7- Color = clBtnFace
8- Font.Charset = SHIFTJIS_CHARSET
9- Font.Color = clWindowText
10- Font.Height = -12
11- Font.Name = #65325#65331' '#65328#12468#12471#12483#12463
12- Font.Style = []
13- OldCreateOrder = False
14- DesignSize = (
15- 459
16- 333)
17- PixelsPerInch = 96
18- TextHeight = 12
19- object Edit1: TEdit
20- Left = 8
21- Top = 16
22- Width = 448
23- Height = 20
24- Anchors = [akLeft, akTop, akRight]
25- TabOrder = 0
26- Text = '\t'#12362#12399#12424#12358'\e'
27- end
28- object Button1: TButton
29- Left = 8
30- Top = 80
31- Width = 75
32- Height = 25
33- Caption = 'Parse'
34- TabOrder = 1
35- OnClick = Button1Click
36- end
37- object ListView1: TListView
38- Left = 0
39- Top = 139
40- Width = 459
41- Height = 194
42- Align = alBottom
43- Anchors = [akLeft, akTop, akRight, akBottom]
44- Columns = <
45- item
46- Caption = #12479#12452#12503
47- Width = 100
48- end
49- item
50- Caption = 'Index'
51- end
52- item
53- Caption = #25991#23383#21015
54- Width = 150
55- end
56- item
57- Alignment = taRightJustify
58- Caption = #12458#12501#12475#12483#12488
59- Width = 100
60- end>
61- TabOrder = 2
62- ViewStyle = vsReport
63- end
64- object Edit2: TEdit
65- Left = 8
66- Top = 48
67- Width = 448
68- Height = 20
69- Anchors = [akLeft, akTop, akRight]
70- TabOrder = 3
71- Text = '\t'
72- end
73- object Button2: TButton
74- Left = 88
75- Top = 80
76- Width = 75
77- Height = 25
78- Caption = 'Match'
79- TabOrder = 4
80- OnClick = Button2Click
81- end
82- object CheckBox1: TCheckBox
83- Left = 16
84- Top = 112
85- Width = 137
86- Height = 17
87- Caption = 'EscapeInvalidMeta'
88- TabOrder = 5
89- OnClick = CheckBox1Click
90- end
91- object CheckBox2: TCheckBox
92- Left = 184
93- Top = 113
94- Width = 97
95- Height = 15
96- Caption = 'LeaveEscape'
97- Checked = True
98- State = cbChecked
99- TabOrder = 6
100- OnClick = CheckBox2Click
101- end
102- object Button3: TButton
103- Left = 168
104- Top = 80
105- Width = 75
106- Height = 25
107- Caption = 'GetParam'
108- TabOrder = 7
109- OnClick = Button3Click
110- end
111- object Button4: TButton
112- Left = 248
113- Top = 80
114- Width = 75
115- Height = 25
116- Caption = 'Benchmark'
117- TabOrder = 8
118- OnClick = Button4Click
119- end
120- object SsParser: TSsParser
121- TagPattern.Strings = (
122- '\h '
123- '\u'
124- '\s[%D]'
125- '\s%d'
126- '!s%b'
127- '!s%.'
128- '\b[%D]'
129- '\b%d'
130- '!b%b'
131- '!b%.'
132- '\n'
133- '\w%d'
134- '!w%.'
135- '\e'
136- '\t'
137- '\j%b'
138- '!j'
139- '\c'
140- '\x'
141- '\q%d%b%b'
142- '\z'
143- '\y'
144- '\*'
145- '\v'
146- '\8%b'
147- '\m%b'
148- '\i[%D]'
149- '\i%d'
150- '!i%b'
151- '!i%.'
152- '\_i '
153- '\a'
154- '\_c%b'
155- '\__c'
156- '\-'
157- '\1'
158- '\2'
159- '\3'
160- '\4'
161- '\|')
162- MetaPattern.Strings = (
163- 'selfname2'
164- 'selfname'
165- 'keroname'
166- 'username'
167- 'screenwidth'
168- 'screenheight'
169- 'month'
170- 'day'
171- 'hour'
172- 'minute'
173- 'second'
174- 'j%b'
175- 'exh'
176- 'by'
177- 'bm'
178- 'bd'
179- 'o'
180- 'd'
181- 'h'
182- 'm'
183- 's'
184- 'c'
185- '0'
186- '1'
187- 'et'
188- 'ms'
189- 'mz'
190- 'mc'
191- 'mh'
192- 'mt'
193- 'me'
194- 'mp'
195- 'm?'
196- 'dms')
197- Left = 376
198- Top = 80
199- end
200-end
--- a/sakurasuite/sample_parser/Unit1.pas
+++ /dev/null
@@ -1,100 +0,0 @@
1-unit Unit1;
2-
3-interface
4-
5-uses
6- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7- SsParser, ComCtrls, StdCtrls;
8-
9-type
10- TForm1 = class(TForm)
11- Edit1: TEdit;
12- Button1: TButton;
13- ListView1: TListView;
14- SsParser: TSsParser;
15- Edit2: TEdit;
16- Button2: TButton;
17- CheckBox1: TCheckBox;
18- CheckBox2: TCheckBox;
19- Button3: TButton;
20- Button4: TButton;
21- procedure Button1Click(Sender: TObject);
22- procedure Button2Click(Sender: TObject);
23- procedure CheckBox2Click(Sender: TObject);
24- procedure CheckBox1Click(Sender: TObject);
25- procedure Button3Click(Sender: TObject);
26- procedure Button4Click(Sender: TObject);
27- private
28- { Private 宣言 }
29- public
30- { Public 宣言 }
31- end;
32-
33-var
34- Form1: TForm1;
35-
36-implementation
37-
38-{$R *.DFM}
39-
40-procedure TForm1.Button1Click(Sender: TObject);
41-var i: integer;
42- Li: TListItem;
43-begin
44- ListView1.Items.Clear;
45- SsParser.InputString := Edit1.Text;
46- for i := 0 to SsParser.Count-1 do begin
47- Li := ListView1.Items.Add;
48- case SsParser.MarkUpType[i] of
49- mtTag: Li.Caption := 'Tag';
50- mtTagErr: Li.Caption := 'TagErr';
51- mtMeta: Li.Caption := 'Meta';
52- mtStr: Li.Caption := 'Str';
53- end;
54- Li.SubItems.Add(IntToStr(i));
55- Li.SubItems.Add(SsParser[i]);
56- Li.SubItems.Add(IntToStr(SsParser.Position[i]));
57- end;
58-end;
59-
60-procedure TForm1.Button2Click(Sender: TObject);
61-var i: integer;
62- Str: String;
63-begin
64- i := SsParser.Match(Edit1.Text, Edit2.Text);
65- Str := Copy(Edit1.Text, 1, i);
66- ShowMessage(IntToStr(i) + #13#10 + Str);
67-end;
68-
69-procedure TForm1.CheckBox2Click(Sender: TObject);
70-begin
71- SsParser.LeaveEscape := CheckBox2.Checked;
72-end;
73-
74-procedure TForm1.CheckBox1Click(Sender: TObject);
75-begin
76- SsParser.EscapeInvalidMeta := CheckBox1.Checked;
77-end;
78-
79-procedure TForm1.Button3Click(Sender: TObject);
80-begin
81- try
82- ShowMessage(SsParser.GetParam(Edit1.Text, StrToInt(Edit2.Text)));
83- except
84- on EConvertError do ShowMessage('Edit2 is not Integer');
85- end;
86-end;
87-
88-procedure TForm1.Button4Click(Sender: TObject);
89-var i: integer;
90- from: Int64;
91-const
92- loop = 100;
93-begin
94- from := GetTickCount;
95- for i := 1 to loop do
96- SsParser.InputString := Edit1.Text;
97- ShowMessage(Format('%d loops, %d ms.', [loop, GetTickCount - from]));
98-end;
99-
100-end.
--- a/sakurasuite/sample_parser/pattern.txt
+++ /dev/null
@@ -1,85 +0,0 @@
1-以下は、SsParserのTagPatternに使えるパターン文字列例です。
2-2001年3月31日現在の最新版に対応していると思います。
3-古いマークアップも残っていますので自分でよく確かめてください、開発者なら…
4-
5-スクリプトの目的によっても以下のパターンは変わってくるでしょうし、
6-また将来タグが増えたり減ったりすることを考えると、
7-外部ファイルから読み込むような形式にしておくといいかもしれません。
8-
9-===============以下TagPattern===========
10-\h
11-\u
12-\s[%D]
13-\s%d
14-!s%b
15-!s%.
16-\b[%D]
17-\b%d
18-!b%b
19-!b%.
20-\n
21-\w%d
22-!w%.
23-\e
24-\t
25-\j%b
26-!j
27-\c
28-\x
29-\q%d%b%b
30-\z
31-\y
32-\*
33-\v
34-\8%b
35-\m%b
36-\i[%D]
37-\i%d
38-!i%b
39-!i%.
40-\_i
41-\a
42-\_c%b
43-\__c
44-\-
45-\1
46-\2
47-\3
48-\4
49-\|
50-
51-================以下MetaPattern==================
52-selfname2
53-selfname
54-keroname
55-username
56-screenwidth
57-screenheight
58-month
59-day
60-hour
61-minute
62-second
63-j%b
64-exh
65-by
66-bm
67-bd
68-o
69-d
70-h
71-m
72-s
73-c
74-0
75-1
76-et
77-ms
78-mz
79-mc
80-mh
81-mt
82-me
83-mp
84-m?
85-dms
\ No newline at end of file
--- a/sakurasuite/sample_seeker/Project1.dpr
+++ /dev/null
@@ -1,13 +0,0 @@
1-program Project1;
2-
3-uses
4- Forms,
5- Unit1 in 'Unit1.pas' {Form1};
6-
7-{$R *.RES}
8-
9-begin
10- Application.Initialize;
11- Application.CreateForm(TForm1, Form1);
12- Application.Run;
13-end.
Binary files a/sakurasuite/sample_seeker/Project1.res and /dev/null differ
--- a/sakurasuite/sample_seeker/Unit1.dfm
+++ /dev/null
@@ -1,112 +0,0 @@
1-object Form1: TForm1
2- Left = 286
3- Top = 205
4- Width = 393
5- Height = 241
6- Caption = 'SakuraSeeker Test Program'
7- Color = clBtnFace
8- Font.Charset = SHIFTJIS_CHARSET
9- Font.Color = clWindowText
10- Font.Height = -12
11- Font.Name = 'MS Pゴシック'
12- Font.Style = []
13- Menu = MainMenu1
14- OldCreateOrder = False
15- OnCreate = FormCreate
16- PixelsPerInch = 96
17- TextHeight = 12
18- object ListView1: TListView
19- Left = 0
20- Top = 0
21- Width = 385
22- Height = 152
23- Align = alClient
24- Columns = <
25- item
26- Caption = 'ID'
27- Width = 150
28- end
29- item
30- Caption = 'HWND'
31- Width = 80
32- end
33- item
34- Caption = 'Name'
35- Width = 150
36- end>
37- HideSelection = False
38- ReadOnly = True
39- TabOrder = 0
40- ViewStyle = vsReport
41- end
42- object StatusBar1: TStatusBar
43- Left = 0
44- Top = 176
45- Width = 385
46- Height = 19
47- Panels = <>
48- SimplePanel = True
49- end
50- object Panel1: TPanel
51- Left = 0
52- Top = 152
53- Width = 385
54- Height = 24
55- Align = alBottom
56- BevelOuter = bvNone
57- TabOrder = 2
58- object Button1: TButton
59- Left = 8
60- Top = 0
61- Width = 105
62- Height = 25
63- Caption = '&Send DirectSSTP'
64- TabOrder = 0
65- OnClick = Button1Click
66- end
67- object Button2: TButton
68- Left = 152
69- Top = 0
70- Width = 75
71- Height = 25
72- Caption = 'Test2'
73- TabOrder = 1
74- OnClick = Button2Click
75- end
76- end
77- object SakuraSeeker1: TSakuraSeeker
78- OnAfterDetection = SakuraSeeker1AfterDetection
79- OnDetectResultChanged = SakuraSeeker1DetectResultChanged
80- FileMappingTarget.Strings = (
81- 'Sakura'
82- 'Usagi'
83- 'UmiUmi')
84- Left = 16
85- Top = 32
86- end
87- object MainMenu1: TMainMenu
88- Left = 176
89- Top = 96
90- object File1: TMenuItem
91- Caption = '&File'
92- object Update1: TMenuItem
93- Caption = '&Update'
94- OnClick = Update1Click
95- end
96- object Exit1: TMenuItem
97- Caption = '&Exit'
98- OnClick = Exit1Click
99- end
100- end
101- end
102- object Timer1: TTimer
103- Enabled = False
104- OnTimer = Timer1Timer
105- Left = 48
106- Top = 32
107- end
108- object TestDSstp1: TTestDSstp
109- Left = 176
110- Top = 32
111- end
112-end
--- a/sakurasuite/sample_seeker/Unit1.pas
+++ /dev/null
@@ -1,126 +0,0 @@
1-unit Unit1;
2-
3-interface
4-
5-uses
6- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7- SakuraSeeker, ComCtrls, Menus, ExtCtrls, StdCtrls, TestDSstp;
8-
9-type
10- TForm1 = class(TForm)
11- ListView1: TListView;
12- StatusBar1: TStatusBar;
13- SakuraSeeker1: TSakuraSeeker;
14- MainMenu1: TMainMenu;
15- File1: TMenuItem;
16- Update1: TMenuItem;
17- Exit1: TMenuItem;
18- Timer1: TTimer;
19- Panel1: TPanel;
20- Button1: TButton;
21- TestDSstp1: TTestDSstp;
22- Button2: TButton;
23- procedure FormCreate(Sender: TObject);
24- procedure Exit1Click(Sender: TObject);
25- procedure Update1Click(Sender: TObject);
26- procedure SakuraSeeker1AfterDetection(Sender: TObject);
27- procedure SakuraSeeker1DetectResultChanged(Sender: TObject);
28- procedure Timer1Timer(Sender: TObject);
29- procedure Button1Click(Sender: TObject);
30- procedure Button2Click(Sender: TObject);
31- private
32- { Private 宣言 }
33- protected
34- procedure GetMessage(var Message: TWMCopyData); message WM_COPYDATA;
35- public
36- { Public 宣言 }
37- procedure Update;
38- end;
39-
40-var
41- Form1: TForm1;
42-
43-implementation
44-
45-{$R *.DFM}
46-
47-procedure TForm1.FormCreate(Sender: TObject);
48-var SakuraSeeker: TSakuraSeeker;
49-begin
50- SakuraSeeker := TSakuraSeeker.Create(Self);
51- SakuraSeeker.BeginDetect;
52-end;
53-
54-procedure TForm1.Exit1Click(Sender: TObject);
55-begin
56- Close;
57-end;
58-
59-procedure TForm1.Update1Click(Sender: TObject);
60-begin
61- SakuraSeeker1.BeginDetect;
62- Update;
63-end;
64-
65-procedure TForm1.Update;
66-var i: integer;
67- Item: TListItem;
68-begin
69- ListView1.Items.Clear;
70- for i := 0 to SakuraSeeker1.Count-1 do begin
71- Item := ListView1.Items.Add;
72- Item.Caption := SakuraSeeker1[i].ProcessID;
73- Item.SubItems.Add(IntToStr(SakuraSeeker1[i].HWnd));
74- Item.SubItems.Add(SakuraSeeker1[i].Name);
75- end;
76-end;
77-
78-procedure TForm1.SakuraSeeker1AfterDetection(Sender: TObject);
79-begin
80- StatusBar1.SimpleText := IntToStr(SakuraSeeker1.Count) + '件 ' +
81- DateTimeToStr(Now);
82- Update;
83-end;
84-
85-procedure TForm1.SakuraSeeker1DetectResultChanged(Sender: TObject);
86-begin
87- ShowMessage('Status Changed!');
88-end;
89-
90-procedure TForm1.Timer1Timer(Sender: TObject);
91-begin
92- SakuraSeeker1.BeginDetect;
93-end;
94-
95-procedure TForm1.Button1Click(Sender: TObject);
96-var Target: THandle;
97- Dat: TCopyDataStruct;
98- Str: String;
99-begin
100- if ListView1.Selected = nil then Exit;
101- Target := SakuraSeeker1[ListView1.Selected.Index].HWnd;
102-
103- Str := 'SEND SSTP/1.4'#13#10'HWnd: '+IntToStr(Form1.Handle)+#13#10'Charset: Shift_JIS'#13#10 +
104- 'Sender: Tester'#13#10'Script: \tてすてす。\e'#13#10#13#10;
105-
106- Dat.dwData := 9801;
107- Dat.cbData := Length(Str);
108- Dat.lpData := PChar(Str);
109-
110- SendMessage(Target, WM_COPYDATA, Form1.Handle, LPARAM(@Dat));
111-
112-end;
113-
114-procedure TForm1.GetMessage(var Message: TWMCopyData);
115-begin
116- inherited;
117- ShowMessage(PChar(Message.CopyDataStruct^.lpData));
118-end;
119-
120-procedure TForm1.Button2Click(Sender: TObject);
121-begin
122- if SakuraSeeker1.Count > 0 then
123- TestDSstp1.Go(SakuraSeeker1[0].HWnd);
124-end;
125-
126-end.
Binary files a/sakurasuite/ssparser.dcr and /dev/null differ
--- a/sakurasuite/ssparser.html
+++ /dev/null
@@ -1,330 +0,0 @@
1-<html>
2-
3-<head>
4-<meta http-equiv="Content-Language" content="ja">
5-<meta http-equiv="Content-Type" content="text/html; charset=shift_jis">
6-<meta name="GENERATOR" content="Microsoft FrontPage 4.0">
7-<meta name="ProgId" content="FrontPage.Editor.Document">
8-<title>TSsParser</title>
9-<style>
10-<!--
11-body { background-color: #FFFFFF; font-family: MS ゴシック; color: #000000;
12- font-size: 9pt; margin-left: 20px }
13-td, th { font-size: 9pt }
14-h1, h2, h3, h4, h5, h6 { margin-left: -10px }
15-p { margin-top: 4px; margin-bottom: 4px }
16-h1 { border: 2pt solid black }
17-h2 { background-color: silver; border: 1pt solid gray }
18-strong { text-decoration: underline; font-weight: bolder; color: brown }
19-em { color: brown; font-style: normal }
20-code { font-size: 100%; font-family: MS ゴシック; color: green }
21--->
22-</style>
23-</head>
24-
25-<body>
26-
27-<h1>TSsParser</h1>
28-<p>「さくらスクリプト」の多機能パーサ機能を持つ非ビジュアルコンポーネントです。単一行のさくらスクリプトを処理します。つまり典型的には\tから始まり\eで終わる、1行のスクリプトです。Entryなどが絡んだ複数行スクリプトには対応していませんが、補助としては使えます。</p>
29-<h2>主な用途</h2>
30-<ul>
31- <li>独自のSSTPサーバを構築する場合の補助</li>
32- <li>さくらスクリプトのエディタ作成のための補助(色分け、タグチェック、etc...)</li>
33- <li>SSTPクライアントを構築する場合の、事前のタグチェック</li>
34-</ul>
35-<h2>使用条件</h2>
36-<ul>
37- <li>いわゆるフリーの範疇に含まれるソフトです。著作権は放棄していません。以下の条件にしたがってお使いください。</li>
38- <li>試用はもちろん自由ですが、<strong>このコンポーネントを使用したプログラムを公開する場合は、作者に一報する必要があります。</strong>これは、バグが発見された場合などに連絡するためと、単に作者が把握しておきたいから、です。</li>
39- <li>自作プログラムで使用する場合においての改変・改造はご自由にどうぞ。</li>
40- <li>コンポーネント自体としての再配布は、改変/未改変の別や形態(ソース/バイナリ)に関わらず、原則禁止します。</li>
41- <li>ドキュメントなどにこのコンポーネントの著作権表示しろ、といった面倒なことを強制はしません。書いてくれれば喜びますが。</li>
42- <li>お約束ですが、コンポーネントを使用した/しなかったことによって発生するあらゆる責任はとれません。自己責任でお使いください。</li>
43-</ul>
44-<h2>SYNOPSIS - 基本的な使い方</h2>
45-<p>TagPattern, MetaPatternプロパティに、さくらスクリプトの解析の基準となるパターンを指定します。添付されているテキストファイルをコピーすれば一応OKです。</p>
46-<p>InputStringプロパティに、スクリプトを指定すれば、スクリプトが解析され、Count,
47-MarkUpType, Strの各プロパティを通してアクセスできます。</p>
48-<p>例えば、「<code>\t\s[0]いらっしゃい%ませ、%usernameさん、\s[5]\\300のお\買い上げになりますね\e</code>」という文字列をInputStringに入れた場合には、Count=10となり、MarkUpType,
49-Strプロパティには以下のような値が入ります。</p>
50-<p>TSsParserでは、Indexで区別されるスクリプト素片、つまり下の表における各行を<strong>「エレメント」</strong>と呼ぶことにします。</p>
51-<table border="1">
52- <tr>
53- <th>Index</th>
54- <th>Str[Index]</th>
55- <th>MarkUpType[Index]</th>
56- </tr>
57- <tr>
58- <td>0</td>
59- <td>\t</td>
60- <td>mtTag</td>
61- </tr>
62- <tr>
63- <td>1</td>
64- <td>\s[0]</td>
65- <td>mtTag</td>
66- </tr>
67- <tr>
68- <td>2</td>
69- <td>いらっしゃい%ませ、<em><sup>※</sup></em></td>
70- <td>mtStr</td>
71- </tr>
72- <tr>
73- <td>3</td>
74- <td>%username</td>
75- <td>mtMeta</td>
76- </tr>
77- <tr>
78- <td>4</td>
79- <td>さん、</td>
80- <td>mtStr</td>
81- </tr>
82- <tr>
83- <td>5</td>
84- <td>\s[5]</td>
85- <td>mtTag</td>
86- </tr>
87- <tr>
88- <td>6</td>
89- <td>\\300のお<em><sup>※</sup></em></td>
90- <td>mtStr</td>
91- </tr>
92- <tr>
93- <td>7</td>
94- <td>\買</td>
95- <td>mtTagErr</td>
96- </tr>
97- <tr>
98- <td>8</td>
99- <td>い上げになりますね</td>
100- <td>mtStr</td>
101- </tr>
102- <tr>
103- <td>9</td>
104- <td>\e</td>
105- <td>mtTag</td>
106- </tr>
107-</table>
108-<ul>
109- <li>これはデフォルトのパターンを使用した典型的な解析の結果であり、解析結果はパターンによって変化します。極端に言えば、\w8をタグとして認識しない、ということも可能です。</li>
110- <li>Str[2]については、EscapeInvalidMeta = falseの場合の結果です。trueの場合は、「いらっしゃい\%ませ」となります。</li>
111- <li>Str[6]については、LeaveEscape = trueの場合の結果です。falseの場合は、「\300のお」となります。</li>
112-</ul>
113-<h2>リファレンス-プロパティ</h2>
114-<h3>LeaveEscape: boolean [実/設][読/書]</h3>
115-<p>デフォルトはtrueです。mtStrで切り出された通常文字列に含まれる、<code>\\</code>
116-や <code>\%</code>
117-の文字列を変換せずに残すかどうか設定します。falseにすることで、<code>\\</code>
118-や <code>\%</code> は1文字に変換されてmtStrエレメントに代入されます。</p>
119-<p>TSsParserをスクリプトの色分けや、危険タグチェックなどに使用する場合は、文字列長やスクリプトそのものが変わらないようにtrueにします。独自SSTPサーバ開発の場合などは、falseにすることで変換の手間を省けます。</p>
120-<p>変更した場合、その結果は次回の解析から反映されます。</p>
121-<h3>EscapeInvalidMeta: boolean [実/設][読/書]</h3>
122-<p>デフォルトはfalseです。MetaPatternによって、%文字以降がメタ文字列と判断できない場合、%文字を「\%」にエスケープするかどうか設定します。</p>
123-<p>TSsParserをスクリプトの色分けなどに使用する場合は、文字列長が変わらないようにfalseにします。堅牢なスクリプト作成のための文法チェックのためにはtrueにします。</p>
124-<p>変更した場合、その結果は次回の解析から反映されます。</p>
125-<h3>TagPattern: TStrings [実/設][読/書]<br>
126-MetaPattern: TStrings [実/設][読/書]</h3>
127-<p>それぞれ、タグ切り出しのためのパターン、メタ文字列切り出しのためのパターンです。別項「パターンについて」参照。変更した場合、その結果は次回の解析から反映されます。</p>
128-<h3>InputString: String [実のみ][読/書]</h3>
129-<p>このプロパティに書き込んで、解析すべきスクリプトを設定します。読み出しの場合は最後に解析したスクリプトが入っています。</p>
130-<h3>Count: integer [実のみ][読のみ]</h3>
131-<p>スクリプト解析後のエレメント総数を返します。スクリプトエレメントをループ処理する場合の上限値として使用します。</p>
132-<h3>Str[Index: integer]: String [実のみ][読のみ]</h3>
133-<p>解析後の文字列を返します。最初のエレメントはStr[0]、最後のエレメントはStr[Count-1]です。LeaveExcape,
134-EscapeInavlidMetaの両プロパティの影響を受けます。</p>
135-<h3>Extra[Index: integer]: String [実のみ][読/書]</h3>
136-<p>ご自由にお使いください、の文字列です。解析結果にメモをつけたりする用途にどうぞ。</p>
137-<h3>MarkUpType[Index: integer]: TSsMarkUpType [実のみ][読のみ]</h3>
138-<p><code>type TSsMarkUpType = (mtTag, mtMeta, mtTagErr, mtStr);</code></p>
139-<p>エレメントの種類を返します。最初のエレメントはMarkUpType[0]、最後のエレメントはMarkUpType[Count-1]です。</p>
140-<h2>リファレンス-イベント</h2>
141-<h3>OnSsParse: TSsParseEvent</h3>
142-<p><code>TSsParseEvent = procedure (Sender: TObject; const Script: String;<br>
143-var Len: integer; var MarkType: TSsMarkUpType; var Extra: String) of object;</code></p>
144-<p>タグまたはメタ文字列のパターンマッチ試行の前に呼び出されます。このイベントを使用すると、TagPattern,
145-MetaPatternの仕様では切り出せないマークアップが将来できた場合に、スクリプトからのタグやメタ文字列の切り出しを自由にコーディングできます。</p>
146-<p>Scriptは解析途中のスクリプトです。1文字目は必ず「\」または「%」となっています。Lenは呼び出し時には0が代入されています。</p>
147-<p>このイベントハンドラ内で、Scriptの先頭から始まる部分を解析します。エレメントを解釈できた場合はそエレメントの長さ(バイト数)をLen(&gt;2)に、タイプをMarkTypeに、必要ならExtraに文字列を入れて、イベントハンドラを終了してください。解釈できない場合はLen=0のまま終了すれば、そのまま通常のパターンマッチ試行に入ります。</p>
148-<p>要は、文字列先頭からここまでがタグ(メタ文字列)だよ、というのを見つけて返してくれ、ということです。</p>
149-<p>Len&gt;1であっても、Scriptの1文字目が\なのにMarkUpTypeがmtTagでもmtTagErrでもない場合、あるいはScriptの1文字目が%なのにMarkUpTypeがmtMetaでない場合は例外が発生します。</p>
150-<h2>リファレンス-メソッド</h2>
151-<h3>function Match(Str, Pattern: String): integer;</h3>
152-<p>SSTP解析用のパターンマッチングを行います。Strの先頭部分、Patternで示されるパターンが存在すれば、マッチした部分のバイト数(文字数ではない)を返します。マッチングが失敗した場合は0を返します。</p>
153-<p>例えば、</p>
154-<p><code>Match('ABC', 'AB') = 2<br>
155-Match('ABC', 'A%.%.') = 3<br>
156-Match('A20BC', 'A%D') = 3<br>
157-Match('\s[20]', '\s%b') = 6<br>
158-Match('\s2', '\s%b') = 0</code></p>
159-<h3>function GetParam(Tag: String; const Index: integer): String;</h3>
160-<p><code>\s[3]</code> や <code>\_c[こんにちは]</code> , <code>\q1[#cancel][キャンセル]</code>
161-といったマークアップから、スクウェアブラケットに囲まれたパラメータを取り出します。Tagは取り出したいタグ全体、Indexは何番目のパラメータを取り出すか、で、1から始まります。<code>\\</code>
162-や <code>\]</code>
163-によるエスケープに対応し、これらのエスケープは自動的に元の形に戻されます。</p>
164-<p>Indexがゼロ以下の場合、パラメータが取り出せなかった場合などには、空文字列が返ります。</p>
165-<p><code>GetParam('\s[3]', 1) = '3';<br>
166-GetParam('\s[3]', 2) = '';<br>
167-GetParam('\j[http://www.yahoo.co.jp/index[1\].html]', 1) =
168-'http://www.yahoo.co.jp/index[1].html'</code></p>
169-<h3>function EscapeParam(const Param: String): String;</h3>
170-<p>\j[] の中に安全に代入できるように、<code>\</code> を <code>\\</code>
171-に、<code>]</code> を <code>\]</code>
172-に変換した文字列を返します。堅牢なスクリプト作成のためには是非利用するようにしてください。</p>
173-<h2>パターンについて</h2>
174-<p>TagPattern, MetaPatternプロパティに、さくらスクリプトを解析するときのパターンを指定します。</p>
175-<p>通常はアーカイブ同梱のテキストファイルからコピーすれば問題はありませんが、将来のタグ拡張等のためにこの仕様が存在します。このパターンリスト自身をテキストファイルなどから読み込むようにすることで、実行ファイルを更新せずにタグ解析部を更新することも可能です。</p>
176-<p>「タグが\で始まる」「メタ文字列が%で始まる」「\\や\%はエスケープ」などといった基本的な仕様が変更にならない限り、タグの通常の増減に関しては、Patternプロパティを変更することで、大抵対応できると思います。特殊な書き方の場合、イベントを利用する方法もあります。</p>
177-<h3>パターンの書き方概略</h3>
178-<p>TagPatternの各行が、1つのタグに応答するパターンです。例えば、「\e」という行をTagPatternプロパティに追加することで、「\e」というタグに反応できるようになり、「!_c」という行を追加すれば、「\_c」というタグはエラーである、と解析するようになります。</p>
179-<p>パターンは上から順番に試行され、マッチした時点で試行を中止します。</p>
180-<p>TagPatternの各行は、\記号または!記号で始めてください。\記号で始まるパターンは、マッチした場合それを正当なタグをして処理します。!記号で始まるパターンは、マッチした場合それをタグのエラーとして処理します。</p>
181-<p>例えば、「\w」タグの処理のためには、</p>
182-<blockquote>
183- <p><code>\w%d<br>
184- !w%.</code></p>
185-</blockquote>
186-<p>という2行をTagPatternに加えるとよいでしょう。これで、<code>\w9</code>
187-等は正当なタグで、数字以外がwの後にきた場合は <code>\wあ</code>
188-といった全体をタグエラーとして処理する、という意味になります。</p>
189-<p>MetaPatternの各行が、1つのメタ文字列に応答するパターンです。例えば「selfname」という行をMetaPatternプロパティに追加することで、「%selfname」というメタ文字列に反応します。MetaPatternの場合は、%以降に続く文字列をそのまま記述するような格好で大丈夫です。</p>
190-<p>マッチ試行はパターンリストの上から順番に行われるため、MetaPatternプロパティで、例えば
191-<code>selfname2</code> という行は <code>selfname</code>
192-より上に配置される必要があります。</p>
193-<h3>パターンの記述方法</h3>
194-<p>正規表現みたいなものですが、そこまで高機能ではありません。逆に正規表現では表現できない表記に対応してたりもしますが。</p>
195-<ul>
196- <li><code>%d</code> は任意の整数1文字にマッチします。<code>\s%d</code>
197- というパターンは、<code>\s0</code> や <code>\s3</code>
198- にマッチします。</li>
199- <li><code>%D</code> は任意の整数列にマッチします。<code>\s[%D]</code>
200- というパターンは、<code>\s[0]</code> や <code>\s[10]</code>
201- にマッチします。</li>
202- <li><code>%b</code> は[]で囲まれた文字列にマッチします。<code>\]</code>
203- や <code>\\</code> によるエスケープに対応します。<code>\j%b</code>
204- というパターンは、 <code>\j[http://www.a.com/index[1\].html]</code>
205- にマッチします。</li>
206- <li><code>%.</code> は任意の1文字にマッチします。</li>
207- <li><code>%m</code>
208- は任意のシングルバイト文字にマッチします。</li>
209- <li><code>%M</code>
210- は任意のマルチバイト文字にマッチします。</li>
211- <li><code>%%</code> は「%」記号そのものにマッチします。使用しないといけない機会はおそらく将来もありません。</li>
212- <li>%の直後が、上記のいずれでもない文字である場合、とりあえず
213- <code>%%</code>
214- として解釈しますが、このような使い方はしないでください。</li>
215- <li>それ以外の文字はすべてその文字そのものにマッチします。\も含め。</li>
216-</ul>
217-<h3>マッチング詳細</h3>
218-<p>マッチングは以下のように行われます。</p>
219-<ol>
220- <li>マークアップと思われる「\」または「%」を先頭から探します。「\\」や「\%」はエスケープですので読み飛ばされます。その部分までは、マークアップではない通常の文字列です。</li>
221- <li>「%」で始まる場合はメタ文字列の可能性があるので、マッチングを開始します。%以下が有効なメタ文字列として解釈できない場合は、「%」は意味をなさない通常の%文字列として、\%にエスケープされて(EscapeInvalidMetaで制御可能)前のmtStrエレメントにくっつきます。</li>
222- <li>「\」で始まる場合のマッチングを開始します。\以下が正規のタグとして解釈できた場合はmtTagタイプとして、エラータグとなった場合はmtTagErrとして切り出します。TagPatternのどの行にもマッチしなかった場合は、\の次の1文字含めて、エラータグとして切り出します。</li>
223- <li>最初に戻ります。</li>
224-</ol>
225-<h2>使用例 - SSTPサーバ</h2>
226-<p>独自SSTPサーバ構築補助に利用する場合は、LeaveEscape :=
227-false; EscapeInvalidMeta := false; とすると簡単です。</p>
228-<p><code>SsParser1.InputString := Edit1.Text;<br>
229-for i := 0 to SsParser1.Count-1 do begin<br>
230-&nbsp; case SsParser.MarkUpType[i] of<br>
231-&nbsp;&nbsp;&nbsp; mtStr: Memo1.Lines.Add(SsParser.Str[i]);<br>
232-&nbsp;&nbsp;&nbsp; mtTag: {タグ関連の処理}<br>
233-&nbsp;&nbsp;&nbsp; mtTagErr: Memo1.Lines.Add(SsParser.Str[i]); //処理せずにそのまま表示<br>
234-&nbsp;&nbsp;&nbsp; mtMeta: {メタ文字列変換語表示}<br>
235-&nbsp; end;<br>
236-end;</code></p>
237-<h2>使用例 - スクリプト色分けHTML作成</h2>
238-<p>色分けが目的の場合、スクリプトが変わる心配のないよう、LeaveEscape
239-:= true; EscapeInvalidMeta := false;とします。</p>
240-<p>以下は、タグ部分に色を設定するHTMLマークアップです。</p>
241-<p><code>var Html: String;<br>
242-//<br>
243-SsParser1.InputString := Edit1.Text;<br>
244-for i := 0 to SsParser1.Count-1 do begin<br>
245-&nbsp; case SsParser.MarkUpType[i] of<br>
246-&nbsp;&nbsp;&nbsp; mtStr: Html := Html + SsParser.Str[i];<br>
247-&nbsp;&nbsp;&nbsp; mtTag: Html := Html + '&lt;font color=&quot;green&quot;&gt;'
248-+ SsParser.Str[i] + '&lt;/font&gt;';<br>
249-&nbsp;&nbsp;&nbsp; mtTagErr: Html := Html + '&lt;font color=&quot;red&quot;&gt;'
250-+ SsParser.Str[i] + '&lt;/font&gt;';<br>
251-&nbsp;&nbsp;&nbsp; mtMeta: Html + '&lt;font color=&quot;blue&quot;&gt;' +
252-SsParser.Str[i] + '&lt;/font&gt;';<br>
253-&nbsp; end;<br>
254-end;<br>
255-Edit2.Text := Html;</code></p>
256-<h2>使用例 - OnSsParse使用例</h2>
257-<p>以下は、OnSsParseイベントの使用例です。もっとも単純に、\uタグを判定します。TagPatternの1行目に
258-<code>\u</code> と書いた場合と同じ動作となります。</p>
259-<p><code>procedure TForm1.SsParser1SsParse(Sender: TObject; const Script:
260-String;<br>
261-&nbsp; var Len: integer; var MarkType: TSsMarkUpType; var Extra: String)<br>
262-begin<br>
263-&nbsp; if Pos('\u', Script) = 1 then begin<br>
264-&nbsp;&nbsp;&nbsp; Len := Length('\u');<br>
265-&nbsp;&nbsp;&nbsp; MarkType := mtTag;<br>
266-&nbsp; end;<br>
267-end;</code></p>
268-<h2>使用例 - サーフィス判定</h2>
269-<p>一番最後のサーフィスが何になるかを判定します。ただし本来は、\h,
270-\uによる切り替えなどが必要でしょう。</p>
271-<p><code>var Last: integer;<br>
272-//<br>
273-SsParser1.InputString := Edit1.Text;<br>
274-for i := 0 to SsParser1.Count-1 do begin<br>
275-&nbsp; if SsParser.Match(SsParser.Str[i], '\s%b') &gt; 0 then begin<br>
276-&nbsp;&nbsp;&nbsp; try<br>
277-&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Last :=
278-StrToInt(SsParser.GetParam(SsParser.Str[i]));<br>
279-&nbsp;&nbsp;&nbsp; except<br>
280-&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; on EConvertError do begin end;<br>
281-&nbsp;&nbsp;&nbsp; end;<br>
282-&nbsp; end;<br>
283-end;</code></p>
284-<h2>諸注意</h2>
285-<h3>再解析について</h3>
286-<p><code>with SsParser1 do InputString := InputString;</code></p>
287-<p>とすることで、EscapeInvalidMeta等の解析オプションや、MetaPattern等の解析パターンが変化したときに再解析を行えます。変な書き方ですが。</p>
288-<h3>改行文字について</h3>
289-<p>InputStringに改行文字やその他の空白文字が含まれていた場合、通常の文字と同じように扱います。つまり、改行文字だからといって特に何らかの処理が行われたり、逆に処理の邪魔になったりすることはありません。改行を
290-<code>\n</code> に変更したい、などの場合はあらかじめ
291-StringReplace などを利用して自分で変換してください。</p>
292-<h3>タグエラーの利用について</h3>
293-<p>TagPatternで行頭が <code>!</code>
294-で始まるパターンを指定することや、OnSsParseイベントでmtTagErrエレメントを返す事で、\で始まる任意の文字列をタグエラーと見なすことができます。また、TagPatternでマッチしなかった場合は、\記号の次の1文字までを含めてタグエラーとして2文字分切り出します。この利用方法ですが、</p>
295-<ul>
296- <li>スクリプトのチェックに利用する場合、TagPatternを変更する事で、SSTP権限で動かないタグのチェックを行うことができます。</li>
297- <li>SSTPサーバ構築の場合、エラータグはそのままセリフと同じ形で出力するようにすれば、タグのマークアップエラーに関して柔軟な復帰ができます(上の例参照)。</li>
298-</ul>
299-<h2>解析についての注意</h2>
300-<h3>「任意」phase 40.01以前の解析問題</h3>
301-<p>「あれ以外の何か with 任意 phase 40」には、スクリプト解析に関して、以下に挙げる問題があります。原因は面倒なので挙げませんが。</p>
302-<ul>
303- <li>[SSTPの場合] <code>\\30</code><code> </code>といった文字列は本来
304- <code>\\ </code>をエスケープと解釈するべきですが、<code>\3</code><code>
305- </code>が危険タグのため、<code>\\30 </code>が <code>\0 </code>に変換されて実行されてしまいます。</li>
306- <li>[SSTPの場合] <code>を\- </code>など、円記号の前に特定の文字が来る場合、危険タグチェックをすり抜けます。</li>
307- <li><code>\漢 </code>や <code>\w漢 </code>といった記述で文字化けが生じます。</li>
308- <li><code>\能- </code>や <code>\w能- </code>といった記述で危険タグが実行される場合があります。</li>
309- <li><code>能%selfname </code>といった記述で、<code>%selfname</code>
310- が正しく変換されません。</li>
311- <li><code>\\%selfname </code>といった記述で、<code>%selfname</code>
312- が正しく変換されません。</li>
313- <li><code>\j[http://www.珪.com/]</code> といった記述で、「珪」の2バイト目が
314- <code>]</code>
315- 記号とコードが同じであるため解析エラーを起こす場合があります。<code>\q</code>
316- も同様です。</li>
317- <li>スクリプト中の改行が、\記号と同じ意味を持ってしまうことがあります。</li>
318- <li><code>\w\\-</code>
319- といった記述で、危険タグがブロックされずに実行されてしまいます。(これは初期developer's
320- testにも残っていた問題)</li>
321-</ul>
322-<p>TSsParserとは関連しませんが、<code>%songname %enamyname</code>
323-等が危険タグを含む文字列に変換された場合にそのまま実行される、といった問題点もあります。最新版では以上の問題はすべて解決されています。</p>
324-<p>TSsParserは以上の問題点を含まないはずです(パターンの書き方によっては別ですが)ので、<strong>TSsParserの解析は、「何か
325-phase inverse 22.00」以降互換、ということになります。</strong>Phase40.01以前対応を視野に入れたプログラム作成でセキュリティに考慮したい場合、上に挙げた問題点に対して自力で対応してください。</p>
326-<p>TSsParserは独自SSTPサーバ作成補助も視野にいれたコンポーネントですので、上記の問題に対して対応する予定はありません。</p>
327-
328-</body>
329-
330-</html>
Show on old repository browser