FreeBasic
Главная
Вход
Регистрация
Суббота, 23.09.2017, 10:22Приветствую Вас Гость | RSS
[ Новые сообщения · Участники · Правила форума · Поиск · RSS ]
Страница 1 из 11
Форум » Freebasic » Исходники » Исправление регистра кода в буфере обмена
Исправление регистра кода в буфере обмена
SomerickДата: Понедельник, 25.07.2016, 01:51 | Сообщение # 1
Рядовой
Группа: Пользователи
Сообщений: 10
Репутация: 2
Статус: 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
Генерал-лейтенант
Группа: Администраторы
Сообщений: 768
Репутация: 33
Статус: Offline
Хорошая программа. Один важный недостаток: некорректное завершение (висит в диспетчере задач) . Приходится убивать программу вручную.
ExitProcess решит данную проблему.

Если не против, выложу эту программу на основном сайте.


Вы сохраняете власть над людьми покуда оставляете им что-то…Отберите у человека все, и этот человек уже будет неподвластен вам…
 
SomerickДата: Понедельник, 01.08.2016, 20:28 | Сообщение # 3
Рядовой
Группа: Пользователи
Сообщений: 10
Репутация: 2
Статус: 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
Генерал-лейтенант
Группа: Администраторы
Сообщений: 768
Репутация: 33
Статус: Offline
Цитата Somerick ()
ExitProcess тут поставил в конец на всякий... Просьба потестить и без него


Завершается без ExitProcess.

Цитата Somerick ()
При вызове фокус уходит из блокнота?


Да фокус уходит.


Вы сохраняете власть над людьми покуда оставляете им что-то…Отберите у человека все, и этот человек уже будет неподвластен вам…
 
SomerickДата: Суббота, 06.08.2016, 23:25 | Сообщение # 5
Рядовой
Группа: Пользователи
Сообщений: 10
Репутация: 2
Статус: Offline
Цитата haav ()
Завершается без ExitProcess.
Здесь окон не создаётся, функции отрабатывают и ничто не задерживает.

На ХР не уходит, на 7, 8 (наверно и 10) уходит фокус когда любое приложение, даже без создаваемого окна, запустить таким вот методом по горячей кнопке в свойствах ярлыка.
SetForegroundWindow h возвращает фокус.
 
Форум » Freebasic » Исходники » Исправление регистра кода в буфере обмена
Страница 1 из 11
Поиск: