ANTICHAT — форум по информационной безопасности, OSINT и технологиям
ANTICHAT — русскоязычное сообщество по безопасности, OSINT и программированию.
Форум ранее работал на доменах antichat.ru, antichat.com и antichat.club,
и теперь снова доступен на новом адресе —
forum.antichat.xyz.
Форум восстановлен и продолжает развитие: доступны архивные темы, добавляются новые обсуждения и материалы.
⚠️ Старые аккаунты восстановить невозможно — необходимо зарегистрироваться заново.
 |
|

31.03.2009, 13:13
|
|
Участник форума
Регистрация: 28.04.2008
Сообщений: 172
Провел на форуме: 1191083
Репутация:
270
|
|
1) Нет возможности подключится к сервоку (Нет инета на компе)
Проверить подключение к инету можно так:
Код:
if GetSystemMetrics(SM_NETWORK) and $01 = $01 then
ShowMessage('Computer is attached to a network!')
else
ShowMessage('Computer is not attached to a network!');
|
|
|

31.03.2009, 14:36
|
|
Постоянный
Регистрация: 26.01.2008
Сообщений: 796
Провел на форуме: 5209663
Репутация:
357
|
|
Сообщение от art2222
Проверить подключение к инету можно так:
Код:
if GetSystemMetrics(SM_NETWORK) and $01 = $01 then
ShowMessage('Computer is attached to a network!')
else
ShowMessage('Computer is not attached to a network!');
Не подходит, т.к. если icq сменит протоколы , то будет происходить попытка с сервером icq
С этим я разобрался, теперь надо команду которыя будет делать батон не кликабельным и наоборот
Последний раз редактировалось НTL; 31.03.2009 в 14:41..
|
|
|

31.03.2009, 14:56
|
|
Участник форума
Регистрация: 28.04.2008
Сообщений: 172
Провел на форуме: 1191083
Репутация:
270
|
|
С этим я разобрался, теперь надо команду которыя будет делать батон не кликабельным и наоборот
Button1.enabled:= not Button1.Enabled;
Не подходит, т.к. если icq сменит протоколы , то будет происходить попытка с сервером icq
Это просто проверка соединения с инетом.
|
|
|

31.03.2009, 15:06
|
|
Постоянный
Регистрация: 26.01.2008
Сообщений: 796
Провел на форуме: 5209663
Репутация:
357
|
|
Button1.enabled:= not Button1.Enabled;
А обратно как?
|
|
|

31.03.2009, 15:10
|
|
Участник форума
Регистрация: 28.04.2008
Сообщений: 172
Провел на форуме: 1191083
Репутация:
270
|
|
Button1.enabled:= true //доступен
Button1.enabled:= false //недоступен
|
|
|
UnDelphiX - частые ошибки типа Access Violation |

