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

Выпуск № 869
от 16.07.2007, 02:35

Вопрос № 94.545

Здравствуйте уважаемые эксперты! В одной из таблиц моей БД (InterBase) имеется поле с логическим типом данных (истина, ложь), мне нужно, чтобы при нажатии кнопки (отдельной кнопки от таблицы) удалялись строки из таблицы, в которых значения данного столбца равны ложь. Заранее, всем спасибо!

Отправлен: 10.07.2007, 05:04 Вопрос задал: Киселев Сергей Николаевич (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: sir henry Здравствуйте, Киселев Сергей Николаевич! Очень просто. В тот элемент, который Вы приспособили для общения с Вашей базой InterBase, записываете запрос на удаление, потом выполняете его, потом фиксируете транзакцию: Const qrdel = 'DELETE FROM Талица WHERE Столбец=False'; {Текст запроса на удаление} Begin {IBSQL - компонент общения с базой} IBSQL1.SQL.Clear; {Очищаем от старого текста запроса, если он был} IBSQL1.SQL.Add(qrdel); {Заносим новый текст} IBSQL1.ExecQuery; {Выполняем запрос} IBTransaction.Commit; {Подтверждаем транзакцию} End; Всё это записываете в событие OnClick Вашей кнопки.

Ответ отправил: sir henry (статус: Академик) Россия, Красноярск ---- Ответ отправлен: 10.07.2007, 08:17

Вопрос № 94.614

BORLAND DELPHI 8 Я: Файл => Новый =>Wimdows Forms Aplication Размещаю на форме единственную кнопку, жму F9 Delphi: [Предупр.] Project1.dpr(8): File not found: 'WinForm.TWinForm.resources' [Error] File not found: 'WinForm.TWinForm.resources' В папке Borland Studio Projects появляется экзешник и даже работает. Borland Delphi 8 - свежеинсталированный, свежекрякнутый и свежерусифицированный Вопрос: как избежать ерора? Приложение: program Project1; {%DelphiDotNetAssemblyCompiler '$(SystemRoot)microsoft.netframeworkv1.1.4322System.dll'} {%DelphiDotNetAssemblyCompiler '$(SystemRoot)microsoft.netframeworkv1.1.4322System.Data.dll'} {%DelphiDotNetAssemblyCompiler '$(SystemRoot)microsoft.netframeworkv1.1.4322System.Drawing.dll'} {%DelphiDotNetAssemblyCompiler '$(SystemRoot)microsoft.netframeworkv1.1.4322System.Windows.Forms.dll'} {%DelphiDotNetAssemblyCompiler '$(SystemRoot)microsoft.netframeworkv1.1.4322System.XML.dll'} {$R 'WinForm.TWinForm.resources' 'WinForm.resx'} uses System.Reflection, System.Runtime.CompilerServices, System.Windows.Forms, WinForm in 'WinForm.pas' {WinForm.TWinForm: System.Windows.Forms.Form}; {$R *.res} [STAThread] begin Application.Run(TWinForm.Create); end.

Отправлен: 10.07.2007, 14:46 Вопрос задал: Валерий Александрович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Василенко Алексей Васильевич Здравствуйте, Валерий Александрович! ИМХО, причин эрора может бытть 2е: 1 - кривой инстал (не битый. а именно кривой) 2 - последствия крека или русификатора. вариан тешения.. попробовать без руссификатора --------- Человек развивается только преодолевая трудности

Ответ отправил: Василенко Алексей Васильевич (статус: 2-ой класс) Ответ отправлен: 11.07.2007, 18:26

Вопрос № 94.638

Я хочу запустить на одном пк 2 рользователей и работать независимо друг от друга пример: 1системный блок - подключаем 2 монитора, 2 мышки, 2 - клавиатуры и.т.д p.s где можно найти исходник программы, вообще любую информацию на счет этого.

Отправлен: 10.07.2007, 18:18 Вопрос задал: Serik Serik v (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: din Здравствуйте, Serik Serik v! Нигде такую информацию Вы не найдете, потому что такое в принципе невозможно сделать. Для понимания принципа работы и устройства персональных компьютеров почитайте этот курс http://www.intuit.ru/department/hardware/archhard2/ --------- Есть только одно зло - невежество, и только одно благо - знания

Ответ отправил: din (статус: Практикант) Ответ отправлен: 10.07.2007, 19:44

Отвечает: PGM Здравствуйте, Serik Serik v! Вам нужно писать такую программу? Или просто найти существующую? В принципе под системами класса NT/2K/XP или под Unix такое создать возможно, но это требует очень приличной квалификации и знаний. Исходники под Microsoft вы вряд ли найдете - это очень трудоемкое (денежно затратное) занятие и вряд ли кто будет это выкладывать. Попробуйте поискать под Linux- там вполне могут быть нужные материалы. Вот кстати нашел старую статейку http://www.osp.ru/pcworld/2004/06/168150/ А вот и программа (всего 900 р на пользователя) http://www.softkey.ru/catalog/program.php?printable=yes&ID=2587

Ответ отправил: PGM (статус: 9-ый класс) Ответ отправлен: 10.07.2007, 21:53

Вопрос № 94.644

Как узнать директорию, откуда был запущен процесс, если знаешь его имя?

Отправлен: 10.07.2007, 19:14 Вопрос задал: Танасюк Олег Олегович (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: PGM Здравствуйте, Танасюк Олег Олегович! Ниже код получающий PID и полные пути с именами файлов (AFullPath) для всех процессов (для которых разрешено вашими правами - обычно системные процессы не очень доступны :) ), вам остается только сравнить с искомым и выйти из цикла. Используется PSAPI.DLL и соответсвующий заголовок PSAPI.PAS (Delphi6). Приложение: const MAX_PROCESSES = 200; MAX_MODULES = 100; var pID : array [0..MAX_PROCESSES-1] of DWORD; cb, cbNeeded, i : Cardinal; hProc : THandle; buf : array[0..255] of Char; AMOD : array[1..MAX_MODULES] of DWORD; AFullPath : array[0..MAX_PROCESSES-1] of String; begin cb := Sizeof(pID); EnumProcesses(@pID, cb, cbNeeded); cb := cbNeeded div Sizeof(DWORD); for i := 0 to cb-1 do begin hProc := OpenProcess( PROCESS_VM_READ or PROCESS_QUERY_INFORMATION, False, PID[i]); if hProc <> 0 then begin if EnumProcessModules(hProc,@AMOD,sizeof(AMOD),c) then begin if GetModuleFileNameEx(hProc,AMOD[1],buf,sizeof(buf)) <> 0 then AFullPath[i] := buf; end; CloseHandle(hProc); end; end;

Ответ отправил: PGM (статус: 9-ый класс) Ответ отправлен: 10.07.2007, 22:14 Оценка за ответ: 4

Отвечает: Denisss Здравствуйте, Танасюк Олег Олегович! См. пример в приложении. Имя процесса вводится в Edit1 (не забудьте, что имя нужно вводить вместе с .ехе). Чтобы пример работал, необходимо подключить следующие модули: TLHELP32, ShellAPI, PsAPI. Результат выводится в тот же Edit1. Удачи! Приложение: procedure TForm1.Button1Click(Sender: TObject); var hSnapShot: THandle; pe32: TProcessEntry32; hProc: THandle; fProcName: String; lpProcName: array[0..MAX_PATH - 1] of Char; begin hSnapShot:= CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); if (hSnapShot = 0) then Exit; ZeroMemory(@lpProcName, MAX_PATH); try fProcName:= AnsiUpperCase(Edit1.Text); ZeroMemory(@pe32, sizeof(TProcessEntry32)); pe32.dwSize:= sizeof(TProcessEntry32); if (Process32First(hSnapShot, pe32)) then repeat if (AnsiUpperCase(pe32.szExeFile) = fProcName) then begin hProc:= OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, pe32.th32ProcessID); if (hProc = 0) then Exit; try GetModuleFileNameEx(hProc, 0, lpProcName, MAX_PATH); finally CloseHandle(hProc); end; Edit1.Text:= lpProcName; Exit; end; until not Process32Next(hSnapShot, pe32); finally CloseHandle(hSnapShot); end; end;

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва WWW: Хлама много, по сути ничего... ---- Ответ отправлен: 10.07.2007, 22:25 Оценка за ответ: 5

