|
Исправление регистра кода в буфере обмена
|
|
| Somerick | Дата: Понедельник, 25.07.2016, 01:51 | Сообщение # 1 |
|
Рядовой
Группа: Пользователи
Сообщений: 14
Статус: Offline
| Небольшая программа. В скомпилированном виде 4,5 килобайта.
Ищет в тексте из буфера обмена определённые слова и исправляет их регистр. Удаляет лишние пробелы в строках и в конце их. Причём, что важно, не трогает текст в кавычках типа "" и !""
Программа не занимается расставлением отступов, не исправляет неоптимальный код, ещё не реализовано и не скоро:D
Две процедуры собственно работающие с текстом наворочены на асме, а так нравится. Вы можете заменить на свои, добавить другие меняющие, парсящие обработчики.
CorrectCode копирует текст обходя лишние пробелы.
CorrectWordRegistr ищет и заменяет в тексте все заданные слова.
Например первым параметром указатель на "аБв-АБВ абвг абв", если задано вторым "Абв", то после вызова текст станет "Абв-Абв абвг Абв", причём совпадение трёх букв будет найдено и в начале "абвг" но пропущено, не заменено так как это другое слово.
Алгоритм не вызывает совсем никаких других, функций InStr, strstr, strcmp, RTrim, итд итп. Использует символьные таблицы для регистронезависимого поиска слов.
Использование программы.
1. Скопировать чей-то код, например эти две строки:
# define i iF 1 =( a - hIwORd(b )- 8)* cAsT( LONG,c) tHen d stRPtR( " cAsT( LONG,e)")
declare function x( y AS any PTR) as ZSTRING
2. Запустить программу. Готово, в буфере теперь такое содержание, можно вставить в текстовый редактор
#Define i If 1=(a-HiWord(b)-8)*Cast(Long,c) Then d StrPtr(" cAsT( LONG,e)")
Declare Function x(y As Any Ptr) As ZString
Маленькое всплывающее окошко показывает что программа сработала, если буфер с нетекстовым форматом или пуст выдаёт "В буфере нет текста!", через 2 секунды программа завершается.
Реализовано в процедуре WndView, отказался от MessageBox. Кстати самый минимальный код без WndProc, на основе диалогового класса.
ClipboardCodeCorrect.bas
Код #Include Once"windows.bi"
'копирует текст из Src в Dst без лишних пробелов
Declare Sub CorrectCode(Src As ZString Ptr,Dst As ZString Ptr)
'ищет в тексте s все слова sWord и меняет их регистр
Declare Sub CorrectWordRegistr(s As ZString Ptr,sWord As ZString Ptr)
'окошко уведомления, s текст col цвет текста
Declare Sub WndView(s As ZString Ptr,col As Long)
#Define Words !"As Is If IIf EndIf Then Else Asm Sub Function End Return Select Case Do Loop While Wend Exit GoTo For Next To HiWord LoWord "_
!"Long ULong Short UShort Byte UByte Double LongInt ULongInt ZString String StrPtr Ptr Dim Var Any Static Shared Cast "_
!"Shr Shl And Or Not Xor Poke Peek "_
!"Declare Enum Define Undef Ifdef Include Once Inclib "_
!"SendMessage "
'1-буквы и цифры, 0-знаки препинания и пр.
Dim Shared Word_tbl(256)As UByte={0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,_
0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,_
1,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,_
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,_
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1}
'таблица нижнего регистра
Dim Shared Cmpi_tbl(256)As UByte={0,1,2,3,4,5,6,7,8,32,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,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,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,156,158,159,_
160,161,162,163,164,165,166,167,184,169,170,171,172,173,173,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,_
190,191,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,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}
Sub main Cdecl alias"main"()'Точка входа. Программа начинает выполняться здесь.
If IsClipboardFormatAvailable(CF_TEXT)=0 Then
WndView "В буфере нет текста!",7679
Exit Sub
EndIf
OpenClipboard 0
Var cl=GetClipboardData(CF_TEXT)
Var m=GlobalLock(cl)'Данные из буфера
Var cl2=GlobalAlloc(GMEM_MOVEABLE Or GMEM_SHARE,lstrlen(m)+2)
Var m2=GlobalLock(cl2)'Память для нового буфера
CorrectCode m,m2'm-исходный текст m2-скопированный без лишних пробелов
Dim As Long c=Any
Dim As ZString*2000 S=Any
Dim As ZString Ptr pS=@S,pWords=@Words
Do
c=Peek(pWords)
pWords+=1
If c=32 Then'конец слова из Words
Poke pS,0
pS=@s
CorrectWordRegistr m2,pS'поиск слова s и исправление регистра
While Peek(pWords)=32
pWords+=1
Wend
Else
Poke pS,c
pS+=1
EndIf
Loop While c
GlobalUnlock m
GlobalUnlock m2
EmptyClipboard
SetClipboardData CF_TEXT,cl2'Задать текст
cl=GlobalAlloc(GMEM_MOVEABLE Or GMEM_SHARE,5)
m=GlobalLock(cl)
Poke dword,m,959721521'1049
Poke m+4,0
GlobalUnlock m
SetClipboardData CF_LOCALE,cl'Задать локаль
CloseClipboard
WndView !"Готово!\r\nОбработан текст в буфере.",55808
End Sub
Sub WndView(s As ZString Ptr,col As Long)
Static As Long rccol
Dim As Long x=Any,a=240
Dim As HWND h=CreateWindowEx(&h000800AC,"#32770",s,&hD0000000,GetSystemMetrics(0)Shr 1-100,GetSystemMetrics(1)Shr 1-60,200,100,0,0,0,0)
Dim As HBRUSH Brush=CreateSolidBrush(723467)
Dim As RECT rr=Type(0,25,200,100)
For x=0 To 30
SetLayeredWindowAttributes h,0,a,LWA_ALPHA
a-=10
If col=55808 Then
If a<60 Then Exit For
Else
If a<180 Then a=250
EndIf
Dim As HDC dc=GetDC(h)
rccol+=758630
Dim As HPEN pen=CreatePen(0,5,rccol)
SelectObject dc,Pen
SelectObject dc,Brush
Rectangle dc,0,0,200,100'рамка
DeleteObject Pen
SetTextColor dc,col
SetBkMode dc,TRANSPARENT
DrawText dc,s,-1,@rr,2309'текст
ReleaseDC h,dc
Sleep_ 70'Sleep WinApi
Next
DestroyWindow h'удаление окна и кисти
DeleteObject Brush
ExitProcess 0 'добавлено, завершение программы
End Sub
Sub CorrectWordRegistr naked(s As ZString Ptr,sWord As ZString Ptr)
Asm
mov eax,[esp+4]
mov edx,[esp+8]
push ebx
push esi
movzx ecx,Byte Ptr[edx]'
test cl,cl
jz ex0
mov bl,Byte Ptr[ecx+Cmpi_tbl]'первый символ sWord в нижнем регистре
dec eax
NowSymvol:'цикл поиска в s первого символа
inc eax
NowSymvolStart:
movzx ecx,Byte Ptr[eax]'
cmp cl,34
je Short Skip34'исключение слов в кавычках
test cl,cl
jz Short ex0'конец строки, выход
cmp bl,Byte Ptr[ecx+Cmpi_tbl]
jne Short NowSymvol'новая итерация
cmp eax,[esp+12]'s
je Short Ok1'символ первый в строке
movzx ecx,Byte Ptr[eax-1]
cmp Byte Ptr[ecx+Word_tbl],1'проверка на начало слова
je Short NowSymvol
Ok1:
Xor esi,esi
NowCmp:'цикл сравнения слова
inc esi
movzx ecx,Byte Ptr[edx+esi]
test cl,cl
jz Short WordOk'конец слова
mov bh,Byte Ptr[ecx+Cmpi_tbl]
movzx ecx,Byte Ptr[eax+esi]
cmp bh,Byte Ptr[ecx+Cmpi_tbl]
je Short NowCmp
jmp Short NowSymvol
WordOk:
movzx ecx,Byte Ptr[eax+esi]
cmp Byte Ptr[ecx+Word_tbl],1
je Short NowSymvol'слово не завершено
Xor esi,esi
NowCopy:'цикл замены найденного слова
mov cl,Byte Ptr[edx+esi]
test cl,cl
jz NowSymvolStart
mov [eax],cl
inc eax
inc esi
jmp Short NowCopy
Skip34:'пропуск фразы в кавычках
cmp eax,[esp+12]'s
je Short Ok134
cmp Byte Ptr[eax-1],33
jne Short Ok134
Ok234:'цикл пропуска фразы в !""
inc eax
mov cx,[eax]'
cmp cl,34
je Short NowSymvol
cmp cl,13
je Short NowSymvol
test cl,cl
jz Short ex0
cmp cx,8796'\"
jne Short Ok234
inc eax
jmp Short Ok234
Ok134:'цикл пропуска фразы в ""
inc eax
mov cl,[eax]'
cmp cl,34
je Short NowSymvol
cmp cl,13
je Short NowSymvol
test cl,cl
jnz Short Ok134
ex0:
pop esi
pop ebx
ret 8
End Asm
End Sub
Sub CorrectCode naked(Src As ZString Ptr,Dst As ZString Ptr)
Asm
mov eax,[esp+4]
mov edx,[esp+8]
jmp Short skip0131
skip:'цикл пропуска всех пробелов
inc eax
mov cl,[eax]'
cmp cl,32
je Short skip
cmp cl,9
je Short skip
inc edx
mov [edx],cl
jmp Short tspp'в основной цикл
skip13:
cmp Byte Ptr[eax+1],10'проверка завершения строки
jne Short skip10
inc eax
skip10:'цикл RТrim строки
dec edx
cmp edx,[esp+8]
jl Short scxx13
cmp Byte Ptr[edx],32
je Short skip10
cmp Byte Ptr[edx],9
je Short skip10
scxx13:
inc edx
mov word Ptr[edx],2573'13 10
inc edx
'началась новая строка
skip013:'цикл копирования пробелов в начале строки
inc eax
inc edx
skip0131:
mov cl,[eax]'
mov [edx],cl
cmp cl,32
je Short skip013
cmp cl,9
je Short skip013
jmp tspp'переход вниз в основной цикл
NxtSymv:
inc eax
inc edx
mov cl,[eax]'
mov [edx],cl
tspp:
test cl,cl
jz Short exit0
cmp cl,94
jg Short NxtSymv
cmp cl,91'[
jg Short skip1
je Short skip
cmp cl,62
jg Short NxtSymv
cmp cl,32
je Short skip
cmp cl,9
je Short skip
cmp cl,13'CR
je Short skip13
cmp cl,10'LF
je Short skip10
cmp cl,57'<=>
jg Short skip1
cmp cl,45',
jg Short NxtSymv
cmp cl,41')*
jg Short skip1
cmp cl,34
jne Short ffno34
cmp eax,[esp+4]
jle Short skipcopy34
cmp Byte Ptr[eax-1],33'!
jne Short skipcopy34
skipcopy34x:'цикл копирования текста в !""
inc eax
inc edx
mov cl,[eax]'
mov [edx],cl
test cl,cl
jz Short exit0
cmp cl,34
jne skipcopy34x
cmp Byte Ptr[eax-1],92
je Short skipcopy34x
jmp Short NxtSymv
skipcopy34:'цикл копирования текста в ""
inc eax
inc edx
mov cl,[eax]'
mov [edx],cl
test cl,cl
jz Short exit0
cmp cl,34
jne Short skipcopy34
jmp Short NxtSymv
ffno34:
cmp cl,35'#
je Short skip1
cmp cl,40'{
je Short skip
cmp cl,41')
je Short skip1b
jmp Short NxtSymv
skip1:'исключение пробелов до и после символа
dec edx
cmp edx,[esp+8]
jl Short scxx
cmp Byte Ptr[edx],32
je Short skip1
cmp Byte Ptr[edx],9
je Short skip1
scxx:
inc edx
mov [edx],cl
jmp skip
skip1b:'исключение пробелов до
dec edx
cmp edx,[esp+8]
jl Short scxx1
cmp Byte Ptr[edx],32
je Short skip1b
cmp Byte Ptr[edx],9
je Short skip1b
scxx1:
inc edx
mov [edx],cl
jmp NxtSymv
exit0:
dec edx
cmp edx,[esp+8]
jl Short scxx11
cmp Byte Ptr[edx],32
je Short scxx110
cmp Byte Ptr[edx],9
je Short scxx110
inc edx
scxx110:
mov [edx],cl
scxx11:
ret 8
End Asm
End Sub
CompileExeGUISubmain.bat
Код @echo off
SET FBPATH=C:\FreeBASIC-1.05.0-win32
%~d1
cd %~p1
SET File=%~n1
SET LIBS=-lkernel32 -luser32 -lgdi32 -lmsimg32 -lshell32 -lComdlg32 -lole32 -ladvapi32.dll -luuid -loleaut32 -limm32 -lwinmm -lcomctl32.dll -lfb -lgcc -lmingw32 -lmingwex -lmoldname -lsupc++ -lgcc_eh -lmsvcrt
If Not Exist %File%.rc GoTo norc
echo compiling resource..
SET RES="%File%.res.obj"
%FBPATH%\bin\win32\gorc /ni /nw /o /fo %RES% "%File%.rc"
:norc
echo compiling..
%FBPATH%\fbc.exe -w 3 %1 -r -lib
If ErrorLevel 1 echo # Compile error! # && GoTo exit
echo assembling..
%FBPATH%\bin\win32\as.exe --32 --strip-local-absolute %File%.asm -o %File%.o
If ErrorLevel 1 echo # Asm error! # && GoTo exit
echo linking..
%FBPATH%\bin\win32\ld.exe -e _main -subsystem windows "%FBPATH%\lib\win32\fbextra.x" -s --stack 102400,102400 -L %FBPATH%\lib\win32 -L "./" "%File%.o" %RES% -o "%File%.exe" -( %LIBS% -)
If ErrorLevel 1 echo # Link error! # && GoTo exit
echo # No errors ! #
:exit
pause
С ресурсами тоже может компилить. Для этого рядом с bat положить rc с тем же именем.
Сообщение отредактировал Somerick - Суббота, 06.08.2016, 23:16 |
| |
| |
| haav | Дата: Понедельник, 25.07.2016, 07:36 | Сообщение # 2 |
 Генералиссимус