31.03.2009, 17:24
|
|
Новичок
Регистрация: 12.05.2008
Сообщений: 19
Провел на форуме: 28051
Репутация:
2
|
|
UnDelphiX - частые ошибки типа Access Violation
Здравствуйте!
С DelphiX начал общаться совсем недавно, скачал и установил какую-то доступную версию неофициального DelphiX (так называемый UnDelphiX)..
Попробовал написать свою первую программу. Это простенькая игрушка: есть игрок, который управляется стрелочками с клавиатуры, на него с верней части экрана падают звезды. При касании звезды игрок умирает. Иногда выпадают некоторые бонусы (сейчас 2: некое бессмертие с возможностью уничтожения звезд и небольшое замедление скорости всех объектов).. С течением времени, кстати, звезды появляются все чаще и чаще.. К моменту ошибки максимум на экране бывало отображалось до 28 живых звезд
Все вроде бы работает, можно играть, но иногда, в произвольный момент (можно и три минуты играть) игра вылетает, выдавая ошибку Access Violation и окошко CPU (с которым я работать совершенно не умею, и поэтому я не могу сделать отладку программы).
Это портит, понятное дело, всю игру.. я прилагаю к сообщению ссылку на архив со своей программой, может быть у кого-нибудь найдется время посмотреть и помочь мне, вдруг я какие ошибки совершаю, чтобы в будущем этого не было, пока проект-то не такой серьезный.. детская же совсем игруля..
Я просто устал несколько дней подряд бороться с ошибками, прошу помощи! Спасибо всем тем, кто откликнется!
На всякий случай прилагаю установщик моей версии UnDelphiX).
Для справок:
ОС: WinVista Home Premium
версия Delphi 7
P.S. раньше еще часто возникала ошибка типа Stack Overflow (я не знаю, удалось ли мне от нее целиком избавиться, но я давно ее не наблюдал.. у меня в таймерах я вызывал эти же таймеры, что, возможно, давало эффект обратной связи и зацикливание.. я устранил это путем булевых переменных, вроде бы теперь не возникает.. но если такое обнаружится в ходе отладки, просьба, сообщите об этом мне)..
Ссылка: Скачать (размер 3,867 Mb)
(из-за проблем сервера не смог выложить на ucoz, поэтому простите за rapidshare)
Кстати, установщик UnDelphiX предлагает найти и установить новую версию. Ее он находит, успешно куда-то загружает, а установщик не запускает. Помогите определить, куда он закачивает новую версию! Спасибо!
Последний раз редактировалось Nick_Rimer; 31.03.2009 в 17:37..
|
|
|

31.03.2009, 18:56
|
|
Постоянный
Регистрация: 05.07.2008
Сообщений: 555
Провел на форуме: 3134311
Репутация:
1467
|
|
Программу сейчас посмотреть не могу.
Но попробуй везде где только можешь вставить такие строчки
try
begin
СЮДА ВСТАВЛЯЕШЬ СВОЙ КОД ПРОСТО, БЕЗ ИЗМЕНЕНИЙ
end
except on EAssesViolation do
begin
ТУТ ОСТАВЛЯЕШЬ ПУСТОТУ
НО ПРИ ЖЕЛАНИИ МОЖЕШЬ ОКОШКО КАКОЕ-ТО ОТКРЫТЬ
end;
При отладке программы будут возникать ошибки всё-равно.
Но когда будешь играть запуская программу не из Delphi a просто из Винды, то ошибок не будет.
попробуй, может просто программа закроется в какой-то момент (ошибка не выведется и там из-за глюка её закроет..)
Насчет UnDelphi попробуй папку Temp. Чаще всего туда загружаются такие файлы. Поищи по дате
попробуй ещё папку Tempory Internet Files в папкее Windows.
|
|
|

31.03.2009, 20:52
|
|
Новичок
Регистрация: 12.05.2008
Сообщений: 19
Провел на форуме: 28051
Репутация:
2
|
|
Немного добавим..
Тогда у меня еще пару вопросов:
1. Все-таки нарвался на Stack overflow.. есть ли на него exception? чтобы попробовать его отловить.. и избавиться бы от него!
2. Когда загружается приложение, курсор мышки сразу устанавливается на середину.. меня это бесит, мне в этом приложении вообще мышь не нужна.. убрать бы этот курсор на время работы приложения.. только чтобы в других приложениях он был!
Спасибо.. только и все предыдущее пока остается в силе..
|
|
|

31.03.2009, 21:10
|
|
Участник форума
Регистрация: 06.03.2007
Сообщений: 283
Провел на форуме: 1547094
Репутация:
120
|
|
Пацаны, ну помогите написать один код на delphi который будет каждую минуту открывать файл 1.txt в диске C:\ , и если там написано '123', то тогда программа должна проверить запущен ли процесс 1.exe, и если да, то закрыть его и вывести сообщение типа 'Процесс закрыт', цикл должен быть бессконечным.
Плиз, просто сам никак не могу написать такой код, новичок еще в этом деле...=)))
|
|
|

