Сохранение данных приложения и пользователя

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

Например, в Windows для сохранения специфических для приложения файлов, таких как INI-файлы, файлы состояния программы, временные файлы и т.п., должен быть использован каталог "Application Data".

Крайне нежелательно использовать жёстко прописанные пути вроде "C:\Program Files". При сохранении файлов в этом каталоге, приложение вряд ли будет корректно работать в других версиях Windows, потому что этот путь может быть изменён в следующих версиях Windows, либо пользователь может установить ОС на другой диск. К тому же, Windows Vista может не дать доступ ко многим каталогам. Даже пользователю с правами администратора.

WinAPI-функция SHGetFolderPath
Функция SHGetFolderPath определенна в модуле SHFolder. SHGetFolderPath возвращает полный путь к указанному специальному каталогу по его идентификатору.

Ниже приведена функция-обёртка для SHGetFolderPath, чтобы было проще получить стандартные каталоги (для всех пользователей или только для текущего пользователя).


uses SHFolder;  
...  
function GetSpecialFolderPath(folder : integer) : string;  
const  
  SHGFP_TYPE_CURRENT = 0;  
var  
  path: array [0..MAX_PATH] of char;  
begin  
  if SUCCEEDED(SHGetFolderPath(0,folder,0,SHGFP_TYPE_CURRENT,@path[0])) then  
    Result := path  
  else  
    Result := '';  
end;  

Теперь создадим приложение для использования функции SHGetFolderPath:

Положим на форму TRadioGroup ("RadioGroup1");
Положим на форму TLabel ("Label1")
Добавим пять элементов в RadioGroup (свойство Items):
"[Текущий пользователь]\My Documents"
"All Users\Application Data"
"[User Specific]\Application Data"
"Program Files"
"All Users\Documents"
Добавим обработчик события OnClick для RadioGroup.



//RadioGroup1 OnClick  
procedure TForm1.RadioGroup1Click(Sender: TObject);  
var  
  index : integer;  
  specialFolder : integer;  
begin  
  if RadioGroup1.ItemIndex = -1 then Exit;  
  index := RadioGroup1.ItemIndex;  
  case index of  
    //[Current User]My Documents  
    0: specialFolder := CSIDL_PERSONAL;  
    //All UsersApplication Data  
    1: specialFolder := CSIDL_COMMON_APPDATA;  
    //[User Specific]Application Data  
    2: specialFolder := CSIDL_LOCAL_APPDATA;  
    //Program Files  
    3: specialFolder := CSIDL_PROGRAM_FILES;  
    //All UsersDocuments  
    4: specialFolder := CSIDL_COMMON_DOCUMENTS;  
  end;  
  Label1.Caption := GetSpecialFolderPath(specialFolder) ;  
end;  

Примечание: "[Текущий пользователь]" - это имя пользователя, сеанс которого в данный момент активен в Windows.

Функция SHGetFolderPath является более расширенным вариантом функции SHGetSpecialFolderPath.

Программа не должна сохранять свою информацию (временные файлы, пользовательские настройки, файлы конфигурации приложения, и т.д.) в каталоге My Documents (Мои документы), либо в каталоге самого приложения (т.е. в одном из подкаталогов Program Files). Следует использовать специальный каталог в Application Data, отведённый именно для Вашего приложения. Как правило, его имя совпадает с именем каталога программы в Program Files).

Всегда создавайте подкаталог только в тех путях, которые возвращает функция SHGetFolderPath! Как правило, каталог создаётся такой: "\Application Data\Название компании\Название продукта\Версия продукта".

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

Добавлено: 07 Августа 2018 21:39:29 Добавил: Андрей Ковальчук

Создание компонентов в Run-Time

Итак, рассмотрим на первый взгляд сложный вопрос о создании компонентов в Run_time (то есть во время работы программы). Но на самом деле этот вопрос довольно просто решается.

Давайте вместе попробуем написать код, чтобы при нажатии на кнопку на форме появлялось текстовое поле с каким-нибудь текстом. Для этого надо проделать следующие действия: объявить переменную необходимого вам типа компонента, в нашем случае TEdit, затем необходимо описать процедуру Create для нашей переменной, задать обязательное свойство Parent (то есть где появится наш компонент), ну и установить необязательные параметры типа высоты, ширины и т.д. Лучше разбираться на конкретном примере, так что смотрите какой у меня получился код:


procedure TForm1.Button1Click(Sender: TObject);  
var x:TEdit; // объявляем переменную типа TEdit  
begin  
x:=TEdit.create(self);// создаем экземпляр компонента  
x.parent:=form1;// текстовое поле появится на форме   
x.left:=10;  
x.top:=10;  
x.Width:=250;  
x.Text:='Привет компонент появился сам!!!';  
end;  

Как вы видите все очень просто. Поупражняйтесь с различными параметрами.

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


procedure TForm1.Button2Click(Sender: TObject);  
var y:TFontDialog; // объявляем переменную типа TFontDialog  
begin  
y:=TFontdialog.Create(self);  
y.Execute; //только для демонстрации. Показать что работает.  
end;   

Вы свободно можете изменять любые свойства компонента, созданного во время работы приложения.

Поскольку само Memo сортировать данные не умеет, то нам придется во время работы программы создать какую-нибудь переменную абстрактного класса TStringList (этот класс сортировать умеет), затем присвоить этому классу строки из Memo, отсортировать их и присвоить их обратно Memo. Поставим еще одну кнопку на форму, которая будет запускать процесс. Код получится примерно таким:


procedure TForm1.Button3Click(Sender: TObject);  
var t:TStringList;  
begin  
t:=TStringList.Create; //создаем  
t.AddStrings(memo1.lines); //присваиваем переменной t строки из Memo  
t.Sort; // сортируем  
memo1.Clear;  
memo1.Lines.AddStrings(t); // присваиваем memo уже отсортированные строки  
end;  

Теперь рассмотрим еще один вопрос, касающийся создания компонентов в Run-time. Допустим вам надо создать 20 полей для ввода текста (Edit) и еще десять меток (Label), не будете же вы 20 раз писать одно и тоже для каждого edit'a. В этой ситуации есть очень элегантный выход: воспользоваться массивом компонентов. В общем виде объявление массива компонентов может выглядеть так: имя_переменной:array[нижний_индекс..верхний_индекс] of тип_компонента. Теперь поупражняемся в этом. Создайте новое приложение. На форму поместите только кнопку. Обработчик события OnClick которой у меня получился таким:


procedure TForm1.Button1Click(Sender: TObject);  
var a:array[1..20] of TEdit; // массив элементов Edit  
      b:array[1..10] of TLabel; //массив меток  
      i,j:integer;  
begin  
 for i:=1 to 20 do begin  
 a[i]:=TEdit.create(self);  
 a[i].parent:=form1;  
 a[i].left:=10;  
 a[i].text:='элемент # '+inttostr(i);  
 a[i].top:=i*20;  
end;  
for j:=1 to 10 do begin  
 b[j]:=TLabel.create(self);  
 b[j].parent:=form1;  
 b[j].left:=200;  
 b[j].Caption:='элемент # '+inttostr(j);  
 b[j].top:=j*30;  
end;  
end;  

Ну как?! Иногда воспользоваться массивом компонентов очень даже удобно, потому что в массиве обращение к его элементам происходит по индексу, а в обычной ситуации обращение происходит по имени компонента, что не всегда удобно.

Автор: Михаил Христосенко

Добавлено: 07 Августа 2018 21:38:37 Добавил: Андрей Ковальчук

Создание заставок для ваших программ

Наверно, каждый программист на Дельфи хоть раз хотел создать к какой-нибудь своей программе заставку. В этой статье мы рассмотрим создание заставок в Дельфи. Тому кто умеет работать более чем с одной формой в приложении, будет очень легко это понять. Чтобы не вдаваться в теорию, начнем сразу с практики.

Откройте какое-нибудь свое приложение, к которому вы хотите добавить заставку, или создайте новое (на чистом проще разбираться). Теперь необходимо добавить в наш проект еще одну форму, которая будет заставкой. Для этого нажмите File->New Form и Дельфи создаст вам новую форму. Измените ее размеры как вам хочется. Потом установите свойство Border Style вашей формы в bsNone (у формы не будет заголовка и системных кнопок), установите свойство Visible в false. Свойтсво Position должно быть poScreenCenter - это значит, что форма появится по центру экрана. И чтобы не перепутать эту форму ни с какой другой задайте ей имя Logo.

Настройка формы заставки произведена, теперь необходимо сделать, чтобы по щелчку мышкой по этой форме или после нажатия клавиши или по истечении 5 секунд форма-заставка закрывалась. Для этого установите на форму Timer, его свойству Interval задайте значение 5000 (форма будет закрываться через 5 секунд). В обработчик события OnTimer напишите всего одно слово: Close;

В обработчик события OnClick для формы-заставки напишите тоже самое. Установите свойство формы KeyPreview в true (это делается для того, чтобы при нажатии любой клавиши вначале реагировала форма, а затем тот элемент, который был в фокусе в момент нажатия). А в обработчик события OnKeyPress (для формы-заставки конечно же) опять-таки напишите close;

Форма-заставка готова полностью и теперь необходимо, чтобы она запускалась перед главной формой. Для этого сделайте активной вашу главную форму, перейдите на вкладку Events в Object Inspector'e и выберите событие OnShow. В обработчике этого события надо написать следующее:


logo.showmodal;  

Меня иногда спрашивают, чем отличаются процедуры show и showmodal. У них только одно принципиальное различие: если форма открылась методом Showmodal, то пока она не закроется пользователь не сможет взаимодействовать с остальными формами приложения. А если форма была открыта методом Show, то пользователь легко может перейти к любой форме приложения.

Итак, форма-заставка готова. Теперь мы слегка ее усовершенствуем. Добавим такую же штуку, как в формах-заставках Microsoft Office, а именно на форме будет показываться имя пользователя и организация. Для этого разместите на форме-заставке две метки (Label). Первую назовите UserName, а вторую - Organization. Чтобы это сделать мы воспользуемся реестром (тас вообще очень много интересного можно найти). Теперь откройте обработчик события OnCreate для формы-заставки и объявите там переменную R типа TRegistry, а в раздел Uses всей программы добавьте Registry. Теперь нам нужно создать объект R :


R:=TRegistry.Create;  
R.RootKey:=HKEY_LOCAL_MACHINE;  
//именно здесь эта информация хранится  
R.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion', False);  

Теперь необходимо прочитать нужные строки из этого раздела реестра и присвоить их соответствующим меткам:


UserName.Caption:=r.readstring('RegisteredOwner');  
Organization.Caption:=r.readstring('RegisteredOrganization');  
r.Free; //надо уничтожить этот объект, так как он нам больше не нужен  

Таким образом весь этот обработчик должен иметь примерно такой вид:


procedure TLogo.FormCreate(Sender: TObject);  
var R:Tregistry;  
begin  
R:=TRegistry.Create;  
R.RootKey:=HKEY_LOCAL_MACHINE;  
R.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion', False);  
UserName.Caption:=r.readstring('RegisteredOwner');  
Organization.Caption:=r.readstring('RegisteredOrganization');  
r.Free;  
end;  

Ну вот собственно и все что я хотел вам рассказать о заставках. Теперь ваши программы будут выглядеть более солидно. Но помните, что при создании небольших, вспомогательных программ, объем которых не превышает килобайт 100-150 заставки лучше не использовать.

Удачи в программировании...

Автор: Михаил Христосенко

Добавлено: 07 Августа 2018 21:36:57 Добавил: Андрей Ковальчук

События, происходящие в приложениях Delphi при завершении работы Windows

Я провел небольшое исследование, и вот что я выяснил:

При закрытии приложения (используя системное меню или вызывая метод закрытия формы), возникают следующие события:

FormCloseQuery - действие по умолчанию, устанавливает переменную CanClose в значание TRUE и продолжает закрытие формы.
FormClose
FormDestroy
Если приложение активно и вы пытаетесь завершить работу Windows (Shut Down), происходят следующие события (с соблюдением последовательности):

FormCloseQuery
FormDestroy
Мы видим, что метод FormClose в этом случае не вызывается.

Теперь воспроизведем всю последовательность событий, происходящую при попытке завершить работу Windows:

Windows посылает сообщение WM_QUERYENDSESSION всем приложениям и ожидает ответ.
Каждое приложение получает сообщение и возвращает одну из величин: не равную нулю - приложение готово завершить свою работу, 0 - приложение не может завершить свою работу.
Если одно из приложений возвращает 0, Windows не завершает свою работу, а снова рассылает всем окнам сообщение, на этот раз WM_ENDSESSION.
Каждое приложение должно снова подтвердить свою готовность завершить работу, поэтому операционная система ожидает ответа TRUE, резонно предполагая, что оставшиеся приложения с момента предыдущего сообщения закрыли свои сессии и готовы завершить работу. Теперь посмотрим, как на это реагирует Delphi-приложение: приложение возвращает значение TRUE и немедленно вызывает метод FormDestroy, игнорируя при этом метод FormClose. Налицо проблема.
Завершение работы Windows.
Первое решение проблемы: приложение Delphi на сообщение WM_QUERYENDSESSION должно возвратить 0, не дав при этом Windows завершить свою работу. При этом бессмысленно пытаться воспользоваться методом FormCloseQuery, поскольку нет возможности определить виновника завершения работы приложения (это может являться как результатом сообщения WM_QUERYENDSESSION, так и просто действием пользователя при попытке закрыть приложение).

Другое решение состоит в том, чтобы при получении сообщения WM_QUERYENDSESSION самим выполнить необходимые действия, вызвав метод FormClose.

Пример:


unit Unit1;  
interface  
uses  
   
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms,  
  
Dialogs;  
type  
   
TForm1 = class(TForm)  
procedure FormClose(Sender: TObject; var Action: TCloseAction);  
private  
{--------------------------------------------------------}  
{ Объявляем свой обработчик сообщения WM_QUERYENDSESSION }  
{--------------------------------------------------------}  
procedure WMQueryEndSession(  
var Message: TWMQueryEndSession); message WM_QUERYENDSESSION;  
public  
{ Public declarations }  
end;  
  
var  
   
Form1    : TForm1;  
  
  
implementation  
{$R *.DFM}  
  
{--------------------------------------------------------------}  
{ Создаем процедуру обработки сообщения WM_QUERYENDSESSION.    }  
{ Приложение получит только это сообщение при попытке Windows  }  
{ завершить работу                                             }  
{--------------------------------------------------------------}  
procedure TForm1.WMQueryEndSession(var Message: TWMQueryEndSession);  
begin  
   
inherited;   { сначала сообщание должен обработать наследуемый метод }  
{--------------------------------------------------------------------}  
{ в этой точке вы также можете сообщить Windows о неготовности       }  
{ приложения завершить работу...                                     }  
{ Message.Result:=0;                                                 }  
{-------------------------------------------или----------------------}  
{ вызов процедуры освобождения ресурсов, предусмотренной в FormClose }  
{ MyCleanUpProcedure;                                                }  
{--------------------------------------------------------------------}  
  
end;  
  
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);  
begin  
   
MyCleanUpProcedure;  
  
end;  
  
end.  

Я не тестировал этот код, но могу предположить, что он должен работать. Сообщите, если это не так!

Добавлено: 07 Августа 2018 21:36:04 Добавил: Андрей Ковальчук

Создать динамический массив

Массив, который может менять свой размер во время работы программы, нужен тогда, когда неизвестно количество элементов на стадии разработки программы. Например, Вам не известен размер изображения, которое нужно будет поместить в память.

Этот динамический массив основан на массиве Delphi. Поэтому обращение к нему быстро и удобно. Тип TArray – это массив нужного типа. 128 элементов можно заменить любым другим числом, хоть 0. Повлиять это может только на отладку программы, так как Delphi выведет (если уместится) именно это количество элементов. PArray – это указатель на TArray. При обращении к элементам массива для Delphi главное, чтобы этот элемент существовал в памяти, то есть, чтобы под него была выделена память. А проверять, находится ли номер нужного элемента между 0 и 127 Delphi не будет.

Главным методом объекта является SetCount. Он сделан таким образом, что при изменении количество элементом старые данные не теряются, а новые элементы всегда обнуляются.

Процедура Reset обнуляет все существующие элементы.

Для того чтобы сделать этот массив, например, массивом целых чисел нужно поменять все double на integer или еще что-то.

Если Ваша программа часто обращается к элементам массива, то имеет смысл создать переменную типа PArray и присвоить ей адрес данных (поле p динамического массива), а дальше обращаться к ней, как к самому обыкновенному массиву. Только не забудьте обновлять эту переменную при изменении количества элементов.


type  
  TForm1 = ...  
    ...  
  end;  
  
  TArray = array [0..127] of double;  
  PArray = ^TArray;  
  TDynArray = object  
    p: PArray;  
    count: integer;  
    constructor Create(ACount: integer); { инициализация }  
    procedure SetCount(ACount: integer); { установка количества 
                                           элементов }  
    procedure Reset; { обнуление данных }  
    destructor Destroy; { уничтожение }  
  end;  
  
var  
  Form1: TForm1;  
  
implementation  
  
{$R *.DFM}  
  
constructor TDynArray.Create(aCount: integer);  
begin  
  p := nil;  
  count := 0;  
  SetCount(ACount);  
end;  
  
procedure TDynArray.SetCount(ACount: integer);  
var  
  np: PArray;  
begin  
  if count = ACount then Exit;  
  if p = nil then begin { память не была выделена }  
    if ACount <= 0 then begin { новое количество элементов 
                                в массиве равно 0 }  
      count := 0;  
    end else begin  { новое количество элементов в массиве 
                      больше 0 }  
      GetMem(p, ACount * sizeof(double)); { выделение памяти }  
      fillchar(p^, ACount * sizeof(double), 0); { обнуление данных }  
      count := ACount;  
    end;  
  end else begin  
    if ACount <= 0 then begin { новое количество элементов в 
                                массиве равно 0 }  
      FreeMem(p, count * sizeof(double)); { освобождение памяти }  
      count := 0;  
    end else begin  
      GetMem(np, ACount * sizeof(double)); { выделение памяти }  
      if ACount > count then begin { требуется увеличить 
                                     количество элементов }  
        move(p^, np^, count * sizeof(double)); { перемещение 
                                старых данных на новое место }  
        fillchar(np^[count], (ACount - count) * sizeof(double),  
          0); { обнуление новых элементов массива }  
      end else begin  
        move(p^, np^, ACount * sizeof(double)); { перемещение  
                           части старых данных на новое место }  
      end;  
      FreeMem(p, count * sizeof(double)); { освобождение старой 
                                            памяти }  
      p := np;  
      count := ACount;  
    end;  
  end;  
end;  
  
procedure TDynArray.Reset;  
begin  
  fillchar(p^, count * sizeof(double), 0); { обнуление данных }  
end;  
  
destructor TDynArray.Destroy;  
begin  
  SetCount(0);  
end;  
  
procedure TForm1.Button1Click(Sender: TObject);  
var  
  a: TDynArray;  
  i: integer;  
  s: string;  
