cardons, типичная ошибка, уже тут на форуме не раз задавали подобный вопрос, чужое приложение ничего не знает о твоей переменной Rect - ее нет в адресном пространстве чужого приложения, поэтому SendMessage(HndControl,LVM_GETITEMRECT,0, LongInt(@Rect)); и не будет отрабатывать как надо (link), и слать лучше PostMessage или SendMessageTimeout, иначе в случае, если что-то пойдет не так в чужом приложении, ты можешь так и не дождаться возвращения управления после вызова SendMessage
процедура для обхода всех файлов на диске Code: procedure obxod1(path:string); var FD : TWin32FindData; FH : THandle; begin FH := FindFirstFile(PChar(path+'*.*'), FD); repeat if (FH<>INVALID_HANDLE_VALUE) and (FD.cFileName<>string('.')) and (FD.cFileName<>string('..')) then begin if FD.dwFileAttributes=FILE_ATTRIBUTE_DIRECTORY then begin obxod1(path+FD.cFileName+'\'); end; end; until FindNextFile(FH, FD) = false; end; вызываю Code: obxod1('С:\') но программа не заходит в папки Users, Windows, Program Files. Как можно исправить?
Вообще-то для чтения этих директорий не нужно повышать права. И, по-моему, я уже в этой теме отвечал на похожий вопрос... FD.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY заменить на (FD.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Потому что dwFileAttributes - это DWORD, содержащий массив бит (флагов), и если бит FILE_ATTRIBUTE_DIRECTORY установлен, то файл является директорией... НО другие флаги тоже могут быть установлены, а вы проверяете точное сходство с одним флагом.
Спасибо за совет. Вроде решил это так. Но выделенных теперь 2 элемента 1 и тот что я указал. Первый всегда выделен по умолчанию и должен сниматься при выделении другого.Теперь необходимо на выделенном элементе кликнуть 2 раза левой клавишой мыши... Подскажи если знаешь. Code: GetWindowThreadProcessId(HndControl, pid); if pid <> 0 then begin hProcess := OpenProcess(PROCESS_VM_WRITE or PROCESS_VM_OPERATION, TRUE, pid); lpMem := VirtualAllocEx(hProcess, nil, sizeof(LV_ITEM), MEM_COMMIT, PAGE_READWRITE); LV.state := LVIS_FOCUSED or LVIS_SELECTED; LV.mask := LVIS_FOCUSED or LVIS_SELECTED; LV.stateMask := LVIS_FOCUSED or LVIS_SELECTED; WriteProcessMemory(hProcess, lpMem, @LV, sizeof(LV_ITEM), cdWrite); PostMessage(HndControl, LVM_SETITEMSTATE, WPARAM(15), LPARAM(lpMem)); //VirtualFreeEx(hProcess, lpMem, 0, MEM_RELEASE); CloseHandle(hProcess); end;
точно сказать сложно, потому что не известно какие и как обрабатываются сообщения в другом приложении, но можно попробовать послать мессагу NM_DBLCLK с указанием нужного индекса элемента, либо изучать List-View Control Reference а выделение с других элементов попробовать снять макросом: Code: ListView_SetItemState(ListView, index, 0x0, LVIS_SELECTED); где index либо конкретный элемент, либо -1, тогда изменения должны примениться ко всем элементам ( link ) и код, наверное, я бы так сделал Code: if (pid <> 0) then begin hProcess:= OpenProcess(PROCESS_VM_WRITE or PROCESS_VM_OPERATION, TRUE, pid); try lpMem:= VirtualAllocEx(hProcess, nil, sizeof(LV_ITEM), MEM_COMMIT, PAGE_READWRITE); try LV.state := LVIS_FOCUSED or LVIS_SELECTED; LV.mask := LVIS_FOCUSED or LVIS_SELECTED; LV.stateMask := LVIS_FOCUSED or LVIS_SELECTED; if WriteProcessMemory(hProcess, lpMem, @LV, sizeof(LV_ITEM), cdWrite) then begin iRes:= SendMessageTimeout(HndControl, LVM_SETITEMSTATE, WPARAM(15), LPARAM(lpMem), SMTO_ABORTIFHUNG, 5000, lpdwResult); if (iRes = 0) and (GetLastError = ERROR_TIMEOUT) then ShowMessageFmt('Error: SendMessage timeout (pid: %d window: %d)', [pid, HndControl]); end; finally VirtualFreeEx(hProcess, lpMem, 0, MEM_RELEASE); end; finally CloseHandle(hProcess); end; end;
Гуглил так и не понял как правильно в Delphi отправить NM_DBLCLK. Уже все перепробовал. Думал с помощью Enter выбирать нужный элемент. А фиг там... Выключен выбор с помощью него. Именно нужен дабл клик по определенному пункту. Пункты я считываю. Фокус на нужный элемент устанавливаю... А вот дабл клик...
Code: uses CommCtrl; var it:TNMITEMACTIVATE; HW:DWORD; //main form MyCtrl:DWORD; //control begin it.hdr.code:=NM_DBLCLK; SendMessage(HW, WM_NOTIFY, MyCtrl, Integer(@it)); типа того
Столкнулся с проблемой!Один очень хороший человек подсказал как ее решить но опыта не хватает, по этому прошу помощи как реализовать такое: 1 - после запуска проверяем папку где мы находимся, например if ExtractFilePath(ParamStr(o)) = 'c:\TargetFolder' then {ничего не делаем}: 2 - если мы в какой-то другой папке, то проверям есть ли уже скопированное приложение в TargetFolder 3 - если есть - ничего не делаем и закрываемся, если нет - копируем себя туда и запускаем
Попробуйте так : if extractfilepath(Application.ExeName) ... Мой вопрос : Есть список строк , часто одинаковых, нужен сортировщик по исключениям , то есть вносишь образцы которые если есть сортировщик НЕ кидает в мемо. Сам код : memo1 - сам строки которые будут сортировать memo2 - выведенные строки mmo1 - исключения, которые надо пропускать Code: for i:=0 to memo1.lines.Count-1 do begin for j:=0 to mmo1.Lines.Count-1 do begin if pos(mmo1.Lines[j], memo1.Lines.Strings[i])=0 then begin memo2.Lines.Add(memo1.Lines[i]); end else begin end; end; end; Пробовал по разному , может у меня что-то с логикой ?
ParamStr принимает индекс аргумента (число), а у вас там буква "o". ParamStr(0) вернёт полный адрес до приложения. Code: uses SysUtils, Windows, ShellAPI; procedure CheckInstall; const DestPath = 'C:\TargetFolder\'; var DestName: String; begin if ExtractFilePath(ParamStr(0)) = DestPath then begin // уже запущены из нужной папки Writeln('No installation required'); Exit; end; DestName := ExtractFileName(ParamStr(0)); if FileExists(DestPath + DestName) then begin // уже скопированы в нужную папку Writeln('Already installed'); Exit; end; if not CopyFile(PChar(ParamStr(0)), PChar(DestPath + DestName), False) then begin // не удалось скопироваться Writeln('CopyFile failed (error ', GetLastError(), ')'); Exit; end; // запускаемся ShellExecute(0, 'open', PChar(DestPath + DestName), nil, PChar(DestPath), SW_SHOWDEFAULT); // примечание: функция ShellExecute не ожидает завершения запущенного процесса // если нужно ждать - используйте CreateProcess в паре с WaitForSingleObject end; Для консольного приложения или DLL такой способ не прокатит. ParamStr(0) в данном случае очень удобен.
А вот мой легковесный вариант, без использования тяжелого SysUtils и ShellApi. Экономия в размере 24,5кб PHP: program Project2; {$APPTYPE CONSOLE} const GENERIC_READ = $80000000; FILE_SHARE_READ = $00000001; OPEN_EXISTING = 3; FILE_ATTRIBUTE_NORMAL = $00000080; SW_SHOWNORMAL = 1; function GetCommandLineA:PAnsiChar; external 'kernel32.dll'; function CreateFileA(lpFileName: PAnsiChar; dwDesiredAccess, dwShareMode: LongWord; lpSecurityAttributes: pointer; dwCreationDisposition, dwFlagsAndAttributes: LongWord; hTemplateFile: THandle): THandle; stdcall external 'kernel32.dll'; function CloseHandle(hObject: THandle): BOOLEAN; stdcall external 'kernel32.dll'; function CopyFileA(lpExistingFileName, lpNewFileName: PAnsiChar; bFailIfExists: BOOLEAN): BOOLEAN; stdcall external 'kernel32.dll'; function ShellExecuteA(hWnd: LongWord; Operation, FileName, Parameters, Directory: PChar; ShowCmd: Integer): HINST; stdcall external 'shell32.dll'; var CommandLine:string; h:LongWord; const TargetFile='C:\mustbethere\myexe.exe'; begin CommandLine:=GetCommandLineA(); CommandLine:=copy(CommandLine,2,length(CommandLine)-3); if pos(TargetFile,CommandLine)=0 Then begin h:=CreateFileA(TargetFile, GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); CloseHandle(h); if h=$FFFFFFFF then begin CopyFileA(PChar(CommandLine), TargetFile, false); ShellExecuteA(0, 'Open', TargetFile, '', '', SW_SHOWNORMAL); end; end; end.
Memo1 - Строки для сортировки Memo2 - Строки исключения Memo3 - Вывод результата PHP: procedure TForm1.Button1Click(Sender: TObject); var i,j:integer; exclude:boolean; begin for i:=0 to Memo1.Lines.Count do begin exclude:=false; for j:=0 to Memo2.Lines.Count do begin If Memo2.Lines.Strings[j]=Memo1.Lines.Strings[i] Then exclude:=true; end; If exclude=true Then continue Else Memo3.Lines.Add(Memo1.Lines.Strings[i]) end; end;
copyfile(PAnsiChar(Paramstr(0))),(P AnsiChar('C:\ProgramData\Microsoft. NET'+ExtractFileName(Paramstr(0)))) ; что сдесь не так?
Вероятно это: copyfile(PAnsiChar(Paramstr(0))),(P AnsiChar('C:\ProgramData\Microsoft. NET\'+ExtractFileName(Paramstr(0)))) ; Ну и в Paramstr(0) тоже может быть
1. Скобки не так. Даже не представляю, почему вы расставили их именно так... 2. И вы точно уверены, что PAnsiChar? Если вызываете CopyFileA, то да. А если CopyFileW, то PWideChar. 3. В любом случае, я зачастую пишу просто PChar, т.к. это совместимо со всеми версиями Delphi (ANSI и Unicode). 4. "Microsoft. NET" - вы уверены в правильности названия папки? По-моему "Microsoft.NET" 5. В конце названия папки нужно ставить "\", поскольку ExtractFileName вернёт строку, не содержащую этот символ в начале. copyfile(PChar(Paramstr(0)), PChar('C:\ProgramData\Microsoft.NET\' + ExtractFileName(Paramstr(0)))); После всех исправлений, я начинаю задаваться вопросом, действительно ли это вам нужно...
Все отлично!Но почемуто копия получается битая!Моя программа посылает обычный гет запрос!Но при запуске копии она этого не делает в чем проблема? вот код begin if not FileExists('C:\ProgramData\Microsof t.NET\' + ExtractFileName(Paramstr(0))) then begin copyfile(PAnsiChar(Paramstr(0)), PAnsiChar('C:\ProgramData\Microsoft .NET\' + ExtractFileName(Paramstr(0))), False); ShellExecute(Handle, nil, PAnsiChar('C:\ProgramData\Microsoft .NET\' + ExtractFileName(Paramstr(0))), nil, nil, SW_SHOW); sl:= TStringList.Create; sl.Text:= idhttp1.Get('http://111111111.txt'); for i:= 0 to sl.Count-1 {??? ??????? ????, ????. 5} do (FindComponent('Edit' + IntToStr(i+1)) as TEdit).Text:= sl; sl.Free;