31.03.2009, 21:20
|
|
Участник форума
Регистрация: 28.04.2008
Сообщений: 172
Провел на форуме: 1191083
Репутация:
270
|
|
Код:
uses
Psapi, tlhelp32;
procedure CreateWin9xProcessList(List: TstringList);
var
hSnapShot: THandle;
ProcInfo: TProcessEntry32;
begin
if List = nil then Exit;
hSnapShot := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if (hSnapShot <> THandle(-1)) then
begin
ProcInfo.dwSize := SizeOf(ProcInfo);
if (Process32First(hSnapshot, ProcInfo)) then
begin
List.Add(ProcInfo.szExeFile);
while (Process32Next(hSnapShot, ProcInfo)) do
List.Add(ProcInfo.szExeFile);
end;
CloseHandle(hSnapShot);
end;
end;
procedure CreateWinNTProcessList(List: TstringList);
var
PIDArray: array [0..1023] of DWORD;
cb: DWORD;
I: Integer;
ProcCount: Integer;
hMod: HMODULE;
hProcess: THandle;
ModuleName: array [0..300] of Char;
begin
if List = nil then Exit;
EnumProcesses(@PIDArray, SizeOf(PIDArray), cb);
ProcCount := cb div SizeOf(DWORD);
for I := 0 to ProcCount - 1 do
begin
hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or
PROCESS_VM_READ,
False,
PIDArray[I]);
if (hProcess <> 0) then
begin
EnumProcessModules(hProcess, @hMod, SizeOf(hMod), cb);
GetModuleFilenameEx(hProcess, hMod, ModuleName, SizeOf(ModuleName));
List.Add(ModuleName);
CloseHandle(hProcess);
end;
end;
end;
procedure GetProcessList(var List: TstringList);
var
ovi: TOSVersionInfo;
begin
if List = nil then Exit;
ovi.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
GetVersionEx(ovi);
case ovi.dwPlatformId of
VER_PLATFORM_WIN32_WINDOWS: CreateWin9xProcessList(List);
VER_PLATFORM_WIN32_NT: CreateWinNTProcessList(List);
end
end;
function EXE_Running(FileName: string; bFullpath: Boolean): Boolean;
var
i: Integer;
MyProcList: TstringList;
begin
MyProcList := TStringList.Create;
try
GetProcessList(MyProcList);
Result := False;
if MyProcList = nil then Exit;
for i := 0 to MyProcList.Count - 1 do
begin
if not bFullpath then
begin
if CompareText(ExtractFileName(MyProcList.Strings[i]), FileName) = 0 then
Result := True
end
else if CompareText(MyProcList.strings[i], FileName) = 0 then Result := True;
if Result then Break;
end;
finally
MyProcList.Free;
end;
end;
(c) DRKB
Проверяем так:
Код:
procedure CheckFile;
var
f: TextFile;
s: string;
begin
AssignFile(f,'c:\1.txt');
Reset(f);
Readln(f,s);
if s='123' then
begin
if EXE_Running('1.exe', False) then
ShowMessage('EXE is running')
else
ShowMessage('EXE is not running');
end;
CloseFile(f);
end;
Потом в цикле вызываешь процедуру и все.
А вот как нужно убивать процесс зная только его имя (notepad.exe например)
Код:
uses
Tlhelp32, Windows, SysUtils;
function KillTask(ExeFileName: string): integer;
const
PROCESS_TERMINATE=$0001;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
result := 0;
FSnapshotHandle := CreateToolhelp32Snapshot
(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle,
FProcessEntry32);
while integer(ContinueLoop) <> 0 do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
UpperCase(ExeFileName))
or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(ExeFileName))) then
Result := Integer(TerminateProcess(OpenProcess(
PROCESS_TERMINATE, BOOL(0),
FProcessEntry32.th32ProcessID), 0));
ContinueLoop := Process32Next(FSnapshotHandle,
FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;
Последний раз редактировалось art2222; 31.03.2009 в 21:25..
|
|
|
|
 |
|
|
Здесь присутствуют: 1 (пользователей: 0 , гостей: 1)
|
|
|
|