#Include Once "cmptable.bi"

Function MegaInstrBas(s As zString Ptr,w As zString Ptr,Aa As Long=0,Ww As Long=0,rev As zString Ptr=0)As zString Ptr
Dim As zString Ptr p=Any,p1=Any
Dim As Long x=Any,wLen=Any
Dim As Byte b=IIf(aa,Cmpi_tbl(Peek(w)),Peek(w)),c=Any
If b=0 Then Exit Function

If rev=0 Then'forvard
    p=s-1
    If aa=0 Then
        Do:p+=1:c=Peek(p)
        If c=0 Then Exit Function
        If c=b Then
            If ww Then
                If p>s Then
                    If Word_tbl(Peek(p-1))Then Continue Do
                EndIf    
            EndIf
            x=1
            Do:c=Peek(w+x)
                If c=0 Then
                    If ww Then
                        If Word_tbl(Peek(p+x))Then Exit Do
                    EndIf
                    Return p
                EndIf
                If c<>Peek(p+x)Then Exit Do
                x+=1
            Loop
        EndIf
        Loop
    
    Else'ignore case
        Do:p+=1:c=Cmpi_tbl(Peek(p))
        If c=0 Then Exit Function
        If c=b Then
            If ww Then
                If p>s Then
                    If Word_tbl(Peek(p-1))Then Continue Do
                EndIf    
            EndIf
            x=1
            Do:c=Cmpi_tbl(Peek(w+x))
                If c=0 Then
                    If ww Then
                        If Word_tbl(Peek(p+x))Then Exit Do
                    EndIf
                    Return p
                EndIf
                If c<>Cmpi_tbl(Peek(p+x))Then Exit Do
                x+=1
            Loop
        EndIf
        Loop
    EndIf

Else'backvard
    p=w
    While Peek(p):p+=1:Wend
    wLen=p-w
    If rev<0 Then
        rev=s
        While Peek(rev):rev+=1:Wend
    EndIf
    rev-=wLen
    If rev<s Then Exit Function
    p=rev+1
    If aa=0 Then
        Do:p-=1
        If p<s Then Exit Function
        c=Peek(p)
        If c=b Then
            If ww Then
                If p>s Then
                    If Word_tbl(Peek(p-1))Then Continue Do
                EndIf    
            EndIf
            x=1
            Do:c=Peek(w+x)
                If c=0 Then
                    If ww Then
                        If Word_tbl(Peek(p+x))Then Exit Do
                    EndIf
                    Return p
                EndIf
                If c<>Peek(p+x)Then Exit Do
                x+=1
            Loop
        EndIf
        Loop
    
    Else'ignore case
        Do:p-=1
        If p<s Then Exit Function
        c=Cmpi_tbl(Peek(p))
        If c=b Then
            If ww Then
                If p>s Then
                    If Word_tbl(Peek(p-1))Then Continue Do
                EndIf    
            EndIf
            x=1
            Do:c=Cmpi_tbl(Peek(w+x))
                If c=0 Then
                    If ww Then
                        If Word_tbl(Peek(p+x))Then Exit Do
                    EndIf
                    Return p
                EndIf
                If c<>Cmpi_tbl(Peek(p+x))Then Exit Do
                x+=1
            Loop
        EndIf
        Loop
    EndIf
EndIf
End Function

#Include Once "cmptable.bi"

Function MegaInstrAsm naked(s As zString Ptr,w As zString Ptr,Aa As Long=0,Ww As Long=0,rev As zString Ptr=0)As zString Ptr
Scope
#Define p_s esp+16
#Define p_w esp+20
#Define p_aa esp+24
#Define p_ww esp+28
#Define p_rev esp+32
Asm
push ebx
push esi
push edi
mov eax,[p_s]
mov esi,[p_w]
movzx edx,Byte Ptr[eax]'
test dl,dl
jz SI_exit
movzx ebx,Byte Ptr[esi]'
test bl,bl
jz SI_exit

cmp dword Ptr[p_rev],0
jne SI_Revers
cmp Byte Ptr[p_aa],dh
jne SI_F_Aa

'###### StrStr & StrStrW
cmp dl,bl
je Str_One_w

Str_Now:
inc eax
mov dx,[eax]'
cmp dl,bl
je Str_One
test dl,dl
jz SI_exit
test dh,dh
jz SI_exit
inc eax
cmp dh,bl
jne Str_Now

Str_One:'1 char
cmp Byte Ptr[p_ww],bh
je Str_One_w
movzx edx,Byte Ptr[eax-1]
cmp Byte Ptr[edx+Word_tbl],dh
jne Str_Now

