Hex Viewer (Find, GOTO)

Это будет заключительная статья про Hex Viewer. В ней будет реализован переход на нужный адрес и простенький поиск (без Find next).

В декларацию переменных добавим несколько глобальных:

....
Dim Shared As HWND hwndEditGoto ' контрол EDIT "переход по адресу"
Dim Shared As HWND hwndEditFind ' контрол EDIT "поиск"
....
Dim Shared As Ulongint ullOffsetFind ' смещение при операции "Поиск" в случае удачного поиска
Dim Shared As BOOL boolFlagFind ' флаг (TRUE - поиск удачен, FALSE - поиск неудачен)
....


Первые две переменные по сути хендлы на дочерние окошки EDIT . Нужны для ввода адреса и текста для поиска

Переменная ullOffsetFind является смещением найденного текста в файле после поиска, с помощью которого будет определяться новый адрес прокрутки. Так же данная переменная поможет вычислить адрес, который можно будет подкрасить для более визуального подтверждения поиска.

Переменная boolFlagFind - просто вспомогательный флаг, помогающий включать нужный код при удачном поиске. Или отключать нужный код, если поиск неудачен, либо вообще поиск не проводился. 


Далее добавим код процедуры для создания новых дочерних окон, а их будет в коде 6 (4 кнопки и 2 области редактирования) ,не считая контрола вывода HEX данных:

' Остальные контролы окна
Sub CreateAnotherChildProc(hwnd As hwnd)
    CreateWindowEx(0,"Button","Открыть файл",_
    WS_VISIBLE Or WS_CHILD,10,1,100,20,hwnd,Cast(HMENU,2),Hinst,0) ' Кнопка открыть файл
    CreateWindowEx(0,"Button","Перейти",_
    WS_VISIBLE Or WS_CHILD,725,1,65,20,hwnd,Cast(HMENU,3),Hinst,0) ' Кнопка перейти
    hwndEditGoto = CreateWindowEx( WS_EX_STATICEDGE,"Edit","",_
    WS_VISIBLE Or WS_CHILD,630,2,90,20,hwnd,Cast(HMENU,4),Hinst,0) ' Текстовое окно для перехода на адрес
    CreateWindowEx(0,"Button","Искать HEX",_
    WS_VISIBLE Or WS_CHILD,180,1,85,20,hwnd,Cast(HMENU,5),Hinst,0) ' Кнопка искать hex
    CreateWindowEx(0,"Button","Искать ASCII",_
    WS_VISIBLE Or WS_CHILD,465,1,90,20,hwnd,Cast(HMENU,6),Hinst,0) ' Кнопка перейти искать ascii
    hwndEditFind = CreateWindowEx( WS_EX_STATICEDGE,"Edit","",_
    WS_VISIBLE Or WS_CHILD,270,2,190,20,hwnd,Cast(HMENU,7),Hinst,0) ' Текстовое окно для поиска
End Sub


Сразу скажу, что поиск будет работать следующим образом. Значение для поиска HEX и ACSII значений будет забиваться в одно и тоже окошко. А управлять нужным поиском будут две кнопки ("Искать HEX" , "Искать ACSII").
В эту же процедуру я перенес код создания кнопки "Открыть файл" из функции wndproc. В саму же функцию wndproc в событии WM_CREATE поместим ссылку на вызов функции CreateAnotherChildProc:

....
' оконная процедура главного окна
Function wndproc(hwnd As HWND, msg As Uinteger,_
    wparam As WPARAM, lparam As LPARAM) As Integer

    Select Case msg
        Case WM_CREATE

            CreateChildProc(hwnd) ' Создаем свое дочернее окно для вывода HEX значений
            CreateAnotherChildProc(hwnd) ' Создаем остальные контролы GUI
....


Так же в этой же функции, но только в событии WM_COMMAND добавим обработку кликов по кнопкам:

....
Case WM_COMMAND

    If lparam <> 0 Then ' если сообщения от контролов
        Select Case Loword(wParam)
            Case 2
                onCommandOpenFile() ' Открыть файл
            Case 3
                onCommandGoto() ' переход на нужный адрес
            Case 5,6
                onCommandFind(Loword(wParam)) ' поиск HEX\ASCII
        End Select
    Endif
....


Как видите при нажатии на кнопки 5 и 6 ("Искать HEX" , "Искать ACSII")  осуществляется переход на процедуру поиска, но с определяющим параметром (ID нажатой кнопки).

Для начала можно рассмотреть процедуру "Переход на нужный адрес":

' Обработка кнопки "Перейти на адрес"
Sub onCommandGoto()

    If iFileOpenFlag = FALSE Then Exit Sub ' если файл не загружен, то просто выходим из процедуры

    Dim As Integer iMaxSimvols = 12 'максимальное кол-во символов для возврата из GetWindowText
    Dim As Ulongint ullAddress ' адрес , куда поместится преобразованная строка
    Dim As ZString*15 szTextGoto ' буфер для GetWindowText

    GetWindowText(hwndEditGoto,Strptr(szTextGoto),iMaxSimvols) ' Текст из контрола EDIT
    ullAddress = Valulng("&h" & szTextGoto)

    If ullAddress>=0 AndAlso ullAddress<=ullSizeFile Then ' если адрес в рамках файла   

        If ullSizeFile - ullAddress < (400 + (ullSizeFile Mod 16)) Then ' если адрес в конце файла
            If ullSizeFile <= 416 Then  ' если размер файла умещается в области редактирования
                ullVScrollPos = 0 'тогда прокрутку на 0
            Else
                ullVScrollPos = (ullSizeFile-400)\16 ' тогда рассчитываем прокрутку в самый конец
            Endif
        Else            
            ullVScrollPos = ullAddress\16 ' просто делим значение адреса на кол-во столбцов     
        Endif

        SetScrollProc() ' скроллим
    Endif

End Sub


В самом начале , во избежание тупых ситуаций, когда ничего еще не загружено, а пользователь щелкает кнопку поиска, добавим обработку:

If iFileOpenFlag = FALSE Then Exit Sub ' если файл не загружен, то просто выходим из процедуры


Далее получаем текст из EDIT , в котором записан адрес для перехода и преобразовываем его в тип ULONGINT:

Dim As Integer iMaxSimvols = 12 'максимальное кол-во символов для возврата из GetWindowText
Dim As Ulongint ullAddress ' адрес , куда поместится преобразованная строка
Dim As ZString*15 szTextGoto ' буфер для GetWindowText

GetWindowText(hwndEditGoto,Strptr(szTextGoto),iMaxSimvols) ' Текст из контрола EDIT
ullAddress = Valulng("&h" & szTextGoto)


Далее опять проверки (введен ли адрес и вообще находится ли он в рамках файла):

If ullAddress>=0 AndAlso ullAddress<=ullSizeFile Then ' если адрес в рамках файла


Если все нормально, то вычисляем новый адрес прокрутки и скроллим на эту позицию:

If ullSizeFile - ullAddress < (400 + (ullSizeFile Mod 16)) Then ' если адрес в конце файла
    If ullSizeFile <= 416 Then  ' если размер файла умещается в области редактирования
        ullVScrollPos = 0 'тогда прокрутку на 0
    Else
        ullVScrollPos = (ullSizeFile-400)\16 ' тогда рассчитываем прокрутку в самый конец
    Endif
Else            
    ullVScrollPos = ullAddress\16 ' просто делим значение адреса на кол-во столбцов     
Endif

SetScrollProc() ' скроллим


Вот такая в принципе простенькая процедура.

А теперь рассмотрим более увесистую процедуру поиска.

Для начала определим несколько локальных переменных:

Dim As Ulongint ullTempVScrollPos = ullVScrollPos ' сохраняем старое значение прокрутки
Static As Integer iMaxSimvols = 20 ' предел возвращаемых символов от GetWindowText
Dim As ZString*20 szTextFind ' строка-буфер для GetWindowText
Dim As String sFindPointer = "" ' строка в которой нужно искать для патча типа STRING
Dim As String sFindTemplate = ""  ' строка что нужно искать для патча типа STRING
Dim As Integer iReturn ' кол-во возвращенных символов
Dim As Ulongint ullCountSectors ' кол-во секторов
Dim As Ulongint ullTempCountSectors ' счетчик для цикла при подсчете секторов
Dim li As ULARGE_INTEGER ' вспомогательная структура для объеденения\раъеденения 4-х байтовых значений в 8-ми байтовые
Dim As Ubyte bDim(20) ' массив для хранения искомой строки


ullTempVScrollPos - сохранение значения прокрутки перед поиском. По логике она не нужна, но для страховки я все таки решил на всякий случай сохранять и восстанавливать это значение при неудачном поиске.

bDim(20) - массив, в который будем помещать байты, которые преобразуем из строки, полученной с помощью GetWindowText

ullCountSectors - кол-во секторов по 65536 байт в файле

ullTempCountSectors - по сути переменная счетчик. Мы не можем использовать цикл FOR-NEXT из-за того, что он оперирует счетчиком с 32-битной размерностью.Поэтому нам нужна какая-то 64-битная переменная, которая в цикле будет считать кол-во проходов по нему.

iReturn - кол-во возвращенных символов из GetWindowText

sFindPointer и sFindTemplate - это строки , которые будут параметрами для функции INSTR. Здесь я остановлюсь поподробнее. Вся фишка в том, что функция INSTR работает только со строковыми типами. У нас же буфер для поиска бинарный (байтовый). Для компилятора это важный вопрос, хотя с технической точки зрения, строка тоже является массивом байт. Можно конечно каждый раз преобразовывать бинарные данные в строковые, но это сожрет кучу времени, особенно на больших файлах. Так же в библиотеке CRT есть какая-то функция для поиска именно бинарных данных , но я ее никогда не использовал и понятия не имею как она себя поведет и как она по скорости. Так же можно написать какую-то свою функцию поиска, но для данного цикла статей - это будет чересчур. Функция INSTR обладает хорошими характеристиками поиска, хоть и имеет ограничение на вводные данные по типу. Данное ограничение легко обойти. Поэтому я решил остановиться на этом варианте.

Сам принцип патча строки:

класс строки имеет три поля:

' тип для патча STRING
Type tStr
    ubPtr As Ubyte Ptr ' адрес на буфер
    uiLen As Uinteger ' длина буфера
    uiMem As Uinteger ' кол-во выделенной памяти
End Type


Если мы создадим пустую строку , то элементы типа будут иметь нулевые значения. Значение uiMem нам не требуется, поскольку та же функция INSTR на этот параметр не обращает никакого внимания. Ей важны только два параметра: ubPtr - адрес на строку и uiLen - длина этой строки. Хотя длина строки рассчитывается\извлекается уже внутри функции INSTR. Так для типа ZSTRING длина ограничивается нулевым символом. Для типа же STRING длина записана в структуре. Если мы в ubPtr запишем адрес нашего байтового буфера и укажем его размер в uiLen , то функция INSTR это "проглотит" и будет работать так же , как с обычной строкой. Главное во всей этой схеме, не забывать перед выходом из процедуры вернуть строке ее первоначальные значения, иначе вылета программы не избежать. 

Как и в случае с процедурой onCommandGoto() делаем проверку на дурака:

If iFileOpenFlag = FALSE Then Exit Sub ' если файл не загружен, то просто выходим из процедуры


Перед поиском сбрасываем флаг:

boolFlagFind = FALSE ' сбрасываем флаг поиска


Получаем текст из EDIT и кол-во искомых символов сохраняем в переменной iReturn , при этом в данной реализации я решил ограничить длину поиска 20 символами (iMaxSimvols = 20). А запись iMaxSimvols+1 просто добавляет ячейку для нуля в конце строки. Так для HEX можно искать 10 байт, а для ASCII 20 символов:

iReturn = GetWindowText(hwndEditFind,Strptr(szTextFind),iMaxSimvols+1) ' Текст из контрола Find  

Получаем кол-во секторов в файле:

ullCountSectors = ullSizeFile\65536 ' кол-во секторов по 65536 байт


Получаем адреса на начало структуры для строк sFindPointer и sFindTemplate:

Dim StringPtr As tStr Ptr  = Cast(tStr Ptr,@sFindPointer) ' получаем адрес sFindPointer

Dim StringPtr2 As tStr Ptr  = Cast(tStr Ptr,@sFindTemplate) ' получаем адрес sFindTemplate


Опять делаем проверку на дурака:

If szTextFind <> "" Then ' если текст не пустой


Далее в зависимости от нажатой кнопки, преобразуем и\или копируем искомую строку в массив bDIM:

If iButtonNumber = 5 Then ' если ищем HEX

    If iReturn > 1 Then ' для HEX чтобы строка была не меньше 2 символов

        For i As Integer = 0 To iReturn\2 - 1 ' цикл по кол-ву символов\2

            bDim(i)  = Val("&h" & Mid(szTextFind,i*2+1,2)) ' собираем массив

        Next

    Endif

Else 'если ищем ACSII

    For i As Integer = 0 To iReturn -1 ' цикл по кол-ву символов

        bDim(i)  = szTextFind[i] ' собираем массив

    Next

Endif


Теперь в поле структуры ubPtr записываем адрес нашего массива, а в поле uiLen кол-во байт:

StringPtr2->ubPtr = @bDim(0) ' патчим строку FindTemplate, загоняя ей адрес массива

If iButtonNumber = 5 Then ' если HEX
    StringPtr2->uiLen = iReturn\2 'патчим строку FindTemplate, загоняя ей длину строки\2
Else ' если ASCII
    StringPtr2->uiLen = iReturn 'патчим строку FindTemplate, загоняя ей длину строки
Endif 


Заводим наш счетчик на значение, равное кол-ву секторов:

ullTempCountSectors = ullCountSectors ' определяем счетчик по кол-ву секторов


Далее идет цикл DO-LOOP, в котором мы проводим поиск в каждом секторе:

Do ' цикл по кол-ву секторов

    UnmapViewOfFile(pbFileBytesBuffer) ' удаляем мэпирование старого буфера

    li.QuadPart = (ullCountSectors-ullTempCountSectors)*65536 ' определяем адрес , кратный 4096 для MapViewOfFile

    If (li.QuadPart+66000)>ullSizeFile Then ' если вышли за пределы файла

        pbFileBytesBuffer = MapViewOfFile(hFileMap,FILE_MAP_READ, li.HighPart,li.LowPart,ullSizeFile - li.QuadPart) ' указатель с остатками байт

        StringPtr->ubPtr = pbFileBytesBuffer 'патчим строку sFindPointer, загоняя ей указатель на буфер

        StringPtr->uiLen = ullSizeFile - li.QuadPart 'патчим строку sFindPointer, загоняя ей длину буфера с остатками байт

    Else

        pbFileBytesBuffer = MapViewOfFile(hFileMap,FILE_MAP_READ, li.HighPart,li.LowPart,66000) ' просто читаем 66000 байт

        StringPtr->ubPtr = pbFileBytesBuffer 'патчим строку sFindPointer, загоняя ей указатель на буфер

        StringPtr->uiLen = 66000 'патчим строку sFindPointer, загоняя ей длину буфера размером 66000

    Endif

    ullOffsetFind  = Instr(sFindPointer,sFindTemplate) ' ищем соответствия

    If ullOffsetFind <> 0 Then ' если что-то найдено

        ullOffsetFind = (li.QuadPart + ullOffsetFind) - 1 ' определяем смещение в файле для найденного

        boolFlagFind = TRUE ' активируем флаг успешности поиска

        Exit Do ' выходим из цикла

    Endif

    ullTempCountSectors-=1 ' уменьшаем счетчик

Loop Until ullTempCountSectors = &hFFFFFFFFFFFFFFFFull ' когда счетчик достигнет -1


Разберем более подробно код выше.

Как видно из кода, сначала освобождается указатель pbFileBytesBuffer:

UnmapViewOfFile(pbFileBytesBuffer) ' удаляем мэпирование старого буфера


Далее определяется адрес на нужный для поиска сектор для MapViewOfFile с правилом гранулярности:

li.QuadPart = (ullCountSectors-ullTempCountSectors)*65536 ' определяем адрес , кратный 4096 для MapViewOfFile


После этого создается новый указатель на требуемый буфер, в котором собственно и будет проходить поиск. Нет нужды копировать куски памяти в какой нибудь буфер. Здесь просто подсовывается промэпированный указатель на нужный сектор полю структуры ubPtr, ну а полю uiLen длина буфера:

If (li.QuadPart+66000)>ullSizeFile Then ' если вышли за пределы файла

    pbFileBytesBuffer = MapViewOfFile(hFileMap,FILE_MAP_READ, li.HighPart,li.LowPart,ullSizeFile - li.QuadPart) ' указатель с остатками байт

    StringPtr->ubPtr = pbFileBytesBuffer 'патчим строку sFindPointer, загоняя ей указатель на буфер

    StringPtr->uiLen = ullSizeFile - li.QuadPart 'патчим строку sFindPointer, загоняя ей длину буфера с остатками байт

Else

    pbFileBytesBuffer = MapViewOfFile(hFileMap,FILE_MAP_READ, li.HighPart,li.LowPart,66000) ' просто читаем 66000 байт

    StringPtr->ubPtr = pbFileBytesBuffer 'патчим строку sFindPointer, загоняя ей указатель на буфер

    StringPtr->uiLen = 66000 'патчим строку sFindPointer, загоняя ей длину буфера размером 66000

Endif


Все подготовлено, теперь можно проводить поиск с помощью InStr:

ullOffsetFind  = Instr(sFindPointer,sFindTemplate) ' ищем соответствия


Поскольку функция Instr ищет в рамках сектора , то найденное значение ullOffsetFind нужно преобразовать к смещению в файле:

If ullOffsetFind <> 0 Then ' если что-то найдено

    ullOffsetFind = (li.QuadPart + ullOffsetFind) - 1 ' определяем смещение в файле для найденного


Активируем флаг поиска и выходим из цикла DO-LOOP:

    boolFlagFind = TRUE ' активируем флаг успешности поиска

    Exit Do ' выходим из цикла

Endif


В конце цикла уменьшаем счетчик на единицу:

ullTempCountSectors-=1 ' уменьшаем счетчик


После поиска вернем строкам sFindPointer,sFindTemplate их первоначальные значения:

'обнуляем все ранее пропатченные узлы структуры(класса) STRING
StringPtr->ubPtr = 0
StringPtr->uiLen = 0
StringPtr2->ubPtr = 0
StringPtr2->uiLen = 0


Если поиск удачный, то выссчитываем прокрутку и скроллим:

If boolFlagFind = TRUE Then ' если поиск удачен

    If ullSizeFile - ullOffsetFind < (400 + (ullSizeFile Mod 16)) Then ' если адрес поиска в конце файла

        If ullSizeFile <= 416 Then  ' если размер файла умещается в области редактирования

            ullVScrollPos = 0 'тогда прокрутку на 0

        Else

            ullVScrollPos = (ullSizeFile-400)\16 ' тогда рассчитываем прокрутку в самый конец

        Endif

    Else

        ullVScrollPos = ullOffsetFind\16 ' просто делим значение адреса поиска на кол-во столбцов

    Endif

    SetScrollProc() ' скроллим


Если поиск неудачный, то восстанавливаем значение прокрутки, принудительно сбрасываем бекап кластера (чтобы функция GetPtrMapFileAnyPosition без проблем получила новый указатель pbFileBytesBuffer) и скроллим:

ullVScrollPos = ullTempVScrollPos ' возвращаем прокрутку как было

ullBackupClaster = &hFFFFFFFFFFFFFFFFull ' сбрасываем бекап кластера для обновления ullClaster

SetScrollProc() ' скроллим


Вот такая получилась процедура поиска.

Теперь при удачном поиске , программа будет прокручивать на ближайший к искомому значению адрес. По хорошему бы надо выделять найденный текст, но это надо возиться с метриками шрифта, подсчетом переносов строк (если найденная строка находится на 2 линиях) , самой подсветкой. Еще для редактора это нормально, там все равно нужно делать подсветку, но здесь я посчитал это лишним. Однако чтобы хоть немного скрасить визуальное подтверждение поиска, я решил подсвечивать адрес , в котором находится найденная строка. Перемещаемся в процедуру PaintHexProc() и немного доработаем макрос mDrawText:

#MACRO mDrawText()
    SelectObject(hdc, hFontCourierNEW) ' свой шрифт в контекст
    If boolFlagFind = TRUE Then ' если поиск был удачен
        If ullOffsetFind >= ullRealOffset AndAlso ullOffsetFind <= (ullRealOffset+416) Then ' если смещение поиска в диапазоне (ullRealOffset....ullRealOffset+416)
            If ullOffsetFind <= ullRealOffset+16*i+15 AndAlso ullOffsetFind >= ullRealOffset+16*i  Then ' если смещение поиска в рисуемой строке
                SetTextColor(hdc, &hFF) ' цвет текста "красный"
                TextOut(hdc,10,y*i+3,Hex(i*16+ullRealOffset,11), 11) ' рисуем строку - адрес
                SetTextColor(hdc, 0)' возвращаем цвет текста по умолчанию
            Else
                TextOut(hdc,10,y*i+3,Hex(i*16+ullRealOffset,11), 11) ' рисуем строку - адрес
            Endif
        Else
            TextOut(hdc,10,y*i+3,Hex(i*16+ullRealOffset,11), 11) ' рисуем строку - адрес
        Endif
    Else
        TextOut(hdc,10,y*i+3,Hex(i*16+ullRealOffset,11), 11) ' рисуем строку - адрес
    Endif

    TextOut(hdc,142,y*i+3,sHex, 47)' рисуем строку - HEX
    TextOut(hdc,611,y*i+3,sString, 16)' рисуем строку - ASCII

#EndMacro


По сути тут при удачном поиске, о чем сигнализирует boolFlagFind проверяется условие на предмет: находится ли смещение ullOffsetFind в рисуемой области и в рисуемой строке:

If boolFlagFind = TRUE Then ' если поиск был удачен
    If ullOffsetFind >= ullRealOffset AndAlso ullOffsetFind <= (ullRealOffset+416) Then ' если смещение поиска в диапазоне (ullRealOffset....ullRealOffset+416)
        If ullOffsetFind <= ullRealOffset+16*i+15 AndAlso ullOffsetFind >= ullRealOffset+16*i  Then ' если смещение поиска в рисуемой строке


Если все совпало, то меняется цвет текста , рисуется адрес и снова возвращается цвет к значению по умолчанию:

SetTextColor(hdc, &hFF) ' цвет текста "красный"
TextOut(hdc,10,y*i+3,Hex(i*16+ullRealOffset,11), 11) ' рисуем строку - адрес
SetTextColor(hdc, 0)' возвращаем цвет текста по умолчанию 


Во всех остальных случаях просто рисуется адрес цветом по умолчанию:

TextOut(hdc,10,y*i+3,Hex(i*16+ullRealOffset,11), 11) ' рисуем строку - адрес


Нужно позаботиться о флаге boolFlagFind , ведь после поиска он остается активным, до тех пор пока не начнется новый поиск. А ведь флаг используется при рисовании. Мне кажется правильнее его сбрасывать при прокрутке, что я и сделал в процедуре ScrollProc:

' обработка информации о скроллинге
Sub ScrollProc(hwnd As HWND, param As Integer)
        ......
    boolFlagFind = FALSE ' сбрасываем флаг поиска
    SetScrollProc()' скроллим

End Sub


Ну а теперь полный код:

#INCLUDE "windows.bi"
#INCLUDE "win/commctrl.bi"
#INCLUDE "win/commdlg.bi"
InitCommonControls()

#DEFINE iMax_scrolling_16 &h7fffl
#DEFINE iMax_scrolling_32 &h7fffffffl

Declare Function HexWndProc(hwnd As HWND, msg As Uinteger,_
wparam As WPARAM, lparam As LPARAM) As Integer
Declare Function CreateMapping(szFileName As Zstring Ptr) As Integer
Declare Sub CloseMapping()
Declare Function GetPtrMapFile() As Integer
Declare Function GetPtrMapFileAnyPosition() As Integer
Declare Sub CopyBytesProc()
Declare Sub SetScrollProc()

' Переменные
Dim Shared hinst As HINSTANCE : hinst = GetModuleHandle(0)
Dim msg As MSG
Dim As WNDCLASSEX wc
Dim As ZString*20 sNameClass = "HexViewer"
Dim Shared As ZString*20 szHexClass: szHexClass = "szHexClass"
Dim Shared As HFONT hFontCourierNew
Dim Shared As HWND mainHwnd ' основное окно
Dim Shared As HWND childHwnd ' окно HEX
Dim Shared As HWND hwndEditGoto ' контрол EDIT "переход по адресу"
Dim Shared As HWND hwndEditFind ' контрол EDIT "поиск"
Dim Shared ofn  As OPENFILENAME
Dim Shared filename        As Zstring * 512
Dim Shared As Ulongint ullSizeFile ' размер файла
Dim Shared As Ulongint ullNullOffsetView 'смещение в самом начале видимой части окна
Dim Shared As Ubyte Ptr pbBytesBuffer ' буфер , ограниченный в размере (416 байт),
'используется для копирования в него части информации, которая отображается в видимой части окна

Dim Shared As Ubyte Ptr pbFileBytesBuffer ' указатель на буфер мэпированного файла
pbBytesBuffer = Callocate(416) ' выделим память для буфера
Dim Shared As Ulongint ullVScrollPos,ullMaxCount  ' позиция скрола, кол-во прокручиваемых областей
Dim Shared As HANDLE hFileMap , hFile ' хендлы для файлов
Dim Shared As Integer iFileOpenFlag ' флаг , если произошла загрузка файла
Dim Shared As Ulongint ullClaster,ullBackupClaster ' текущий кластер, бекап кластера
Dim Shared As Ulongint ullRealOffset ' реальное смещение от начала файла
Dim Shared As Integer iMax_scrolling ' максимальное значение для прокручивания
Dim Shared As Ulongint ullOffsetFind ' смещение при операции "Поиск" в случае удачного поиска
Dim Shared As BOOL boolFlagFind ' флаг (TRUE - поиск удачен, FALSE - поиск неудачен)

' загрузка шрифта
Function LoadFontProc(Byval Name_     As String, _
    Byval Size      As Integer, _
    Byval corner    As Integer,_
    Byval BOLD      As Integer,_
    Byval Italic    As Integer,_
    Byval Underline As Integer,_
    Byval StrikeOut As Integer,_
    Byval CharSet As Integer) As HFONT
    Dim As Integer size_
    If BOLD=1 Then
        BOLD=700 ' жирный шрифт
    Else
        BOLD=400 ' обычный
    Endif
    Dim As HDC hdc = CreateDC("DISPLAY",0,0,0) ' создаем контекст
    size_ = -MulDiv(Size, GetDeviceCaps(hdc, LOGPIXELSY), 72) ' высчитываем размер шрифта
    DeleteDC(hdc) ' удаляем контекст
    Return CreateFont(size_,0,corner*10,0,Bold,Italic,Underline,StrikeOut, _ 'создаем шрифт
    CharSet, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH Or FF_DONTCARE,Name_)
End Function

