Г-н Посол
Профиль
Группа: Экс. модератор
Сообщений: 3668
Регистрация: 13.7.2003
Где: 58°38' с.ш. 4 9°41' в.д.
Репутация: 58
Всего: 112
|
| Код | // числа
123 123.456 123.456.789
-123 -123.456 -123.456.789
16 $16
-16 $-16 -$10
+16 +$10 $+16
$
$0 $1 $2 $3 $4 $5 $6 $7 $8 $9 $A $B $C $D $E $F
$G $H $I $J $K $L $M $N $O $P $Q $R $S $T $U $V $W $X $Y $Z
$0ABCDEFGH $0abcdefgh
0.123 .123
12e56 -1e56 12e-56 -12e-56 -12e+56
0.11e56 -0.12e56 0.12e-56 -0.12e-56 -0.12e+56
.12e56 -.12e56 .12e-56 -.12e-56 -.12e+56
0e123abc
// строки
'string1'
'abc''def''ghi'+'klm''nop'
// символы
#
#0 #1 #2 #3 #4 #5 #6 #7 #8 #9 #a #b #c #d #e #f #g #h
#$0 #$1 #$2 #$3 #$4 #$5 #$6 #$7 #$8 #$9 #$a #$b #$c #$d #$e #$f #$g #$h
#$+44 #$-44
#$45a #$45b #$45c #$45d #$45e #$45f #$45g #$45h
#123abc |
Снова директивы и комментарии | Код |
{
abc
(* abc
// abc
*) // abc
{$ abc } // abc
} abc
{ aaa *) _end }
|
asm..end тест: | Код |
asm
loop
//end
{ end } jmp
(* end } jmp *) mul
loop
end
|
asm..end тест2: | Код |
asm
jmp @codeend
@codeend:
jmp @end1
@end1:
jmp @_end
@_end:
jmp @end
@end:
jmp
end
|
Для тестирования подсветки Delphi и Delphi-asm'а: | Код |
unit uMsg;
{ Модуль для работы с текущим набором объявлений }
interface
uses uTypes;
type
TMessags = array of PMess;
var
messagCnt : integer;
messags : TMessags;
fmessagCnt : integer;
fmessags : TMessags;
addMask : cardinal;
procedure msgCRC;
procedure msgCmp;
function msgSize (msg : PMess) : integer;
function msgFind (msg : PMess) : PMess;
procedure msgAdd (msg : PMess);
procedure msgBaseFree;
procedure msgBaseSave (const fn : string);
procedure msgBaseLoad (const fn : string);
procedure msgBaseCRC;
procedure msgBaseCRCfree;
procedure msgFields (msg : PMess; var fld : TMessFields);
procedure msgSetDates;
implementation
uses Windows, SysUtils, uConst, uGlobal, uIdentifiers, uSet, uUtils, uMsgFilter;
var
crc : pointer = nil;
_objCount : byte;
fnd_adr : cardinal;
////////////////////////////////////////////////////////////////////////////////
// Освобождает память
procedure msgBaseFree;
var i : integer;
begin
for i := 0 to messagCnt-1 do GlobalFree (cardinal(messags[i]));
messagCnt := 0;
setLength (messags, 0);
end;
////////////////////////////////////////////////////////////////////////////////
// Вычисляет CRC объявления
// in: eax = message
// out: eax = CRC of message
procedure msgCRC; assembler;
asm
push ebx
push ecx
movzx ecx, word ptr [eax + TMess.sizMain]
sub cx, msgVarSize
mov ebx, eax
push ecx
xor eax, eax
shr ecx, 2
add ebx, msgVarSize
@loopCRC:
add eax, [ebx]
add ebx, 4
ror eax, 1
loop @loopCRC
pop ecx
and ecx, 3
jz @skip
@loopCRC2:
add al, [ebx]
inc ebx
ror eax, 1
loop @loopCRC2
@skip:
pop ecx
pop ebx
ret
end;
////////////////////////////////////////////////////////////////////////////////
// Сравнивает объявления
// in: esi, edi = адреса двух объявлений
// out: z=1 -> объявления одинаковые
procedure msgCmp; assembler;
asm
push ecx
movzx ecx, word ptr [esi + TMess.sizMain]
cmp cx, [edi + TMess.sizMain]
jnz @exit
sub cx, msgVarSize
push esi
push edi
add esi, msgVarSize
add edi, msgVarSize
push ecx
shr ecx, 2
repe cmpsd
pop ecx
jnz @exit2
and ecx, 3
jz @exit2
repe cmpsb
@exit2:
pop edi
pop esi
@exit:
pop ecx
ret
end;
////////////////////////////////////////////////////////////////////////////////
// Вычисляет размер обявления
// in: eax = message
// out: eax = size of message
function msgSize; assembler;
asm
push ecx
push edx
mov ecx, eax
movzx eax, word ptr [ecx + TMess.sizMain]
movzx edx, byte ptr [ecx + eax] // other
lea eax, [eax + edx + 1]
mov dl, byte ptr [ecx + eax] // phone
lea eax, [eax + edx + 1]
mov dx, word ptr [ecx + eax] // txt
lea eax, [eax + edx + 2]
pop edx
pop ecx
ret
end;
////////////////////////////////////////////////////////////////////////////////
// Записывает объявления в dat-файл
procedure msgBaseSave;
var
f : file;
i, siz, res : integer;
begin
AssignFile (f, fn + '.dat');
Rewrite (f, 1);
siz := sizeof(version);
BlockWrite (f, version, siz, res);
if res = siz then
begin
siz := sizeof(gOptions.skips);
BlockWrite (f, gOptions.skips[0], siz, res);
if res = siz then
begin
siz := sizeof(messagCnt);
BlockWrite (f, messagCnt, siz, res);
if res = siz then
for i := 0 to messagCnt-1 do
begin
siz := msgSize(messags[i]);
BlockWrite(f, messags[i]^, siz, res);
if res <> siz then break;
end;
end;
end;
CloseFile (f);
if res <> siz then Raise Exception.Create(error_SaveBase);
end;
////////////////////////////////////////////////////////////////////////////////
// Считывает объявления из dat-файла
procedure msgBaseLoad;
begin
msgBaseFree;
setLoadDat(fn, true);
checkPhones;
end;
////////////////////////////////////////////////////////////////////////////////
// Создает массив контрольных сумм для объявлений
procedure msgBaseCRC;
begin
CRC := VirtualAlloc (0, length(messags)*4, MEM_COMMIT, PAGE_READWRITE);
asm
push ecx
push esi
push edi
mov ecx, [messagCnt]
jcxz @end
mov esi, [messags]
mov edi, [crc]
cld
@calcs:
lodsd
call msgCRC
stosd
loop @calcs
@end:
pop edi
pop esi
pop ecx
end;
end;
////////////////////////////////////////////////////////////////////////////////
// Освобождает массив контрольных сумм
procedure msgBaseCRCfree;
begin
if crc <> nil then VirtualFreeEx (hProcess, crc, 0, MEM_RELEASE);
end;
////////////////////////////////////////////////////////////////////////////////
// in: eax = message
// out: z = 1 - message already exists
function msgFind; assembler;
asm
pushad
cld
mov ebx, eax
call msgCRC
// eax = CRC of message
mov ecx, [messagCnt]
mov edi, [crc]
@scan:
jcxz @not_found
repne scasd
jnz @not_found
push eax
mov eax, [messagCnt]
sub eax, ecx
dec eax
mov edx, [messags]
lea edx, [edx + eax*4]
push edi
mov esi, ebx
mov edi, [edx]
call msgCmp
pop edi
pop eax
jnz @scan
// found equal messages
mov [fnd_adr], edx
popad
mov eax, [fnd_adr]
mov eax, [eax]
test eax, eax
ret
@not_found:
popad
xor eax, eax
ret
end;
////////////////////////////////////////////////////////////////////////////////
// Добавляет объявление в базу
// in: eax = message
procedure msgAdd; assembler;
asm
pushad
cld
mov ebx, eax
call msgCRC
// eax = CRC of message
mov ecx, [messagCnt]
mov edi, [crc]
lea edi, [edi + ecx*4]
mov [edi], eax
push ebx
mov eax, ebx
call msgSize
push eax
push eax // eax = size
push DWORD (GMEM_FIXED)
call GlobalAlloc
mov ecx, [messagCnt]
mov edx, [messags]
lea edx, [edx + ecx*4]
mov [edx], eax
pop ecx
pop esi
mov edi, eax
push ecx
shr ecx, 2
rep movsd
pop ecx
and ecx, 3
jz @skip1
rep movsb
@skip1:
inc dword ptr [messagCnt]
@end:
popad
ret
end;
////////////////////////////////////////////////////////////////////////////////
// Добавляет в строковое поле символы ->
procedure _arrow; assembler;
asm
push eax
movzx eax, byte ptr [edi]
lea eax, [eax + edi + 1]
mov word ptr [eax], '>-'
add byte ptr [edi], 2
pop eax
end;
////////////////////////////////////////////////////////////////////////////////
// Расшифровывает массив битов (создает строку)
// in: eax = Value, edi = адрес текстового поля, ebp = адрес строковых эквивалентов
procedure _bitsTxt; assembler;
asm
push esi
push edi
movzx ecx, [edi]
lea edi, [edi + ecx + 1]
@loop:
test eax, eax
jz @end
shr eax, 1
jnc @no_print
mov cl, [ebp]
jcxz @no_print
lea esi, [ebp+1]
rep movsb
test eax, eax
jz @end
mov byte ptr [edi], ','
inc edi
@no_print:
add ebp, 16
jmp @loop
@end:
pop ecx
sub edi, ecx
lea edx, [edi-1]
mov byte ptr [ecx], dl
pop esi
ret
end;
procedure _bitsTxt0; assembler;
asm
mov byte ptr [edi], 0
jmp _bitsTxt;
end;
// Для обмена: если есть хоть один включенный бит, то прибавляет "->"
procedure _bitsTxt2; assembler;
asm
test eax, eax
jz _bitsTxt
call _arrow
jmp _bitsTxt
end;
////////////////////////////////////////////////////////////////////////////////
// Расшифровывает поле reg в строковый вид
procedure _regTxt; assembler;
asm
push edi
movzx ecx, byte ptr [edi]
lea edi, [edi + ecx + 1]
mov cl, byte ptr [esi]
inc esi
shr ecx, 1
jz @reg1_end
xor eax, eax
@reg1:
lodsw
mov edx, [groups]
mov edx, [edx + sizIdGroup + TIdGroup.grp_names]
push esi
push ecx
mov esi, [edx + eax*4]
mov ecx, [esi-4]
rep movsb
pop ecx
pop esi
cmp ecx, 1
jz @reg1_next
mov word ptr [edi], ' ,'
inc edi
inc edi
@reg1_next:
loop @reg1
@reg1_end:
pop ecx
sub edi, ecx
lea edx, [edi-1]
mov byte ptr [ecx], dl
ret
end;
////////////////////////////////////////////////////////////////////////////////
// Расшифровывает поле adr в строковый вид
procedure _adrTxt; assembler;
asm
push edi
movzx edx, byte ptr [edi]
lea edi, [edi + edx + 1]
mov dl, byte ptr [esi]
inc esi
@adr1:
test edx, edx
jz @adr1_end
xor eax, eax
lodsw
mov ecx, [groups]
mov ecx, [ecx + TIdGroup.grp_names]
push esi
mov esi, [ecx + eax*4]
mov ecx, [esi-4]
rep movsb
pop esi
movzx ecx, byte ptr [esi]
inc esi
sub edx, 3
sub edx, ecx
jcxz @adr1_next
mov byte ptr [edi], ' '
inc edi
rep movsb
@adr1_next:
test edx, edx
jz @adr1_end
mov word ptr [edi], ' ,'
inc edi
inc edi
jmp @adr1
@adr1_end:
pop ecx
sub edi, ecx
lea edx, [edi-1]
mov byte ptr [ecx], dl
ret
end;
////////////////////////////////////////////////////////////////////////////////
// Заполняет у объявления строковые поля
// in: eax = message, edx = адрес структуры TMessFields
procedure msgFields; assembler;
asm
pushad
cld
mov esi, eax
mov ebx, edx
mov dl, [esi + TMess.objCount]
push edx
xor eax, eax
// deal
mov al, byte ptr [esi + TMess.deal]
lea edi, [ebx + TMessFields.deal]
lea ebp, [_Names._deal]
call _bitsTxt0
// price
xor ecx, ecx
mov edx, [esi + TMess.price]
lea edi, [ebx + TMessFields.price + 1]
mov ebp, edi
test edx, edx
jz @price_end
mov cl, 8
@price:
rol edx, 4
mov al, dl
and al, $0F
jnz @price_wr
cmp cl, 4
jz @price_wr
cmp edi, ebp
jz @price_next
@price_wr:
add al, $30
stosb
@price_next:
cmp cl, 4
jnz @price_next2
mov byte ptr [edi], '.'
inc edi
@price_next2:
loop @price
@price_2:
cmp byte ptr [edi-1], '0'
jnz @price_3
dec edi
jmp @price_2
@price_3:
cmp byte ptr [edi-1], '.'
jnz @price_4
dec edi
@price_4:
mov dl, [esi + TMess.price_flg]
test dl, $02
jnz @rubli
mov dword ptr [edi], 'у.т '
mov dword ptr [edi+4], ' .е.'
add edi, 7
jmp @price_5
@rubli:
mov dword ptr [edi], 'р.т '
mov byte ptr [edi+4], '.'
add edi, 5
@price_5:
test dl, $10
jz @price_end
mov dword ptr [edi], 'м 1/'
mov byte ptr [edi+4], '.'
add edi, 5
@price_end:
sub edi, ebp
mov ecx, edi
mov [ebp-1], cl
add esi, sizMess
// area
movzx ecx, byte ptr [esi]
push ebx
lea ebx, [ebx + TMessFields.area + 1]
mov edi, ebx
inc esi
jcxz @area_end
@area:
lodsb
test al, al
jz @ar_code
stosb
loop @area
jmp @area_end
@ar_code:
cmp ebx, edi
jz @ar_first
mov byte ptr [edi], ';'
inc edi
@ar_first:
movzx eax, [esi]
shl eax, 4
inc esi
push esi
push ecx
lea esi, [_Names._area]
add esi, eax
mov cl, [esi]
inc esi
rep movsb
mov byte ptr [edi], ' '
inc edi
pop ecx
pop esi
dec ecx
loop @area
@area_end:
mov edx, edi
sub edx, ebx
mov [ebx-1], dl
pop ebx
movzx eax, byte ptr [esi]
lea esi, [esi + eax + 1] // skip phone_abc
//////////////////////////////////
// object1
// immove1
mov al, byte ptr [esi + TImmoveInfo.immove]
lea edi, [ebx + TMessFields.immove]
lea ebp, [_Names._immove]
call _bitsTxt0
// rooms1
movzx eax, byte ptr [esi + TImmoveInfo.rooms]
lea edi, [ebx + TMessFields.rooms]
lea ebp, [_Names._rooms]
call _bitsTxt0
// roomsav1
movzx eax, byte ptr [esi + TImmoveInfo.roomsav]
lea edi, [ebx + TMessFields.roomsav]
lea ebp, [_Names._roomsav]
call _bitsTxt0
// mat1
mov al, byte ptr [esi + TImmoveInfo.mat]
lea edi, [ebx + TMessFields.mat]
lea ebp, [_Names._mat]
call _bitsTxt0
// plan1
mov al, byte ptr [esi + TImmoveInfo.plan]
lea edi, [ebx + TMessFields.plan]
lea ebp, [_Names._plan]
call _bitsTxt0
// floor1
mov eax, [esi + TImmoveInfo.floor]
lea edi, [ebx + TMessFields.floor]
lea ebp, [_Names._floor]
call _bitsTxt0
// floors1
mov eax, [esi + TImmoveInfo.floors]
lea edi, [ebx + TMessFields.floors]
lea ebp, [_Names._floors]
call _bitsTxt0
add esi, sizImmoveInfo
// reg1
lea edi, [ebx + TMessFields.reg]
mov byte ptr [edi], 0
call _regTxt
// adr1
lea edi, [ebx + TMessFields.adr]
mov byte ptr [edi], 0
call _adrTxt
//////////////////////////////////////////////////
// object2
pop edx
cmp dl, 2
jb @other
// immove2
movzx eax, byte ptr [esi + TImmoveInfo.immove]
lea edi, [ebx + TMessFields.immove]
lea ebp, [_Names._immove]
call _bitsTxt2
// rooms2
movzx eax, byte ptr [esi + TImmoveInfo.rooms]
lea edi, [ebx + TMessFields.rooms]
lea ebp, [_Names._rooms]
call _bitsTxt2
// roomsav2
movzx eax, byte ptr [esi + TImmoveInfo.roomsav]
lea edi, [ebx + TMessFields.roomsav]
lea ebp, [_Names._roomsav]
call _bitsTxt2
// mat2
mov al, byte ptr [esi + TImmoveInfo.mat]
lea edi, [ebx + TMessFields.mat]
lea ebp, [_Names._mat]
call _bitsTxt2
// plan2
mov al, byte ptr [esi + TImmoveInfo.plan]
lea edi, [ebx + TMessFields.plan]
lea ebp, [_Names._plan]
call _bitsTxt2
// floor2
movzx eax, word ptr [esi + TImmoveInfo.floor]
lea edi, [ebx + TMessFields.floor]
lea ebp, [_Names._floor]
call _bitsTxt2
// floors2
movzx eax, word ptr [esi + TImmoveInfo.floors]
lea edi, [ebx + TMessFields.floors]
lea ebp, [_Names._floors]
call _bitsTxt2
add esi, sizImmoveInfo
// reg2
lea edi, [ebx + TMessFields.reg]
cmp byte ptr [esi], 0
jz @skip_reg2
call _arrow
@skip_reg2:
call _regTxt
// adr2
lea edi, [ebx + TMessFields.adr]
cmp byte ptr [esi], 0
jz @skip_adr2
call _arrow
@skip_adr2:
call _adrTxt
@other:
// other
lea edi, [ebx + TMessFields.other]
movzx ecx, byte ptr [esi]
inc ecx
rep movsb
// phone
lea edi, [ebx + TMessFields.phone]
movzx ecx, byte ptr [esi]
inc ecx
rep movsb
popad
ret
end;
////////////////////////////////////////////////////////////////////////////////
// Ставит у объявлений последнюю возможную дату
procedure msgSetDates;
var
i, j : integer;
_sets, _set : cardinal;
begin
for i := 0 to messagCnt-1 do
begin
_sets := messags[i].dates;
for j := setCnt-1 downto 0 do
begin
_set := sets[j].s_mask;
if (_sets and _set) <> 0 then
begin
messags[i].datelast := _set;
break;
end;
end;
end;
end;
////////////////////////////////////////////////////////////////////////////////
initialization
messagCnt := 0;
setLength (messags, 0);
finalization
msgBaseFree;
msgBaseCRCfree;
end.
|
Опять тест ключевых слов Delphi: | Код |
and xor or not shl shr mod div cdecl stdcall register pascal safecall varargs export far near external
forward platform deprecated assembler begin asm end virtual dynamic abstract automated dispid
overload override reintroduce constructor destructor private protected public published
package contains requires program unit library implementation initialization finalization uses var
threadvar const resourcestring type label try except finally raise for do while repeat until on to
downto is as on in of if then else exports class dispinterface interface file array object packed record
set string function procedure absolute message case goto inherited inline nil out with property |
Свойства: | Код | index default nodefault stored read write readonly writeonly implements
property abc : integer
index 5 default 3 nodefault stored 1 read write readonly writeonly implements;
index default nodefault stored read write readonly writeonly implements |
Это сообщение отредактировал(а) p0s0l - 20.10.2004, 21:03
--------------------
С уважением, г-н Посол. |
Тест подсветки 
Загрузка ...
test2.gif