begin  
  a.Create(3);  
  a.p[0] := 10;  
  a.p[1] := 20;  
  { второй элемент не указывается, но вследствие обнуления 
    при создании массива он равен 0 }  
  s := 'Элементы в массиве:';  
  for i := 0 to a.count - 1 do  
    s := s + #13#10 + IntToStr(i+1) + ': ' + FloatToStr(a.p[i]);  
  ShowMessage(s);  
  
  a.SetCount(4);  
  a.p^[3] := 50;  
  { значения первых элементов не теряются }  
  s := 'Элементы в массиве:';  
  for i := 0 to a.count - 1 do  
    s := s + #13#10 + IntToStr(i+1) + ': ' + FloatToStr(a.p[i]);  
  ShowMessage(s);  
  
  a.Destroy;  
end;  

Добавлено: 07 Августа 2018 21:35:15 Добавил: Андрей Ковальчук

Пример авторизации на сайте с помощью idHTTP.Post

Несмотря на то, что все мои заготовки статей канули в Лету вместе с другими данными (в том числе исходниками), которые были на флешке, я не пала духом и попытаюсь написать что-нибудь полезное заново.

Сегодня расскажу, как использовать idHTTP.Post для авторизации на сайте. Я возьму для примера сайт LiveJournal.com.

Немного теории для начинающих. Итак, вызов метода Post компонента idHTTP отличается от вызова Get-а только тем, что помимо URL-а необходимо передать параметры. Параметры можно передавать в виде StringList-а, или каких-нибудь Stream-ов, или чего-нибудь еще подходящего.)

Пример Post-процедуры (параметры передаются в виде StringList-а):


procedure TForm1.Button1Click(Sender: TObject);  
var  
  LoginInfo: TStringList;  
  Response: TStringStream;  
begin  
  try  
    LoginInfo := TStringList.Create;  
    Response := TStringStream.Create('');  
    LoginInfo.Add('username=MyName');  
    LoginInfo.Add('password=MyPass');  
    IdHTTP1.Post('http://mywebsite.xxx/login.php',LoginInfo,Response);  
    Showmessage(Response.DataString);  
  finally  
    begin  
      Response.Free;  
      LoginInfo.Free;  
    end;  
  end;  
end;  

Пример Post-функции (параметры передаются в виде IdMultiPartFormDataStream-а):


uses IdMultipartFormData;  
{ .... }  
  
procedure TForm1.Button1Click(Sender: TObject);  
var  
  data: TIdMultiPartFormDataStream;  
begin  
  data := TIdMultiPartFormDataStream.Create;  
  try  
    // добавляем нужные параметры  
    data.AddFormField('param1', 'value1');  
    data.AddFormField('param2', 'value2');  
    // для примера выводим в мемо все, что вернулось  
    Memo1.Lines.Text := IdHTTP1.Post('http://localhost/script.php', data);  
  finally  
    data.Free;  
  end;  
end;  

Сейчас попробуем применить полученные знания. Идем на LiveJournal.com, включаем сниффер, логинимся на сайте и смотрим, какие параметры надо передавать ('mode=login', 'user=логин', 'password=пароль'). Авторизация не произойдет, если на стороне клиента не будут сохранены кукисы. Для сохранения кукисов среди компонентов Indy существует TidCookieManager. IdCookieManager подключается к idHTTP через свойство CookieManager.


idHttp.CookieManager := IdCookieManager;  

В этом случае при запросах в заголовок добавляются кукисы, автоматически сохраненные в IdCookieManager. IdCookieManager можно найти на закладке Indy Misc или создать динамически.



Поместим на форму 2 TEdit-а, TMemo и кнопку, на которую повесим следующий работающий код авторизации:


procedure TForm1.Button1Click(Sender: TObject);  
var  
  Http  : TidHttp;  
  CM    : TidCookieManager;  
  Data  : TStringList;  
  StrPage, UserID,  UserName  :  String;  
  i : integer;  
begin  
  try  
    Http := TIdHTTP.Create(Self);  
    Data := TStringList.Create;  
    CM := TidCookieManager.Create(Http);  
    Http.AllowCookies := true;  
    Http.CookieManager := CM;  
    Http.HandleRedirects := true;  
  
    Http.Request.Host:='livejournal.com';  
    Http.Request.UserAgent:='Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.0.10) Gecko/2009042316 Firefox/3.0.10';  
    Http.Request.Accept:='text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';  
    Http.Request.AcceptLanguage:='ru,en-us;q=0.7,en;q=0.3';  
    Http.Request.AcceptCharSet:='windows-1251,utf-8;q=0.7,*;q=0.7';  
    Http.Request.Referer:='http://www.livejournal.com/';  
  
    Data.Add('mode=login');  
    Data.Add('user=' + Edit1.Text);  
    Data.Add('password=' + Edit2.Text);  
    StrPage := Http.Post('http://www.livejournal.com/login.bml?ret=1', Data);  
  finally  
    Data.Free;  
    CM.Free;  
    Http.Free;  
  end;  
  
  if Pos('<input class="logoutlj_hidden" id="user" name="user" type="hidden" value="'+Edit1.Text,StrPage) <> 0 then  
    ShowMessage('Авторизация прошла успешно')  
  else  
    ShowMessage('Авторизация провалилась');  
  
  Memo1.Lines.Text := StrPage;  
end;  

Возвращенные заголовки (после ответа сервера) можно посмотреть так:


idHttp.Response.RawHeaders.GetText;  

Сохраненные в CookieManager-е кукисы можно посмотреть так:


for i := 0 to Http.CookieManager.CookieCollection.Count - 1 do  
  StrPage := StrPage + CM.CookieCollection.Items[i].CookieText + #13#10;  

Добавлено: 07 Августа 2018 21:34:31 Добавил: Андрей Ковальчук

Работа с динамическими массивами в Delphi

Что такое динамический массив? Динамический массив есть контейнер, содержащий определенное число данных, которые могут быть записаны либо извлечены для каких-нибудь с ними действий. Проще говоря, это лимитированный список различных значений одной переменной (Integer, String и т.д.), каждый из которых можно затребовать простым указанием порядкового номера. Зачем он нужен? как с ним работать? — читайте далее и всё поймете.

Прежде всего, надо продекларировать наш массив (то бишь записать его название). Название массива имеет такой вид:


<Имя_Массива>: Array[<область_определения>] of <Тип_переменных>
Идентификаторы Array и of постоянны, так что их нужно указывать в любом случае. Имя массива зависит только от вашей фантазии. Область определения имеет вид [X..Y], где первая величина — наименьшее значение числа определяемых параметров, вторая — наибольшее. Заметьте, данное свойство указывается именно в квадратных скобках — собственно значения X и Y входят в область определения массива. Повторю, что эти значения определяют именно порядковые номера хранящихся в массиве значений и предназначены для их чтения («вытаскивания» из массива) посредством указания порядкового номера. X и Y могут быть только простыми числами. Так же они могут быть частями какого-либо упорядоченного целого: например, можно указать [‘а’..’я’], и массив будет состоять из тридцати трех значений (по числу букв алфавита).

Далее после идентификатора of указывается тип переменных, в котором хранятся данные в массиве. Если это Boolean, то всякий параметр может иметь значение только True или False. Если Integer — то этот же параметр является простым числом, и т.д.

Сейчас мы по всем правилам продекларируем какой-нибудь массив:


EditArray: Array[1..5] of String  

Наметанным глазом можно прочитать здесь следующее: имеется массив с именем EditArray, в котором хранится пять различных значений типа String (текст). Кажется, всё правильно :). Но этот массив пуст: в нем нет еще никаких данных. Сейчас мы используем его, чтобы запомнить строковую информацию, содержащуюся в TEdit’ах и, когда нужно, достать ее.

Выложите на форму пять компонентов TEdit и две кнопки. Назовите их GetBtn и ResultBtn. Чтобы можно было отличать строки ввода друг от друга, измените им в редакторе свойств параметр Tag: у Edit1 на «1», у Edit2 на «2» и так далее вплоть до «5» у Edit5.


//...  
var  
Form1: TForm1;  
EditArray: Array[1..5] of String;  
//...  
  
//записываем информацию в массив  
procedure TForm1.GetBtnClick(Sender: TObject);  
var  
i: integer;  
begin  
//перебираем все компоненты   
for i:=0 to ComponentCount-1 do  
if Components[i] is TEdit then  
EditArray[TEdit(Components[i]).Tag]:=TEdit(Components[i]).Text;  
end;  
   
//читаем информацию из массива  
procedure TForm1.SetBtnClick(Sender: TObject);  
var  
i: integer;  
begin  
for i:=0 to ComponentCount-1 do  
if Components[i] is TEdit then  
TEdit(Components[i]).Text:=EditArray[TEdit(Components[i]).Tag];  
end;  

Теперь введите в Edit’ы какой-нибудь текст и нажмите GetBtn. Сотрите текст и нажмите ResultBtn.

Ага! Вот мы и поработали с декларированным массивом. Но надо иметь ввиду, что есть и константированные массивы с изначально записанными значениями, которые нельзя изменить. Такие массивы прописываются в разделе const. Они полезны, когда нужно выполнить множество низкоуровневых операций.

В одном из последних выпусков журнала «Хакерспец» вебмастерам предлагался весьма простой способ обозначить копирайт текстов своего сайта: менять некоторые русские буквы на латинские, которые выглядят точно так же. (Чтобы, буде информацию все-таки умыкнут, можно было воспользоваться этим отличием для подтверждения авторских прав). Вот моя реализация данного совета с помощью констатированного массива. Осчастливьте вашу форму компонентами TRichEdit и TButton, по событию OnClick последнего поставьте следующий код:


procedure TForm1.Button1Click(Sender: TObject);  
const  
RusSymbols: Array[1..10] of ShortString = ('а','с','о','р','х','А','С','О','Р','Х');  
EngSymbols: Array[1..10] of ShortString = ('a','c','o','p','x','A','C','O','P','X');  
var  
i, position: integer;  
Text: String;  
begin  
Text:=RichEdit1.Lines.Text;  
repeat  
//Массив состоит из десяти символов,   
//поэтому цикл повторится 10 раз.  
for i:=1 to 10 do begin  
position:=pos(RusSymbols[i],Text);  
if position>0 then begin  
delete(Text,position,1);  
insert(EngSymbols[i],Text,position);  
end;  
end;  
until position<=0;  
RichEdit1.Lines.Text:=Text;  
end;  

Закодируйте таким образом какой-нибудь текст и проверьте правописание полученного в MS Word.

Теперь вы знаете простейшие примеры работы с динамическими массивами.

Автор: Трофим Роцкий

Добавлено: 07 Августа 2018 21:33:28 Добавил: Андрей Ковальчук

Фрактальные множества Delphi

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

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

Итак приступим к самому главному, ради чего мы здесь и собрались. Как же строятся эти удивителные множества ?

Все сводится к вычислению одной единственной формулы.


Zi+1=Zi2+C   

Здесь Z и C - комплексные числа. Как видно, формулы по сути представляет собой обычную рекурсию (или что-то вроде многократно примененного преобразования). Зная правила работы с комплексными числами данную формулу можно упростить и привести к следующему виду.


xi+1=xi2-yi2+a  
yi+1=2*xi*yi+b  

Построение множества Мандельброта сводится к следующему. Для каждой точки (a,b) проводится серия вычислений по вышеприведенным формулам, причем x0 и y0 принимаются равными нулю, т.е. точка в формуле выступает в качестве константы. На каждом шаге вычиляется величина r=sqrt(x2+y2 ). Значением r ,как ни трудно заметить, является расстояние точки с координатами (x,y) от начала координат ( r=sqrt[ (x-0)2+(y-0)2] ). Исходная точка (a,b) считается принадлежащей множеству Мандельброта, если она никогда не удаляется от начала координат на какое-то критическое число. Для отображения можно подсчитать скорость удаления от центра, если например точка ушла за критическое расстояние, и в зависимости от нее окрасить исходную точку в соответствующие цвет. Полное изображение множества Мандельброта можно получить на плоскости от -2 до 1 по оси x и от -1.5 до 1.5 по оси y. Также известно, что для получения примелимой точности достаточно 100 итеарций (по теории их должно быть бесконечно много). Ниже представлен листинг функции реализующей выполнение итераций и определение принадлежности точки множеству Мандельброта, точнее на выходе мы получаем цвет для соответствующе точки. В качестве критического числа взято число 2. Чтобы не вычислять корень, мы сравниваем квадрат расстояния (r2) с квадратом критического числа, т.е. сравниваем (x2+y2) и 4.


function MandelBrot(a,b: real): TColor;  
var  
    x,y,xy: real;  
    x2,y2: real;  
    r:real;  
    k: integer;  
begin  
    r:=0;  
    x:=0; y:=0;  
    k:=100;  
    while (k>0)and(r<4) do  
    begin  
        x2:=x*x;  
        y2:=y*y;  
        xy:=x*y;  
        x:=x2-y2+a;  
        y:=2*xy+b;  
        r:=x2+y2;  
        dec(k)  
    end;  
    k:=round((k/100)*255);  
    result:=RGB(k,k,k);  
end;   

Множество Жюлиа получается если зафиксировать в формуле значение комплексной константы (a+ib), которая будет одинакова для всех точек, а начальные значения x0 и y0 принимать равными значениям координатам вычисляемой точки. Листинг для множества Жюлиа приведен ниже.


function Julia(x0,y0: real): TColor;  
var  
    a,b,x,y,x2,y2,xy: real;  
    r:real;  
    speed,k: integer;  
begin  
    r:=1;  
    a:=-0.55; b:=-0.55;  
    x:=x0; y:=y0;  
    k:=100;  
    while (k>0)and(r<4) do  
    begin  
        x2:=x*x;  
        y2:=y*y;  
        xy:=x*y;  
        x:=x2-y2+a;  
        y:=2*xy+b;  
        r:=x2+y2;  
        dec(k)  
    end;  
    k:=round((k/100)*255);  
    result:=RGB(k,k,k);  
end;   

Ниже приведен листинг функции отображающий данные множества.


procedure TForm1.BitBtn2Click(Sender: TObject);  
var  
    x_min,y_min,x_max,y_max,hx,hy,x,y: real;  
    i,j,n: integer;  
    color: TColor;  
begin  
    x_min:=-1.5; x_max:=2;  
    y_min:=-1.5; y_max:=1.5;  
    n:=300;  
    y:=y_min;  
    hx:=(x_max-x_min)/n;  
    hy:=(y_max-y_min)/n;  
    for j:=0 to n do  
    begin  
        x:=x_min;  
        for i:=0 to n do  
        begin  
            if rbM.Checked then color:=MandelBrot(x,y);  
            if rbJ.Checked then color:=Julia(x,y);  
            imPict.Picture.Bitmap.Canvas.Pixels[i,j]:=color;  
            x:=x+hx;  
        end;  
        y:=y+hy;  
    end;  
end;   

При рассмотрении темы большую помощь оказала статья А.Колесникова "Визуализация фрактальных структур" в "Компьтерных вестях".

Добавлено: 07 Августа 2018 21:32:09 Добавил: Андрей Ковальчук

ШИФРОВАНИЕ В DELPHI

Данные надо беречь. Сам посуди, обидно, если открытие ценой в сто миллионов енотов или рецепт безалкогольной водки, над которым ты корпел три вечера в мрачном подвале нелегального компьютерного клуба, — уплывет к злостному ленивому конкуренту, который, пользуясь твоим похмельем, наложил грязную лапу на приватные дискеты с ценнейшей инфой?! Дальше можно не продолжать. Шифруем, шифруем, шифруем!..

Добрый дядюшка Borland предоставил нам несколько занятных функций для работы со строками, о которых не все знают. Сосредоточены они в модуле StrUtils.pas. Такие функции, как RightStr, LeftStr совмещают стандартные команды Copy и Delete: так, LeftStr возвращает значение левой части строки до указанной вами позиции (что вытворяет RightStr, догадайся сам), а функция ReverseString и вовсе делает зеркальное отображение данной строки: 321 вместо 123. Используем ее в особенности, чтобы осложнить жизнь хитрому дешифровщику.
Алгоритм шифрования будет прост, как Win 3.1. С каждым символом кодируемого документа проделаем следующее:

Преобразуем символ в число командой Ord.
Преобразуем каждый символ пользовательского пароля в число и сумму этих чисел прибавим к полученному в пункте 1.
От результата отнимаем число, равное позиции данного символа. То есть буковки будут шифроваться по-разному в зависимости от их позиции в строке :).
То, что получилось, запишем обратно из чисел в символы командой Chr. Как видишь, после всех наших манипуляций этот символ уже будет другим.
Запишем всю строку навыворот командой ReverseString.
Дешифровка, как ты догадываешься, будет производиться в обратном порядке.
Теперь, когда алгоритм намертво засел в голове, реализуем соответствующую программу. Внимание! Не исключено, что это будет первая твоя программа с настоящим синтаксисом команд:
<команда> <путь> <пароль>
— так будет выглядеть он в консоли нашего приложения (да, оно будет консольным!). Команд всего две: crypt и decrypt — соответственно зашифровать и дешифровать файл, путь к которому указывается после пробела, а затем — твой пароль. НЕ ЗАБУДЬ ЕГО! Предупреждаю совершенно серьезно. Запомнил? В бой!

Crypt C:\file.txt linuxmustsurvive

— закодируем File.txt. Результат (зашифрованный текст) сохраниться в той же директории, что и исполняемый файл нашего приложения под именем Translated_File.txt.

Decrypt C:\Translated_file.txt linuxmustsurvive

— дешифровка.
Реализовывается это вот как:


program Crypter;  
  
