Включен ли автозапуск CD

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Оформил: DeeCo

Автор: http://www.swissdelphicenter.ch

procedure TForm1.SetCDAutoRun(AAutoRun: Boolean);

const

DoAutoRun: array[Boolean] of Integer = (0, 1);

var

Reg: TRegistry;

begin

try

Reg := TRegistry.Create;

Reg.RootKey := HKEY_LOCAL_MACHINE;

if Reg.KeyExists(‘System\CurrentControlSet\Services\Class\CDROM’) then

begin

if Reg.OpenKey(‘System\CurrentControlSet\Services\Class\CDROM’, False) then

Reg.WriteBinaryData(‘AutoRun’, DoAutoRun[AAutoRun], 1);

end

finally

Reg.Free;

end;

ShowMessage(‘Your settings will take effect on the next reboot of Windows.’);

end;

{/codecitation}

Блокировка и разблокировка CD-ROM 2

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: ReLock

Я сам долго искал, как блокировать/разблокировать CD-ROM на Delphi. Поэтому не претендую на авторство этой статьи. Просто собрал все, так сказать, в кучу. Проверено на D7.

procedure TMainForm.CD_Lock(Locked: Boolean, DriveLetter: string);

const

IOCTL_STORAGE_MEDIA_REMOVAL = $002D4804;

var

hDrive: THandle;

Returned: DWORD;

DisableEject: boolean;

begin

hDrive := CreateFile(PChar(‘\\.\’ DriveLetter), GENERIC_READ,

FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL,

0);

if GetLastError 0 then

MessageDlg(‘Error:’ IntToStr(GetLastError), mtError, [mbOK], 0);

try

DisableEject := Locked;

if not DeviceIoControl(hDrive,

IOCTL_STORAGE_MEDIA_REMOVAL, // PREVENT_MEDIA_REMOVAL,

@DisableEject,

SizeOf(DisableEject),

nil,

0,

Returned,

nil) then

MessageDlg(‘Ошибка:’ IntToStr(GetLastError), mtError, [mbOK], 0)

finally

CloseHandle(hDrive)

end;

end;

CD_Lock(True) — блокирует CD-ROM

CD_Lock(False) — разблокирует CD-ROM

Для полного веселья можно заблокировать все CD-ROMы в системе через это:

procedure TMainForm.LockCDROMs;

var

w: dword;

Root: string;

i: byte;

begin

w := GetLogicalDrives;

Root := ‘#:\’;

for i := 0 to 25 do

begin

Root[1] := Char(Ord(‘A’) i);

if (W and (1 shl i)) > 0 then

if GetDriveType(PChar(Root)) = DRIVE_CDROM then

begin

DriveLetter := Copy(Root, 1, Length(Root) — 1);

CD_Lock(True, DriveLetter)

end

end;

end;

{/codecitation}

Блокировка и разблокировка CD-ROM

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Baa

WEB-сайт: http://forum.vingrad.ru

Вы уж простите, что на сях… сподручней было :\

//заблокировать

void CMFcDlg::OnBnClickedButton1()

{

HANDLE hDevice = CreateFile («\\\\.\\E:»,

GENERIC_READ,

FILE_SHARE_READ | FILE_SHARE_WRITE,

NULL,

OPEN_EXISTING,

NULL,

NULL);

DWORD dwBytesReturned = 0;

PREVENT_MEDIA_REMOVAL pmr = {TRUE};

if(!DeviceIoControl (hDevice, IOCTL_STORAGE_MEDIA_REMOVAL,

Управление реестром в Delphi

 

Реестр очень нужная вещь! Им должен уметь пользоваться каждый. Сегодня я покажу маленький пример как сохранить некоторые параметры Вашей программы.
Первое что надо сделать это добавить в uses модуль Registry
Затем написать две процедуры:

{codecitation class="brush: pascal; gutter: false;" width="600px"}type
TForm1 = class(TForm)
procedure SaveProgParam;
procedure LoadProgParam;

procedure TForm1.SaveProgParam;
var
FIniFile: TRegIniFile;
Begin
// по умолчанию всё делается в HKEY_CURRENT_USER
FIniFile := TRegIniFile.Create(’Software’);
FIniFile.OpenKey(’Папка_вашей_программы’,true);
if Form1.WindowState=wsNormal then
begin
FIniFile.WriteInteger(’Option’, ‘Width’, Width);
// Write… — означает запись, …Integer – означает тип записываемой переменной
// Первый параметр ‘Option’ – это подраздел: ‘Папка_вашей_программы\Option\’
// Второй параметр ‘Width’ – название ключа (файла в реестре)
// Третий – это переменная которую мы записываем
FIniFile.WriteInteger(’Option’, ‘Heigth’, Height);
FIniFile.WriteInteger(’Option’, ‘Left’, Left);
FIniFile.WriteInteger(’Option’, ‘Top’, Top);
end;
FIniFile.WriteInteger(’Option’, ‘WinState’, Integer(WindowState));
FIniFile.Free; //освобождаем переменную
end;
{/codecitation}

Здесь мы записали положение окна и развёрнуто ли оно. Далее мы пишем процедуру загрузки этих параметров:
{codecitation class="brush: pascal; gutter: false;" width="600px"}procedure TForm1.LoadProgParam;
var
FIniFile: TRegIniFile;
Begin
// по умолчанию всё делается в HKEY_CURRENT_USER
FIniFile := TRegIniFile.Create(’Software’);
FIniFile.OpenKey(’Папка_вашей_программы’,true);
Width:=FIniFile.ReadInteger(’Option’, ‘Width’, 600);
// Read… — означает чтение, …Integer – означает тип считываемой переменной
// Первый параметр ‘Option’ – это подраздел: ‘Папка_вашей_программы\Option\’
// Второй параметр ‘Width’ – название ключа (файла в реестре)
// Третий параметр 600 – это значение по умолчанию, если ключ с названием ‘Width’ не будет найден
Height:=FIniFile.ReadInteger(’Option’, ‘Heigth’, 300);
Left:=FIniFile.ReadInteger(’Option’, ‘Left’, 10);
Top:=FIniFile.ReadInteger(’Option’, ‘Top’, 10);
WindowState:=TWindowState(FIniFile.ReadInteger(’Option’, ‘WinState’, 0));
FIniFile.Free; //освобождаем переменную
end;
{/codecitation}

И теперь внедряем эти процедуры в программу:

{codecitation class="brush: pascal; gutter: false;" width="600px"}procedure TForm1.FormCreate(Sender: TObject);
begin
LoadProgParam;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
SaveProgParam;
end;
{/codecitation}

Работа с *.INI — файлами

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

Использование *.INI в Delphi

Для работы с *.INI — файлами в Delphi вам необходимо подключить модуль IniFiles, и создать объект TIniFile, затем с ним работать. После завершения работы объект необходимо удалить методом Free.

Основные методы:

Create — создает экземпляр объекта TIniFile в качестве параметра указывается путь и имя файла (если путь не указан, то файл создается в стандартной директории Windows (можно использовать GetDir для создания файла в папке с программой))

  • Free — удаляет объект TIniFile
  • FileName — возвращает имя файла, с которым связан объект TIniFile
  • DeleteKey — удаляет ключ в разделе
  • EraseSection — удаляет раздел
  • ReadInteger — считывает из файла целочисленные данные
  • ReadString — считывает из файла строковые данные
  • ReadBool — считывает из файла логические (true, false) данные
  • WriteBool — записывает в файл логические данные
  • WriteString — записывает в файл строковые данные
  • WriteInteger — записывает в файл целочисленные данные
  • ReadSection — извлекает имена идентификаторов в указанном разделе INI — файла
  • ReadSections — извлекает все имена разделов
  • ReadSectionValues — извлекает из заданного раздела все ключи
  • ReadBinaryStream — считывает поток из файла
  • WriteBinaryStream — записывает поток в файл

Для более детального изучения можно обратиться к исходному коду модуля IniFile (однако приведенных выше методов вполне хватает для работы).

Вот несколько дополнительных функций, которые помогут вам в решении некоторых проблем связанных с использованием INI — файлов:

WriteProfileString и WritePrivateProfileString — сбрасывают изменения в INI — файле на диск, что позволяет немедленно записать все изменения в вашем файле настроек. Функции находятся в модуле Windows.pas (импортированы из kernel32.dll).

А вот еще небольшая вещь: сообщение WM_WININICHANGE позволяет отслеживать изменения происходящие в файле Win.ini.

Иерархия объектов

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

Также в модуле IniFiles описаны два дополнительных класса (в помощь TMemIniFile — файлы в памяти (увеличивается быстродействие, но при неправильной работе можно вызвать сбой)) — это TStringHash и THashedStringList.

Удаление файлов

Для удаления файлов в Delphi так же предусмотрена специальная процедура DeleteFile. В качестве параметра, передаваемого в функцию, выступает строка типа PChar, указывающая имя файла, который нужно удалить. Сразу предлагаю Вам простой пример на использование этой функции:

{codecitation class="brush: pascal; gutter: false;" width="600px"} 

procedure TForm1.Button1Click(Sender: TObject);
begin
if DeleteFile(‘c:\2.txt’) then
ShowMessage(‘Файл успешно удален!’)
else
ShowMessage(‘Ошибка! Вот ее код: ‘+IntToStr(GetLastError));
end;{/codecitation}
 

Итератор для поиска файлов в директории

Очень часто задают вопрос «как перебрать все файлы папки».
Так же часто предлагают использовать FindFirst/FindNext.
Я написал класс TEnumFolder который предоставляет более
удобный интерфейс поиска за счет использованием методов
First/Next/Eof.

Используйте свойства AbsPath и RelPath для получения абсолютного
и относетильного пути текущего файла/папки. Свойство SR типа PSearchRec,
содержит информацию о текущем файле/папке.

Так же можно указать режим перебора (IsFolderFirst = False) при котором,
можно удалить всю папку(!), т.е. в начале находятся все файлы папки,
а потом сама папка (т.к. можно удалять только пустую папку).

Зависимости: Classes, SysUtils

unit EnmFolder;

interface

uses
Classes, SysUtils;

type
PSearchRec = ^TSearchRec;
TEnumFolder = class
private
FBasePath: string;
FList: TStrings;
FSR: PSearchRec;
FIsFolderFirst: Boolean;
FBasePos: Integer;
FNextProc: procedure of object;
function GetAbsPath: string;
function GetRelPath: string;
procedure ClearList;
function GetPathType(Path: string): Integer;
procedure PushSR(Dir: string);
procedure PopSR;
procedure Next1;
procedure Next2;
public
constructor Create(BasePath: string; IsFolderFirst: Boolean = True);
destructor Destroy; override;
procedure First;
procedure Next;
function Eof: Boolean;
property AbsPath: string read GetAbsPath;
property RelPath: string read GetRelPath;
property SR: PSearchRec read FSR;
end;

implementation

{ TEnumFolder }

constructor TEnumFolder.Create(BasePath: string; IsFolderFirst: Boolean);
begin
inherited Create;
FList := TStringList.Create;
FBasePath := ExcludeTrailingBackslash(BasePath);
FIsFolderFirst := IsFolderFirst;
if IsFolderFirst then
FNextProc := Next1
else
FNextProc := Next2;
end;

destructor TEnumFolder.Destroy;
begin
ClearList;
FList.Free;
inherited;
end;

procedure TEnumFolder.ClearList;
begin
while (FList.Count > 0) do
PopSR;
end;

function TEnumFolder.GetAbsPath: string;
begin
Result := FList[0] + SR.Name;
end;

function TEnumFolder.GetRelPath: string;
begin
Result := Copy(AbsPath, FBasePos, MaxInt);
end;

function TEnumFolder.GetPathType(Path: string): Integer;
begin
New(FSR);
if (FindFirst(Path, faAnyFile, SR^) <> 0) then
Result := -1 { Not found }
else
begin
if (SR.Attr and faDirectory <> 0) then
begin
FBasePos := Length(Path) + 2;
Path := ExtractFilePath(Path);
FList.InsertObject(0, Path, TObject(SR));
Result := 1; { Folder }
end
else
begin
Path := ExtractFilePath(Path);
FBasePos := Length(Path) + 1;
FList.InsertObject(0, Path, TObject(SR));
Result := 0; { File }
end;
end;
end;

function TEnumFolder.Eof: Boolean;
begin
Result := (FList.Count = 0);
end;

procedure TEnumFolder.First;
begin
FSR := nil;
ClearList;
case GetPathType(FBasePath) of
{ Folder }
1:
if not FIsFolderFirst then
begin
PushSR(FBasePath);
Next;
end;
{ File }
0: ;
end;
end;

procedure TEnumFolder.Next;
begin
FNextProc;
end;

procedure TEnumFolder.Next1;
begin
{ Push folder }
if (SR.Attr and faDirectory <> 0) then
PushSR(FList[0] + FSR.Name);

while (FList.Count > 0) and (FindNext(SR^) <> 0) do
PopSR;
end;

procedure TEnumFolder.Next2;
begin
while (FList.Count > 0) do
if (FindNext(SR^) <> 0) then
begin
PopSR;
Break;
end
else if (SR.Attr and faDirectory <> 0) then
PushSR(FList[0] + FSR.Name)
else
Break;
end;

procedure TEnumFolder.PushSR(Dir: string);
begin
New(FSR);
FindFirst(Dir + '\*.*', faAnyFile, FSR^);
FindNext(FSR^); { Skip "." and ".." }
FList.InsertObject(0, Dir + '\', TObject(FSR));
end;

procedure TEnumFolder.PopSR;
begin
FList.Delete(0);
FindClose(SR^);
Dispose(SR);
if FList.Count > 0 then
FSR := PSearchRec(FList.Objects[0])
else
FSR := nil;
end;

end.

Пример использования:

procedure TForm1.Button1Click(Sender: TObject);
var
fe: TEnumFolder;
begin
{ Показываем содержимое папки }
Memo1.Lines.BeginUpdate;
Memo1.Clear;
fe := TEnumFolder.Create('c:\temp', True);
fe.First;
while not fe.Eof do
begin
Memo1.Lines.Add(fe.AbsPath);
fe.Next;
end;
fe.Free;
Memo1.Lines.EndUpdate;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
fe: TEnumFolder;
begin
{ Удаляем папку }
fe := TEnumFolder.Create('c:\temp', False);
fe.First;
while not fe.Eof do
begin
if (fe.SR.Attr and faDirectory) = 0 then
DeleteFile(fe.AbsPath)
else
RemoveDir(fe.AbsPath);
fe.Next;
end;
fe.Free;
end;