» Вопросы по Delphi (все версии) - часть 4

Подскажите плиз где найти/посмотреть модули с шифрованием для делфи (т.е. хорошо реализованные на паскале)

Интересует двустороннеее шифрование, чуточку сложнее чем XOR, но не сильно, т.е. чтоб код был не многотысячным исходником, спасибо :)

ЗЫ. К сожалению точные алгоритмы назвать не могу - не помню правильных названий из курса по криптографии - помню только что есть всякие алгоритмы со сдвигами, основанные на умножении по модулю и т.п. методиками на остатках по модулю - т.е. шифруют они достаточно просто, но взламываются существенно сложнее чем XOR :)

xy
http://algolist.manual.ru/defence/well_known/index.php

afiget
спасибо, изучу

xy, нашел в папке с лабораторными по ИБиЗИ (Информационная безопасность и защита информации), на 3 курсе делал. Тема "Применение метода гаммирования для шифровки и дешифровки текста". [more=Исходник]
const
a = 7;
m = 4096;
y0 = 502;

type
mas = array[1..8] of byte;

var
source, coded, decoded: file;
gamma, block: mas;
i,k: integer;

procedure generategamma;
var
i: integer;
begin
gamma[1] := byte(y0);
for i := 2 to 8 do
gamma[i] := (a * gamma[i-1]) mod m;
end;

begin
assignfile(source,'source.txt');
reset(source,1);
assignfile(coded,'coded.txt');
rewrite(coded,1);
repeat
blockread(source,block,8,i);
generategamma;
for k := 1 to i do
block[k] := block[k] xor gamma[k];
blockwrite(coded,block,i);
until
i < 8;
closefile(source);
closefile(coded);

assignfile(coded,'coded.txt');
reset(coded,1);
assignfile(decoded,'decoded.txt');
rewrite(decoded,1);
repeat
blockread(coded,block,8,i);
generategamma;
for k := 1 to i do
block[k] := block[k] xor gamma[k];
blockwrite(decoded,block,i);
until
i < 8;
closefile(coded);
closefile(decoded);
end.[/more]

В папке с программой ложишь файл source.txt с текстом, программа после выполнения создает файлы coded.txt и decoded.txt, с зашифрованным и обратно расшифрованным сообщением. Где-то была методичка, там много теории по разным методам, найти не могу