{$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:=LeftStr(CryptStr,1);  
CryptStr:=RightStr(CryptStr,Length(CryptStr)-1);  
//ШИФРОВКА:  
s:=chr(ord(s[1])+Password(PassW)-i);  
result:=result+s;  
end;  
result:=ReverseString(result);  
end;  
  
function Decrypt(DecryptStr: String): String;  
var  
i: integer;  
s: String;  
begin  
DecryptStr:=ReverseString(DecryptStr);  
if DecryptStr<>EmptyStr then  
for i:=1 to Length(DeCryptStr) do begin  
s:=LeftStr(DeCryptStr,1);  
DeCryptStr:=RightStr(DeCryptStr,Length(DeCryptStr)-1);  
//ДЕШИФРОВКА:  
result:=result+chr(ord(s[1])-password(PassW)+i);  
end;  
end;  
  
begin  
while true do begin  
isCrypt:=0;  
writeln(#10+'Crypter >'+#10);  
//Какую команду ввел юзер?  
readln(ToDo);  
if UpperCase(ToDo)='EXIT' then Exit;  
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 года, производить и распространять любые шифрующие средства можно, только имея лицензию ФАПСИ. Соответственно, шифровать нельзя :). Поэтому пиши программы только для личного пользования и только в познавательных целях.

Автор: Трофим Роцкий

Добавлено: 07 Августа 2018 21:31:09 Добавил: Андрей Ковальчук

Работа с форматом M3U

Интро.

Поводом для написания этой статьи послужило то, что я в Интернете не нашёл ни одной подобной статьи, описывающей такой формат. Начнём с назначения m3u файлов. Не для кого, думаю, не секрет, что этот тип файлов используется в WinAmp 'е для (со)хранения «плей листа». В этой статье мы рассмотрим запись и чтение m3u файлов.

Ближе к делу. Теория.

Формат этого файла таков: в начале файла есть служебное слово [#EXTM3U], означающее, что выбранный нами файл действительно m3u. Далее идут строки вида:

#EXTINF:120,Вася барабанщик – Kill My
My Music\Kill_My.mp3


Где [#EXTINF:] служебное слово, [120] – длина трека в секундах, [Вася барабанщик – Kill My ] – тэг, а [ My Music\Kill_My.mp3] – путь к файлу. Причём путь к файлу не полный и зависит от места расположения m3u файла. Пример: m3u файл находится в папке X:\ Music, а муз. файлы в X:\Music\My Music\Kill_My.mp3, тогда путь к файлу в плей листе будет My Music\Kill_My.mp3. А если файл музыки и файл плей листа будут на разных дисках, то путь будет полным. К чему такие сложности я не знаю, ведь можно просто писать полный путь и никаких проблем не будет. И ещё, если переместить файл плей листа, то WinAmp (и др. программы) не смогут воспроизвести файл, так как не найдут путь к нему. (При условии, что путь неполный).

Ближе к делу. Практика.

Казалось бы неполный путь к файлу создаёт нам дополнительные проблемы. Это так. Но я написал функцию, которая восстанавливает этот путь. Итак, рассмотрим на примере, как можно загрузить в ListView данные из m3u файла. На форму помещаем ListView с тремя колонками. 1-я колонка – тэг, 2-я – длина трека, 3-я – путь. И добавим OpenDialog, для открытия файла, и кнопочку.


function NotFullPathToFullPath(FM3U, FM: string): string;  
(*Из неполного пути -> полный*)  
var  
  Ress: string;  
begin  
  Ress := '';  
  Result := '';  
(*Если 1-й символ ‘\’, то просто добавляем букву диска*)  
  if FM[1] = '\' then  
  begin  
    Result := ExtractFileDrive(FM3U) + FM;  
    exit;  
  end else  
  begin  
(*Путь к m3u + неполный путь к файлу*)  
    if FileExists(ExtractFilePath(FM3U) + FM) then  
    begin  
      Result := ExtractFilePath(FM3U) + FM;  
      exit;  
    end;  
(*А вдруг путь уже полный?*)  
    if FileExists(FM) then  
    begin  
      Result := FM;  
      exit;  
    end;  
  end;  
end;  
  
procedure ReadM3U(files: string);  
(*Чтение m3u*)  
(*Думаю всё и так понятно без комментариев ;)*)  
var List: TStringList;  
  i, n: integer;  
  s, a: string;  
  ListItem: TListItem;  
begin  
(*Очищаем ЛистВив*)  
  Form1.ListView1.Clear;  
  List := TStringList.Create;  
  try  
    List.LoadFromFile(files);  
    for i := 0 to List.Count - 1 do  
    begin  
(*Первая строка – «#EXTM3U»? Если да, то это файл m3u*)  
      if List.Strings[0] = '#EXTM3U' then  
      begin  
        s := List.Strings[i];  
        if s[1] <> '#' then  
        begin  
          ListItem.SubItems.Add('');  
          s := NotFullPathToFullPath(Files, s);  
          ListItem.SubItems[1] := s;  
        end else  
        begin  
          if s <> '#EXTM3U' then  
          begin  
            Delete(S, 1, 8);  
            a := '';  
            n := 1;  
            repeat  
              a := a + s[n];  
              Inc(n);  
            until s[n] = ',';  
            Delete(S, 1, Length(a) + 1);  
            ListItem := Form1.ListView1.Items.Add;  
            ListItem.Caption := s;  
            ListItem.SubItems.Add(Format('%d:%.2d', [StrToInt(a) div 60, StrToInt(a) mod 60]));  
          end;  
        end;  
      end;  
    end;  
  finally  
    List.Free;  
  end;  
end;  

А вызывать будем по кнопке:


procedure TForm1.Button1Click(Sender: TObject);  
begin  
  if OpenDialog1.Execute then  
    ReadM3U(OpenDialog1.FileName) else exit;  
end;  

Так. Открытие мы сделали. Можете открыть свой плей лист, сохраненный в WinAmp'е и вглянуть на то, что получилось. Перейдём к сохранению. Положите на форму ещё одну кнопку и в путь. Не забудьте подключить модуль StrUtils.


function ExtNotFullPath(FM3U, FM: string): string;  
(*Из полного пути в неполный*)  
var  
  i: integer;  
  Ress: string;  
begin  
  Ress := '';  
  Result := '';  
  for i := 1 to Length(FM3U) do  
  begin  
    if FM3U[i] = FM[i] then  
    begin  
      Ress := Ress + FM3U[i];  
      if FM3U[i] = '\' then Result := Ress;  
    end else exit;  
  end;  
end;  
  
function MinToSec(tim: string): string;  
(*Это такой компьютерный юмор, функция из минут в секунды, результат String ;)*)  
(*Помнишь мы секунды преобразовывали в минуты? Вот теперь всё наоборот*)  
var n: integer;  
  a: string;  
begin  
  n := 1;  
  a := '';  
  repeat  
    a := a + tim[n];  
    Inc(n);  
  until tim[n] = ':';  
  Delete(tim, 1, Length(a) + 1);  
  result := IntToStr((StrToInt(a) * 60) + StrToInt(tim));  
end;  
  
procedure SaveList(SaveFile: string);  
(*Сохранение...*)  
var List: TStringList;  
  i: integer;  
  b, s: string;  
begin  
  List := TStringList.Create;  
  List.Add('#EXTM3U');  
  for i := 0 to Form1.ListView1.Items.Count - 1 do  
  begin  
    s := '';  
    List.Add('#EXTINF:' + MinToSec(Form1.ListView1.Items.Item[i].SubItems.Strings[0]) + ',' + Form1.ListView1.Items.Item[i].Caption);  
    b := ExtNotFullPath(SaveFile, Form1.ListView1.Items.Item[i].SubItems.Strings[1]);  
    if Length(b) < Length(ExtractFilePath(SaveFile)) then  
    begin  
      s := Form1.ListView1.Items.Item[i].SubItems.Strings[1];  
      if b<>`` then //проверка, на одинаковых ли дисках?  
        Delete(s, 1, 2);  
    end else  
      s := AnsiReplaceText(Form1.ListView1.Items.Item[i].SubItems.Strings[1], b, '');  
    List.Add(s);  
  end;  
(*Сохраняем в файл*)  
  List.SaveToFile(SaveFile);  
  List.Free;  
end;  

А вот и кнопочка пригодилась :-)


procedure TForm1.Button2Click(Sender: TObject);  
begin  
  if SaveDialog1.Execute then  
  begin  
    if ExtractFileExt(SaveDialog1.FileName) = '.m3u' then  
      SaveList(SaveDialog1.FileName) else SaveList(SaveDialog1.FileName + '.m3u');  
  end;  
end;  

The End.

Добавлено: 07 Августа 2018 21:29:11 Добавил: Андрей Ковальчук

Работа с массивами в Delphi

Очень был удивлен когда к нам поступила просьба рассказать о массивах и о их сортировке в Delphi. Но раз уж поступила просьба, а сайт наш призван помочь в освоении Delphi, то я решил написать эту статью, в которой расскажу Вам о возможных действиях с массивами в Delphi. При этом мы напишем несколько пользовательских функций, которые будут помогать нам в дальнейшем при работе с массивами.

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

Давайте сейчас этим и займемся. Поставьте на Вашу форму кнопку Button и пооле редактирования Edit.

Заголовок нашей функции будет такой:


function GetSubStr(st:string; expl:string; n:integer):string;  

где

st - строка, содержащая массив
expl - строка разделитель
n - номер подстроки


function TForm1.GetSubStr(st:string; expl:string ;n:integer):string;  
Var p,i:integer;  
Begin  
for i:= 1 to n-1 do  
begin  
p:=pos(expl,st);  
st:=copy(st,p+1,Length(st)-p);  
while (pos(expl,st)=1) and (length(st)>0) do  
delete(st,1,1);  
end;  
p:=pos(expl,st);  
if p<>0 then result:=copy(st,1,p-1)  
else result:=st;  
End;  

Для получения n-ой подстроки (элемента массива) из полученной в качестве аргумента строки функция сначала удаляет предшествующую ей n-1 подстроку (цикл for), затем находит разделитель, который обозначает конец нужной подстроки, выделяет подстроку и возвращает ее в качестве значения функции (через свое имя).

Не забудьте добавить заголовок нашей функции в раздел Public модуля программы.

Теперь для проверки работы нашей функции напишем обработчик события OnClick, для нашей кнопки. В начале мы с помощью нашей функции получим массив из Edit1, а потом выведем его:


procedure TForm1.Button1Click(Sender: TObject);  
var i:integer;  
a:array[1..10] of string[10];  
st:string;  
begin  
for i:=1 to 10 do  
a[i]:=GetSubStr(Edit1.text,' ',i);//используем пробел в качестве разделителя  
  
for i:=1 to 10 do  
st:=st+IntTostr(i)+' '+a[i]+#13;  
ShowMessage(st);  
end;  

Поиск минимального (максимального) элемента массива
Будем искать минимальный элемент в целочисленном массиве. Для этого немного изменим обработчик события OnClick для кнопки:


procedure TForm1.Button1Click(Sender: TObject);  
var i:integer;//номер элемента, сравниваемого с минимальным  
a:array[1..10] of integer;   
min:integer;//номер минимального элемента  
  
begin  
//Введем массив  
for i:=1 to 10 do  
//Преобразуем полученные подстроки в числа  
a[i]:=StrToInt(GetSubStr(Edit1.text,' ',i));//используем пробел в качестве разделителя  
//Найдем минимальный элемент  
min:=1; //пусть номер минимального элемента = 1  
for i:= 2 to 10 do // начнем искать со следующего   
if a[i] < a[min] then min:=i;  
Form1.caption:=IntToStr(a[min]); // выводим в заголовок формы минимальный элемент  
end;  

В этом примере a
 минимальный элемент массива, а min - номер минимального элемента. Алгоритм очень простой: сравниваем каждый следующий элемент с минимальным, если он меньше минимального, то запоминаем его номер в переменной min, и продолжаем сравнивать уже с ним. 

Чтобы найти максимальный элемент, нужно изменить всего одну строку:


[DELPHI]>>> if a[i] < a[min] then min:=i;  

Надо заменить на:


if a[i] > a[min] then min:=i;  

Только теперь a
 - максимальный элемент, а min  - номер максимального элемента.

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

Элемент, совпадение с которым нам надо найти будем хранить в текстовом поле Edit2. Обработчик события OnClick нашей кнопки будет иметь такой вид:


[DELPHI]procedure TForm1.Button1Click(Sender: TObject);  
var i:integer;  
a:array[1..10] of integer;  
n:integer;//образец  
found:boolean;  
  
begin  
//Введем массив  
for i:=1 to 10 do  
//Преобразуем полученные подстроки в числа  
a[i]:=StrToInt(GetSubStr(Edit1.text,' ',i));//используем пробел в качестве разделителя  
  
  
n:=StrToInt(Edit2.text);  
found:=false;  
i:=1;  
REPEAT  
if a[i] = n then found:=true  
else i:=i+1;  
UNTIL (i > 10) or (found = true);  
if found then showmessage('Совпадение с элементом номер '+IntToStr(i));  
end;  

Сортировка массива
Вот мы и дошли до самого интересного - до сортировки массива. Рассмотрим алгоритм т.н. прямого выбора. Смысл его заключается в следующем:

Просматривая массив от первого элемента, найдем минимальный элемент и поместим его на место первого элемента, а первый элемент - на место минимального.

Затем будем просматривать массив, начиная со второго элемента, и далее поступим, как поступили перед этим шагом.

Алгоритм ясен, теперь приступим к написанию кода. Все тот же обработчик события OnClick принимает теперь такой вид:


procedure TForm1.Button1Click(Sender: TObject);  
var i,k,j,min:integer;  
buf:integer; // буфер для обмена  
a:array[1..10] of integer;  
st:string;  
begin  
//введем массив  
for i:=1 to 10 do  
a[i]:=StrToInt(GetSubStr(Edit1.text,' ',i));//используем пробел в качестве разделителя  
  
for i:=1 to 10 - 1 do // кол-во элементов минус один  
begin  
//поищем минимальный элемент  
min:=i;  
for j:=i+1 to 10 do  
if a[j] < a[min] then min:=j;  
//поменяем местами  
buf:=a[i];  
a[i]:=a[min];  
a[min]:=buf;  
end;  
  
for k:=1 to 10 do  
Form1.Caption:=Form1.caption + ' '+ IntToStr(a[k]);  
end;  

Ну вот мы и познакомились с самыми типичными действиями с массивами. Надеюсь эта статья оказалась Вам хоть немного полезной :)

