|
Раздел "Кодинг". Содержание:
Статьи:
 Уменьшаем размер
EXE в 40 раз, или Вся правда о консольных приложениях Delphi
Шифрование в Delphi
Тест скоростных характеристик некоторых компонентов в Delphi
Защита формы паролем реализованная в Delphi
Поиск файлов на винчестере в Delphi
Раздел "Кодинг". Статьи:
 | Уменьшаем размер
EXE в 40 раз, или Вся правда о консольных приложениях Delphi |
|
"Пустая" форма весит около 355 КБ, и этот начальный размер увеличивается с каждой новой версией Delphi. "Пустая" программа, написанная с использованием библиотеки KOL, уменьшающей размер исполняемого файла, - 32 КБ.
"Чистое" консольное приложение имеет размер 8 КБ, поскольку отображается как процесс и, соответственно, не имеет сложных взаимодействий с Windows-окнами. То есть можно сделать так, чтобы по Ctrl+Alt+Del консоль не было видно :).
Итак, в меню Delphi выберите File>New>Other и в появившемся окне среди прочего найдите пункт Console Application. Возникнет следующая заготовка:
program Project1; //название проекта
{$APPTYPE CONSOLE} //директива, указывающая на наличие консоли
uses SysUtils; //подключенные модули
begin //начало процесса
{ TODO -oUser -cConsole Main : Insert code here } //комментарий от Borland
end. //конец процесса
Ага. Это "пустое" консольное приложение. Нажмите F9, чтобы запустить его. Что вы увидели? Черное окошко вроде Сеанса MS-DOS возникло и сразу исчезло. Куда оно делось? Всё дело в том, что консольное приложение - это процесс, который, как и всё на свете, когда-нибудь закончится :). Начало процесса - ключевое слово begin, а конец - end. Поскольку между ними отсутствуют какие-либо другие команды, то end (прекращение процесса) исполняется сразу после начала, и консоль исчезает. Чтобы такого не было, надо "занять" приложение каким-нибудь циклом, желательно вечным ;). Вот так:
begin
repeat
//это наш вечный цикл
until 1=0;
end.
Обратите внимание на команду until. Наш цикл будет исполнятся до тех пор, пока 1 не станет равен 0. Угадайте сами, когда это случится :). Другой вариант:
begin
while true do begin
//вставляйте ваш код здесь
end;
end.
И еще вариант:
Label MyLabel; //"метка"
begin
MyLabel:
//ваш код здесь
goto MyLabel;
end.
В общем, вариантов сколько угодно. Главное, что консоль не будет закрываться. А теперь надо реализовать чтение и запись на полотно консоли, как это сделано в (не)старом (не)добром MS-DOS. Помогут нам в этом процедуры из модуля System.pas. Синтаксис:
WriteLn(ЧТО_ЗАПИСЫВАЕМ) //вывод данных в консоль
ReadLn(ЧТО_ЧИТАЕМ) //чтение данных из консоли
Почему же модуль System.pas не продекларирован в разделе uses? Это базовый модуль Delphi, который всегда подключен "по умолчанию". А теперь добавьте к исходному коду:
WriteLn('Hello World!');
Соответствующая строка ("Hello World!") будет выведена на консоль. Если эта команда будет помещена в вечный цикл (как его создать - см. выше), то строка "Hello World!" тоже будет добавляться бесконечное число раз. Чтобы это исправить, нужно написать:
Begin
While true do begin
Writeln('Hello World!');
Readln;
End;
End.
Как вы уже поняли, команда WriteLn записывает, а ReadLn - читает. При этом команда, стоящая после ReadLn, выполнится, только когда юзер нажмет клавишу Enter.
Если же вы собираетесь читать конкретную строку, которую ввел юзер, то нужно указать переменную, из которой будет осуществляться чтение:
var S: String; //наша переменная
begin
while true do begin
Writeln('Enter your name'+#10);
Readln(S);
Writeln(#10+'Your name is '+S);
end;
end.
Здесь "№10" обозначает конец абзаца, переход курсора на следующую строку (клавиша Enter). А вот пример, где программа закрывается по команде юзера:
var s: String;
begin
while true do begin
Readln(S); //что ввел юзер?
//Юзер мог ввести команду и прописными буквами,
//и строчными. Преобразуем буквы в прописные
//командой UpperCase.
If UpperCase(s)='EXIT' then begin
//переспросим еще раз
Writeln('Do you really want to exit? [y/n]');
//читаем ответ юзера
Readln(s);
if UpperCase(s)='Y' then exit; //выходим
end;
end;
end.
Вот так. Сюда можно вставить какой угодно код, только подключив, если требуется, необходимые модули. Теперь еще раз откомпилируйте проект и нажмите Project>Information for 'ProjectName'. Размер EXE будет около 40 килобайт, но только потому, что модуль SysUtils.pas в разделе Uses весит так много. А если вы замените этот модуль на Windows.pas, то программа будет занимать, как я и обещал, ВОСЕМЬ :) кило на вашем харде :).
Конечно, при условии, что вы будете пользоваться только модулем Windows, который содержит большинство команд, необходимых в повседневности. Если вы не собираетесь вступать в консольные переговоры с юзером и пользоваться процедурами WriteLn и ReadLn, то и консоль не нужна. Удалите директиву {$APPTYPE CONSOLE}, чтобы черное MS-DOS'овское окошко не появлялось.
Но если это окошко вам очень нужно и вы собираетесь вести диалог с пользователем, то не пытайтесь указывать русские буквы в команде WriteLn: консоль отобразит их в другой кодировке. Чтобы это исправить, напечатайте исходный (русский) текст в Блокноте и поставьте шрифт Terminal. Результат будет в кодировке DOS, как его и надо указывать в процедуре WriteLn.
Очистить полотно консоли от текста можно так:
program Project1;
{$APPTYPE CONSOLE}
uses Windows;
var
buffer: TConsoleScreenBufferInfo; //буфер
i: integer;
begin
WriteLn('Press <Enter> to clear screen');
ReadLn;
GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE),buffer);
for i:=0 to buffer.dwSize.y do writeln;
Writeln('Screen is cleared :)');
Readln;
end.
Вот и всё. Как собрать что-нибудь посерьезнее, чем обхаянное крутыми программистами приложение типа "Hello World", мы расскажем вам в следующей серии.
   