Jokerjar79
спасибо
плохо что он xor`ит и использует только три параметра, т.е. зная шифр и исходный текст довольно просто, по-моему найти параметры :)
однако сам метод освежил в памяти, как отправная точка очень полезно ;)

xy, это хотя и простой, но достаточно эффективный метод. По этим трем параметрам осуществляется не непосредственное шифрование, а генерация псевдослучайной последовательности. Таким образом, каждый байт шифруется xor'ом не постоянным числом, а элементом ключевого потока. И такой шифр нельзя взломать анализом частот появления символов и т.п. В примере используетя длина гаммы 8 байт, хотя ее можно сделать любой длины (например, использовать длину гаммы равную длине сообщения)

Jokerjar79
да мне понравилось :), только помоему мы такое взламывали "в столбик" на контрольный с короткой последовательностью.. 1 или 2

но точно не скажу, увы, уже всё позабывал

но методикой воспользуюсь :) главное, что просто :)

Jokerjar79
я так понимаю делать
generategamma;
в цикле нет никакой необходимости :)

Привет всем.

Уже достаточно давно (безуспешно как видите) ищу реализацию LZX (используется в chm, cab и др…) алгоритма для Делфи. Собственно пока ничего не нашел, поэтому и решил спросить.
Может, кто видел где-нибудь такую вещь?
На то, что такая вещь может существовать указывает программа CHM Editor (http://www.gridinsoft.com/downloads.php), она написана на делфи и может редактировать chm файлы, там как раз используется LZX.

Заранее благодарю за ответ.

Собственно такой вопросик. Чето не доперло решение...
Имеем

Код: type
FN_HTTPDOWNLOAD = function(szURL : PChar; szMethod : PChar; szArgs : PChar; szReferrer : PChar; szContentType : PChar; pBuffer : pBYTE; dwMaxBufferLen : DWORD) : BOOL; stdcall;

Четвертым параметром передается указатель на функцию типа FN_HTTPDOWNLOAD, переменную DWORD она явно не скушает. Реализация функции, по всей видимости, где-то в библиотеке.

Цитата:

function GetStkCardBilling(hWndNum, hWndPsw, hWndBil : THandle; httpDownload : FN_HTTPDOWNLOAD) : Boolean;

Возможно, четвертый параметр вообще не к чему, ведь какую функцию вызывать известно, просто экспортировать ее из библиотеки (либо искать реализацию, если я ошибаюсь на счет экспорта)

Кто может помочь с JvCreateProcess из пакета JVCL.
Никак не могу сделать так, чтоб консоль отображала русские буквы, никак не могу понять что там надо сделать, я уже и AnsiString менял на WideString и пытался отображать в юникоде, но безуспешно, помогите пожайлуста.

консоль использует кодировку cp866 ("досовская"). Ваше приложение работает под cp1251. В области русских букв они как раз и не совместимы.
можно делать следующее.
- перед выводом в консоль русскоязычного текста конверитровать в нужную кодировку. в интерненте полно статей на эту тему.
- указать консоли, что у неё "будет другая кодировка". Для этого надо в консоли выполнить команду "chcp 1251". Для возврата к старому режиму - "chcp 866". Этот способ хорош тем, что больше переделывать ничего не надо. строки можно слать напрямую. Но если используется стороннее приложение, выводящее в русской кодировке, то после такой строки оно начнёт выводить "иероглифами". В свое время я использовал этот метод, только приложение запускалось через маленький bat файл.

OdesitVadim
Все оказалось проще, надо было просто поменять в memo charset на OEM и все теперь нормально отображается. Спасибо за подсказку ))

DmitryKz
Поигрался с твоим кодом, максимум чего удалось достичь - разбор Word документа из 50000 слов за 4 минуты. Долговато. Главный тормоз в задаче - взаимодействие с другим процессом. Если открыть Word документ в своем процессе, то должно работать намного быстрее. Но непонятно как это сделать, документ можно открыть в TOleContainer, это без проблем. Но как из этого контейнера получить ссылку на встроенный документ?

anfilat
Да, я уже и так и этак - этот способ вряд ли можно считать правильным. Я даже удивляюсь, как тебе удалось так повысить скорость в сравнении с моими результатам - 10 минут на 10 тысяч слов
Думаю, лучше не париться и получать весь текст в строковую переменную (или текстовой файл??? - хотя вряд ли сие имеет большой смысл) и парсить на отдельные слова. Парсер-то написать можно, но может кто видел уже готовый код?

Подскажите кто нибудь виуализировал графы?

DmitryKz
Можно поиграться с парсером VBScript, в папке Demos что-то было.

Здраствуйте. Эм, необходимо на заднем фоне листбокса отображать битмап. Сделал следующее:

Код:
WM_DRAWITEM :
begin
case wParam of
ID_PLAYLIST_LISTBOX :
begin
ListWnd := PDRAWITEMSTRUCT(lParam).hwndItem;
RectLB := PDRAWITEMSTRUCT(lParam).rcItem;
ListDC := PDRAWITEMSTRUCT(lParam).hDC;

GetClientRect(GetDlgItem(hWndApp, ID_PLAYLIST_LISTBOX), Rect);
MemoryDC := CreateCompatibleDC(ListDC);
SelectObject(MemoryDC, lBoxBitmap);
GetObject(lBoxBitmap, SizeOf(TBitmapInfo), @BitmapInfo);
BitBlt(ListDC, ((Rect.Right - Rect.Left) - BitmapInfo.bmiHeader.biWidth) - 7, ((Rect.Bottom - Rect.Top) - BitmapInfo.bmiHeader.biHeight) - 7, BitmapInfo.bmiHeader.biWidth, BitmapInfo.bmiHeader.biHeight, MemoryDC, 0, 0, SRCAND);
SelectObject(MemoryDC, ListDC);
DeleteObject(MemoryDC);
DeleteDC(MemoryDC);

if Integer(PDRAWITEMSTRUCT(lParam).ItemID) > -1 then
begin
if (PDRAWITEMSTRUCT(lParam).itemState and ODS_SELECTED) <> 0 then
begin
FillRect(ListDC, RectLB, GetSysColorBrush(COLOR_HIGHLIGHT));
SetBkMode(ListDC, GetSysColor(COLOR_HIGHLIGHT));
SetTextColor(ListDC, GetSysColor(COLOR_HIGHLIGHTTEXT));
end
else
begin
FillRect(ListDC, RectLB, GetSysColorBrush(COLOR_WINDOW));
SetBkColor(ListDC, GetSysColor(COLOR_WINDOW));
SetTextColor(ListDC, GetSysColor(COLOR_WINDOWTEXT));
if (PDRAWITEMSTRUCT(lParam).itemID mod 2) <> 0 then
begin
BrushNew := CreateSolidBrush(RGB(245, 245, 245));
BrushOld := SelectObject(ListDC, BrushNew);
FillRect(ListDC, RectLB, BrushNew);
SetBkColor(ListDC, RGB(245, 245, 245));
SelectObject(ListDC, BrushOld);
DeleteObject(BrushNew);
end;
end;
RectLB.Left := RectLB.Left + 5;
RectLB.Right := RectLB.Right - 5;
SendMessage(ListWnd, LB_GETTEXT, PDRAWITEMSTRUCT(lParam).ItemID, LongInt(@TextLB[0]));
DrawText(ListDC, @TextLB[0], - 1, RectLB, DT_SINGLELINE or DT_VCENTER);
end;

end;
end;
end;

А никому не доводилось реализовывать нечто подобное?
Есть два одинаковых грида, ссылающихся на одинаковые по структуре наборы данных.
В каждом гриде есть столбец "Код". Необходимо, чтоб во время инкрементного поиска в этом столбце в первом гриде (он реализован самим гридом) производился аналогичный инкрементный поиск в другом гриде.
Есть мысль на событие OnKeyPress в первом гриде вызывать аналогичное событие во втором, но не знаю, как это сделать.

Maks150988

Цитата:

Все бы ничего, но когда скроллируешь контрол через его скроллер - изображеия накладываются друг на друга. Пробовал обновлять контро/окно - но тут тормоза получаются. Как зачищать фон перед наложением картинки?

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

Код:
ODT_LISTBOX:
begin
DC:=DStr.hDC;
Rect:=DStr.rcItem;
if (DStr.itemState and ODS_SELECTED)<>0 then DrawHotLight(Rect,DC) else
DrawBackGround(Rect,DC);
holdFONT:=SelectObject(DC,holdFONT);
SetFont(DC,-14,600,clBlack);
Item:=GetItem(DStr.itemID);
if History then begin
if Pos('Соединение',Item)>0 then begin
DrawImage(DC,Rect.Left+1,Rect.Top+4,4);
Inc(Rect.Left,18);
DrawList3D(DC,Rect,PChar(Item),clLime);
end;
if Pos('Начало',Item)>0 then begin
Inc(Rect.Left,18);
DrawList3D(DC,Rect,PChar(Item),clRed);
end;
if Pos('Конец',Item)>0 then begin
Inc(Rect.Left,18);
DrawList3D(DC,Rect,PChar(Item),clLtAqua);
end;
if Pos('лительность',Item)>0 then begin
DrawImage(DC,Rect.Left+1,Rect.Top+4,14);
Inc(Rect.Left,18);
DrawList3D(DC,Rect,PChar(Item),clYellow);
end;
end
else DrawList3D(DC,Rect,PChar(Item),clAqua);
holdFONT:=SelectObject(DC,holdFONT);
end;

ShIvADeSt
Дык вот без картинки то нормально отрисовывется. Оно итак нормально отрисовывается. Я не знаю где уж код править - итак перепроверил - правильно ж вроде как. А растровое изображение каким тогда образом вставить на элемент еще? Этот FillRect еще уж везде насовал на всякий случай чтоб затирался фон.

Maks150988
По ссылке не то немного
Прочитал тут http://www.delphikingdom.ru/asp/itemq.asp?MessageID=4 чтьо надо еще WM_ERASEBKGND как минимум для листбокса обрабатывать. Рекомендуют забить на листбокс, а использовать ListView с нужным флагом. Там все фонарно отрисовывается. Сам пробовал, при скролинге фигня у листбокса вылазит.
вот еще
http://www.dotnetspider.com/resources/374-Displaying-Background-Images-Listbox-TextBo.aspx
достаточно понятный код.
и вот еще, хоть и на С, но очень понятно - наверху фотка, как будет выглядеть
http://www.codeguru.com/cpp/controls/listbox/colorlistboxes/article.php/c10413/

Maks150988

Цитата:

WM_ERASEBKGND

Обязательно для всего. Но веть там по моему ничего сложного. Это со схемами xp получилось наверное. Ну так можно манифест отключить и посмотреть. Может всё правильно, а может там ещё страшнее.

SIS33

Визуализировать as можно несколькими способами например с помощью компонент
- DeveloperExpress OrgChart
- DeveloperExpress FlowChart
- TeeTreeView
- FlexGraphics
- TCAD
- CommonCad
- Drawing Engine
Все эти компоненты реально найти на руборде, причем первые два оптимизированы на построение графов.

Добавлено:
brookson
Мне приходилось, но одним сорбытием не обошлось.
Может в твоем случае пройдет полсто становка курсора таблицы при помощи функции Locate для которой назначен грид, поскольку изменение текушей позиции в Dataset приводит к визуальному изменению в связаном гриде.
Резюме.
В первом гриде делаем инсрементальный поиск, запоминаем ключ.
Во втором Датасете ищем по запомненому ключу запись с помощью Locate.
Текущая запись во втором гриде должна изменится автоматически.

Добрый день.
Подскажите, где я тут накосячил и как исправить


Код:
type
Procedure NewKSA(Dir:string);

...


Procedure TForm1.NewKSA;

var
SearchRec:TSearchRec;
buttonSelected : Integer;

begin

Application.ProcessMessages;

if Dir<>'' then if Dir[length(Dir)]<>'\' then Dir:=Dir+'\';
if FindFirst(Dir+'*.*', faAnyFile, SearchRec)=0 then
repeat
if (SearchRec.name='.') or (SearchRec.name='..') then continue;
if (SearchRec.Attr and faDirectory)<>0 then

Log('Проверка папки '+Dir+SearchRec.name); //это проц. ведения логов
KT := Copy(SearchRec.name,3,5); //это поиск имени КСА в имени папки
Table1.First;
if Table1.Locate('NOMER_KSA',KT, [loPartialKey]) = false then //если такого номера в таблице нет, запрос на добавление
buttonSelected := MessageDlg('Добавить новый КСА '+KT,mtConfirmation,
[mbYes,mbNo], 0);
if buttonSelected = mrNo then
begin
Log('Отмена занесения КТ '+KT+' в список');
Table1.append;
Table1.fieldbyname('NOMER_KSA').asString:=KT;
Table1.fieldbyname('IGNOR').asInteger:=1;
Table1.post;
end;
if buttonSelected = mrYes then
begin
Log('Добавление нового кассового аппарата '+KT+' в список');
Table1.append;
Table1.fieldbyname('NOMER_KSA').asString:=KT;
Table1.fieldbyname('IGNOR').asInteger:=0;
ShowMessage('Не забудьте отредактировать настройки для КТ'+KT+' в ksa.dbf');
Table1.post;
end;
until FindNext(SearchRec)<>0;
FindClose(SearchRec);
end;

V1s1ter
да, была и такая мысль. придётся попробовать.

V1s1ter
Нет там все виде деревьев.
а хотелось как в пакете graphviz.
Чтобы сначала граф разбирался на плоскости.

Товарищи, помогите, не пойму как прорисовать сепараторы в меню.
http://webdrive.avtograd.ru/Download/Explorer/Download/menu_test_draw.rar
Вот тестовый проект. А заодно хочется полоску слева на все окно меню, а получается сейчас кусками для каждого пункта.
Вот код прорисовки сепаратора:

Код:
separator:=GetMenuState(FMenu, DrawStruct.itemID, MF_BYCOMMAND);
if (separator and MF_SEPARATOR)<>0 then
begin
Pen:=CreatePen(PS_SOLID, 1, COLOR_LEFT_SPACE);
SelObjPn:=SelectObject(DrawStruct.hDC, Pen);
for i:=LEFT_SPACE downto 0 do
begin
SetDCPenColor(DrawStruct.hDC, GetGradientColor(COLOR_LEFT_SPACE, i*2));
SelTmp:=SelectObject(DrawStruct.hDC, GetStockObject(DC_PEN));
MoveToEx(DrawStruct.hDC, DrawStruct.rcItem.Left+i, DrawStruct.rcItem.Top, nil);
LineTo(DrawStruct.hDC, DrawStruct.rcItem.Left+i, DrawStruct.rcItem.Bottom);
if SelTmp<>0 then DeleteObject(SelTmp);
end;
if SelObjPn<>0 then DeleteObject(SelObjPn);
if Pen<>0 then DeleteObject(Pen);
MoveToEx(DrawStruct.hDC, LEFT_SPACE+6, DrawStruct.rcItem.Top+1, nil);
LineTo(DrawStruct.hDC, DrawStruct.rcItem.Right, DrawStruct.rcItem.Top+1);
exit;
end;

Переделал пример. Теперь нужно просто узнать сепаратор пункта меню. Там в исходнике по ссылке выше есть, но я походу неправильно сделал такую фичу. Кому не сложно - посмотрите пожалуйста.
И заодно хотелось бы узнать. Поделитесь инфой о том кто как делает подсчет каждой компиляции проекта не самостоятельно (build нужно для версии), а при помощи пакетного файла или как-то компилятором. Чего-то ничего не найду реализацию...