Str_One_w:
Xor edi,edi

Str_Pr:
inc edi
mov dx,[esi+edi]
test dl,dl
jz Str_enOK
cmp dl,[eax+edi]
jne Str_Now
inc edi
test dh,dh
jz Str_enOK
cmp dh,[eax+edi]
je Str_Pr
jmp Str_Now

Str_enOK:
cmp Byte Ptr[p_ww],bh
je SI_exitOK
movzx edx,Byte Ptr[eax+edi]
cmp Byte Ptr[edx+Word_tbl],dh
jne Str_Now
jmp SI_exitOK

'###### начало StrStri & StrStriW
SI_F_Aa:
Xor ecx,ecx
mov bl,Byte Ptr[ebx+Cmpi_tbl]
cmp bl,Byte Ptr[edx+Cmpi_tbl]
je Stri_One_w

Stri_Now:
inc eax
mov dl,[eax]'
test dl,dl
jz SI_exit
cmp bl,Byte Ptr[edx+Cmpi_tbl]
jne Stri_Now

Stri_One:
cmp Byte Ptr[p_ww],bh
je Stri_One_w
mov dl,[eax-1]'
cmp Byte Ptr[edx+Word_tbl],dh
jne Stri_Now

Stri_One_w:
Xor edi,edi

Stri_Pr:
inc edi
mov dl,[esi+edi]
test dl,dl
jz Stri_enOK
mov dl,Byte Ptr[edx+Cmpi_tbl]
mov cl,[eax+edi]
cmp dl,Byte Ptr[ecx+Cmpi_tbl]
je Stri_Pr
jmp Stri_Now

Stri_enOK:
cmp Byte Ptr[p_ww],bh
je SI_exitOK
mov dl,[eax+edi]
cmp Byte Ptr[edx+Word_tbl],dh
jne Stri_Now
jmp SI_exitOK
'######## конец функционала поиска в прямом направлении

SI_Revers:'StrStrRev & StrStrWRev & StrStriRev & StrStriWRev
'Далее почти до конца, до SI_exit: код для поиска в обратном.
'Если не требуется искать назад, можно уменьшить размер исключить этот код
cld
xor eax,eax
mov edi,esi
mov ecx,&h7FFFFFFE
repne scasb
dec edi
sub edi,esi
push edi

mov edi,[p_rev+4]
cmp edi,eax
jg short StrR_r
mov edi,[p_s+4]
repne scasb
dec edi

StrR_r:
pop ecx
mov eax,[p_s]
sub edi,eax
cmp ecx,edi
jg SI_exit'оказалось длина w > диапазона поиска

sub edi,ecx
mov ebx,edi
mov edi,eax
add eax,ebx

movzx ebx,Byte Ptr[esi]'
inc eax
cmp Byte Ptr[p_aa],bh
jne SI_R_Aa

'###### StrStrRev & StrStrWRev
StrR_Now:
dec eax
cmp eax,edi
jl short SI_exit
cmp bl,[eax]'
jne short StrR_Now

cmp Byte Ptr[p_ww],0
je StrR_One_w
cmp eax,edi
jle StrR_One_w
movzx edx,Byte Ptr[eax-1]'
cmp Byte Ptr[edx+Word_tbl],dh
jne StrR_Now

StrR_One_w:
Xor edx,edx

StrR_Pr:
inc edx
mov bh,[esi+edx]
test bh,bh
jz short StrR_enOK
cmp bh,[eax+edx]
je short StrR_Pr
jmp short StrR_Now

StrR_enOK:
cmp Byte Ptr[p_ww],0
je SI_exitOK
movzx edx,Byte Ptr[eax+edx]
cmp Byte Ptr[edx+Word_tbl],dh
jne StrR_Now
jmp SI_exitOK

'###### часть StrStriRev & StrStriWRev
SI_R_Aa:
mov bl,Byte Ptr[ebx+Cmpi_tbl]
Xor ecx,ecx

StriR_Now:
dec eax
cmp eax,edi
jl short SI_exit
mov cl,[eax]'
cmp bl,Byte Ptr[ecx+Cmpi_tbl]
jne short StriR_Now

cmp Byte Ptr[p_ww],0
je StriR_One_w
cmp eax,edi
jle StriR_One_w
movzx edx,Byte Ptr[eax-1]
cmp Byte Ptr[edx+Word_tbl],dh
jne StriR_Now

StriR_One_w:
Xor edx,edx