| Шифрование в Delphi |
|
Данные надо беречь. Сами посудите, обидно, если открытие ценой в сто миллионов долларов или рецепт безалкогольной водки, над которым вы корпели три вечера в мрачном подвале нелегального компьютерного клуба, - уплывет к злостному ленивому конкуренту, который, пользуясь вашим похмельем, наложил грязную лапу на приватные дискеты с ценнейшей инфой?! Дальше можно не продолжать. Шифруем, шифруем, шифруем!..
Добрый дядюшка Borland предоставил нам несколько занятных функций для работы со строками, о которых не все знают. Сосредоточены они в модуле
StrUtils.pas. Такие функции, как RightStr, LeftStr совмещают известные нам стандартные команды Copy и Delete: так, LeftStr возвращает значение левой части строки до указанной вами позиции (что вытворяет RightStr, догадайтесь сами), а функция ReverseString и вовсе делает зеркальное отображение данной строки: 321 вместо 123. Используем ее в особенности, чтобы осложнить жизнь хитрому дешифровщику.
Алгоритм шифрования будет прост, как Win 3.1: с помощью команды Ord получим числовой код данного символа. НО! Для дешифровки нужен пароль, который (я надеюсь) будете знать только вы. Каждый символ пароля будет декодирован в числовое значение, и алгебраическая сумма всех этих чисел будет прибавлена к имеющемуся значению зашифрованного знака в тексте. И так - для каждой буквы шифруемого документа, между которыми добавятся пробелы, иначе декодер примет множество символов, записанных в цифровом виде, за одно большое многозначное число и ничего не переведет. А затем результат будет записан навыворот командой ReverseString.
Когда же настанет пора декодировать информацию, обработанные "чистые" цифровые значения переведутся в символьные командой Chr. Без пароля такой цикл взломать достаточно сложно, даже зная алгоритм, если только вы не гуру криптографии или титан алгебры (я-то надеюсь, что вы, конечно же, усовершенствуете мое скромное творение: это - лишь заготовка).
Единственный значительный недостаток - размер зашифрованного файла увеличивается по сравнению с исходным в 3 раза. Но для того и архиваторы придумали :).
Теперь, когда алгоритм намертво засел в голове, реализуем соответствующую программу. Внимание! Не исключено, что это будет первая ваша программа с настоящим синтаксисом команд:
<команда> <путь> <пароль>
- так будет выглядеть он в консоли нашего приложения (да, оно будет консольным!). Команд всего две:
crypt и decrypt - соответственно зашифровать и дешифровать файл, путь к которому указывается после пробела, а затем - ваш пароль. НЕ ЗАБУДЬТЕ ЕГО! Предупреждаю совершенно серьезно. Запомнили? В бой!
Crypt C:\file.txt linuxmustsurvive
- закодируем File.txt. Результат (зашифрованный текст) сохраниться в той же директории, что и исполняемый файл нашего приложения под именем Translated_File.txt.
{$APPTYPE CONSOLE}
uses
SysUtils,
StrUtils; //!!
var
F, //входящий файл
F1: TextFile; //результат (файл с переводом)
ToDo, FileName, PassW, Line, TranslatedFile: string;
position, IsCrypt: integer;
//преобразуем пароль в числовое значение
function Password(Psw: string): integer;
var
i,res: integer;
begin
res:=0;
for i:=1 to Length(psw) do res:=res+ord(psw[i]);
result:=res;
end;
function Crypt(CryptStr: string): string;
var
s: string;
i: integer;
begin
if CryptStr<>EmptyStr then
for i:=1 to Length(CryptStr) do begin
s:=CryptStr;
s:=LeftStr(s,1);
CryptStr:=RightStr(CryptStr,Length(CryptStr)-1);
s:=IntToStr(ord(s[1])+Password(PassW));
result:=result+s+' ';
end;
delete(result,Length(result),1);
result:=ReverseString(result);
end;
function Decrypt(DecryptStr: String): String;
var
Xpos, i: integer;
Code: String;
begin
DecryptStr:=ReverseString(DecryptStr);
for i:=1 to length(decryptstr) do begin
xpos:=pos(' ',decryptstr);
if xpos<=0 then begin
result:=result+chr(StrToInt(decryptStr)-password(PassW));
exit;
end;
code:=copy(DeCryptStr,1,Xpos-1);
result:=result+chr(StrToInt(code)-password(PassW));
delete(DecryptStr,1,Xpos);
end;
end;
begin
while true do begin
isCrypt:=0;
writeln(#10+'Crypter >'+#10);
//Какую команду ввел юзер?
readln(ToDo);
if AnsiContainsText(ToDo,'decrypt') then isCrypt:=1
else if AnsiContainsText(ToDo,'crypt') then isCrypt:=2;
position:=pos(' ',ToDo);
if position>0 then ToDo:=RightStr(ToDo,Length(ToDo)-position);
//Читаем путь к файлу
position:=pos(' ',ToDo);
if position>0 then FileName:=LeftStr(ToDo,position-1);
//Читаем пароль
PassW:=RightStr(ToDo,Length(ToDo)-position);
//Всё правильно? Начинаем!
if (isCrypt<=0) or (PassW=EmptyStr) or (not FileExists(FileName)) then writeln('Wrong command')
else begin
TranslatedFile:=ExtractFilePath(paramStr(0))+'translated_'+ExtractFileName(FileName);
AssignFile(F, FileName);
AssignFile(F1, TranslatedFile);
Rewrite(F1);
Reset(F);
while not EOF(F) do begin
ReadLn(F, Line);
if isCrypt=1 then Line:=Decrypt(Line);
if isCrypt=2 then Line:=Crypt(Line);
Writeln(F1, Line);
end;
CloseFile(f);
CloseFile(F1);
end;
end;
end.
Вот, собственно, и всё. В заключение процитирую отрывок из статьи "Криптография в C + +" в номере 3.03 журнала "Хакер":
//(с) Николай "GorluM" Андреев
Но я хочу тебя предупредить: в нашей стране, согласно указу № 334 от 1995 года, производить и распространять любые шифрующие средства можно, только имея лицензию ФАПСИ. Соответственно, шифровать нельзя :). Поэтому пиши программы только для личного пользования и только в познавательных целях
| Тест скоростных характеристик некоторых компонентов в Delphi |
|
Как-то на досуге написал программку для подсчета количества счастливых билетиков.
Для тех, кто не в курсе - это вроде шутка такая, дают тебе в автобусе билет. Там шесть цифр, если сумма первой тройки цифр совпадает со второй, значит, билетик считается счастливым. В общем, это не важно, а важно то, что когда я стал всякие украшательства вешать, всякие там ProgressBar, вывод результатов в Memo и т.д. скорость подсчета значительно упала. И решил я все это потестить отдельно, вот что получилось.
Тест 1
в процессе проверки:
- Real-Time вывод кол-ва счастливых билетиков(СБ)
- работает Progressbar.
- работает вывод номеров СБ в RichEdit.
- Application.ProcessMessages;
Время подсчета 123456 билетов: 15.658
Тест 2
для наглядности список возможностей
программы сохранен, но отключенные
возможности закоментированы.
в процессе проверки:
//- Real-Time вывод кол-ва СБ.
- работает Progressbar.
//- работает вывод номеров СБ в RichEdit.
//- Application.ProcessMessages;
Время подсчета 123456 билетов: 8.435
Тест 3
в процессе проверки:
//- Real-Time вывод кол-ва СБ.
//- работает Progressbar.
- работает вывод номеров СБ в RichEdit.
- Application.ProcessMessages;
Время подсчета 123456 билетов: 4.977
Тест 4
в процессе проверки:
- Real-Time вывод кол-ва СБ.
//- работает Progressbar.
//- работает вывод номеров СБ в RichEdit.
- Application.ProcessMessages;
Время подсчета 123456 билетов: 1.065
Тест 5
в процессе проверки:
//- Real-Time вывод кол-ва СБ.
//- работает Progressbar.
//- работает вывод номеров СБ в RichEdit.
//- Application.ProcessMessages;
Время подсчета 123456 билетов: 0.04
Тест 6
в процессе проверки:
//- Real-Time вывод кол-ва СБ.
//- работает Progressbar.
//- работает вывод номеров СБ в RichEdit.
//- Application.ProcessMessages;
- Вместо ProgressBar был использован Gauge
Время подсчета 123456 билетов: 0.101
Вывод: прежде чем собачить в процесс какой-нибудь лишний финт, лучше сначала подумать нужен ли он вам...:)
| Защита формы паролем реализованная в Delphi |
|
Вот уже вторая заявка посвящена проблеме
защиты формы паролем. Раз это вызывает
такой интерес, сегодня мы попробуем
разобраться с азами такой защиты. Давайте
обсудим как мы это будем делать. Логично,
что перед запуском формы, которую мы хотим
защитить, надо запросить у пользователя
пароль (можно конечно и комбинацию имя
пользователя - пароль, но мы рассмотрим на
примере только пароля) и сравнить введенное
значение с каким-то зарезервированным в
программе (оно может храниться как в явном
виде так и в зашифрованном). Если значения
совпадут, то мы откроем необходимую форму,
иначе завершим все приложение.
Теперь непосредственно займемся
разработкой формы запроса пароля. Хотя
разрабатывать нам ничего и не надо: самый
простой вариант такой формы Delphi поставляет.
Вам надо выбрать пункт меню File -> New, в
открывшемся диалоговом окне выберите
закладку Dialogs, щелкните на значке Password
Dialog и нажмите Ok. На экране появится
готовая форма запроса пароля с именем PasswordDlg.
На этой форме будут две кнопки Ok и Cancel,
текстовое поле ввода пароля с именем Password,
метка Label1 с надписью Enter Password. Заменим
свойство Caption метки Label1 на более
приятное русскому глазу 'Введите пароль'.
Также поменяем свойство Caption и для самой
формы на 'Запрос пароля', например.
Обратите внимание на свойство PasswordChar поля
ввода Edit равно * (звездочке) - это
означает, что при вводе все символы будут
заменены на звездочки.
Нам необходимо добиться, чтобы форма
запроса пароля появлялась на экран раньше
основной формы. Это делается так. В
обработчике события OnShow главной формы
нужно написать такой код:
PasswordDlg.showmodal;
Этот код запустит нашу форму запроса
пароля (PasswordDlg) перед основной. И сделает
недоступной основную форму, до закрытия
формы запроса пароля. Теперь запустите
программу, компилятор спросит Вас хотите ли
Вы добавить в Uses, модуль второй формы,
конечно же надо ответить, что хотите!
Далее поступим следующим образом. Пароль будет
хранится в виде константы в нашем
приложении. При вводе правильного пароля
будет открываться главная форма, а при
вводе неправильного пароля, нажатии кнопки
Cancel и других попытках закрыть форму запроса
будем завершать наше приложение.
Для этого напишем обработчик для события OnFormCloseQuery
для формы запроса. Здесь мы будем
сравнивать содержимое строки ввода пароля
с нашей константой, которую объявим в
этом же обработчике. Таким образом
получается такой код:
procedure TPasswordDlg.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
const pass='велкам'; //наш праоль
begin
if Password.Text = pass then CanClose:=true
else Application.Terminate;
end;
Вот мы и реализовали самый простой способ
защиты формы. Если хотите сравнивать пароль
без учета регистра, то нужно обе строки
преобразовать, например, в нижний регистр.
Для этого надо поменять всего одну строку:
if Password.Text = pass then CanClose:=true
надо заменить на:
if lowerCase(Password.Text) = lowerCase(pass) then CanClose:=true
Теперь попробуем защитить форму паролем,
который будет храниться в зашифрованном
виде.
Зашифруем пароль самым простым способом - Xor.
Для этого напишем свою функцию:
function TPasswordDlg.xortext(text:string):string;
var key, longkey : string;
i : integer;
toto: char;
begin
key:='da'; //ключ
for i := 0 to (length(text) div length(key)) do
longkey := longkey + key;
for i := 1 to length(text) do begin
toto := chr((ord(text[i]) XOR ord(longkey[i])));
result := result + toto;
end;
end;
Через свое имя функция будет возвращать
зашифрованную строку переданную в
параметре Text. Не забудьте объявить эту
функцию в разделе Public:
public
{ Public declarations }
function xortext(text:string):string;
Вот, например, что получится, если
зашифровать этой процедурой наш "велкам":
†„Џ‹„Ќ
Теперь поменяем обработчик события onFormCloseQuery,
описанный в первом пример, на такой:
procedure TPasswordDlg.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
var pass:string;
begin
pass:=xortext('велкам');
if xortext(Password.Text) = pass then CanClose:=true
else Application.Terminate;
end;
Как Вы видите поменялось совсем не много,
теперь пароль в зашифрованном виде можно
хранить например в каком-нибудь файле. Так
что защищайте Ваши формы :)
| Поиск файлов на винчестере в Delphi |
|
Хотя я и не очень хороший "Делфер",
но я очень
люблю программировать в Delphi, делать
маленькие полезные программки
для себя и своего компьютера. Недавно я узнал
как производить поиск
файлов на компьютере, причем поиск файлов
производится не в отдельном
каталоге, а на всем винчестере и в процессе
поиска возможно следить за
поиском. Процедуре поиска я нашел очень
широкое применение, например, у
меня на компьютере имеется папка с
исходниками по Delphi и в этой
папки очень много лишних файлов, которые
занимают место на винчестере
и при помощи процедуры поиска я удаляю
ненужные файлы (*.cfg; *.~dfm;
*.~pas и др.). Начнем с описания процедуры FindResursive( Const path:
String; Const mask: String)
где переменная Path - каталог в котором будет
производится поиск
('c:\'), а Mask - название файла или его часть ('*.exe'
или '*.*' или
'project.dpr'). В самой процедуре будем
использовать только одну
(не считая вложенные функции)переменную,
которая будет носить полное название
найденного файла. А найденные файлы
будем записывать в ListBox. Данную процедуру будем вызывать при
нажатии кнопки.
Процедура FindRecursive выглядит следующим
образом:
Procedure FindRecursive( Const path: String; Const mask: String);
Var
fullpath: String;
Function Recurse( Var path: String; Const mask: String ): Boolean;
Var
SRec: TSearchRec;
retval: Integer;
oldlen: Integer;
Begin
Recurse := True;
oldlen := Length( path );
retval := FindFirst( path+mask, faAnyFile, SRec
);
While retval = 0 Do Begin
If (SRec.Attr and (faDirectory or
faVolumeID)) = 0 Then
form1.ListBox1.items.Add(path+srec.name);
retval := FindNext( SRec );
End;
FindClose( SRec );
If not Result Then Exit;
retval := FindFirst( path+'*.*', faDirectory,
SRec );
While retval = 0 Do Begin
If (SRec.Attr and faDirectory)
<> 0 Then
If (SRec.Name <>
'.') and (SRec.Name <> '..') Then Begin
path := path
+ SRec.Name + '\';
If not
Recurse( path, mask ) Then Begin
Result := False;
Break;
End;
Delete( path,
oldlen+1, 255 );
End;
retval := FindNext( SRec );
End;
FindClose( SRec );
End; { Recurse }
Begin
If path = '' Then
GetDir(0, fullpath)
Else
fullpath := path;
If fullpath[Length(fullpath)] <> '\' Then
fullpath := fullpath + '\';
If mask = '' Then
Recurse( fullpath, '*.*' )
Else
Recurse( fullpath, mask );
End;
В целом же программа выглядит так:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
Procedure FindRecursive( Const path: String; Const mask: String);
Var
fullpath: String;
Function Recurse( Var path: String; Const mask: String ): Boolean;
Var
SRec: TSearchRec;
retval: Integer;
oldlen: Integer;
Begin
Recurse := True;
oldlen := Length( path );
retval := FindFirst( path+mask, faAnyFile, SRec
);
While retval = 0 Do Begin
If (SRec.Attr and (faDirectory or
faVolumeID)) = 0 Then
form1.ListBox1.items.Add(path+srec.name);
{добавление}
{очередного
найденного файла в ListBox}
{-------------------------------------}
{здесь можно
производить слежением за выполнение
процедуры}
{например, поставить
ProgressBar}
retval := FindNext( SRec );
End;
FindClose( SRec );
If not Result Then Exit;
retval := FindFirst( path+'*.*', faDirectory,
SRec );
While retval = 0 Do Begin
If (SRec.Attr and faDirectory)
<> 0 Then
If (SRec.Name <>
'.') and (SRec.Name <> '..') Then Begin
path := path
+ SRec.Name + '\';
If not
Recurse( path, mask ) Then Begin
Result := False;
Break;
End;
Delete( path,
oldlen+1, 255 );
End;
retval := FindNext( SRec );
End;
FindClose( SRec );
End; { Recurse }
Begin
If path = '' Then
GetDir(0, fullpath)
Else
fullpath := path;
If fullpath[Length(fullpath)] <> '\' Then
fullpath := fullpath + '\';
If mask = '' Then
Recurse( fullpath, '*.*' )
Else
Recurse( fullpath, mask );
End;
procedure TForm1.Button1Click(Sender: TObject);
begin
FindRecursive('d:\','*.*'); {вместо 'd:\' можно написать
лубой каталог}
end;
end.
| 
