/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Delphi

Выпуск № 1085
от 07.03.2008, 17:05

Вопрос № 125.610

Программе на делфи требуется определить когда к компьютеру подключается флешка и узнать ее имя в системе. как это реализовать?

Отправлен: 01.03.2008, 21:25 Вопрос задал: Shell (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Selya Здравствуйте, Shell! Вот компонент TComponentUSB, инкапсулирующий события подключения/отключения USB: (см. прил.1) А уже на событие OnUSBArrival можно подвесить такой код, определяющий букву диска подключенного устройства: (см. прил.2, конечно не btnGetDriveTypesClick, а USBArrival) Приложение: прил.1 unit UsbUtils; interface uses Windows, Messages, SysUtils, Classes, Forms; type PDevBroadcastHdr = ^DEV_BROADCAST_HDR; DEV_BROADCAST_HDR = packed record dbch_size: DWORD; dbch_devicetype: DWORD; dbch_reserved: DWORD; end; PDevBroadcastDeviceInterface = ^DEV_BROADCAST_DEVICEINTERFACE; DEV_BROADCAST_DEVICEINTERFACE = record dbcc_size: DWORD; dbcc_devicetype: DWORD; dbcc_reserved: DWORD; dbcc_classguid: TGUID; dbcc_name: short; end; const GUID_DEVINTERFACE_USB_DEVICE: TGUID = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}'; DBT_DEVICEARRIVAL = $8000; // system detected a new device DBT_DEVICEREMOVECOMPLETE = $8004; // device is gone DBT_DEVTYP_DEVICEINTERFACE = $00000005; // device interface class type TComponentUSB = class(TComponent) private FWindowHandle: HWND; FOnUSBArrival: TNotifyEvent; FOnUSBRemove: TNotifyEvent; procedure WndProc(var Msg: TMessage); function USBRegister: Boolean; protected procedure WMDeviceChange(var Msg: TMessage); dynamic; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property OnUSBArrival: TNotifyEvent read FOnUSBArrival write FOnUSBArrival; property OnUSBRemove: TNotifyEvent read FOnUSBRemove write FOnUSBRemove; end; implementation constructor TComponentUSB.Create(AOwner: TComponent); begin inherited Create(AOwner); FWindowHandle := Classes.AllocateHWnd(WndProc); USBRegister; end; destructor TComponentUSB.Destroy; begin Classes.DeallocateHWnd(FWindowHandle); inherited Destroy; end; procedure TComponentUSB.WndProc(var Msg: TMessage); begin if (Msg.Msg = WM_DEVICECHANGE) then begin try WMDeviceChange(Msg); except Application.HandleException(Self); end; end else Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam); end; procedure TComponentUSB.WMDeviceChange(var Msg: TMessage); var devType: Integer; Datos: PDevBroadcastHdr; begin if (Msg.wParam = DBT_DEVICEARRIVAL) or (Msg.wParam = DBT_DEVICEREMOVECOMPLETE) then begin Datos := PDevBroadcastHdr(Msg.lParam); devType := Datos^.dbch_devicetype; if devType = DBT_DEVTYP_DEVICEINTERFACE then begin // USB Device if Msg.wParam = DBT_DEVICEARRIVAL then begin if Assigned(FOnUSBArrival) then FOnUSBArrival(Self); end else begin if Assigned(FOnUSBRemove) then FOnUSBRemove(Self); end; end; end; end; function TComponentUSB.USBRegister: Boolean; var dbi: DEV_BROADCAST_DEVICEINTERFACE; Size: Integer; r: Pointer; begin Result := False; Size := SizeOf(DEV_BROADCAST_DEVICEINTERFACE); ZeroMemory(@dbi, Size); dbi.dbcc_size := Size; dbi.dbcc_devicetype := DBT_DEVTYP_DEVICEINTERFACE; dbi.dbcc_reserved := 0; dbi.dbcc_classguid := GUID_DEVINTERFACE_USB_DEVICE; dbi.dbcc_name := 0; r := RegisterDeviceNotification(FWindowHandle, @dbi, DEVICE_NOTIFY_WINDOW_HANDLE); if Assigned(r) then Result := True; end; end. прил.2 procedure TMainForm.btnGetDriveTypesClick(Sender: TObject); var I: Integer; C: string; DType: Integer; DriveString: string; begin { Цикл по всем буквам A..Z для определения доступных устройств } for i := 65 to 90 do begin C := chr(I) + ': '; // Форматируем строку для представления корневого каталога { Вызываем функцию GetDriveType(), которая возвращает целое значение, представляющее один из типов, приведенных в инструкции case. } DType := GetDriveType(PChar(C)); { На основе полученного типа устройства форматируем строку для добавления в список различных типов устройств. } case DType of 0: DriveString := C + ' The drive type cannot be determined.'; // Нельзя определить тип устройства 1: DriveString := C + ' The root directory does not exist.'; // Корневого каталога не существует DRIVE_REMOVABLE: DriveString := C + ' The drive can be removed from the drive.'; // Съемное устройство DRIVE_FIXED: DriveString := C + ' The disk cannot be removed from the drive.'; // Несъемное устройство DRIVE_REMOTE: DriveString := C + ' The drive is a remote (network) drive.'; // Удаленное (сетевое) устройство DRIVE_CDROM: DriveString := C + ' The drive is a CD-ROM drive.'; // Компакт-диск DRIVE_RAMDISK: DriveString := C + ' The drive is a RAM disk.'; // Псевдодиск в ОЗУ end; { Добавляем только те типы, которые поддаются определению. } if not ((DType = 0) or (DType = 1)) then lbDrives.Items.AddObject(DriveString, Pointer(I)); end; end;

