Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Как сделать программное безопасное извлечение флешки?


Страницы:   1 2 3 4 5

mlm68 ©   (2006-03-30 21:13:00) 

Как сделать программное безопасное извлечение флешки?

Rouse_   (2006-04-04 14:07:00) [61]


> Игорь Шевченко ©   (04.04.06 13:39) [27]

Ну по всей видимости у тебя отключена галка в свойствах флешки "Enable write caching on the disk" которая стоит по умолчанию...


> Вставив флешку обратно, выполнив твой код, я прекрасно вижу
> флешку среди дисков проводника.

В списке проводника она безусловно пристутвует, но при попытке обращения к ней выдается надпись "Please insert dist into Drive ..."

fellix   (2006-04-04 13:48:00) [62]

Ну и объявить, желательно, как функцию - чтоб код возврата анализировать.

fellix   (2006-04-04 13:46:00) [63]


> mlm68 ©   (04.04.06 11:24) [20]
> Где ошибка?


@EjectDiskFromSADrive:=GetProcAddress(Handle, 'EjectDiskFromSADrive A ');

Игорь Шевченко   (2006-04-04 13:39:00) [64]

Rouse_ ©   (04.04.06 12:46) [24]


> Ну я както за свои слова привык отвечать:


Это безусловно радует.

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

Тут есть один ма-ааленький момент - флешка не компакт-диск.

Rouse_   (2006-04-04 13:17:00) [65]


> А проще через EjectDiskFromSADrive можно?

не знаю - не пробовал... нет времени эксперементировать...

mlm68   (2006-04-04 13:14:00) [66]


> Rouse_ ©   (04.04.06 12:46) [24]
>
> Ну я както за свои слова привык отвечать:


Вот это круто!

А проще через EjectDiskFromSADriveможно?

Rouse_   (2006-04-04 12:46:00) [67]


> Игорь Шевченко ©   (04.04.06 10:33) [19]
> Rouse_ ©   (03.04.06 21:17) [17]
>
>
> > а через IShellFolder и Context.InvokeCommand
>
>
> Ты тоже приведешь работающее решение ?

Ну я както за свои слова привык отвечать:

unit Unit4;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ShlObj, ActiveX;

type
 TForm4 = class(TForm)
   lbFlashDriveList: TListBox;
   btnSafeEject: TButton;
   procedure btnSafeEjectClick(Sender: TObject);
   procedure FormCreate(Sender: TObject);
 private
   procedure FillFlashDriveList;
   function SafeEjectDrive(const DriveLetter: Char): Boolean;
 end;

var
 Form4: TForm4;

implementation

{$R *.dfm}

procedure TForm4.btnSafeEjectClick(Sender: TObject);
begin
 if lbFlashDriveList.ItemIndex >= 0 then
   SafeEjectDrive(lbFlashDriveList.Items[lbFlashDriveList.ItemIndex][1]);
end;

procedure TForm4.FillFlashDriveList;
const
 NameSize = 4;
 VolumeCount = 26;
 TotalSize = NameSize * VolumeCount;
var
 Buff, Volume, DosDevice: String;
 lpQuery: array [0..MAXCHAR - 1] of Char;
 I, Count: Integer;
begin
 SetLength(Buff, TotalSize);
 Count := GetLogicalDriveStrings(TotalSize, @Buff[1]) div NameSize;
 if Count = 0 then
   RaiseLastOSError
 else
   for I := 0 to Count - 1 do
   begin
     Volume := PChar(@Buff[(I * NameSize) + 1]);
     case GetDriveType(PChar(Volume)) of
       DRIVE_REMOVABLE:
       begin
         Volume[3] := #0;
         QueryDosDevice(PChar(Volume), @lpQuery[0], MAXCHAR);
         Volume[3] := '\';
         DosDevice := String(lpQuery);
         if (DosDevice <> '\Device\Floppy0') and (DosDevice <> '\Device\Floppy1') then
           lbFlashDriveList.Items.Add(Volume[1]);
       end;
     end;
   end;
end;

procedure TForm4.FormCreate(Sender: TObject);
begin
 FillFlashDriveList;
end;

function TForm4.SafeEjectDrive(const DriveLetter: Char): Boolean;
var
 CoInit, AResult: HRESULT;
 CommonDir: String;
 Desktop, ShellFolder: IShellFolder;
 pchEaten, Attr: Cardinal;
 PathPIDL: PItemIDList;
 FilePIDL: array [0..1] of PItemIDList;
 ShellContextMenu: HMenu;
 ICMenu: IContextMenu;
 CMD: TCMInvokeCommandInfo;
 M: IMAlloc;
 CallbackWindow: HWND;