' диалог вызова файла
Function FileOpen(Byval Title As String,Byval curentdir As String, Byval Pattern As String, Byval templateName As String = "") As String
    Dim fbguiTemp As Integer
    filename = templateName

    With ofn
        .hwndOwner       = 0
        .lStructSize     = Sizeof(OPENFILENAME)
        .lpstrFilter     = Cast(LPCTSTR,Strptr(Pattern) )
        .lpstrFile       = Strptr(filename)
        .nFileOffset     = 0
        .nMaxFile        = Sizeof(filename)
        .lpstrFileTitle  = Cast(LPTSTR,Strptr(Title))
        .nMaxFileTitle   = Sizeof(Title)
        .lpstrInitialDir = Cast(LPCTSTR,Strptr(curentdir))
        .lpstrTitle      = Cast(LPCTSTR,Strptr(Title))
        .Flags           = OFN_EXPLORER Or OFN_FILEMUSTEXIST
    End With

    If( GetOpenFileName( @ofn ) = 0 ) Then
        Return ""
    Else
        Return filename
    End If
End Function

' создание HEX окна
Sub CreateChildProc(hwnd As hwnd)
    Dim As WNDCLASSEX wc
    With wc
        .cbSize=SizeOf(WNDCLASSEX)
        .lpfnWndProc=@HexWndProc
        .hInstance=Hinst
        .hCursor=LoadCursor(0,IDC_IBEAM)
        .hbrBackground=Cast(HBRUSH,COLOR_SCROLLBAR)
        .lpszClassName=StrPtr(szHexClass)
    End With

    If RegisterClassEx(@wc)=0 Then
        Print "Register error, press any key"
        Sleep
        End
    Endif

    childHwnd = CreateWindowEx( WS_EX_CLIENTEDGE,szHexClass,"",_
    WS_VSCROLL Or WS_CHILD Or WS_VISIBLE,0,25,794,552,hwnd,Cast(HMENU,1),Hinst,0)

End Sub

' Остальные контролы окна
Sub CreateAnotherChildProc(hwnd As hwnd)
    CreateWindowEx(0,"Button","Открыть файл",_
    WS_VISIBLE Or WS_CHILD,10,1,100,20,hwnd,Cast(HMENU,2),Hinst,0) ' Кнопка открыть файл
    CreateWindowEx(0,"Button","Перейти",_
    WS_VISIBLE Or WS_CHILD,725,1,65,20,hwnd,Cast(HMENU,3),Hinst,0) ' Кнопка перейти
    hwndEditGoto = CreateWindowEx( WS_EX_STATICEDGE,"Edit","",_
    WS_VISIBLE Or WS_CHILD,630,2,90,20,hwnd,Cast(HMENU,4),Hinst,0) ' Текстовое окно для перехода на адрес
    CreateWindowEx(0,"Button","Искать HEX",_
    WS_VISIBLE Or WS_CHILD,180,1,85,20,hwnd,Cast(HMENU,5),Hinst,0) ' Кнопка искать hex
    CreateWindowEx(0,"Button","Искать ASCII",_
    WS_VISIBLE Or WS_CHILD,465,1,90,20,hwnd,Cast(HMENU,6),Hinst,0) ' Кнопка перейти искать ascii
    hwndEditFind = CreateWindowEx( WS_EX_STATICEDGE,"Edit","",_
    WS_VISIBLE Or WS_CHILD,270,2,190,20,hwnd,Cast(HMENU,7),Hinst,0) ' Текстовое окно для поиска
End Sub

' Обработка кнопки "Перейти на адрес"
Sub onCommandFind(iButtonNumber As Integer )

    Dim As Ulongint ullTempVScrollPos = ullVScrollPos ' сохраняем старое значение прокрутки
    Static As Integer iMaxSimvols = 20 ' предел возвращаемых символов от GetWindowText
    Dim As ZString*20 szTextFind ' строка-буфер для GetWindowText
    Dim As String sFindPointer = "" ' строка в которой нужно искать для патча типа STRING
    Dim As String sFindTemplate = ""  ' строка что нужно искать для патча типа STRING
    Dim As Integer iReturn ' кол-во возвращенных символов
    Dim As Ulongint ullCountSectors ' кол-во секторов
    Dim As Ulongint ullTempCountSectors ' счетчик для цикла при подсчете секторов
    Dim li As ULARGE_INTEGER ' вспомогательная структура для объеденения\раъеденения 4-х байтовых значений в 8-ми байтовые
    Dim As Ubyte bDim(20) ' массив для хранения искомой строки

    ' тип для патча STRING
    Type tStr
        ubPtr As Ubyte Ptr ' адрес на буфер
        uiLen As Uinteger ' длина буфера
        uiMem As Uinteger ' кол-во выделенной памяти
    End Type

    If iFileOpenFlag = FALSE Then Exit Sub ' если файл не загружен, то просто выходим из процедуры

    boolFlagFind = FALSE ' сбрасываем флаг поиска

    iReturn = GetWindowText(hwndEditFind,Strptr(szTextFind),iMaxSimvols+1) ' Текст из контрола Find

    ullCountSectors = ullSizeFile\65536 ' кол-во секторов по 65536 байт

    Dim StringPtr As tStr Ptr  = Cast(tStr Ptr,@sFindPointer) ' получаем адрес sFindPointer

    Dim StringPtr2 As tStr Ptr  = Cast(tStr Ptr,@sFindTemplate) ' получаем адрес sFindTemplate

    If szTextFind <> "" Then ' если текст не пустой

        If iButtonNumber = 5 Then ' если ищем HEX

            If iReturn > 1 Then ' для HEX чтобы строка была не меньше 2 символов

                For i As Integer = 0 To iReturn\2 - 1 ' цикл по кол-ву символов\2

                    bDim(i)  = Val("&h" & Mid(szTextFind,i*2+1,2)) ' собираем массив

                Next

            Endif

        Else 'если ищем ACSII

            For i As Integer = 0 To iReturn -1 ' цикл по кол-ву символов

                bDim(i)  = szTextFind[i] ' собираем массив

            Next

        Endif


        StringPtr2->ubPtr = @bDim(0) ' патчим строку FindTemplate, загоняя ей адрес массива

        If iButtonNumber = 5 Then ' если HEX
            StringPtr2->uiLen = iReturn\2 'патчим строку FindTemplate, загоняя ей длину строки\2
        Else ' если ASCII
            StringPtr2->uiLen = iReturn 'патчим строку FindTemplate, загоняя ей длину строки
        Endif

        ullTempCountSectors = ullCountSectors ' определяем счетчик по кол-ву секторов


        Do ' цикл по кол-ву секторов

            UnmapViewOfFile(pbFileBytesBuffer) ' удаляем мэпирование старого буфера

            li.QuadPart = (ullCountSectors-ullTempCountSectors)*65536 ' определяем адрес , кратный 4096 для MapViewOfFile

            If (li.QuadPart+66000)>ullSizeFile Then ' если вышли за пределы файла

                pbFileBytesBuffer = MapViewOfFile(hFileMap,FILE_MAP_READ, li.HighPart,li.LowPart,ullSizeFile - li.QuadPart) ' указатель с остатками байт

                StringPtr->ubPtr = pbFileBytesBuffer 'патчим строку sFindPointer, загоняя ей указатель на буфер

                StringPtr->uiLen = ullSizeFile - li.QuadPart 'патчим строку sFindPointer, загоняя ей длину буфера с остатками байт

            Else

                pbFileBytesBuffer = MapViewOfFile(hFileMap,FILE_MAP_READ, li.HighPart,li.LowPart,66000) ' просто читаем 66000 байт

                StringPtr->ubPtr = pbFileBytesBuffer 'патчим строку sFindPointer, загоняя ей указатель на буфер

                StringPtr->uiLen = 66000 'патчим строку sFindPointer, загоняя ей длину буфера размером 66000

            Endif

            ullOffsetFind  = Instr(sFindPointer,sFindTemplate) ' ищем соответствия

            If ullOffsetFind <> 0 Then ' если что-то найдено

                ullOffsetFind = (li.QuadPart + ullOffsetFind) - 1 ' определяем смещение в файле для найденного

                boolFlagFind = TRUE ' активируем флаг успешности поиска

                Exit Do ' выходим из цикла

            Endif

            ullTempCountSectors-=1 ' уменьшаем счетчик

        Loop Until ullTempCountSectors = &hFFFFFFFFFFFFFFFFull ' когда счетчик достигнет -1

        'обнуляем все ранее пропатченные узлы структуры(класса) STRING
        StringPtr->ubPtr = 0
        StringPtr->uiLen = 0
        StringPtr2->ubPtr = 0
        StringPtr2->uiLen = 0

        If boolFlagFind = TRUE Then ' если поиск удачен

            If ullSizeFile - ullOffsetFind < (400 + (ullSizeFile Mod 16)) Then ' если адрес поиска в конце файла

                If ullSizeFile <= 416 Then  ' если размер файла умещается в области редактирования

                    ullVScrollPos = 0 'тогда прокрутку на 0

                Else

                    ullVScrollPos = (ullSizeFile-400)\16 ' тогда рассчитываем прокрутку в самый конец

                Endif

            Else

                ullVScrollPos = ullOffsetFind\16 ' просто делим значение адреса поиска на кол-во столбцов

            Endif

            SetScrollProc() ' скроллим

        Else ' если ничего не нашли

            ullVScrollPos = ullTempVScrollPos ' возвращаем прокрутку как было

            ullBackupClaster = &hFFFFFFFFFFFFFFFFull ' сбрасываем бекап кластера для обновления ullClaster

            SetScrollProc() ' скроллим

        Endif

    Else

        Exit Sub

    Endif

