1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.
235.
236.
237.
238.
239.
240.
241.
242.
243.
244.
245.
246.
247.
248.
249.
250.
251.
252.
253.
254.
255.
256.
257.
258.
259.
260.
261.
262.
263.
264.
265.
266.
267.
268.
269.
270.
271.
272.
273.
274.
275.
276.
277.
278.
279.
280.
281.
282.
283.
284.
285.
286.
287.
288.
289.
290.
291.
292.
293.
294.
295.
296.
297.
298.
299.
300.
301.
302.
303.
304.
305.
306.
307.
308.
309.
310.
311.
312.
313.
314.
315.
316.
317.
318.
319.
320.
321.
322.
323.
324.
325.
326.
327.
328.
329.
330.
331.
332.
333.
334.
335.
336.
337.
338.
339.
340.
341.
342.
343.
344.
345.
346.
347.
348.
349.
350.
351.
352.
353.
354.
355.
356.
357.
358.
359.
360.
361.
362.
363.
364.
365.
366.
367.
368.
369.
370.
371.
372.
373.
374.
375.
376.
377.
378.
379.
380.
381.
382.
383.
384.
385.
386.
387.
388.
389.
390.
391.
392.
393.
394.
395.
396.
397.
398.
399.
400.
401.
402.
403.
404.
405.
406.
407.
408.
409.
410.
411.
412.
413.
414.
415.
416.
417.
418.
419.
420.
421.
422.
423.
424.
425.
426.
427.
428.
429.
430.
431.
432.
433.
434.
435.
436.
437.
438.
439.
440.
441.
442.
443.
444.
445.
446.
447.
448.
449.
450.
451.
452.
453.
454.
455.
456.
457.
458.
459.
460.
461.
462.
463.
464.
465.
466.
467.
468.
469.
470.
471.
472.
473.
474.
475.
476.
477.
478.
479.
480.
481.
482.
483.
484.
485.
486.
487.
488.
489.
490.
491.
492.
493.
494.
495.
496.
497.
498.
499.
500.
501.
502.
503.
504.
505.
506.
507.
508.
509.
510.
511.
512.
513.
514.
515.
516.
517.
518.
519.
520.
521.
522.
523.
524.
525.
526.
527.
528.
529.
530.
531.
532.
533.
534.
535.
536.
537.
538.
539.
540.
541.
542.
543.
544.
545.
546.
547.
548.
549.
550.
551.
552.
553.
554.
555.
556.
557.
558.
559.
560.
561.
562.
563.
564.
565.
566.
567.
568.
569.
570.
571.
572.
573.
574.
575.
576.
577.
578.
579.
580.
581.
582.
583.
584.
585.
586.
587.
588.
589.
590.
591.
592.
593.
594.
595.
596.
597.
598.
599.
600.
601.
602.
603.
604.
605.
606.
607.
608.
609.
610.
611.
612.
613.
614.
615.
616.
617.
618.
619.
620.
621.
622.
623.
624.
625.
626.
627.
628.
629.
630.
631.
632.
633.
634.
635.
636.
637.
638.
639.
640.
641.
642.
643.
644.
645.
646.
647.
648.
649.
650.
651.
652.
653.
654.
655.
656.
657.
658.
659.
660.
661.
662.
663.
664.
665.
666.
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
Winapi.Windows,
System.SysUtils,
StringCASE;
var
StartTime, StopTime: Int64;
iCounterPerSec: Int64;
procedure BeginTime;
begin
QueryPerformanceCounter(StartTime);
end;
procedure EndTime;
begin
if QueryPerformanceCounter(StopTime) and QueryPerformanceFrequency
(iCounterPerSec) then
Writeln(Format('%.6f', [(StopTime - StartTime) / iCounterPerSec]));
end;
type
PHPTokenType = (T_END, S_START, T_STRING, T_USE, T_VAR, T_REQUIRE_ONCE,
T_RETURN, T_PROTECTED, T_ISSET, T_LIST, T_GOTO, T_IF, T_ENDSWITCH,
T_ENDWHILE, T_CLASS_C, T_DIR, T_IS_IDENTICAL, T_IS_EQUAL, T_DOUBLE_ARROW,
T_ASSIGN, T_SR_EQUAL, T_SR, T_IS_GREATER_OR_EQUAL, T_GREATER);
var
TokenInfoString: array [PHPTokenType] of string = (
'T_END',
'S_START',
'T_STRING',
'T_USE',
'T_VAR',
'T_REQUIRE_ONCE',
'T_RETURN',
'T_PROTECTED',
'T_ISSET',
'T_LIST',
'T_GOTO',
'T_IF',
'T_ENDSWITCH',
'T_ENDWHILE',
'T_CLASS_C',
'T_DIR',
'T_IS_IDENTICAL',
'T_IS_EQUAL',
'T_DOUBLE_ARROW',
'T_ASSIGN',
'T_SR_EQUAL',
'T_SR',
'T_IS_GREATER_OR_EQUAL',
'T_GREATER'
);
var
filelen, tmpAllocSize: Int64;
tmpStrCode: PWideChar;
CurrentToken: PHPTokenType;
StrCode: PWideChar;
Value: String;
CurrentLenToken, i, i2, i3, i4: Cardinal;
function IsCharNext2(i: Byte): Boolean;
begin
case PWideChar(StrCode + i)^ of
#0, #32, #10, #13, #9, '_', '=', '>':
Result := true;
else
Result := false;
end;
end;
function IsCharNext(i: Byte): Boolean; // inline;
begin
case PWideChar(StrCode + i)^ of
#0, '$', '!', '@', '#', '%', '^', '&', '*', '+', '[', ']', '{', '}', ':',
'"', '|', '\', '''', ';', '<', '>', '?', '/', '.', #32, #10, #13, #9, ',',
'-', '=', '`':
Result := true;
else
Result := false;
end;
end;
function GetNextToken(): Boolean;
label NewStart, TokenStr;
var
x: Integer;
begin
CurrentToken := T_END;
NewStart:
case PWord(StrCode)^ or $0020 of
ord(#32), ord(#9), ord(#13), ord(#10):
begin
x := 0;
while true do
begin
case StrCode[x] of
#10, #13, #32, #9:
Inc(x);
else
begin
Inc(StrCode, x);
goto NewStart;
end;
end;
end;
Inc(x);
end;
61: // =
case PWord(StrCode + 1)^ or $0020 of
61: // =
case PWord(StrCode + 2)^ or $0020 of
61: // =
begin
CurrentToken := T_IS_IDENTICAL;
Inc(StrCode, 3);
end;
else
begin
CurrentToken := T_IS_EQUAL;
Inc(StrCode, 2);
end;
end;
62: // >
begin
CurrentToken := T_DOUBLE_ARROW;
Inc(StrCode, 2);
end;
else
begin
CurrentToken := T_ASSIGN;
Inc(StrCode, 1);
end;
end;
62: // >
case PWord(StrCode + 1)^ or $0020 of
61: // =
begin
CurrentToken := T_IS_GREATER_OR_EQUAL;
Inc(StrCode, 2);
end;
62: // >
case PWord(StrCode + 2)^ or $0020 of
61: // =
begin
CurrentToken := T_SR_EQUAL;
Inc(StrCode, 3);
end;
else
begin
CurrentToken := T_SR;
Inc(StrCode, 2);
end;
end;
else
begin
CurrentToken := T_GREATER;
Inc(StrCode, 1);
end;
end;
95: // _
case PWord(StrCode + 1)^ or $0020 of
95: // _
case PWord(StrCode + 2)^ or $0020 of
99: // c
case PWord(StrCode + 3)^ or $0020 of
108: // l
case PWord(StrCode + 4)^ or $0020 of
97: // a
case PWord(StrCode + 5)^ or $0020 of
115: // s
case PWord(StrCode + 6)^ or $0020 of
115: // s
case PWord(StrCode + 7)^ or $0020 of
95: // _
case PWord(StrCode + 8)^ or $0020 of
95: // _
begin
CurrentToken := T_CLASS_C;
Inc(StrCode, 9);
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
100: // d
case PWord(StrCode + 3)^ or $0020 of
105: // i
case PWord(StrCode + 4)^ or $0020 of
114: // r
case PWord(StrCode + 5)^ or $0020 of
95: // _
case PWord(StrCode + 6)^ or $0020 of
95: // _
begin
CurrentToken := T_DIR;
Inc(StrCode, 7);
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
101: // e
case PWord(StrCode + 1)^ or $0020 of
110: // n
case PWord(StrCode + 2)^ or $0020 of
100: // d
case PWord(StrCode + 3)^ or $0020 of
115: // s
case PWord(StrCode + 4)^ or $0020 of
119: // w
case PWord(StrCode + 5)^ or $0020 of
105: // i
case PWord(StrCode + 6)^ or $0020 of
116: // t
case PWord(StrCode + 7)^ or $0020 of
99: // c
case PWord(StrCode + 8)^ or $0020 of
104: // h
if IsCharNext(9) then
begin
CurrentToken := T_ENDSWITCH;
Inc(StrCode, 9);
end
else
goto TokenStr;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
119: // w
case PWord(StrCode + 4)^ or $0020 of
104: // h
case PWord(StrCode + 5)^ or $0020 of
105: // i
case PWord(StrCode + 6)^ or $0020 of
108: // l
case PWord(StrCode + 7)^ or $0020 of
101: // e
if IsCharNext(8) then
begin
CurrentToken := T_ENDWHILE;
Inc(StrCode, 8);
end
else
goto TokenStr;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
103: // g
case PWord(StrCode + 1)^ or $0020 of
111: // o
case PWord(StrCode + 2)^ or $0020 of
116: // t
case PWord(StrCode + 3)^ or $0020 of
111: // o
if IsCharNext(4) then
begin
CurrentToken := T_GOTO;
Inc(StrCode, 4);
end
else
goto TokenStr;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
105: // i
case PWord(StrCode + 1)^ or $0020 of
102: // f
if IsCharNext(2) then
begin
CurrentToken := T_IF;
Inc(StrCode, 2);
end
else
goto TokenStr;
115: // s
case PWord(StrCode + 2)^ or $0020 of
115: // s
case PWord(StrCode + 3)^ or $0020 of
101: // e
case PWord(StrCode + 4)^ or $0020 of
116: // t
if IsCharNext(5) then
begin
CurrentToken := T_ISSET;
Inc(StrCode, 5);
end
else
goto TokenStr;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
108: // l
case PWord(StrCode + 1)^ or $0020 of
105: // i
case PWord(StrCode + 2)^ or $0020 of
115: // s
case PWord(StrCode + 3)^ or $0020 of
116: // t
if IsCharNext(4) then
begin
CurrentToken := T_LIST;
Inc(StrCode, 4);
end
else
goto TokenStr;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
112: // p
case PWord(StrCode + 1)^ or $0020 of
114: // r
case PWord(StrCode + 2)^ or $0020 of
111: // o
case PWord(StrCode + 3)^ or $0020 of
116: // t
case PWord(StrCode + 4)^ or $0020 of
101: // e
case PWord(StrCode + 5)^ or $0020 of
99: // c
case PWord(StrCode + 6)^ or $0020 of
116: // t
case PWord(StrCode + 7)^ or $0020 of
101: // e
case PWord(StrCode + 8)^ or $0020 of
100: // d
if IsCharNext(9) then
begin
CurrentToken := T_PROTECTED;
Inc(StrCode, 9);
end
else
goto TokenStr;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
114: // r
case PWord(StrCode + 1)^ or $0020 of
101: // e
case PWord(StrCode + 2)^ or $0020 of
113: // q
case PWord(StrCode + 3)^ or $0020 of
117: // u
case PWord(StrCode + 4)^ or $0020 of
105: // i
case PWord(StrCode + 5)^ or $0020 of
114: // r
case PWord(StrCode + 6)^ or $0020 of
101: // e
case PWord(StrCode + 7)^ or $0020 of
95: // _
case PWord(StrCode + 8)^ or $0020 of
111: // o
case PWord(StrCode + 9)^ or $0020 of
110: // n
case PWord(StrCode + 10)^ or $0020 of
99: // c
case PWord(StrCode + 11)^ or $0020 of
101: // e
if IsCharNext(12) then
begin
CurrentToken := T_REQUIRE_ONCE;
Inc(StrCode, 12);
end
else
goto TokenStr;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
116: // t
case PWord(StrCode + 3)^ or $0020 of
117: // u
case PWord(StrCode + 4)^ or $0020 of
114: // r
case PWord(StrCode + 5)^ or $0020 of
110: // n
if IsCharNext(6) then
begin
CurrentToken := T_RETURN;
Inc(StrCode, 6);
end
else
goto TokenStr;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
117: // u
case PWord(StrCode + 1)^ or $0020 of
115: // s
case PWord(StrCode + 2)^ or $0020 of
101: // e
if IsCharNext(3) then
begin
CurrentToken := T_USE;
Inc(StrCode, 3);
end
else
goto TokenStr;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
118: // v
case PWord(StrCode + 1)^ or $0020 of
97: // a
case PWord(StrCode + 2)^ or $0020 of
114: // r
if IsCharNext(3) then
begin
CurrentToken := T_VAR;
Inc(StrCode, 3);
end
else
goto TokenStr;
else
goto TokenStr;
end;
else
goto TokenStr;
end;
else
TokenStr:
begin
i3 := 0;
while not IsCharNext(i3) do
Inc(i3);
if i3 <> 0 then
begin
SetLength(Value, i3);
Move(StrCode^, Value[1], i3 * SizeOf(WideChar));
Inc(CurrentLenToken, i3);
Inc(StrCode, i3);
CurrentToken := T_STRING;
end;
end;
end;
Result := CurrentToken <> T_END;
end;
function GetTokenName(FTokenId: PHPTokenType): string; inline;
begin
Result := TokenInfoString[FTokenId];
end;
function FileSeek64(Handle: THandle; const Offset: Int64;
Origin: Integer): Int64;
begin
Result := Offset;
Int64Rec(Result).Lo := SetFilePointer(Handle, Int64Rec(Result).Lo,
@Int64Rec(Result).Hi, Origin);
if (Int64Rec(Result).Lo = $FFFFFFFF) and (GetLastError <> 0) then
Int64Rec(Result).Hi := $FFFFFFFF;
end;
function LoadPHPFile(PHPFile: PWideChar): Boolean;
var
TFile: THandle;
baf: TBytes;
begin
TFile := FileOpen(PHPFile, $0000 or $0020);
Result := TFile <> INVALID_HANDLE_VALUE;
if Result then
begin
filelen := FileSeek64(TFile, 0, 2);
FileSeek64(TFile, 0, 0);
SetLength(baf, filelen);
FileRead(TFile, baf, 0, filelen);
FileClose(TFile);
tmpAllocSize := (filelen + 1) * SizeOf(WideChar);
tmpStrCode := AllocMem(tmpAllocSize);
MultiByteToWideChar(CP_UTF8, 8, @baf[0], filelen, @tmpStrCode[0], filelen);
StrCode := tmpStrCode;
Finalize(baf);
end;
end;
procedure ClosePHPFile;
begin
FreeMem(tmpStrCode, tmpAllocSize);
tmpAllocSize := 0;
tmpStrCode := nil;
StrCode := nil;
filelen := 0;
CurrentToken := S_START;
CurrentLenToken := 0;
Value := '';
end;
begin
BeginTime;
LoadPHPFile('1.file');
while GetNextToken do
begin
// Writeln(GetTokenName(CurrentToken) + '. Value(' + IntToStr(CurrentLenToken)
// + '):' + Value);
end;
ClosePHPFile;
EndTime;
Readln;
end.