begin
 Result := False;
 ShellContextMenu := 0;
 Attr := 0;
 PathPIDL := nil;
 CallbackWindow := 0;
 CoInit := CoInitializeEx(nil, COINIT_MULTITHREADED);
 try
   CommonDir := DriveLetter + ':\';
   if SHGetDesktopFolder(Desktop) <> S_OK then
     RaiseLastOSError;
   if (SHGetSpecialFolderLocation(0, CSIDL_DRIVES, PathPIDL) <> S_OK) or
     (Desktop.BindToObject(PathPIDL,  nil,  IID_IShellFolder,
       Pointer(ShellFolder)) <> S_OK) then RaiseLastOSError;
   ShellFolder.ParseDisplayName(Handle, nil, StringToOleStr(CommonDir),
     pchEaten, FilePIDL[0], Attr);
   AResult := ShellFolder.GetUIObjectOf(Handle, 1, FilePIDL[0],
     IID_IContextMenu, nil, Pointer(ICMenu));

   if Succeeded(AResult) then
   begin
       FillChar(CMD, SizeOf(CMD), #0);
       with CMD do
       begin
         cbSize := SizeOf(CMD);
         hWND := Handle;
         lpVerb := 'Eject';
         nShow := SW_SHOWNORMAL;
       end;
       AResult := ICMenu.InvokeCommand(CMD);
       Result := AResult <> S_OK;
      end;
 finally
   if FilePIDL[0] <> nil then
   begin
     SHGetMAlloc(M);
     if M <> nil then
       M.Free(FilePIDL[0]);
     M:=nil;
   end;
   if PathPIDL <> nil then
   begin
     SHGetMAlloc(M);
     if M <> nil then
       M.Free(PathPIDL);
     M:=nil;
   end;
   if ShellContextMenu <>0 then
     DestroyMenu(ShellContextMenu);
   if CallbackWindow <> 0 then
     DestroyWindow(CallbackWindow);
   ICMenu := nil;
   ShellFolder := nil;
   Desktop := nil;
   if CoInit = S_OK then CoUninitialize;
 end;
end;

end.

Плохиш   (2006-04-04 11:48:00) [68]


> mlm68 ©   (04.04.06 11:31) [22]
> в этой строке проблемка
> EjectDiskFromSADrive(nil,nil,'\\.\Cdrom0',1,'','',0);

Ни кто и не сомневался. Чему равно @EjectDiskFromSADrive?
Почитай http://msdn.microsoft.com/library/default.asp?url=/library/en-us/stgmgmt/fs/ejectdiskfromsadrive.aspособенно про системные требования.

mlm68   (2006-04-04 11:31:00) [69]

в этой строке проблемка
EjectDiskFromSADrive(nil,nil,'\\.\Cdrom0',1,'','',0);

Игорь Шевченко   (2006-04-04 11:29:00) [70]


> Где ошибка?


А отладчика у тебя нету ? Бедняга...

mlm68   (2006-04-04 11:24:00) [71]

Где ошибка?
Есть форма Form1, на ней кнопка Button1.
При нажатии на кнопку выдается ошибка: Access violation at address 00000000. Read of address 00000000.
вот мой код

unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls;
type
 TEjectDiskFromSADrive=procedure(
 lpComputerName:LPCWSTR ;
 lpAppName:LPCWSTR;
 lpDeviceName:LPCWSTR;
 hWnd:HWND;
 lpTitle:LPCWSTR;
 lpMessage:LPCWSTR;
 dwOptions:DWORD
);
 TForm1 = class(TForm)
   Button1: TButton;
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;
var
 Form1: TForm1;
 EjectDiskFromSADrive: TEjectDiskFromSADrive;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
 Handle:THandle;
begin
 Handle := LoadLibrary('Ntmsapi.DLL');
 if Handle <> 0 then
 begin
    @EjectDiskFromSADrive:=GetProcAddress(Handle, 'EjectDiskFromSADrive');
    EjectDiskFromSADrive(nil,nil,'\\.\Cdrom0',1,'','',0);
    FreeLibrary(Handle);
 end;
end;
end.

Игорь Шевченко   (2006-04-04 10:33:00) [72]

Rouse_ ©   (03.04.06 21:17) [17]


> а через IShellFolder и Context.InvokeCommand


Ты тоже приведешь работающеерешение ?

Германн   (2006-04-04 00:20:00) [73]


> n0name   (03.04.06 19:17) [16]
>
> >>Давай для начала ответим на первый вопрос - как ты собираешься
> найти координаты иконки для флешки ?
> А зачем искать?
> Перебрать все иконки, найти нужную, отправить сообщение.
>

А как их перебрать?

Rouse_   (2006-04-03 21:17:00) [74]


> ы, если не трудно, приведи пожалуйста работающее решение
> [6].

Игорь, ну ты наскочил на парня :) В принципе его идея тоже имеет смысл, только конечно не через трей, а через IShellFolder и Context.InvokeCommand

n0name   (2006-04-03 19:17:00) [75]

>>Давай для начала ответим на первый вопрос - как ты собираешься найти координаты иконки для флешки ?
А зачем искать?
Перебрать все иконки, найти нужную, отправить сообщение.
Хотя этим спопсобом я бы пользовался в последнюю очередь.

kaZaNoVa   (2006-04-03 17:19:00) [76]

Игорь Шевченко ©   (03.04.06 17:16) [14]
думаю данное решение реализовать мне будет несколько проблематично, а в [6] была лишь высказана идея, как можно попробоватьрешить проблему :)

с уважением.

Игорь Шевченко   (2006-04-03 17:16:00) [77]

kaZaNoVa ©   (03.04.06 17:12) [13]

Ты, если не трудно, приведи пожалуйста работающеерешение [6].

kaZaNoVa   (2006-04-03 17:12:00) [78]

Игорь Шевченко ©   (03.04.06 17:09) [12]
решение  [11] сразу показывает:) и кликать не нужно

Игорь Шевченко   (2006-04-03 17:09:00) [79]


> а так если скрыта - то есть же значок "показать скрытые"


А как ты его искать собираешься, этот значок ?

kaZaNoVa   (2006-04-03 16:56:00) [80]

"путь к винде\system32\rundll32.exe" shell32.dll,Control_RunDLL hotplug.dll

Страницы:   1 2 3 4 5

Наверх

Титульная страница Поиск, карта сайта Написать письмо