Группа: Администраторы
Сообщений: 1361
Статус: Offline
| Хорошая программа. Один важный недостаток: некорректное завершение (висит в диспетчере задач) . Приходится убивать программу вручную.
ExitProcess решит данную проблему.
Если не против, выложу эту программу на основном сайте.
Вы сохраняете власть над людьми покуда оставляете им что-то…Отберите у человека все, и этот человек уже будет неподвластен вам…
|
| |
| |
| Somerick | Дата: Понедельник, 01.08.2016, 20:28 | Сообщение # 3 |
|
Рядовой
Группа: Пользователи
Сообщений: 14
Статус: Offline
| Уверен что в коде в асме чётко всё, проверено.
Копирую текст десять мегабайт и кликаю запускаю, две-три секунды и готово. Окно исчезает, смотрю и в таскменеджере процесс завершается.
DestroyWindow удаляет окно и должно выходить. Но может ещё сообщения в системе остаются, вернее ставить PostQuitMessage 0 после дестрой. Когда оконная процедура окна из ресурсов в программе, ставлю её в Case WM_CLOSE. Сейчас отредактирую.
ExitProcess это излишне, должно всё работать так.
А с PostQuitMessage у вас нормально работает?
По поводу кодов не против, можно как угодно использовать в любых целях кроме коммерческих и вредоносных :)
Позже если будет время доделать, добавлю более сложные программы, лучше в одной теме или в новых?
Вот скромный результат долгого пути программа, очень маленький всего 3 кило но эффективный исправитель раскладки Рус\Англ.
В системе должны быть как минимум эти две раскладки. Интерфейса у программы совсем нету.
Использование: Скомпилировать. Создать ярлык программы на рабочем столе. В свойствах ярлыка задать клавишу или сочетание быстрого вызова.
Например F7
Теперь открываем блокнот. Набираем там в русской раскладке например: Руддщ цщкдв
Выделяем весь этот набранный текст, курсор должен быть над полем ввода, нажимаем F7 и продолжаем печатать нормально.
Часто вызывать это дело конечно не требуется, я-то давно не ошибаюсь вижу что набираю, но может пригодится кому. Программа мгновенно срабатывает и заканчивается, ExitProcess тут поставил в конец на всякий... Просьба потестить и без него. При вызове фокус уходит из блокнота?
LayoutSwitcher.bas компилить так же.
Код #Include Once"windows.bi"
Dim Shared T(256)As UByte={0,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,64,185,59,37,63,253,40,41,42,43,63,45,47,124,48,49,50,51,52,53,54,55,56,57,94,36,193,61,_
222,38,34,212,200,209,194,211,192,207,208,216,206,203,196,220,210,217,199,201,202,219,197,195,204,214,_
215,205,223,245,92,250,58,95,184,244,232,241,226,243,224,239,240,248,238,235,228,252,242,249,231,233,_
234,251,229,227,236,246,247,237,255,213,47,218,168,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,126,169,170,171,172,173,174,175,176,177,178,179,180,181,182,183,96,35,186,187,188,189,190,191,70,_
60,68,85,76,84,58,80,66,81,82,75,86,89,74,71,72,67,78,69,65,123,87,88,73,79,125,83,77,34,62,90,102,44,100,_
117,108,116,59,112,98,113,114,107,118,121,106,103,104,99,110,101,97,91,119,120,105,111,93,115,109,39,46,122}
Sub main Cdecl alias"main"
Dim As zString*10 s=Any
Dim As Point cp=Any
GetCursorPos @cp
Var h=WindowFromPoint(cp)'узнаём окно под курсором
'Эти две строки только для того чтоб работало в FbEdit
GetClassName h,s,8
If lstrcmp(s,"RAEditC")=0 Then h=GetParent(h)
Var hkl=IIf(LoWord(GetKeyboardLayout(GetWindowThreadProcessId(h,0)))=1033,1049,1033)'локаль в окне, 1049 ru 1033 en
OpenClipboard 0
EmptyClipboard
CloseClipboard
SendMessage h,WM_COPY,0,0
If IsClipboardFormatAvailable(CF_TEXT)Then
OpenClipboard 0
'указание локали
Var cl=GlobalAlloc(GMEM_MOVEABLE Or GMEM_SHARE,5)
Var m=GlobalLock(cl)
Poke dword,m,959721521
Poke m+4,0
GlobalUnlock m
SetClipboardData CF_LOCALE,cl
cl=GetClipboardData(CF_TEXT)
m=GlobalLock(cl)
Dim As ZString Ptr p=m
Dim As Long c=Any
If hkl=1033 Then
Do'Перекодировка по таблице
c=Peek(p)
Poke p,T(c)
p+=1
Loop While c
Else'чтоб не делать вторую таблицу. Одной в одном цикле не обойтись, так как некоторые знаки препинания не совпадают
Do
c=Peek(p)
Select Case c
Case 34:c=221
Case 44:c=225
Case 46:c=254
Case 58:c=198
Case 59:c=230
Case 63:c=44
Case Else:c=T(c)
End Select
Poke p,c
p+=1
Loop While c
EndIf
SendMessage h,EM_REPLACESEL,0,m
GlobalUnlock m
CloseClipboard
EndIf
SendMessage HWND_BROADCAST,WM_INPUTLANGCHANGEREQUEST,1,hkl'задать глобально раскладку.
SetForegroundWindow h'возврат фокуса
ExitProcess 0
End Sub
A также можно вместо EM_REPLACESEL использовать WM_PASTE но это надо вновь заносить результат в буфер обмена. То что в полученной области памяти перекодировалось - не считается, оно не вставляется, проверял, вставляется неперекодированный текст.
Сообщение отредактировал Somerick - Суббота, 06.08.2016, 23:27 |
| |
| |
| haav | Дата: Пятница, 05.08.2016, 10:58 | Сообщение # 4 |
|
Генералиссимус
Группа: Администраторы
Сообщений: 1361
Статус: Offline
| Цитата Somerick (  ) ExitProcess тут поставил в конец на всякий... Просьба потестить и без него
Завершается без ExitProcess.
Цитата Somerick ( ) При вызове фокус уходит из блокнота?
Да фокус уходит.
Вы сохраняете власть над людьми покуда оставляете им что-то…Отберите у человека все, и этот человек уже будет неподвластен вам…
|
| |
| |
| Somerick | Дата: Суббота, 06.08.2016, 23:25 | Сообщение # 5 |
|
Рядовой
Группа: Пользователи
Сообщений: 14
Статус: Offline
| Цитата haav ( ) Завершается без ExitProcess.
На ХР не уходит, на 7, 8 (наверно и 10) уходит фокус когда любое приложение, даже без создаваемого окна, запустить таким вот методом по горячей кнопке в свойствах ярлыка.
SetForegroundWindow h возвращает фокус.
|
| |
| |
|