Вопрос № 94.648

Здравствуйте! Если кто помнит мой вопрос про отключение USB-устройств (№ 93659), то прошу разрешить еще одну неясность. Мне нужно вывести результат отключения устройства: "Отключено успешно", "Ошибка, устройство занято" или "Устройство не найдено". Не могу понять, результат какой функции это позволяет сделать? И, позвольте дополнительно спросить, можно ли отключить устройство принудительно, даже если оно занято в данный момент другим приложением? Если можно то как? Заранее спасибо!

Отправлен: 10.07.2007, 19:52 Вопрос задал: Red Spirit (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 8)

Отвечает: Denisss Здравствуйте, Red Spirit! Подправил немного приведенный мною пример из ответа на вопрос №93659. Теперь отключение USB выполнено в виде функции, а не процедуры. Сама функция вынесена в отдельный модуль. Пример использования см. в прикрепленном файле (usb.zip [2.5 K]). Сам модуль с функцией можно найти как в прикрепленном архиве, так и в приложении. Удачи! Приложение: unit USBEject; interface uses Windows; const setupapi = 'SetupApi.dll'; type HDEVINFO = THandle; PSP_DEVINFO_DATA = ^SP_DEVINFO_DATA; SP_DEVINFO_DATA = packed record cbSize: DWORD; ClassGuid: TGUID; DevInst: DWORD; Reserved: DWORD; end; function SetupDiGetClassDevsA(ClassGuid: PGUID; Enumerator: PChar; hwndParent: HWND; Flags: DWORD): HDEVINFO; stdcall; external setupapi; function SetupDiEnumDeviceInfo(DeviceInfoSet: HDEVINFO; MemberIndex: DWORD; DeviceInfoData: PSP_DEVINFO_DATA): boolean; stdcall; external setupapi; function SetupDiDestroyDeviceInfoList(DeviceInfoSet: HDEVINFO): boolean; stdcall; external setupapi; function CM_Get_Parent(pdnDevInst: PDWORD; dnDevInst: DWORD; ulFlags: DWORD): DWORD; stdcall; external setupapi; function CM_Get_Device_ID_Size(pulLen: PDWORD; dnDevInst: DWORD; ulFlags: DWORD): DWORD; stdcall; external setupapi; function CM_Get_Device_IDA(dnDevInst: DWORD; Buffer: PChar; BufferLen: DWORD; ulFlags: DWORD): DWORD; stdcall; external setupapi; function CM_Locate_DevNodeA(pdnDevInst: PDWORD; pDeviceID: PChar; ulFlags: DWORD): DWORD; stdcall; external setupapi; function CM_Request_Device_EjectA(dnDevInst: DWORD; pVetoType: Pointer; pszVetoName: PChar; ulNameLength: DWORD; ulFlags: DWORD): DWORD; stdcall; external setupapi; type TUSBEvent = (uvSuccess, uvError, uvDevNotFound, uvUnknown); function EjectUSB: TUSBEvent; implementation function IsUSBDevice(DevInst: DWORD): boolean; function CompareMem(p1, p2: Pointer; len: DWORD): boolean; var i: DWORD; begin Result:= False; if (len = 0) then Exit; for i:= 0 to Pred(len) do if PByte(DWORD(p1) + i)^ <> PByte(DWORD(p2) + i)^ then Exit; Result:= True; end; var IDLen: DWORD; ID: PChar; begin result:= false; if (CM_Get_Device_ID_Size(@IDLen, DevInst, 0) <> 0) or (IDLen = 0) then Exit; inc(IDLen); ID:= GetMemory(IDLen); if (ID = nil) then Exit; if (CM_Get_Device_IDA(DevInst, ID, IDLen, 0) <> 0) or (not CompareMem(ID, PChar('USBSTOR'), 7)) then begin FreeMemory(ID); exit; end; FreeMemory(ID); result:= true; end; function EjectUSB: TUSBEvent; const GUID_DEVCLASS_DISKDRIVE: TGUID = (D1: $4D36E967; D2: $E325; D3: $11CE; D4: ($BF, $C1, $08, $00, $2B, $E1, $03, $18)); var hDevInfoSet: HDEVINFO; DevInfo: SP_DEVINFO_DATA; i: Integer; Parent: DWORD; VetoName: PChar; begin Result:= uvError; ZeroMemory(@DevInfo, sizeof(SP_DEVINFO_DATA)); DevInfo.cbSize:= sizeof(SP_DEVINFO_DATA); hDevInfoSet:= SetupDiGetClassDevsA(@GUID_DEVCLASS_DISKDRIVE, nil, 0, 2); if (hDevInfoSet = INVALID_HANDLE_VALUE) then Exit; i:= 0; Result:= uvDevNotFound; while (SetupDiEnumDeviceInfo(hDevInfoSet, i, @DevInfo)) do begin if (IsUSBDevice(DevInfo.DevInst)) and (CM_Get_Parent(@Parent, DevInfo.DevInst, 0) = 0) then begin VetoName:= GetMemory(260); if (CM_Request_Device_EjectA(Parent, nil, VetoName, 260, 0) <> 0) then begin if (CM_Locate_DevNodeA(@Parent, VetoName, 0) <> 0) then begin FreeMemory(VetoName); Continue; end; FreeMemory(VetoName); if (CM_Request_Device_EjectA(Parent, nil, nil, 0, 0) <> 0) then Continue; end; FreeMemory(VetoName); Result:= uvUnknown; SetupDiDestroyDeviceInfoList(hDevInfoSet); ZeroMemory(@DevInfo, sizeof(SP_DEVINFO_DATA)); DevInfo.cbSize:= sizeof(SP_DEVINFO_DATA); hDevInfoSet:= SetupDiGetClassDevsA(@GUID_DEVCLASS_DISKDRIVE, nil, 0, 2); if (hDevInfoSet = INVALID_HANDLE_VALUE) then Exit; Result:= uvSuccess; if (SetupDiEnumDeviceInfo(hDevInfoSet, i, @DevInfo)) then if (IsUSBDevice(DevInfo.DevInst)) and (CM_Get_Parent(@Parent, DevInfo.DevInst, 0) = 0) then Result:= uvError; Break; end; inc(i); end; SetupDiDestroyDeviceInfoList(hDevInfoSet); end; end. Прикреплённый файл: Загрузить >> Срок хранения файла на сервере RusFAQ.ru составляет 30 суток с момента отправки ответа.

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва WWW: Хлама много, по сути ничего... ---- Ответ отправлен: 10.07.2007, 21:35 Оценка за ответ: 5 Комментарий оценки: Спасибо новый пример! Но вопрос на счет принудительного отключения еще остался...