Ответ отправил: Selya (статус: 9-ый класс) Ответ отправлен: 02.03.2008, 03:01

Вопрос № 125.619

Доброго времени суток, уважаемые эксперкты. Вопрос: как программе удалить саму себя?

Отправлен: 01.03.2008, 23:19 Вопрос задал: Хукаленко Дмитрий (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Хукаленко Дмитрий! Программа в приложении (два варинта). Источник - DelphiWorld. Удачи! Приложение: uses Windows, SysUtils; procedure DeleteMe; var BatchFile: TextFile; BatchFileName: string; ProcessInfo: TProcessInformation; StartUpInfo: TStartupInfo; begin { создаём бат-файл в директории приложения } BatchFileName := ExtractFilePath(ParamStr(0)) + '$$336699.bat'; { открываем и записываем в файл } AssignFile(BatchFile, BatchFileName); Rewrite(BatchFile); Writeln(BatchFile, ':try'); Writeln(BatchFile, 'del "' + ParamStr(0) + '"'); Writeln(BatchFile, 'if exist "' + ParamStr(0) + '"' + ' goto try'); Writeln(BatchFile, 'del "' + BatchFileName + '"'); CloseFile(BatchFile); FillChar(StartUpInfo, SizeOf(StartUpInfo), $00); StartUpInfo.dwFlags := STARTF_USESHOWWINDOW; StartUpInfo.wShowWindow := SW_HIDE; if CreateProcess(nil, PChar(BatchFileName), nil, nil, False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo, ProcessInfo) then begin CloseHandle(ProcessInfo.hThread); CloseHandle(ProcessInfo.hProcess); end; end; А вот тот же способ, но немного модифицированный: program delete2; uses SysUtils, windows; var BatchFile: TextFile; BatchFileName: string; TM: Cardinal; TempMem: PChar; begin BatchFileName:=ExtractFilePath(ParamStr(0))+ '$$336699.bat'; AssignFile(BatchFile, BatchFileName); Rewrite(BatchFile); Writeln(BatchFile,':try'); Writeln(BatchFile,'del "' + ParamStr(0) + '"'); Writeln(BatchFile,'if exist "' + ParamStr(0) + '" goto try'); Writeln(BatchFile,'del "' + BatchFileName + '"'); CloseFile(BatchFile); TM:=70; GetMem (TempMem,TM); GetShortPathName (pchar(BatchFileName), TempMem, TM); BatchFileName:=TempMem; FreeMem(TempMem); winexec(Pchar(BatchFileName),sw_hide); halt; end.

Ответ отправил: Николай Владимирович / Н.В. (статус: Профессионал) Россия, Москва WWW: nvsoft.org ICQ: 420720 ---- Ответ отправлен: 02.03.2008, 09:10 Оценка за ответ: 4 Комментарий оценки: Спасибо за ответ, но обе программы не работают, если в пути есть русские буквы. Это очень не удобно.

Отвечает: Denisss Здравствуйте, Хукаленко Дмитрий! В приложении почти тот же ответ, что и у эксперта Николай Владимирович / Н.В., но еще дополнительно модифицированный для работы с папками и файлами, в именах которых есть буквы кириллицы (в имени папки или самого файла). Например, код, описанный выше, не сработал у меня в папке "e:Проекты Delphi". Более того, в папке с exe-файлом появился еще и файл $$336699.bat. Удачи! Приложение: program SelfDelete; uses SysUtils, Windows; var BatchFile: TextFile; ProgName: String; TempMem: Array[0..255] of Char; CurDir: String; const // Чтобы сильнее отличалось от приведенного ранее // примера ;) BatName: String = '$$202803.bat'; begin CurDir:= GetCurrentDir; SetCurrentDirectory(PChar(ExtractFileDir(ParamStr(0)))); ProgName:= ExtractFileName(ParamStr(0)); ZeroMemory(@TempMem, 256); GetShortPathName(PChar(ProgName), TempMem, 256); AnsiToOem(TempMem, TempMem); ProgName:= TempMem; AssignFile(BatchFile, BatName); Rewrite(BatchFile); Writeln(BatchFile, ':try'); Writeln(BatchFile, 'DEL "' + ProgName + '"'); Writeln(BatchFile, 'IF EXIST "' + ProgName + '" GOTO try'); Writeln(BatchFile, 'DEL "' + BatName + '"'); CloseFile(BatchFile); ZeroMemory(@TempMem, 256); GetShortPathName(PChar(BatName), TempMem, 256); WinExec(TempMem, SW_HIDE); SetCurrentDirectory(PChar(CurDir)); end. --------- Будь осторожен, когда молишься ради чего-то, потому что можешь это получить...

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва ICQ: 281599577 ---- Ответ отправлен: 02.03.2008, 11:21 Оценка за ответ: 5 Комментарий оценки: Большое спасибо. Всё отлично работает.

Вопрос № 125.657

Доброго времени суток, уважаемые эксперты. Подскажите, пожалуйста, как осуществить загрузку файла с сетевого ресурса средствами Borland Delphi. Заранее спасибо Исправлена ошибка. ----- ∙ Отредактировал: sir henry (Академик) ∙ Дата редактирования: 03.03.2008, 10:54

Отправлен: 02.03.2008, 12:26 Вопрос задал: Serpenser PO (статус: 1-ый класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Genia007 Здравствуйте, Serpenser PO! Попробуйте следующий код, возможно он Вам подойдёт: uses URLMon, ShellApi; function DownloadFile(SourceFile, DestFile: string): Boolean; begin try Result := UrlDownloadToFile(nil, PChar(SourceFile), PChar(DestFile), 0, nil) = 0; except Result := False; end; end; procedure TForm1.Button1Click(Sender: TObject); var SourceFile: String; {Где находится файл в нете} DestFile: String; {Куда качать} begin if DownloadFile(SourceFile, DestFile) then begin ShowMessage('Download succesful!'); {Показ загруженного изображения в браузере} ShellExecute(Application.Handle, PChar('open'), PChar(DestFile), PChar(''), nil, SW_NORMAL) end else ShowMessage('Ошибка скачивания ' + SourceFile) end; Возможно так-же организовать скачивание с докачкой при помощи Winlnet.Pas модуля дэлфи, пример программы в журнале Хакер за 04.2003.

Ответ отправил: Genia007 (статус: 7-ой класс) Ответ отправлен: 03.03.2008, 13:20

Вопрос № 125.662

Здравствуйте! Помогите решить такой вопрос. Пишу небольшую программку на delphix. Мне нужно программно произвести щелчок мышкой по спрайту. Для этого хочу вычислить абсолютные координаты спрайта. Но такой функции как например для кнопки button1.ClientToScreen(pt) для спрайта нет! Как программно щелкнуть по спрайту и как определить абсолютные координаты спрайта? Спасибо!

Отправлен: 02.03.2008, 13:21 Вопрос задал: Tolorion (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Drbear Здравствуйте, Tolorion! Почитайте Туториал по DelphiX там довольно много информации по DelphiX и спрайтам. Оформлена ссылка. ----- ∙ Отредактировал: Николай Владимирович / Н.В. (Профессионал) ∙ Дата редактирования: 02.03.2008, 14:51

Ответ отправил: Drbear (статус: 8-ой класс) Ответ отправлен: 02.03.2008, 13:40

Отвечает: MaratM Здравствуйте, Tolorion! уважаемый Tolorion , вы же сами создаете спрайт и его координаты неужели вы неможете узнать его координты(которые задаете сами)?

Ответ отправил: MaratM (статус: 1-ый класс) Ответ отправлен: 03.03.2008, 01:24

© 2001-2008, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Техподдержка портала, тел.: +7 (926) 535-23-31 Хостинг: "Московский хостер" Поддержка: "Московский дизайнер" Авторские права | Реклама на портале Версия системы: 4.72.2 от 06.03.2008
RusFAQ.ru | MosHoster.ru | MosDesigner.ru | RusIRC.ru Kalashnikoff.ru | RadioLeader.ru | RusFUCK.ru