End Sub

' Обработка кнопки "Перейти на адрес"
Sub onCommandGoto()

    If iFileOpenFlag = FALSE Then Exit Sub ' если файл не загружен, то просто выходим из процедуры

    Dim As Integer iMaxSimvols = 12 'максимальное кол-во символов для возврата из GetWindowText
    Dim As Ulongint ullAddress ' адрес , куда поместится преобразованная строка
    Dim As ZString*15 szTextGoto ' буфер для GetWindowText

    GetWindowText(hwndEditGoto,Strptr(szTextGoto),iMaxSimvols) ' Текст из контрола EDIT
    ullAddress = Valulng("&h" & szTextGoto)

    If ullAddress>=0 AndAlso ullAddress<=ullSizeFile Then ' если адрес в рамках файла   

        If ullSizeFile - ullAddress < (400 + (ullSizeFile Mod 16)) Then ' если адрес в конце файла
            If ullSizeFile <= 416 Then  ' если размер файла умещается в области редактирования
                ullVScrollPos = 0 'тогда прокрутку на 0
            Else
                ullVScrollPos = (ullSizeFile-400)\16 ' тогда рассчитываем прокрутку в самый конец
            Endif
        Else            
            ullVScrollPos = ullAddress\16 ' просто делим значение адреса на кол-во столбцов     
        Endif

        SetScrollProc() ' скроллим
    Endif

End Sub