StriR_Pr:
inc edx
mov cl,[esi+edx]
test cl,cl
jz short StriR_enOK
mov bh,Byte Ptr[ecx+Cmpi_tbl]
mov cl,[eax+edx]
cmp bh,Byte Ptr[ecx+Cmpi_tbl]
je short StriR_Pr
jmp short StriR_Now

StriR_enOK:
cmp Byte Ptr[p_ww],0
je SI_exitOK
movzx edx,Byte Ptr[eax+edx]
cmp Byte Ptr[edx+Word_tbl],dh
jne StriR_Now
jmp SI_exitOK
'конец кода для поиска в обратном направлении

SI_exit:
Xor eax,eax
SI_exitOK:
pop edi
pop esi
pop ebx
ret 20
End Asm
End Scope
End Function

'1- цифры, буквы, _
Dim Shared As Const UByte Word_tbl(256)={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 As Const UByte Cmpi_tbl(256)={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,157,158,159,160,161,162,163,_
164,165,166,167,184,169,170,171,172,173,174,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}

#Include Once "windows.bi"
#Include Once "win\shlwapi.bi"

Function IfWordCharPtr(s As zString Ptr)As Long
Select Case Peek(s):Case 48 To 57,65 To 90,95,97 To 122,Is>191,168,184:Function=1:End Select
End Function

Function MegaInstrWin(s As zString Ptr,w As zString Ptr,Aa As Long=0,Ww As Long=0,rev As zString Ptr=0)As zString Ptr
Dim As zString Ptr p=Any,p1=Any
Dim As Long wLen=lstrlen(w)
If wLen<1 Then Exit Function

If rev=0 Then'forvard
    p1=s
    Do:p=IIf(aa,StrStrI(p1,w),StrStr(p1,w))
        If ww Then
            If p Then
                If p>s Then
                    If IfWordCharPtr(p-1)Then p1=p+1:Continue Do
                EndIf
                If IfWordCharPtr(p+wLen)Then p1=p+1:Continue Do
            EndIf
        EndIf
        Return p
    Loop

Else'backvard
    p1=rev-wLen+1
    If p1<s Then Exit Function
    Do:p=StrRStrI(s,p1,w)
        If aa=0 Then'no
            If StrCmpN(p,w,wLen)Then
                If p>s Then p1=p-1:Continue Do
                Exit Function
            EndIf
        EndIf
        If ww Then
            If p Then
                If p>s Then
                    If IfWordCharPtr(p-1)Then p1=p-1:Continue Do
                EndIf
                If IfWordCharPtr(p+wLen)Then
                    If p>s Then p1=p-1:Continue Do
                    Exit Function
                EndIf
            EndIf
        EndIf
        Return p
    Loop
EndIf
End Function

#Include Once "MegaInstrAsm.bas"

Function MegaReplaceAsm naked(src As ZString Ptr,dst As ZString Ptr,w1 As ZString Ptr,w2 As ZString Ptr,Aa As Long=0,Ww As Long=0,CopyIfCntMath0 As Long=1,ByRef DstCharCnt As Long=0)As Long
Scope
#Define dstp ebp-24
#Define cnt ebp-20
#Define w1Len ebp-16
#Define RetFlag ebp-12
#Define p_src ebp+8
#Define p_dst ebp+12
#Define p_w1 ebp+16
#Define p_w2 ebp+20
#Define p_aa ebp+24
#Define p_ww ebp+28
#Define p_Cpy0 ebp+32
#Define p_dstCnt ebp+36

Asm
push ebp
mov ebp,esp
sub esp,64
push edi
push esi
Xor eax,eax
mov [cnt],eax
mov [RetFlag],al
mov edi,[p_dst]'
mov [dstp],edi
mov [edi],al
mov edx,[p_w1]
dec edx
RP_l1:
inc edx
cmp [edx],al
jne RP_l1
Sub edx,[p_w1]
mov [w1Len],edx

RP_Now:
push 0
push [p_ww]
push [p_aa]
push [p_w1]
push [p_src]
Call MegaInstrAsm

mov esi,[p_src]
mov edi,[p_dst]
test eax,eax
jnz RP_OK
mov Byte Ptr[RetFlag],1
mov edx,esi
cmp [cnt],eax
jne RP_Copy
cmp [p_Cpy0],eax
je RP_Copy
jmp RP_exit

RP_OK:
inc dword ptr[cnt]'
Sub eax,esi
mov ecx,eax
cld
push ecx
shr ecx,2
rep movsd
pop ecx
and ecx,3
rep movsb
add esi,[w1len]
mov [p_src],esi
mov edx,[p_w2]

RP_Copy:
mov cl,[edx]'
mov [edi],cl
inc edx
inc edi
test cl,cl
jnz RP_Copy
dec edi
mov [p_dst],edi
cmp Byte Ptr[RetFlag],0
je RP_Now

RP_exit:
Sub edi,[dstp]'
mov eax,[p_dstCnt]
mov [eax],eax'byref
mov [eax],edi
mov eax,[cnt]'
pop esi
pop edi
mov esp,ebp
pop ebp
ret 32
End Asm
End Scope
End Function

#Include "MegaReplaceAsm.bas"

Dim As zString*1024 buff1=Any,buff2=Any
Dim As Long CntRep=Any,CntDstChar=Any,Aa=1,Ww=0

'####### Пример 1 с статическим буфером
?"String: "; "test1 test2 abcd TEST2TEST1"

CntRep=MegaReplaceAsm("test1 test2 abcd TEST2TEST1",buff1,"Test1","replace1",Aa,Ww,1,CntDstChar)

?!"Replace ignore case \"Test1\" -> \"replace1\""
?"Result: "; buff1 '"replace1 test2 abcd TEST2replace1"
?"Replace count = "; CntRep; " Result Strlen = "; CntDstChar
'CntRep=2

'####### Пример 2 с статическим буфером
?
?"String: "; buff1
Ww=1'whole word

CntRep=MegaReplaceAsm(buff1,buff2,"Test2","replace2",Aa,Ww,1,CntDstChar)

?!"Replace ignore case and whole word \"Test2\" -> \"replace2\""
?"Result: "; buff2 '"replace1 replace2 abcd TEST2replace1"
?"Replace count = "; CntRep; " Result Strlen = "; CntDstChar
'CntRep=1, TEST2TEST1 - тут не заменено, так как TEST2 часть, не целое слово

'####### Пример с выделяемыми буферами

Dim As zString Ptr m1=Any,m2=Any,p=Any,srcp=Any
Dim As Long srcLen=1000000

m1=New Byte[srcLen+1]{Any}
p=m1
?
?"Speed Test:"
?"Start generation BIG STRING Len 50 * 20000 strcat Wait..."
Dim As Double d=Timer
For x As Long=1 To 20000 'генерация строки
    *p="test1 test2 TEST2TEST1 qwerty1234567890asfghjkl;'-" '50
    p+=50
Next

?"Ok. Time: "; Timer-d'0.003 с 'А если использовать тип String и &= счёт пойдёт на минуты
?

#Define w1Len 5' len "Test1"
#Define w2Len 8' len "replace1"

?!"Start search ignore case and whole word \"Test1\" Wait..."
d=Timer

'узнать количество замен
CntRep=0:srcp=m1
Do:p=MegaInstrAsm(srcp,"Test1",Aa,Ww,0)
    If p=0 Then Exit Do
    CntRep+=1:srcp=p+w1Len
Loop
?"Ok. Count ="; CntRep ; " Time: "; Timer-d'0.006 с

'узнать какой размер будет после замены
Dim As Long dstLen=srcLen-(w1Len*CntRep)+(w2Len*CntRep)

'аллокация нового буфера
m2=New Byte[dstLen+1]{Any}

?
?!"Start Replace ignore case and whole word \"Test1\" -> \"replace1\" Wait..."
d=Timer

'собственно копирование с заменой
CntRep=MegaReplaceAsm(m1,m2,"Test1","replace1",Aa,Ww,0,dstLen)

?"Ok. Count Replace ="; CntRep ; " Time: "; Timer-d'0.007 с
?"Calculated byffers size:     "; srcLen; " & "; dstLen
?"Really text size in byffers: "; Len(*m1) ; " & "; Len(*m2)'всё сходится!

?
m1[1000]=0:m2[1000]=0'чтоб было показано в консоли не 1000000 и 1060000 а первые 1000. желающие могут просмотреть полностью

?"View Src: "; *m1
?
?"View Dst: "; *m2

Delete[] m1:Delete[] m2' освобождение памяти

Sleep
'пауза, выход

#Include Once "windows.bi"
#Include Once "win\shellapi.bi"
#Include Once "win\shlwapi.bi"
#Include Once "win\commdlg.bi"

#Include Once "MegaReplaceAsm.bas"

#Define MegaInstr MegaInstrAsm
#Define EDITFIND 2000
#Define EDITREPLACE 2001
#Define BTNCNT 2002
#Define BTNR 2003
#Define BTNFIND 2004
#Define BTNL 2005
#Define BUTTONREPLACE 2006
#Define EDIT 2007
#Define CHECKWW 2008
#Define CHECKAA 2009
#Define BTNGOTO 2010
#Define EDITGOTO 2011
#Define MENUNEW 2500
#Define MENUOPEN 2501
#Define MENUSAVE 2502
#Define MENUSAVEAS 2503
#Define MENUEXIT 2504

#Define TbLen(t) SendMessage(t,WM_GETTEXTLENGTH,0,0)
#Define TbAdd(t,s) SendMessage t,EM_REPLACESEL,1,s
#Define TbSetSel(t,x,y) SendMessage t,EM_SETSEL,x,y
#Define TbScroll(t) SendMessage t,EM_SCROLLCARET,0,0
Dim Shared As HWND hw,t,tf,tr,l
Dim Shared As ZString*260 sFile
Dim Shared As WndProc EProc

Type zMem
    As ZString Ptr m'указатель на память
    As Long ln,txtln'длина памяти,длина текста
    Declare Function Start(b As Long)As ZString Ptr'возврат указателя на буфер не менее b+2 байт
    Declare Function GetTxt(h As HWND)As ZString Ptr'возврат ук. на память с скопированным текстом из окна h
    Declare Sub free
    Declare Destructor
End Type
Dim Shared As zMem Txt,TxtF,TxtR,TxtBuff

Declare Function WndProc(hWin As HWND,uMsg As UINT,wParam As WPARAM,lParam As LPARAM)As Long
Declare Function EditProc(h As HWND,msg As Ulong,wparam As WPARAM,lParam As LPARAM)As Long
Declare Sub Find(mode As Long)
Declare Sub FileLoadSave(s As ZString Ptr,mode As Long)

Sub main Cdecl Alias "main"'Entry Point
Dim As WNDCLASS wc
Dim As MSG msg=Any
Dim As HFONT f=GetStockObject(DEFAULT_GUI_FONT)
wc.hbrBackground=16
wc.hInstance=GetModuleHandle(0)
wc.style=CS_PARENTDC Or CS_DBLCLKS
wc.lpfnWndProc=@WndProc
wc.lpszClassName=@"TestSearchAndReplace"
RegisterClass @wc
#Define i wc.hInstance

hw=CreateWindowEx(272,"TestSearchAndReplace","Редактор - Новый файл.txt",349110272,100,50,850,668,0,0,i,0)
t=CreateWindowEx(512,"Edit","",&h503011C4,0,48,752,472,hw,EDIT,i,0)
SendMessage t,WM_SETFONT,f,1
SendMessage t,EM_LIMITTEXT,-1,0'No Limit!
EProc=SetWindowLong(t,-4,@EditProc)
tf=CreateWindowEx(512,"Edit","",1342242944,8,8,160,30,hw,EDITFIND,i,0)
SendMessage tf,WM_SETFONT,f,1
tr=CreateWindowEx(512,"Edit","",1342242944,448,8,152,30,hw,EDITREPLACE,i,0)
SendMessage tr,WM_SETFONT,f,1
l=CreateWindowEx(0,"Static","",1342177408,8,600,832,24,hw,2500,i,0)
SendMessage l,WM_SETFONT,f,1
SendMessage CreateWindowEx(0,"Button","Заменить",1342254848,600,8,80,32,hw,BUTTONREPLACE,i,0),WM_SETFONT,f,1
SendMessage CreateWindowEx(0,"Button","Счёт",1342254848,296,8,48,32,hw,BTNCNT,i,0),WM_SETFONT,f,1
SendMessage CreateWindowEx(0,"Button",">",1342254848,264,8,32,32,hw,BTNR,i,0),WM_SETFONT,f,1
SendMessage CreateWindowEx(0,"Button","Ww",1342242819,400,8,48,32,hw,CHECKWW,i,0),WM_SETFONT,f,1
SendMessage CreateWindowEx(0,"Button","A=a",1342242819,352,8,48,32,hw,CHECKAA,i,0),WM_SETFONT,f,1
SendMessage CreateWindowEx(0,"Button","<",1342254848,168,8,32,32,hw,BTNL,i,0),WM_SETFONT,f,1
SendMessage CreateWindowEx(0,"Button","Найти",1342254848,200,8,64,32,hw,BTNFIND,i,0),WM_SETFONT,f,1
SendMessage CreateWindowEx(512,"Edit","1",1342251136,688,8,48,30,hw,EDITGOTO,i,0),WM_SETFONT,f,1
SendMessage CreateWindowEx(0,"Button","Пер. на строку",1342254848,736,8,96,32,hw,BTNGOTO,i,0),WM_SETFONT,f,1
CheckDlgButton hw,CHECKAA,1

Dim As HMENU Menu=CreateMenu,MenuFile=CreateMenu
AppendMenu Menu,MF_POPUP,MenuFile,"Файл"
AppendMenu MenuFile,0,MENUNEW,@!"Создать\tCtrl+N"
AppendMenu MenuFile,0,MENUOPEN,@!"Открыть\tCtrl+O"
AppendMenu MenuFile,0,MENUSAVE,@!"Сохранить\tCtrl+S"
AppendMenu MenuFile,0,MENUSAVEAS,@"Сохранить как.."
AppendMenu MenuFile,MF_SEPARATOR,0,0
AppendMenu MenuFile,0,MENUEXIT,@!"Выход\tAlt+F4"
SetMenu hw,Menu

Static As Const ACCEL Acl(6)={_
(FVIRTKEY Or FCONTROL,Asc("N"),MENUNEW),_
(FVIRTKEY Or FCONTROL,Asc("O"),MENUOPEN),_
(FVIRTKEY Or FCONTROL,Asc("S"),MENUSAVE),_
(FVIRTKEY Or FALT,VK_F4,MENUEXIT),_
(FVIRTKEY,VK_F3,BTNR),_
(FVIRTKEY Or FCONTROL,VK_F3,BTNL),_
(FVIRTKEY,VK_F5,BTNFIND)}

Var Atbl=CreateAcceleratorTable(Cast(LPACCEL,@Acl(0)),7)

Dim As zString Ptr p=PathGetArgs(GetCommandLine),p1=Any
Dim As Long c=Peek(p)
If c Then
    If c=34 Then p+=1 Else c=32
    p1=StrChr(p,c):If p1 Then Poke p1,0
    FileLoadSave p,0
EndIf

While GetMessage(@msg,0,0,0)
If TranslateAccelerator(hw,Atbl,@msg)=0 Then
    Select Case msg.message
        Case WM_KEYDOWN
            Select Case msg.wParam
                Case 13
                    If msg.hwnd=tf Then Find BTNFIND
            End Select
    End Select
    TranslateMessage @msg
    DispatchMessage @msg
EndIf
Wend

DestroyAcceleratorTable Atbl
DestroyMenu MenuFile
DestroyMenu Menu
ExitProcess 0
End Sub

Destructor zMem
free
End Destructor

Sub zMem.Free
If m Then
    If HeapFree(GetProcessHeap,0,m)<>0 Then m=0:ln=0
EndIf
End Sub

Function zMem.Start(b As Long)As ZString Ptr
Dim As zString*255 s=Any
If ln<=b Then
    free
    m=HeapAlloc(GetProcessHeap,0,b+5002)
    If m Then ln=b+5000:Poke m,0 Else StrFormatByteSize b,_
    @s+wsprintf(s,!"Не удалось выделить память.\rЗапрошено "),50:MessageBox hw,s,0,16
EndIf
txtln=0
Function=m
End Function

Function zMem.GetTxt(h As HWND)As ZString Ptr
Dim As Long x=TbLen(h)
Dim As zString Ptr p=Start(x)
If p Then txtln=SendMessage(h,WM_GETTEXT,x+2,p):Poke word,p+txtln,0:Function=p
End Function

Sub Status
Dim As zString*300 s=Any
Dim As Long L1=Any,L2=Any,v=Any,ds,de
SendMessage t,EM_GETSEL,@Ds,@De:v=De-Ds
l1=SendMessage(t,EM_LINEFROMCHAR,ds,0)
De=SendMessage(t,EM_LINEINDEX,L1,0)
StrFormatByteSize TbLen(t),@s+wsprintf(s,IIf(v,_
@"Cтр. %d Поз. %d\%d Выделено %d Всего: ",_
@"Cтр. %d Поз. %d\%d Всего: "),l1+1,Ds-De+1,Ds+1,v),50
SetWindowText l,s
End Sub

Function EditProc(h As HWND,msg As Ulong,wparam As WPARAM,lParam As LPARAM)As Long
Function=callWindowProc(EProc,h,Msg,wParam,lParam)
Select Case msg
    Case WM_MOUSEMOVE:If wParam=MK_LBUTTON Then Status
    Case WM_KEYDOWN:If wparam>32 And wparam<41 Then Status
    Case WM_LBUTTONDOWN,WM_RBUTTONDOWN:Status
End Select
End Function

Sub Find(mode As Long)
Dim As zString*300 s=Any,s1=Any,s2=Any
Dim As zString Ptr p=Any,p1=Any,p2=Any,m=Any,m2=Any,r=Any,w=TxtF.GetTxt(tf),rev
Dim As Long c=Any,cnt=Any,Aa=Any,Ww=Any,wLen=TxtF.txtln,ds,de

If wLen=0 Then
    MessageBox hw,"Пустой поисковый запрос!","",48:Exit Sub
Else
    m=Txt.GetTxt(t):p1=m
    Aa=IsDlgButtonChecked(hw,CHECKAA)
    Ww=IsDlgButtonChecked(hw,CHECKWW)
    SendMessage t,EM_GETSEL,@ds,@de

    Select Case mode
    Case BTNR
        p1+=de
    Case BTNL
        rev=p1+ds
    Case BTNCNT
        cnt=0
        Do:p=MegaInstr(p1,w,Aa,Ww,0)
            If p=0 Then
                Poke dword,w+250,3026478
                wsprintf s,!"Найдено %d \"%s\"",cnt,w
                MessageBox hw,s,"",64:Status:Exit Sub
            EndIf
            If cnt=0 Then TbSetSel(t,p-m,p-m+wLen):TbScroll(t)
            cnt+=1:p1=p+wLen
        Loop

    Case BUTTONREPLACE
        cnt=0
        Do:p=MegaInstrAsm(p1,w,Aa,Ww,0)'первый проход, узнать количество замен
            If p=0 Then Exit Do
            cnt+=1:p1=p+wLen
        Loop

        If cnt Then
            r=TxtR.GetTxt(tr)
    'вычисление необходимой длины и инициация буфера
            m2=TxtBuff.Start(Txt.Txtln-(wLen*cnt)+(TxtR.txtln*cnt))

    'Вызов функции замены    
            cnt=MegaReplaceAsm(m,m2,w,r,Aa,Ww)

            SendMessage t,EM_SETSEL,0,-1:TbAdd(t,m2)'выделить всё и вставить, чтоб состояние отмены сохранилось
            TxtBuff.free
        EndIf
    'показ результата
        StrFormatByteSize Txt.Txtln,s1,30
        c=TbLen(t)
        StrFormatByteSize c,s2,30:c-=Txt.Txtln
        StrFormatByteSize Abs(c),_
        @s+wsprintf(s,!"Количество замен: %d\rРазмер текста до: %s\rНовый размер: %s\rРазница: %s",_
        cnt,s1,s2,IIf(c<0,@"-",IIf(c,@"+",@""))),30
        Status:MessageBox hw,s,"",64:Exit Sub
    End Select
EndIf

p=MegaInstr(p1,w,Aa,Ww,rev)
If p Then TbSetSel(t,p-m,p-m+wLen):TbScroll(t):Status:Exit Sub

MessageBox hw,"Не найдено",IIf(mode=BTNFIND,@"Произведён поиск в всём тексте",_
IIf(mode=BTNL,@!"От начала выделения до начала текста",@!"От конца выделения до конца текста")),64
End Sub

Sub FileLoadSave(s As ZString Ptr,mode As Long)
Dim As zString*500 sh=Any
Dim As ZString Ptr m=Any,msg=Any
Dim As Long fSav=Any,ln=Any,b

If mode=0 Then'open
    msg=@"Загружено ":fSav=3
Else
    msg=@"Coxранено ":fSav=2
EndIf

Var f=CreateFile(s,-1073741824,3,0,fSav,128,0)
If f<>-1 Then
    If mode=0 Then
        ln=GetFileSize(f,0)
        m=Txt.Start(ln)
        ReadFile f,m,ln,@b,0:Poke word,m+ln,0
        SetWindowText t,m
    Else
        m=Txt.GetTxt(t)
        ln=Txt.txtln
        WriteFile f,m,ln,@b,0
    EndIf
    CloseHandle f
    SendMessage t,EM_EMPTYUNDOBUFFER,0,0
    If s<>@sFile Then lstrcpy sFile,s
    wsprintf sh,"Редактор - %s",PathFindFileName(s)
    SetWindowText hw,sh
EndIf
StrFormatByteSize b,@sh+wsprintf(sh,msg),50
SetWindowText l,sh
End Sub

Function OpenSaveDialog(s As ZString Ptr,mode As Long)As Long
Dim As OPENFILENAME ofn
ofn.lStructSize=sizeof(ofn)
ofn.lpstrFilter=@!"Все файлы(*.*)\0*.*\0Текстовые форматы\0"_
"*.txt;*.reg;*.rc;*.bas;*.bi;*.c;*.cpp;*.h;*.hpp;*.cmd;*.bat;*.ini;*.asm;*.inc;*.def;*.nfo\0\0"
ofn.hwndOwner=hw
ofn.nFilterIndex=2
ofn.lpstrFile=s
ofn.lpstrInitialDir=ofn.lpstrFile
ofn.nMaxFile=250
If mode=0 Then
    ofn.Flags=2627588:Return GetOpenFileName(@ofn)
Else
    ofn.Flags=2686982:Return GetSaveFileName(@ofn)
EndIf
End Function

Function SaveMsg As Long
Dim As zString*300 s=Any
wsprintf s,!"Текст%s%s был изменён.\r\nСохранить изменения?",IIf(sFile[0],@" в файле ",@""),sFile
Return MessageBox(hw,s,"Редактор",51)
End Function

Function SaveFunction As Long
Dim As zString*300 s=Any
If SendMessage(t,EM_CANUNDO,0,0)Then
Select Case SaveMsg
    Case 6'yes
        If sFile[0]Then
            FileLoadSave sFile,1
        Else
            lstrcpy s,"Новый файл.txt"
            If OpenSaveDialog(s,1)=0 Then Exit Function
            FileLoadSave s,1
        EndIf
    Case Is<>7:Exit Function
End Select
EndIf
Return 1
End Function

Function WndProc(hWin As HWND,uMsg As UINT,wParam As WPARAM,lParam As LPARAM)As Long
Dim As zString*300 s=Any
Dim As Long x=Any,y=Any,ds=Any,de=Any,id=Any
Select case uMsg
    Case WM_COMMAND
        Select Case HiWord(wParam)
         Case 0,1
         id=LoWord(wParam)
            Select Case id
                Case 2000 To 2006
                    Find id

                Case MENUNEW
                    If SaveFunction Then
                        sFile[0]=0:SetWindowText t,""
                        SendMessage t,EM_EMPTYUNDOBUFFER,0,0
                        SetWindowText hw,"Редактор - Новый файл.txt"
                    EndIf

                Case MENUOPEN
                    If SaveFunction Then
                        s[0]=0:If OpenSaveDialog(s,0)Then FileLoadSave s,0
                    EndIf

                Case MENUSAVE
                    If sFile[0]Then
                        FileLoadSave sFile,1
                    Else
                        SavNew:lstrcpy s,"Новый файл.txt"
                        Sav:If OpenSaveDialog(s,1)=0 Then Exit Function
                        FileLoadSave s,1
                    EndIf

                Case MENUSAVEAS
                    If sFile[0]=0 Then GoTo SavNew
                    lstrcpy s,sFile:GoTo Sav

                Case MENUEXIT
                    If SaveFunction Then DestroyWindow hWin

                Case BTNGOTO
                    y=SendMessage(t,EM_GETLINECOUNT,0,0):x=GetDlgItemInt(hw,EDITGOTO,0,0)
                    ds=SendMessage(t,EM_LINEINDEX,x-1,0)
                    If ds=-1 Then x=y:ds=SendMessage(t,EM_LINEINDEX,x-1,0)
                    de=ds+SendMessage(t,EM_LINELENGTH,ds,0)
                    TbSetSel(t,ds,de):TbScroll(t)
                    wsprintf s,"Строка: %d Число строк: %d",x,y
                    SetWindowText l,s
            End Select

         Case EN_CHANGE
            If wParam=EDIT+(EN_CHANGE Shl 16)Then Status

        End Select

    Case WM_DROPFILES
        DragQueryFile wParam,0,@s,255:DragFinish wParam
        If SaveFunction Then FileLoadSave s,0

    Case WM_SIZE
        x=LoWord(lparam):y=HiWord(lparam)
        MoveWindow t,0,47,x,y-70,1
        MoveWindow l,4,y-20,x,25,1

    Case WM_CLOSE:If SaveFunction Then DestroyWindow hWin
    Case WM_DESTROY:PostQuitMessage 0
Case Else
Return DefWindowProc(hWin,uMsg,wParam,lParam)
End Select
End Function

@echo off
:: Расположение папки компилятора. Задать и сохранить bat. Перетащить bas на этот bat.
SET FBPATH=C:\FreeBASIC-1.05.0-win32
%~d1
cd %~p1
SET File=%~n1
SET LIBS=-lkernel32 -luser32 -lgdi32 -lshell32 -lComdlg32 -lshlwapi -lcomctl32.dll -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
if exist "%File%.o" del "%File%.o"
if exist "%File%.res.obj" del "%File%.res.obj"
echo # No errors ! #
:exit
pause