Исправление регистра кода в буфере обмена
|
|
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 Использование универсального батника: задать в второй строке ваш путь к папке компилятора, сохранить по пути без пробелов. Далее просто перетащить bas на bat. С ресурсами тоже может компилить. Для этого рядом с bat положить rc с тем же именем.
Сообщение отредактировал Somerick - Суббота, 06.08.2016, 23:16 |
|
| |
haav | Дата: Понедельник, 25.07.2016, 07:36 | Сообщение # 2 |
Генералиссимус
Группа: Администраторы
Сообщений: 1366
Статус: 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 |
Генералиссимус
Группа: Администраторы
Сообщений: 1366
Статус: Offline
| Цитата Somerick ( ) ExitProcess тут поставил в конец на всякий... Просьба потестить и без него
Завершается без ExitProcess.
Цитата Somerick ( ) При вызове фокус уходит из блокнота?
Да фокус уходит.
Вы сохраняете власть над людьми покуда оставляете им что-то…Отберите у человека все, и этот человек уже будет неподвластен вам…
|
|
| |
Somerick | Дата: Суббота, 06.08.2016, 23:25 | Сообщение # 5 |
Рядовой
Группа: Пользователи
Сообщений: 14
Статус: Offline
| Цитата haav ( ) Завершается без ExitProcess. Здесь окон не создаётся, функции отрабатывают и ничто не задерживает.
На ХР не уходит, на 7, 8 (наверно и 10) уходит фокус когда любое приложение, даже без создаваемого окна, запустить таким вот методом по горячей кнопке в свойствах ярлыка. SetForegroundWindow h возвращает фокус.
|
|
| |
|