type
TProductThread = class(TThread)
private
FOwnerForm: TForm1;
FErrorMessage: string; // Hataları saklamak için
protected
procedure Execute; override;
procedure UpdateUI; // UI'yi güncellemek için
procedure HandleError; // Hataları UI'de göstermek için
public
constructor Create(AOwnerForm: TForm1);
end;
constructor TProductThread.Create(AOwnerForm: TForm1);
begin
inherited Create(True); // Thread suspended başlar
FOwnerForm := AOwnerForm;
FreeOnTerminate := True; // Thread tamamlandığında serbest bırakılır
FErrorMessage := ''; // Hata mesajını sıfırla
Start; // Thread başlat
end;
procedure TProductThread.Execute;
var
JSONObject, JSONObjectCat: TJSONObject;
DrawArray: TJSONArray;
JSONValue: TJSONValue;
I: Integer;
BasURL: string;
begin
try
BasURL := 'https://api.trendyol.com/sapigw/suppliers/918400/products?page=0&size=300&approved=True';
FOwnerForm.RESTClient1.BaseURL := BasURL;
FOwnerForm.RESTRequest1.Execute;
JSONValue := FOwnerForm.RestResponse1.JSONValue;
if JSONValue = nil then
raise Exception.Create('Geçerli bir JSON yanıtı alınamadı.');
JSONObject := TJSONObject(TJSONObject.ParseJSONValue(JSONValue.ToString));
try
DrawArray := TJSONArray(JSONObject.FindValue('content'));
for I := 0 to DrawArray.Count - 1 do
begin
with TJSONObject(DrawArray.Items[I]) do
begin
isim := FindValue('title').Value;
kategoriadi := FindValue('categoryName').Value;
barkod := FindValue('barcode').Value;
stokkodu := FindValue('stockCode').Value;
fiyat := FindValue('salePrice').Value;
miktar := strtoint(FindValue('quantity').Value);
// drawArraycat := TJSONArray( FindValue('attributes') );
if (miktar = 0) and (fiyat='0') then form1.askmem.Lines.Add(stokkodu) else if miktar = 0 then form1.amsmem.Lines.Add(stokkodu)
else if (form1.kelimeara(stokkodu,form1.asgmem)=False) and (form1.kelimeara(stokkodu,form1.askmem)=False) and (form1.kelimeara(stokkodu,form1.amsmem)=False) then form1.adumem.Lines.Add(stokkodu);
datayaekle(form1.listview6);
end;
end;
finally
JSONObject.Free;
end;
except
on E: Exception do
begin
FErrorMessage := E.Message; // Hata mesajını kaydet
Synchronize(HandleError); // Hata durumunda UI'yi bilgilendir
end;
end;
Synchronize(UpdateUI); // UI'yi güncellemek için çağır
end;
procedure TProductThread.UpdateUI;
begin
// Ana formdaki UI'yi güncelle
FOwnerForm.Memo1.Lines.Add('İşlem tamamlandı!');
end;
procedure TProductThread.HandleError;
begin
if FErrorMessage <> '' then
ShowMessage('Hata: ' + FErrorMessage);
end;
procedure TForm1.StartThread;
begin
if Assigned(ProductThread) and (not ProductThread.Finished) then
begin
ShowMessage('Thread hâlen çalışıyor. Lütfen bekleyin.');
Exit;
end;
ProductThread := TProductThread.Create(Self); // Yeni thread oluştur
end;
Project TrenYolKontrol.exe raised exception class EThread with message 'Cannot call Start on a running or suspended thread'. Hatasını alıyorum. Engelleyemedim...
Amacım şu procedürü thread içine almak
procedure TForm1.ayarurungetir;
var
JSONObject,JSONObjectcat : TJsonObject;
drawArray,drawArraycat : TJSONArray;
JSONValue : TJSONValue;
i,c : integer;
aList : TStringlist;
basurl : string;
bulunan : boolean;
begin
try
askmem.Lines.Clear;
amsmem.Lines.Clear;
adumem.Lines.Clear;
basurl := 'https://api.trendyol.com/sapigw/suppliers/918400/products?page=0&size=300&approved=True';
RESTClient1.BaseURL := basurl;
RESTRequest1.Execute;
jsonvaluec := Restresponse1.JSONValue;
memo1.Lines.Text := jsonvaluec.ToString;
finally
end;
JSONObject := TJSONObject(TJSONObject.ParseJSONValue(memo1.Text));
alist := TStringList.Create;
try
aList.Text := memo1.Text;
JSONObject := TJSONObject(TJSONObject.ParseJSONValue(aList.Text));
finally
FreeAndNil(aList);
end;
if JSONObject <> nil then
try
drawArray := TJSONArray( JSONObject.FindValue('content') );
for I := 0 to drawArray.Count-1 do
begin
with TJSONObject( drawArray.Items[i] ) do
begin
isim := FindValue('title').Value;
kategoriadi := FindValue('categoryName').Value;
barkod := FindValue('barcode').Value;
stokkodu := FindValue('stockCode').Value;
fiyat := FindValue('salePrice').Value;
miktar := strtoint(FindValue('quantity').Value);
drawArraycat := TJSONArray( FindValue('attributes') );
if (miktar = 0) and (fiyat='0') then askmem.Lines.Add(stokkodu) else if miktar = 0 then amsmem.Lines.Add(stokkodu)
else if (kelimeara(stokkodu,asgmem)=False) and (kelimeara(stokkodu,askmem)=False) and (kelimeara(stokkodu,amsmem)=False) then adumem.Lines.Add(stokkodu);
datayaekle(listview6);
end;
end;
finally
JSONObject.Free;
end;
memosirala(askmem);
memosirala(amsmem);
memosirala(adumem);
end;
(29-11-2024, Saat: 17:55)Jakarta2 Adlı Kullanıcıdan Alıntı: [ -> ]type
TProductThread = class(TThread)
private
FOwnerForm: TForm1;
FErrorMessage: string; // Hataları saklamak için
protected
procedure Execute; override;
procedure UpdateUI; // UI'yi güncellemek için
procedure HandleError; // Hataları UI'de göstermek için
public
constructor Create(AOwnerForm: TForm1);
end;
constructor TProductThread.Create(AOwnerForm: TForm1);
begin
inherited Create(True); // Thread suspended başlar
FOwnerForm := AOwnerForm;
FreeOnTerminate := True; // Thread tamamlandığında serbest bırakılır
FErrorMessage := ''; // Hata mesajını sıfırla
Start; // Thread başlat
end;
procedure TProductThread.Execute;
var
JSONObject, JSONObjectCat: TJSONObject;
DrawArray: TJSONArray;
JSONValue: TJSONValue;
I: Integer;
BasURL: string;
begin
try
BasURL := 'https://api.trendyol.com/sapigw/suppliers/918400/products?page=0&size=300&approved=True';
FOwnerForm.RESTClient1.BaseURL := BasURL;
FOwnerForm.RESTRequest1.Execute;
JSONValue := FOwnerForm.RestResponse1.JSONValue;
if JSONValue = nil then
raise Exception.Create('Geçerli bir JSON yanıtı alınamadı.');
JSONObject := TJSONObject(TJSONObject.ParseJSONValue(JSONValue.ToString));
try
DrawArray := TJSONArray(JSONObject.FindValue('content'));
for I := 0 to DrawArray.Count - 1 do
begin
with TJSONObject(DrawArray.Items[I]) do
begin
isim := FindValue('title').Value;
kategoriadi := FindValue('categoryName').Value;
barkod := FindValue('barcode').Value;
stokkodu := FindValue('stockCode').Value;
fiyat := FindValue('salePrice').Value;
miktar := strtoint(FindValue('quantity').Value);
// drawArraycat := TJSONArray( FindValue('attributes') );
if (miktar = 0) and (fiyat='0') then form1.askmem.Lines.Add(stokkodu) else if miktar = 0 then form1.amsmem.Lines.Add(stokkodu)
else if (form1.kelimeara(stokkodu,form1.asgmem)=False) and (form1.kelimeara(stokkodu,form1.askmem)=False) and (form1.kelimeara(stokkodu,form1.amsmem)=False) then form1.adumem.Lines.Add(stokkodu);
datayaekle(form1.listview6);
end;
end;
finally
JSONObject.Free;
end;
except
on E: Exception do
begin
FErrorMessage := E.Message; // Hata mesajını kaydet
Synchronize(HandleError); // Hata durumunda UI'yi bilgilendir
end;
end;
Synchronize(UpdateUI); // UI'yi güncellemek için çağır
end;
procedure TProductThread.UpdateUI;
begin
// Ana formdaki UI'yi güncelle
FOwnerForm.Memo1.Lines.Add('İşlem tamamlandı!');
end;
procedure TProductThread.HandleError;
begin
if FErrorMessage <> '' then
ShowMessage('Hata: ' + FErrorMessage);
end;
procedure TForm1.StartThread;
begin
if Assigned(ProductThread) and (not ProductThread.Finished) then
begin
ShowMessage('Thread hâlen çalışıyor. Lütfen bekleyin.');
Exit;
end;
ProductThread := TProductThread.Create(Self); // Yeni thread oluştur
end;
Project TrenYolKontrol.exe raised exception class EThread with message 'Cannot call Start on a running or suspended thread'. Hatasını alıyorum. Engelleyemedim...
Amacım şu procedürü thread içine almak
procedure TForm1.ayarurungetir;
var
JSONObject,JSONObjectcat : TJsonObject;
drawArray,drawArraycat : TJSONArray;
JSONValue : TJSONValue;
i,c : integer;
aList : TStringlist;
basurl : string;
bulunan : boolean;
begin
try
askmem.Lines.Clear;
amsmem.Lines.Clear;
adumem.Lines.Clear;
basurl := 'https://api.trendyol.com/sapigw/suppliers/918400/products?page=0&size=300&approved=True';
RESTClient1.BaseURL := basurl;
RESTRequest1.Execute;
jsonvaluec := Restresponse1.JSONValue;
memo1.Lines.Text := jsonvaluec.ToString;
finally
end;
JSONObject := TJSONObject(TJSONObject.ParseJSONValue(memo1.Text));
alist := TStringList.Create;
try
aList.Text := memo1.Text;
JSONObject := TJSONObject(TJSONObject.ParseJSONValue(aList.Text));
finally
FreeAndNil(aList);
end;
if JSONObject <> nil then
try
drawArray := TJSONArray( JSONObject.FindValue('content') );
for I := 0 to drawArray.Count-1 do
begin
with TJSONObject( drawArray.Items[i] ) do
begin
isim := FindValue('title').Value;
kategoriadi := FindValue('categoryName').Value;
barkod := FindValue('barcode').Value;
stokkodu := FindValue('stockCode').Value;
fiyat := FindValue('salePrice').Value;
miktar := strtoint(FindValue('quantity').Value);
drawArraycat := TJSONArray( FindValue('attributes') );
if (miktar = 0) and (fiyat='0') then askmem.Lines.Add(stokkodu) else if miktar = 0 then amsmem.Lines.Add(stokkodu)
else if (kelimeara(stokkodu,asgmem)=False) and (kelimeara(stokkodu,askmem)=False) and (kelimeara(stokkodu,amsmem)=False) then adumem.Lines.Add(stokkodu);
datayaekle(listview6);
end;
end;
finally
JSONObject.Free;
end;
memosirala(askmem);
memosirala(amsmem);
memosirala(adumem);
end;
TProductThread.Create içinde Start değil, Resume metodunu çağırmalısınız.
Ayrıca belirtmek isterim ki; bir başka thread içinde iken (örneğimizde sizin TProductThread) ana thread içindeki görsel nesnelere erişim bir çok tahmin edilemez sıkıntılara neden olabilir. Ana thread'e bilgi göndermek, görsel kontrolleri bir şekilde etkilemek istiyorsanız eğer; TThread.Queue metodunu kullanmalısınız. Bu sitede o konu ile ilgili yazılmış bir kaç konu bulabilirsiniz.
Create metodunda tekrar Start kullanmanız problemin kaynağı olarak görülüyor. Fakat bu sorun giderilse dahi Assigned ve Finished gibi kontrol blokları oluşturduğunuz Thread için tekillik sağlamayacak. ProductThread değişkeni, TProductThread sınıfının örneğini temsil ettiği için Assigned bloğu her defasında True olarak yorumlanacaktır. Tüm bunların haricinde @
Tuğrul HELVACI bey'in belirttiği hususları da uygulamanın stabil çalışması için sonrasında ayrıca değerlendirmeniz gerekiyor. Mevcut kodlar üzerinden yapılabilecek bir yaklaşım için aşağıdaki kod bloklarında değişiklik yapabilirsiniz.
ProductThread: array of TProductThread;
constructor TProductThread.Create(AOwnerForm: TForm1);
begin
FOwnerForm := AOwnerForm;
FreeOnTerminate := True; // Thread tamamlandığında serbest bırakılır
FErrorMessage := ''; // Hata mesajını sıfırla
inherited Create(False);
end;
procedure TProductThread.UpdateUI;
begin
// Ana formdaki UI'yi güncelle
FOwnerForm.Memo1.Lines.Add('İşlem tamamlandı!');
SetLength(ProductThread, 0);
end;
procedure TProductThread.HandleError;
begin
SetLength(ProductThread, 0);
if FErrorMessage <> '' then
ShowMessage('Hata: ' + FErrorMessage);
end;
procedure TForm1.StartThread;
begin
if Length(ProductThread) = 0 then
begin
SetLength(ProductThread, 1);
ProductThread[0] := TProductThread.Create(Self);
end
else
ShowMessage('Thread hâlen çalışıyor. Lütfen bekleyin.');
end;
Cevaplarınız için teşekkür ederim. Bu şekilde değiştirdim. İstediğim bu veriler alınırken donma olmamasıydı...
type
TGetAyarThread = class(TThread)
private
FForm: TForm1;
protected
procedure Execute; override;
procedure UpdateUI;
public
constructor Create(AForm: TForm1);
end;
constructor TGetAyarThread.Create(AForm: TForm1);
begin
inherited Create(True);
FreeOnTerminate := True;
FForm := AForm;
end;
procedure TGetAyarThread.Execute;
begin
FForm.ayarurungetir;
Synchronize(UpdateUI);
end;
procedure TGetAyarThread.UpdateUI;
begin
ShowMessage('Veriler alındı!');
end;
procedure TForm1.Image3Click(Sender: TObject);
var
AyarThread: TGetAyarThread;
begin
askmem.Lines.Clear;
amsmem.Lines.Clear;
adumem.Lines.Clear;
AyarThread := TGetAyarThread.Create(Self);
AyarThread.Start; // Thread'i başlat
memosirala(askmem);
memosirala(amsmem);
memosirala(adumem);
end;