' Обработка кнопки "Выбрать файл"
Sub onCommandOpenFile()
    filename = FileOpen("Открыть","C:\","All files (*.*)"+Chr(0)+"*.*"+Chr(0) ,"") ' диалог выбора файла
    If filename <> "" Then
        If iFileOpenFlag  = TRUE Then ' если что-то уже загружено
            SetScrollPos(childHwnd,SB_VERT,0,1)' прокрутку на начало
            CloseMapping() ' освобождаем все хендлы
        Endif
        If CreateMapping(filename) Then ' получаем проекцию файла
            If GetPtrMapFile() = FALSE Then ' получаем указатель
                MessageBox(0,"Не удалось получить указатель для файла","Ошибка!",MB_ICONERROR)
            Else
                iFileOpenFlag = TRUE ' файл загружен
                SendMessage(childHwnd,WM_VSCROLL,SB_THUMBTRACK,0) ' установим прокрутку на нуль
                InvalidateRect(childHwnd,0,false) ' обновляем окно
            Endif
        Else
            MessageBox(0,"Не удалось получить доступ к файлу","Ошибка!",MB_ICONERROR)
        Endif
    Else
        MessageBox(0,"Не удалось получить путь к файлу","Ошибка!",MB_ICONERROR)
    Endif
End Sub

' оконная процедура главного окна
Function wndproc(hwnd As HWND, msg As Uinteger,_
    wparam As WPARAM, lparam As LPARAM) As Integer

    Select Case msg
        Case WM_CREATE

            CreateChildProc(hwnd) ' Создаем свое дочернее окно для вывода HEX значений
            CreateAnotherChildProc(hwnd) ' Создаем остальные контролы GUI

        Case WM_COMMAND

            If lparam <> 0 Then ' если сообщения от контролов
                Select Case Loword(wParam)
                    Case 2
                        onCommandOpenFile() ' Открыть файл
                    Case 3
                        onCommandGoto() ' переход на нужный адрес
                    Case 5,6
                        onCommandFind(Loword(wParam)) ' поиск HEX\ASCII
                End Select
            Endif

        Case WM_DESTROY

            If iFileOpenFlag  = TRUE Then ' если какой-либо файл загружен
                CloseMapping() ' освобождаем все хендлы
            Endif
            DeleteObject(hFontCourierNew) ' освобождаем хендл шрифта
            PostQuitMessage(0)' выходим

    End Select

    Return DefWindowProc(hwnd,msg,wparam,lparam)

End Function

'заполнение буфера pbBytesBuffer данными
Sub CopyBytesProc()

    Dim As Ulongint ullTempSize

    If (ullRealOffset + 416) < ullSizeFile Then
        ullTempSize = 416
    Else
        ullTempSize = ullSizeFile - ullRealOffset
    Endif

    CopyMemory( pbBytesBuffer ,pbFileBytesBuffer+ullNullOffsetView , ullTempSize)

End Sub

' рисование на окне childHwnd
Sub PaintHexProc()
    Dim As HDC hdc,hdc2 ' контексты устройства
    Dim As PAINTSTRUCT ps ' структура, содержащая инфу для рисования
    Dim As HBITMAP hbitmap ' битмап для рисования
    Dim As HBRUSH  brush ' хендл кисти
    Dim As HPEN pen ' хендл пера
    Dim As Integer offset ' смещение
    Dim As Integer y = 21 ' высота букв

    #MACRO mRectangle(col,x,w) ' макрос рисования прямоугольников
        brush=CreateSolidBrush(col) ' создаем кисть
        SelectObject(hdc,brush) ' кисть в контекст
        pen= CreatePen(PS_SOLID ,1,Cast(COLORREF,col)) ' создаем перо
        SelectObject(hDC,Cast(HGDIOBJ,pen)) ' перо в контекст
        Rectangle(hDC,x,0,w,552) ' рисуем прямоугольник
        DeleteObject(brush) ' удаляем кисть
        DeleteObject(pen) ' удаляем перо
    #EndMacro

    #MACRO mDrawText()
        SelectObject(hdc, hFontCourierNEW) ' свой шрифт в контекст
        If boolFlagFind = TRUE Then ' если поиск был удачен
            If ullOffsetFind >= ullRealOffset AndAlso ullOffsetFind <= (ullRealOffset+416) Then ' если смещение поиска в диапазоне (ullRealOffset....ullRealOffset+416)
                If ullOffsetFind <= ullRealOffset+16*i+15 AndAlso ullOffsetFind >= ullRealOffset+16*i  Then ' если смещение поиска в рисуемой строке
                    SetTextColor(hdc, &hFF) ' цвет текста "красный"
                    TextOut(hdc,10,y*i+3,Hex(i*16+ullRealOffset,11), 11) ' рисуем строку - адрес
                    SetTextColor(hdc, 0)' возвращаем цвет текста по умолчанию
                Else
                    TextOut(hdc,10,y*i+3,Hex(i*16+ullRealOffset,11), 11) ' рисуем строку - адрес
                Endif
            Else
                TextOut(hdc,10,y*i+3,Hex(i*16+ullRealOffset,11), 11) ' рисуем строку - адрес
            Endif
        Else
            TextOut(hdc,10,y*i+3,Hex(i*16+ullRealOffset,11), 11) ' рисуем строку - адрес
        Endif

        TextOut(hdc,142,y*i+3,sHex, 47)' рисуем строку - HEX
        TextOut(hdc,611,y*i+3,sString, 16)' рисуем строку - ASCII

    #EndMacro

    hdc2 = BeginPaint(childHwnd, @ps) ' начинаем рисование, получаем контекст
    hdc   = CreateCompatibleDC(hdc2) 'создаем совместимый контекст
    hbitmap = CreateCompatibleBitmap(hdc2,794,552) ' создаем совместимый битмап
    SelectObject(hdc,hbitmap) ' битмап в контекст
    mRectangle(&hFFE9E9,0,109) ' рисуем прямоугольник для адресов
    mRectangle(&hf0f0f0,110,595) 'рисуем прямоугольник для Hex символов
    mRectangle(&hE9FFE9,596,794) ' рисуем прямоугольник для ASCII символов

    SetBkMode(hdc,1) ' режим прозрачности для текста

    For i As Integer = 0 To 25 ' цикл по числу видимых строк
        Dim As ZString*50 sHex ' хранит HEX символы
        Dim As ZString*16 sString ' хранит ASCII символы
        For x As Integer = 0 To 15 ' цикл по числу столбцов
            If ullRealOffset+offset = ullSizeFile Then ' если конец буфера
                If x>0 Then ' если прошла хоть одна итерация
                    mDrawText() ' вызываем макрос
                Endif
                Exit For, For ' выход из обоих циклов
            Endif
            sHex &= (Hex(pbBytesBuffer[offset],2)& " ") ' собираем строку HEX
            Dim As Ubyte btempSimbol = pbBytesBuffer[offset]' получаем ASCCI код
            Select Case btempSimbol ' отсеиваем непечатываемые символы
                Case &h0 To &h1f,&hAD,&h98,&h7f
                    btempSimbol = &h2E ' заменяем их точками
            End Select
            sString[x] = btempSimbol ' собираем строку ASCII
            offset +=1 ' увеличиваем смещение
        Next
        mDrawText()' вызываем макрос
    Next

    BitBlt(hdc2,0,0,794,552,hdc,0,0,SRCCOPY) ' копируем содержимое контекста в другой контекст
    DeleteObject(hbitmap) ' удаляем битмап
    DeleteDC(hDC) ' удаляем совместимый контекст
    EndPaint(childHwnd, @ps) ' заканчиваем рисование
End Sub

' получение информации о скроллинге
Sub GetScrollinfoProc(hwnd As hwnd)
    Dim info As SCROLLINFO
    info.cbSize = Sizeof(SCROLLINFO)
    info.fMask = SIF_TRACKPOS
    GetScrollInfo(hwnd, SB_VERT, @info) ' получаем инфу о скроллинге от системы

    If ullMaxCount<iMax_scrolling Then ' если максимальная прокрутка меньше iMax_scrolling
        ullVScrollPos = info.nTrackPos ' тогда просто присваиваем системную инфу
    Else
        ' высчитываем процентное соотношение позиции скроллинга
        ullVScrollPos = info.nTrackPos
        ullVScrollPos = (ullVScrollPos/iMax_scrolling)*ullMaxCount
    Endif
End Sub

' скроллинг
Sub SetScrollProc()

    Dim As Integer vs
    Dim As SCROLLINFO sInfo
    sInfo.cbSize = Sizeof(SCROLLINFO)
    sInfo.fMask = SIF_ALL ' маска для любых действий со скролом
    sInfo.nMin  = 0
    sInfo.nMax  = Iif (ullMaxCount>iMax_scrolling,iMax_scrolling,ullMaxCount) ' ставим максимальное значение скроллинга
    vs = Iif(ullMaxCount>iMax_scrolling,(ullVScrollPos/ullMaxCount)*iMax_scrolling,ullVScrollPos) ' высчитываем реальное смещение в скроле
    sInfo.nPos  = vs
    sInfo.nPage = 1

    If GetPtrMapFileAnyPosition() = FALSE Then ' получаем новый указатель мэп-файла
        MessageBox(0,"Не удалось получить указатель для файла","Ошибка!",MB_ICONERROR)
    Else
        CopyBytesProc() ' копируем данные в буфер, из которого будем читать информацию и рисовать
    Endif

    SetScrollInfo (childhwnd, SB_VERT,@sInfo, TRUE)
    InvalidateRect(childhwnd,0,false)

End Sub

' обработка информации о скроллинге
Sub ScrollProc(hwnd As HWND, param As Integer)

    Select Case param
        Case SB_TOP
            ullVScrollPos = 0 ' на начало страницы
        Case SB_BOTTOM
            ullVScrollPos = ullMaxCount 'на конец страницы
        Case SB_LINEUP
            If(ullVScrollPos > 0) Then
                ullVScrollPos-=1 'сдвигаемся ближе к началу страницы на 1
            Endif
        Case SB_LINEDOWN
            If(ullVScrollPos < ullMaxCount) Then
                ullVScrollPos+=1 'сдвигаемся ближе к концу страницы на 1
            Endif
        Case SB_PAGEUP
            If(ullVScrollPos > 10) Then
                ullVScrollPos-=10 'сдвигаемся ближе к началу страницы на 10
            Endif
        Case SB_PAGEDOWN
            If(ullVScrollPos < (ullMaxCount-10)) Then
                ullVScrollPos+=10 'сдвигаемся ближе к концу страницы на 10
            Endif
        Case SB_THUMBPOSITION,SB_THUMBTRACK ' если пользовательское перемещение на неопределенное кол-во
            GetScrollinfoProc(hwnd) ' получаем информацию из системы и высчитываем
    End Select
    boolFlagFind = FALSE ' сбрасываем флаг поиска
    SetScrollProc()' скроллим

End Sub

' оконная процедура своего окна, на котором будем рисовать HEX данные
Function HexWndProc(hwnd As HWND, msg As Uinteger,_
    wparam As WPARAM, lparam As LPARAM) As Integer

    Select Case msg
        Case WM_PAINT ' если требуется рисование
            PaintHexProc() ' рисуем
            Return 0
        Case WM_VSCROLL ' если произошло событие скроллинга
            If iFileOpenFlag = TRUE Then
                ScrollProc(hwnd,Loword(wparam)) ' обрабатываем
                Return 0
            Endif

    End Select
    Return DefWindowProc(hwnd,msg,wparam,lparam)

End Function

'Функция открывает\создает файл для мэпирования. Так же получает длину файла
Function CreateMapping(szFileName As Zstring Ptr) As Integer

    Dim li As ULARGE_INTEGER  ' li - структура разделения ULONGINT на младшие и старшие 4 байта
    Dim As Uinteger iFileOffsetHigh,iFileOffsetLow ' старшие и младшие частички ULONGINT

    hFile = CreateFile(szFileName, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, OPEN_ALWAYS, 0, 0)

    If hFile <> INVALID_HANDLE_VALUE Then
        iFileOffsetLow = GetFileSize(hFile, @iFileOffsetHigh) ' получаем размеры файла
        li.LowPart = iFileOffsetLow
        li.HighPart = iFileOffsetHigh
        ullSizeFile = li.QuadPart
        If ullSizeFile < &h1900000000 Then ' размер меньше 100ГБ
            iMax_scrolling = iMax_scrolling_32
        Else
            iMax_scrolling = iMax_scrolling_16
        Endif
        hFileMap = CreateFileMapping(hFile, 0, PAGE_READWRITE, li.HighPart , li.LowPart, 0) ' проекция файла в память
        If hFileMap <> 0 Then

            If ullSizeFile>416 Then ' если развер файла больше кол-ва символов области прокрутки
                ullMaxCount = (ullSizeFile-416)\16+1 ' высчитываем
            Else
                ullMaxCount = 0 ' иначе равно 0
            Endif
            Return TRUE
        Else
            Return FALSE
        Endif
    Else
        Return FALSE
    Endif

End Function

'Процедура закрывает мэпированный файл
Sub CloseMapping()

    UnmapViewOfFile(pbFileBytesBuffer)
    CloseHandle(hFileMap)
    CloseHandle(hFile)
    ' На всякий случай очищаем все переменные
    pbFileBytesBuffer = 0
    hFileMap = 0
    hFile = 0
    ullClaster = 0
    ullRealOffset = 0
    iFileOpenFlag = FALSE
End Sub

' Функция дает указатель на начало промэпированного файла.
Function GetPtrMapFile() As Integer
    If ullSizeFile > 66000 Then ' если размер файла больше чем 66000
        pbFileBytesBuffer = MapViewOfFile(hFileMap,FILE_MAP_READ, 0,0,66000) ' читаем часть файла
    Else
        pbFileBytesBuffer = MapViewOfFile(hFileMap,FILE_MAP_READ, 0,0,0) ' читаем весь файл
    Endif

    If pbFileBytesBuffer = FALSE Then
        Return FALSE
    Else
        Return TRUE
    Endif

End Function

' Функция дает указатель на начало промэпированного файла.
Function GetPtrMapFileAnyPosition() As Integer

    ullRealOffset = ullVScrollPos*16 ' реальное смещение
    ullClaster = ullRealOffset\65536 ' позиция кластера для MapViewOfFile
    Dim li As ULARGE_INTEGER
    li.QuadPart = 65536*ullClaster ' адрес посылаемый в MapViewOfFile , с которого начнется кластер

    If ullBackupClaster <> ullClaster Then ' если позиция кластера изменилась
        UnmapViewOfFile(pbFileBytesBuffer) ' удаляем мэпирование старого буфера
        If (li.QuadPart + 66000) < ullSizeFile Then ' если размер файл больше чем  (адрес + буфер из 66000 байт)
            pbFileBytesBuffer = MapViewOfFile(hFileMap,FILE_MAP_READ, li.HighPart,li.LowPart,66000) ' просто читаем 66000 байт
        Else
            pbFileBytesBuffer = MapViewOfFile(hFileMap,FILE_MAP_READ, li.HighPart,li.LowPart,ullSizeFile-65536*ullClaster) ' читаем остатки байт
        Endif

    Endif

    ullNullOffsetView = ullRealOffset - li.QuadPart  ' получаем начальное смещение в видимой части окна

    ullBackupClaster = ullClaster ' сохраняем позицию кластера

    If pbFileBytesBuffer = FALSE Then
        Return FALSE
    Else
        Return TRUE
    Endif

End Function


' настройки главного окна
With wc
    .cbSize=SizeOf(WNDCLASSEX)
    .style=CS_HREDRAW Or CS_VREDRAW
    .lpfnWndProc=@wndproc
    .hInstance=Hinst
    .hIcon=LoadIcon(0,IDI_QUESTION)
    .hCursor=LoadCursor(0,IDC_ARROW)
    .hbrBackground=Cast(HBRUSH,COLOR_WINDOW)
    .lpszClassName=StrPtr(sNameClass)
    .hIconSm=.hIcon
End With

' регистрация окна
If RegisterClassEx(@wc)=0 Then
    Print "Register error, press any key"
    Sleep
    End
Endif

' Загрузка шрифтов
hFontCourierNew = LoadFontProc("Courier new",11,0,0,0,0,0,DEFAULT_CHARSET)

' создаем главное окно
mainHwnd = CreateWindowEx(0,sNameClass,"HexViewer",_
WS_VISIBLE Or WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_MINIMIZEBOX,100,100,800,610,0,0,Hinst,0)


' главный цикл
While GetMessage(@msg,0,0,0)
    TranslateMessage(@msg)
    DispatchMessage(@msg)
Wend


 

simple_hex_viewer.png

Надеюсь данный цикл статей поможет кому-нибудь в разработке своих программ. Я допускаю, что в коде могут быть ошибки, ведь я сильно не тестировал. Чисто для пробы, я на коленке за 15 минут переписал код , используя вместо мэп-файлов , привычные файловые функции (ReadFile, SetFilePointer). Программа все так же работала хорошо. При использовании(ReadFile, SetFilePointer), я даже просматривал данной программой свой физический жесткий диск размером 1 ТБ и успешно проводил поиск. Возможно где-то что-то можно улучшить, но это уже без меня :) Удачи!

содержание | назад