Автор: Михаил Христосенко

Добавлено: 07 Августа 2018 21:28:08 Добавил: Андрей Ковальчук

Экспорт документов в Excel

Эта статья первая из цикла статей посвященных экспорту документов в MS Excel. В ней мы рассмотрим подключение к Excel, заполнению ячеек и простейшее оформление документа.

Я не буду углубляться в теорию, рассказывать о том как работает OLE механизм, начнем с самого главного.

Подключение.
Для подключения к Excel и работы с ним нам понадобится переменная типа Variant:


Excel:Variant;  

Далее создаем OLE объект:


Excel:=CreateOleObject('Excel.Application');  

Добавляем новую книгу:


Excel.Workbooks.Add;  

Показываем Excel:


Excel.Visible:=true;  

Так же нам понадобятся константы:


const  
xlContinuous=1;  
xlThin=2;  
xlTop = -4160;  
xlCenter = -4108;  

Текст ячеек.
Теперь до любой ячейки мы можем добраться следующим образом:


Excel.ActiveWorkBook.WorkSheets[1].Cells[1, 2]:='Текст ячейки (1,2)';  

Объект Range, выделение диапазона, объединение ячеек, выравнивание.
Представьте такую ситуацию: необходимо объединить несколько ячеек и выровнять текст в них по центру.

Выделяем:


Excel.ActiveWorkBook.WorkSheets[1].Range['A1:G1'].Select;  

Объединяем:


Excel.ActiveWorkBook.WorkSheets[1].Range['A1:G1'].Merge;  

И выравниваем:


Excel.Selection.HorizontalAlignment:=xlCenter;  

Границы и перенос по словам.
Для начала выделяем нужный диапазон а затем...

Показываем границы:


Excel.Selection.Borders.LineStyle:=xlContinuous;  
Excel.Selection.Borders.Weight:=xlThin;  

И включаем перенос по словам:


Excel.Selection.WrapText:=true;  


Параметры страницы.
Начнем с полей страницы. Во первых для того чтобы добраться до параметров страницы у листа Excel имеется свойство объект PageSetup его мы и будем использовать. Для установки размеров полей необходимо изменить соответствующие свойства PageSetup, вот эти свойства:

LeftMargin - Левое поле
RightMargin - Правое поле
TopMargin - Верхнее поле
BottomMargin - Нижнее поле
Значение размеров полей необходимо указывать в пикселях, к чему мы не очень привыкли, поэтому воспользуемся функцией InchesToPoints объекта Application, которая переводит значение в дюймах в значение в пикселях. Теперь напишем процедуру которая подключит Excel и установит поля равные 0.44 дюйма (приблизительно 1 см):


procedure Connect;  
var  
  Excel:Variant;  
begin  
  Excel:=CreateOleObject('Excel.Application');  
  Excel.Workbooks.Add;  
  
  Excel.ActiveSheet.PageSetup.LeftMargin:= Excel.Application.InchesToPoints(0.44);  
  Excel.ActiveSheet.PageSetup.RightMargin:= Excel.Application.InchesToPoints(0.44);  
  Excel.ActiveSheet.PageSetup.TopMargin:= Excel.Application.InchesToPoints(0.44);  
  Excel.ActiveSheet.PageSetup.BottomMargin:= Excel.Application.InchesToPoints(0.44);  
end;  

Иногда полезно уметь установить и ориентацию страницы:


Excel.ActiveSheet.PageSetup.Orientation:= 2;  

Здесь значение ориентации = 2, означает альбомную, при книжной ориентации присвойте Orientation значение 1.

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


Excel.ActiveSheet.PageSetup.PrintTitleRows:='$2:$3';  

Здесь мы указываем вторую и третью строки для печати на каждой странице.

Шрифты и цвета.
Для установки шрифта и размера текста выделите нужный диапазон и установите свойство Name объекта-свойства Font объекта Selection или свойство Size для изменения размера:


Excel.ActiveWorkBook.WorkSheets[1].Range['F1'].Select;  
Excel.Selection.Font.Name:='Courier New';  
Excel.Selection.Font.Size:=18;  

Если Вы хотите установить жирный или, например, наклонный стиль написания текста установите соответствующие свойства:


Excel.ActiveWorkBook.WorkSheets[1].Range['G1'].Select;  
Excel.Selection.Font.Bold:=true; // Для жирного текста  
Excel.Selection.Font.Italic:=true; // Для наклонного текста  

Для указания цвета текста измените свойство ColorIndex все того же объекта Font:


Excel.ActiveWorkBook.WorkSheets[1].Range['A1'].Select;  
Excel.Selection.Font.ColorIndex:=3;  

Вот несколько индексов цветов:

Индекс - Цвет
0 - Авто
2 - Белый
3 - Красный
5 - Синий
6 - Желтый
10 - Зеленый
Для изменения цвета фона ячейки используйте объект Interior свойства Selection:


Excel.ActiveWorkBook.WorkSheets[1].Range['H1'].Select;  
Excel.Selection.Interior.ColorIndex:=3; // Цвет  

Колонтитулы.
Для добавления колонтитула к документу достаточно указать его содержание:


Excel.ActiveSheet.PageSetup.LeftFooter:='Левый нижний колонтитул';  
Excel.ActiveSheet.PageSetup.CenterFooter:='Центральный нижний колонтитул';  
Excel.ActiveSheet.PageSetup.RightFooter:='Правый нижний колонтитул';  
Excel.ActiveSheet.PageSetup.LeftHeader:='Левый верхний колонтитул';  
Excel.ActiveSheet.PageSetup.CenterHeader:='Центральный верхний колонтитул';  
Excel.ActiveSheet.PageSetup.RightHeader:='Правый верхний колонтитул';  

Для изменения размера шрифта добавьте к колонтитулу управляющий символ "&" и размер шрифта:


Excel.ActiveSheet.PageSetup.LeftFooter:='&7Левый нижний колонтитул';  

Автор: JB

Добавлено: 07 Августа 2018 21:26:49 Добавил: Андрей Ковальчук

Ярлыки

Пользовательский интерфейс трудно представить без ярлычков с оперативной подсказкой (Hints). Если задержать курсор, например, над кнопкой или компонентом палитры самой среды Delphi, появляется маленький прямоугольник яркого цвета (окно подсказки), в котором одной строкой сказано о названии этого элемента или связанном с ним действии. Delphi поддерживает механизмы создания и отображения таких ярлычков в создаваемых программах.

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