Вопрос № 94.675

У меня такой вопрос: Как можно в Charte нарисовать скажем пучек прямых из какой-либо точки под разными углами.

Отправлен: 10.07.2007, 22:27 Вопрос задал: Ибрагимов Дмитрий Владимирович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Примак Руслан Николаевич Здравствуйте, Ибрагимов Дмитрий Владимирович! В общем случае уравнение пучка прямых проходящих через точку А(x1, y1) равно y-y1 = k(x-x1 ), где k - параметр пучка (взято с http://www.mathelp.spb.ru/book1/lines.htm). Собственно, реализация в приложении. Не забудьте в Charte отключить автомасштаб по оси Y. Приложение: unit MainUnit; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, TeeProcs, TeEngine, Chart, Series; type TForm1 = class(TForm) Chart1: TChart; GoBtn: TButton; procedure GoBtnClick(Sender: TObject); private { Private declarations } function NewSeries(K: Double): TFastLineSeries; public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} { TForm1 } procedure TForm1.GoBtnClick(Sender: TObject); Const MIN_K = 0; MAX_K = 10; STEP_K = 0.2; var i: Double; begin i := MIN_K; while i <= MAX_K do begin Chart1.AddSeries(NewSeries(i)); i := i + STEP_K; end; Chart1.Repaint; end; function TForm1.NewSeries(K: Double): TFastLineSeries; Const MAX_X = 100; X1 = 5; Y1 = 2; var tmpFLS: TFastLineSeries; x: Integer; begin tmpFLS := TFastLineSeries.Create(self); for x := 0 to MAX_X do tmpFLS.AddXY(x, K*(x-X1) + Y1); Result := tmpFLS; end; end.

Ответ отправил: Примак Руслан Николаевич (статус: 3-ий класс) Ответ отправлен: 12.07.2007, 18:14

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