Czy można zrobic tak w delphi, jak robi moduł eventlet w pythonie? Ewntualnie, czy istnieje jakaś możliwość, aby wątki wypisywały jednocześnie np. w memo nie powodując błędu?
Aktualizacja zawartości danego komponentu musi być synchronizowana, więc jeśli kilka wątków pobocznych ma dodawać dane do Memo
, to każdy z nich powinien do tego używać metody Synchronize
. Nie będzie żadnego błędu.
O to chodziło. Dzięki. Czyli wykorzystując CreateThread nie da sie tego zrobic. Trzeba normalnie w delphi.
da się - możesz z wątku pobocznego wysłać tekst to wątku głównego przez SendMessage
ale to więcej pisania
Pewnie, że bezpośrednio w WinApi też się da https://docs.microsoft.com/pl-pl/windows/desktop/Sync/critical-section-objects zresztą Delphi (mowa o apkach pod Windows) też wykorzystuje te funkcje tylko je "obudowuje".
Chodzi mi o wywoływanie funkcjii GetIPThreadProc w osobnych wątkach (jakiś multithreading) z funkcjii GetChannelsThreadProc z kolejnymi ip. Kod poniżej. Funkcja Log wypisuje w Memo. StreamToStr to moja własna funkcja.
procedure TMainForm.FormShow(Sender: TObject);
var
ThreadId : Cardinal;
begin
SynHttp := THttpSend.Create;
if Channels_Page <> '' then
begin
ThreadHandle := CreateThread(nil, 0, @GetChannelsThreadProc, Pointer(RefreshBtnHandle), 0, ThreadId);
end;
end;
procedure GetChannelsThreadProc(Param : Pointer); stdcall;
var
DocStr : string;
List, ListIP : TStringList;
data : Utf8String;
IP, PORT : string;
I : Integer;
ThreadId : Cardinal;
R : TRegExpr;
pattern : string;
begin
with MainForm do
begin
if Param <> nil then
begin
EnableWindow(HWND(Param), False);
end;
IP := '89.66.193.3';
PORT := '80';
R := TRegexpr.Create;
Log('Wyszukuj� list� zakres�w IP...');
List := TStringList.Create;
ListIP := TStringList.Create;
ListIP.Sorted := True;
with SynHttp do
begin
data := DecodeUrl(EncodeUrlElement('<s:Envelope xmlns:s="http://schemas.xmlsoap.org/soap/envelope/"><s:Body><GetData xmlns="http://iptv-backend.apphb.com/" xmlns:i="http://www.w3.org/2001/XMLSchema-instance"><ip>'+IP+'</ip><port>'+PORT+'</port><source>pf1.18</source></GetData></s:Body></s:Envelope>'));
MimeType := 'text/xml;charset=utf-8';
UserAgent := '';
Headers.Add('Accept-Encoding:xml,deflate');
Document.Write(Pointer(data)^, Length(data));
HTTPMethod('POST',Channels_Page);
DocStr := StreamToStr(Document);
end;
pattern := ('<Country>(.+?)</Country><Network>(.+?)</Network><AsName>(.+?)</AsName><LastUpdate>(.+?)</LastUpdate>');
R.Expression := pattern;
if R.Exec(DocStr) then
begin
Log(#13#10 + #13#10 + 'Kraj: ' + R.Match[1] + #13#10 +
'Sie�: ' + R.Match[2] + #13#10 +
'AS: ' + R.Match[3] + #13#10 +
'Aktualizacja: ' + R.Match[4] + #13#10);
end;
List := ParseXML(DocStr);
Log('Zakres�w: ' + IntToStr(List.Count - 1));
Log('Tworz� list� ip do skanu.');
ListIP := ParseListIP(List);
Log ('Wygenerowana ilo�� IP: ' + IntToStr(ListIP.Count));
Log ('Skanuj� IP.');
CreateThread(nil, 0, @GetIPThreadProc, Pointer(ListIP), 0, ThreadId);
R.Free;
end;
end;
procedure GetIPThreadProc(Param : Pointer); stdcall;
var
url, ip : string;
DocStr : string;
Lista : TStringList;
I : Integer;
HTTP : THttpSend;
s : TStream;
code : Integer;
begin
Lista := TStringList(Param);
url := 'http://%s/stalker_portal/c/';
HTTP :=ThttpSend.Create;
for I := 0 to Lista.Count - 1 do
begin
ip := Lista.Strings[I];
HTTP :=ThttpSend.Create;
with HTTP do
begin
Sock.NonBlockMode:=true;
Protocol := '1.1';
UserAgent := '';
KeepAlive := True;
Sock.ConnectionTimeout := 300;
Sock.NonBlockMode := True;
//Sock.SocksTimeout:=300;
//Sock.SetTimeout(300);
//Sock.NonblockSendTimeout:=500;
//TimeOut := 300;
HTTPMethod('HEAD',Format(url, [ip]));
DocStr := StreamToStr(Document);
if ResultCode = 200 then
MainForm.Log(IntToStr(ResultCode) + ' ' + Format(url, [ip]));
Free;
end;
end;
end;
Generalnie pomijając jakość Twojego kodu synchronizacja sprowadza się do:
var
Form1: TForm1;
CSec: TRTLCriticalSection;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
InitializeCriticalSection(CSec);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteCriticalSection(CSec);
end;
A w procedurach wątków umieszczasz kod który operuje na komponentach pomiędzy:
EnterCriticalSection(CSec);
//tu kod modyfikujacy komponenty (czyli cały ten kod z wpisywaniem do memo (Log))
LeaveCriticalSection(CSec);
Nie działa, ale dzięki. kAzek mówisz, że kod do kitu. A jakbyś Ty napisał?
xenix33 napisał(a):
Nie działa, ale dzięki. kAzek mówisz, że kod do kitu. A jakbyś Ty napisał?
Ja bym spojrzał np, tutaj
https://www.thoughtco.com/synchronizing-threads-and-gui-delphi-application-1058159
szczegolnie zwrócił bym uwage na sposób w jaki **TMyThread **uruchamia metode DoProgress