property ShowHint: Boolean;
Если свойство ShowHint установлено в True, и во время выполнения курсор задержался над компонентом на некоторое время, в окне подсказки высвечивается текстовая строка с подсказкой, которая задана свойством:


property Hint: string;  

Подсказка компонента может быть пустой строкой — в этом случае система ищет в цепочке первый родительский компонент с непустой подсказкой.

Если в строке Hint встречается специальный символ-разделитель "Г, то часть строки до него ("короткая") передается в окно подсказки, а после ("длинная") — присваивается свойству Hint объекта Application. Ее можно использовать, например, в строке состояния внизу главной формы приложения (см. пример ниже).

Система оперативных подсказок имеет свойства и методы, общие для всех форм в приложении. Не удивительно, что они сосредоточены в Application — глобальном объекте, соответствующем работающему приложению. Все описанные ниже в этом разделе свойства относятся не к компоненту, показывающему подсказку, а именно к Application.

Фоновый цвет окна подсказки можно изменить посредством свойства


property HintColor: TColor;  

У объекта Application значение свойства showHint нужно устанавливать во время выполнения, например, в обработчике OnCreate главной формы приложения. Оно является главенствующим для всей системы подсказок: если оно установлено в значение False, ярлычки не возникают.

Есть еще один способ получения подсказки. При смене текущего элемента управления (т. е. при смене текста в свойстве Hint) в объекте Application возникает событие


property OnHint: TNotifyEvent;   

Пример:


procedure TForml.AppHint(Sender: TObject);  
begin  
Panell.Caption:= Application.Hint;:  
end;  
procedure TForml.FormCreate(Sender: TObject);  
begin  
Application.OnHint := AppHint;  
end;  

В этом примере текст подсказки будет отображаться в строке состояния Panell независимо от значения showHint у любого объекта — лишь бы этот текст был в наличии. Для этого разделяйте подсказку у элементов управления вашего приложения на две части при помощи символа " |" — краткая информация появится рядом с элементом, а более полная — в строке состояния.


function GetLongHint(const Hint: string): string; function GetShortHint(const Hint: string): string;

У других компонентов свойство ShowHint интерпретируется системой так: когда курсор мыши останавливается над элементом управления или пунктом меню, и приложение не занято обработкой сообщения, происходит проверка, и если свойство showHint у элемента или у одного из его родительских элементов в иерархии равно True, то начинается ожидание.

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


property HintPause: Integer;  

Интервал времени по умолчанию равен 500 мс. Если в данный момент уже виден ярлычок другого компонента, то интервал времени ожидания задается свойством:


property HintShortPause: Integer;  

По истечении этого времени, если мышь осталась над тем же элементом управления, наступает момент инициализации окна подсказки. При этом программист может получить управление, предусмотрев обработчик события объекта Application:


property OnShowHint: TShowHintEvent;  
TShowHintEvent = procedure (var HintStr: string;  
var CanShow: Boolean;  
var Hintlnfo: THintlnfo) of object;  

Рассмотрим параметры обработчика события OnShowHint:

Hintstr — отображаемый текст;
CanShow — необходимость (возможность) появления подсказки. Если в переменной CanShow обработчик вернет значение False, то окно подсказки высвечиваться не будет;
Hintinfo — структура, несущая всю информацию о том, какой элемент управления, где и как собирается показать подсказку. Ее описание:

THintlnfo = record  
HintControl: TControl;  
HintPos: TPoint;  
HintMaxWidth: Integer;  
HintColor: TColor;  
CursorRect: TRect;  
CursorPos: TPoint;  
end;  

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


procedure TForml.AppShowHint(var HintStr: string;  
var CanShow: Boolean;var Hintlnfo: THintlnfo);  
begin if HintStr='' then  
begin  
HintStr := Hintlnfo.HintControl.Name; Hintlnfo.HintColor := clRed; CanShow := True;  
end;  
end;  

Присвоив этот метод обработчику Application.OnShowHint, установив Form.showHint:=True и очистив все строки Hint, получим в качестве подсказки имя каждого элемента.

Длительность показа ярлычка задается свойством


property HintHidePause: Integer;  

По умолчанию его значение равно 2500 мс.

Свойство


property HintShortCuts: Boolean;  

отвечает за показ вместе с текстом ярлычка описания "горячих" клавиш данного элемента управления.

Наконец, можно вручную "зажечь" и "потушить" ярлычок. При помощи метода


procedure ActivateHint(CursorPos: TPoint);  

ярлычок показывается в точке CursorPos (система координат — экранная). "Спрятать" окно подсказки можно с помощью метода:


procedure CancelHint;  

Без повторного перемещения мыши на текущий элемент оно более не возникнет.

Добавлено: 07 Августа 2018 21:16:14 Добавил: Андрей Ковальчук

Создание COM-сервера

Всем привет!

Чем отличается программист от другого типа человека разумного?
Я думаю, постоянным желанием подшутить над братом меньшим - Человеком нормальным, благо способов для этого - великое множество. В реестре Windows неограниченное количество мест для автоматического запуска программ - сейчас нас интересует расширение оболочки - контекстное меню Эксплорера. Займемся созданием +СОМ-сервера который будет запускаться при вызове контекстного меню.
Сразу оговорюсь - на компе потенциального испытуемого должна стоять звуковая карта и, желательно, антивирус Касперского, чтобы испытуемому был хорошо известен вопль AVP при обнаружении вируса.

Для начала, создадим файл ресурса содержащего нужный нам вопль.
Создаем текстовый файл, пишем в нем на одной строке:

MYWAVE RCData C:\Temp\Infected.wav


(вместо C:\Temp\Infected.wav пишете реальный путь к *.wav файлу)
Сохраняем файл с именем WAVE.RC. Далее выполняем команду:

brcc32.exe C:\Temp\Wave.rc


(вместо C:\Temp\Wave.rc пишете реальный путь к Wave.rc файлу)
У нас получился файл ресурсов Wave.res который мы будем использовать дальше.

В примерах Delphi есть почти все, что нам нужно:

..:\Program Files\Borland\Delphi7\Demos\ActiveX\ShellExt\ContextM.pas


Немножко редактируем этот файл (в смысле выбрасываем ненужное - добавляем нужное) и получаем примерно это:


unit Unit1;  
  
interface  
  
uses  
  Windows, ActiveX, ComObj, Classes,  
  Dialogs, StdCtrls,  
  ShlObj;  
  
type  
  TInitWormHook = class(TComObject, IShellExtInit, IContextMenu)  
  protected  
    { IShellExtInit }  
    function IShellExtInit.Initialize = SEIInitialize;  
    function SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;  
      hKeyProgID: HKEY): HResult; stdcall;  
    { IContextMenu }  
    function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast,  
      uFlags: UINT): HResult; stdcall;  
    function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;  
    function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;  
      pszName: LPSTR; cchMax: UINT): HResult; stdcall;  
  end;  
  
  function DllGetClassObject(const CLSID, IID: TGUID; var Obj): HResult; stdcall;  
  function DllCanUnloadNow: HResult; stdcall;  
  
const  
  Class_ContextMenu: TGUID = '{1A39ADB3-5ED9-44F4-B6BA-5B3D41255033}';  
  
implementation  
  
uses ComServ, SysUtils, ShellApi, Registry, Graphics, mmSystem;  
  
//Цепляем наш ресурс  
{$R wave.res}  
  
function TInitWormHook.SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;  
  hKeyProgID: HKEY): HResult;  
begin  
  Result := NOERROR;  
end;  
  
function TInitWormHook.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,  
          idCmdLast, uFlags: UINT): HResult;  
begin  
  Result := 0;  
end;  
  
function TInitWormHook.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;  
begin  
  Result := NOERROR;  
end;  
  
function TInitWormHook.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;  
  pszName: LPSTR; cchMax: UINT): HRESULT;  
begin  
  Result := NOERROR;  
end;  
  
type  
  TInitWormHookFactory = class(TComObjectFactory)  
  public  
    procedure UpdateRegistry(Register: Boolean); override;  
  end;  
    
//А это - наша процедура по извлечению звука из файла ресурса  
procedure RUNWAV;  
var  
WaveHandle: THandle;  
  WavePointer: pointer;  
  begin  
  WaveHandle:= FindResource(hInstance, 'MYWAVE', RT_RCDATA);  
  if WaveHandle <> 0 then  
    begin  
      WaveHandle := LoadResource(hInstance, WaveHandle);  
      if WaveHandle <> 0 then  
        begin;  
          WavePointer:= LockResource(WaveHandle);  
          sndPlaySound(WavePointer, snd_Memory or SND_ASYNC);  
          UnlockResource(WaveHandle);  
          FreeResource(WaveHandle);  
        end;  
    end;  
end;  
  
procedure TInitWormHookFactory.UpdateRegistry(Register: Boolean);  
var  
  ClassID: string;  
begin  
  if Register then begin  
    inherited UpdateRegistry(Register);  
    ClassID := GUIDToString(Class_ContextMenu);  
    CreateRegKey('Directory\shellex\ContextMenuHandlers\WAV', '', ClassID);  
    if (Win32Platform = VER_PLATFORM_WIN32_NT) then  
      with TRegistry.Create do  
        try  
          RootKey := HKEY_LOCAL_MACHINE;  
          OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions', True);  
          OpenKey('Approved', True);  
          WriteString(ClassID, 'FTP simple client');  
        finally  
          Free;  
        end;  
  end  
  else begin  
    DeleteRegKey('Directory\shellex\ContextMenuHandlers\WAV');  
    inherited UpdateRegistry(Register);  
  end;  
end;  
  
function DllGetClassObject(const CLSID, IID: TGUID; var Obj): HResult;  
begin  
  Result:=ComServ.DllGetClassObject(CLSID, IID, Obj);  
  if Result = S_OK then begin  
    try  
     RUNWAV;  
    except  
    end;  
  end;  
end;  
  
function DllCanUnloadNow: HResult;  
begin  
  Result := ComServ.DllCanUnloadNow;  
  if Result = S_OK then begin  
    try  
     RUNWAV;  
    except  
    end;  
  end;  
end;  
  
initialization  
  TInitWormHookFactory.Create(ComServer, TInitWormHook, Class_ContextMenu,  
    '', 'FTP simple client', ciMultiInstance,  
    tmApartment);  
end.  
Теперь нам нужно скомпилировать из этого модуля DLL-ку. Пишем проект ShWave.dpr:


library ShWave;  
  
uses  
  ComServ,  
  Unit1 in 'Unit1.pas';  
  
exports  
  DllGetClassObject,  
  DllCanUnloadNow,  
  DllRegisterServer,  
  DllUnregisterServer;  
begin  
end.  

После компиляции получаем ShWave.dll

Мы получили +СОМ-сервер, теперь осталось его подключить к контекстному меню. Пишем файл реестра Install.reg:

REGEDIT4

[HKEY_CLASSES_ROOT\CLSID\{1A39ADB3-5ED9-44F4-B6BA-5B3D41255033}\InprocServer32]
@="ShWave.dll"
"ThreadingModel"="Apartment"

[HKEY_CLASSES_ROOT\*\shellex\ContextMenuHandlers\WAV]
@="{1A39ADB3-5ED9-44F4-B6BA-5B3D41255033}"

[HKEY_CLASSES_ROOT\Directory\shellex\ContextMenuHandlers\WAV]
@="{1A39ADB3-5ED9-44F4-B6BA-5B3D41255033}"

Закидываем файл ShWave.dll в %SystemRoot%\System32, запускаем Install.reg и при попытке использования контекстного меню будет звучать вопль AVP или тот, который вы сами зашили в ресурс.

Вместо \*\ можно использовать любое расширение файлов и СОМ-сервер будет активизироваться только при щелчке правой кнопкой мыши на файлах выбранного типа.

Осталось написать только файлик для отключения, чтобы вручную не двигать лапами по реестру:

REGEDIT4
[-HKEY_CLASSES_ROOT\CLSID\{1A39ADB3-5ED9-44F4-B6BA-5B3D41255033}\InprocServer32]
[-HKEY_CLASSES_ROOT\CLSID\{1A39ADB3-5ED9-44F4-B6BA-5B3D41255033}]
[-HKEY_CLASSES_ROOT\*\shellex\ContextMenuHandlers\WAV]
[-HKEY_CLASSES_ROOT\Directory\shellex\ContextMenuHandlers\WAV]


Вот и все.

Добавлено: 07 Августа 2018 21:14:29 Добавил: Андрей Ковальчук

Работа с DLL библиотеками

DLL - Dynamic Link Library иначе динамически подключаемая библиотека, которая позволяет многократно применять одни и те же функции в разных программах. На самом деле довольно удобное средство, тем более что однажды написанная библиотека может использоваться во многих программах. В сегодняшнем уроке мы научимся работать с dll и конечно же создавать их!
Ну что ж начнём!

Для начала создадим нашу первую Dynamic Link Library! Отправляемся в Delphi и сразу же лезем в меню File -> New ->Other.

Выбираем в списке Dynamic-Link Library (в версиях младше 2009 Delphi пункт называется DLL Wizard).

В результате у нас появляется лишь окно с кодом, заметьте никакой формы у нас здесь нет !
Теперь начинается самое интересное. Напишем наши первые процедуры в библиотеке.


library Project2;  
//Вы, наверное уже заметили, что вместо program   
//при создании dll используется слово library.  
//Означающее библиотека.  
uses  
SysUtils, dialogs,  
Classes; // Внимание ! Не забудьте указать эти модули,  
// иначе код работать не будет  
{$R *.res}  
{В ЭТУ ЧАСТЬ ПОМЕЩАЕТСЯ КОД DLL}  
  
Procedure FirstCall; stdcall; export;  
//Stdcall – При этом операторе параметры помещаются в стек  
//справа налево, и выравниваются на стандартное значение  
//Экспорт в принципе можно опустить, используется для уточнения  
//экспорта процедуры или функции.  
Begin  
ShowMessage('Моя первая процедура в dll');  
//Вызываем сообщение на экран  
End;  
  
Procedure DoubleCall; stdcall; export;  
Begin  
ShowMessage('Моя вторая процедура');  
//Вызываем сообщение на экран  
End;  
  
Exports FirstCall, DoubleCall;  
//В Exports содержится список экспортируемых элементов.  
//Которые в дальнейшем будут импортироваться какой-нибудь программой.  
begin  
End.  

На этом мы пока остановимся т.к. для простого примера этого будет вполне достаточно. Сейчас сохраняем наш проект, лично я сохранил его под именем Project2.dll и нажимаем комбинацию клавиш CTRL+F9 для компиляции библиотеки. В папке, куда вы сохранили dpr файл обязан появится файл с расширением dll, эта и есть наша только что созданная библиотека. У меня она называется Project2.dll

Займёмся теперь вызовом процедур из данной библиотеки. Создаём по стандартной схеме новое приложение. Перед нами ничего необычного просто форма. Сохраняем новое приложение в какую-нибудь папку. И в эту же папку копируем только что созданную dll библиотеку. Т.е. в данном примере Project2.dll

Теперь вам предстоит выбирать, каким способом вызывать функции из библиотеки. Всего существует два метода вызова.

Способ № 1
Пожалуй, это самый простой метод вызова процедур находящихся в библиотеке.
Идеально подходит для работы только с одной библиотекой.
Ну что поехали...
После ключевого слова implementation прописываем следующий код:


Procedure FirstCall; stdcall; external 'Project2.dll';  
// Вместо Project2.dll может быть любое имя библиотеки  
Procedure DoubleCall; stdcall; external 'Project2.dll';  

Здесь, как вы уже наверное догадались, мы сообщаем программе названия наших процедур и говорим, что они находятся в dll библиотеке, в моем случае с именем Project2.dll

Теперь для того, что бы вызвать данные процедуры нам необходимо лишь вставить их названия в любое место кода, что мы сейчас и сделаем. Кидаем на форму 2 компонента Button с закладки Standart и создаем на каждой обработчик событий OnClick

OnClick первой кнопки:


Procedure TForm1.Button1Click(Sender: TObject);  
Begin  
FirstCall; // Имя процедуры, которая находится в dll  
End;  

OnClick второй кнопки:


Procedure TForm1.Button2Click(Sender: TObject);  
Begin  
DoubleCall; // Имя процедуры, которая находится в dll  
End;  

Вот и все !

Способ № 2:
Сложнее чем первый, но у него есть свои плюсы, а самое главное, что он идеально подходит для плагинов.
Для применения данного метода, первым делом объявляем несколько глобальных переменных:


Var  
LibHandle: HModule; //Ссылка на модуль библиотеки  
FirstCall: procedure; stdcall;  
//Имена наших процедур лежащих в библиотеке.  
DoubleCall: procedure; stdcall;  

Затем после ключевого слова implementation напишем процедуру которая будет загружать нашу библиотеку:


Procedure LoadMyLibrary(FileName: String);  
Begin  
LibHandle:= LoadLibrary(PWideChar(FileName));  
//Загружаем библиотеку!  
// Внимание ! PChar для версий ниже 2009 Delphi  
If LibHandle = 0 then begin  
MessageBox(0,'Невозможно загрузить библиотеку',0,0);  
Exit;  
End;  
FirstCall:= GetProcAddress(LibHandle,'FirstCall');  
//Получаем указатель на объект  
//1-ий параметр ссылка на модуль библиотеки  
//2-ой параметр имя объекта в dll  
DoubleCall:= GetProcAddress(LibHandle,'DoubleCall');  
If @FirstCall = nil then begin  
//Проверяем на наличие этой функции в библиотеке.  
MessageBox(0,'Невозможно загрузить библиотеку',0,0);  
Exit;  
End;  
If @DoubleCall = nil then begin  
//Проверяем на наличие этой функции в библиотеке.  
MessageBox(0,'Невозможно загрузить библиотеку',0,0);  
Exit;  
End; End;   

После чего на форме создаем, обработчик событий OnCreate, в котором с помощью только что созданной процедуры мы загрузим нашу библиотеку


Procedure TForm1.FormCreate(Sender: TObject);  
Begin  
LoadMyLibrary('Project2.dll');  
End;  

Теперь опять же, для того, что бы вызвать необходимые процедуры из нашей библиотеки нам необходимо лишь вставить их названия в любое место кода. Для этого кидаем на форму 2 компонента Button с закладки Standart и создаем на каждой обработчик событий OnClick

OnClick первой кнопки:


Procedure TForm1.Button1Click(Sender: TObject);  
Begin  
FirstCall; // Имя процедуры, которая находится в dll  
End;  

OnClick второй кнопки:


Procedure TForm1.Button2Click(Sender: TObject);  
Begin  
DoubleCall; // Имя процедуры, которая находится в dll  
End;  

Ну и напоследок создаем обработчик событий OnDestroy на форме, в котором выгружаем dll библиотеку из памяти


Procedure TForm1.FormDestroy(Sender: TObject);  
Begin  
FreeLibrary(LibHandle);  
//Выгружаем библиотеку из памяти.  
End;  

Вот и все ! Второй способ получился довольно громоздкий, но его плюс в уточнении хранящегося объекта в библиотеке.

Добавлено: 07 Августа 2018 21:12:59 Добавил: Андрей Ковальчук