Guest User

Untitled

a guest
Jun 21st, 2018
75
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 3.28 KB | None | 0 0
  1. var
  2. a, b, c: string;
  3.  
  4. type
  5. TThread_1 = class(TThread)
  6. private
  7. FVar_1: string;
  8.  
  9. procedure Update_1;
  10. protected
  11. procedure Execute; override;
  12. end;
  13.  
  14. TThread_2 = class(TThread)
  15. private
  16. FVar_2: string;
  17.  
  18. procedure Update_2;
  19. protected
  20. procedure Execute; override;
  21. end;
  22.  
  23. TThread_3 = class(TThread)
  24. private
  25. FVar_3: string;
  26.  
  27. procedure Update_3;
  28. protected
  29. procedure Execute; override;
  30. end;
  31.  
  32.  
  33. procedure TThread_1.Execute;
  34. begin
  35. FVar_1 := HttpGet('url', 'a');
  36. Synchronize(Update_1);
  37. end;
  38.  
  39. procedure TThread_1.Update_1;
  40. begin
  41. a := FVar_1;
  42. end;
  43.  
  44. procedure TThread_2.Execute;
  45. begin
  46. FVar_2 := HttpGet('url', 'b');
  47. Synchronize(Update_2);
  48. end;
  49.  
  50. procedure TThread_2.Update_2;
  51. begin
  52. b := FVar_2;
  53. end;
  54.  
  55. procedure TThread_3.Execute;
  56. begin
  57. FVar_3 := HttpGet('url', 'c');
  58. Synchronize(Update_3);
  59. end;
  60.  
  61. procedure TThread_3.Update_3;
  62. begin
  63. c := FVar_3;
  64. end;
  65.  
  66.  
  67. procedure TForm1.Timer_thread(Sender: TObject);
  68. var
  69. t1 : TThread_1;
  70. t2 : TThread_2;
  71. t3 : TThread_3;
  72. begin
  73. if lb_1.IsChecked = True then
  74. begin
  75. t1 := TThread_1.Create(true);
  76. try
  77. t1.FreeOnTerminate := true;
  78. finally
  79. t1.Start;
  80. end;
  81. end;
  82.  
  83. if lb_2.IsChecked = True then
  84. begin
  85. t2 := TThread_2.Create(true);
  86. try
  87. t2.FreeOnTerminate := true;
  88. finally
  89. t2.Start;
  90. end;
  91. end;
  92.  
  93. if lb_3.IsChecked = True then
  94. begin
  95. t3 := TThread_3.Create(true);
  96. try
  97. t3.FreeOnTerminate := true;
  98. finally
  99. t3.Start;
  100. end;
  101. end;
  102. end;
  103.  
  104. function HttpGet(const url: string; const tip: string): string;
  105. var
  106. HTTP: TIdHTTp;
  107. begin
  108. HTTP := TIdHTTP.Create(nil);
  109. HTTP.Request.UserAgent := 'Mozilla/6.0 (compatible; Delphi)';
  110. try
  111. try
  112. Result:=http.Get(url);
  113. except
  114. on E : Exception do
  115. begin
  116. if Pos('Error resolving Address', E.Message) <> 0 then
  117. begin
  118. if tip = '1' then Form1.lb_1.Text:='1';
  119. if tip = '2' then Form1.lb_2.Text:='2';
  120. if tip = '3' then Form1.lb_3.Text:='2';
  121. end;
  122. end;
  123. end;
  124. finally
  125. FreeAndNil (http);
  126. end;
  127. end;
  128.  
  129. procedure TForm1.Timer_thread(Sender: TObject);
  130. var
  131. t1 : TThread;
  132. t2 : TThread;
  133. t3 : TThread;
  134.  
  135. begin
  136. if lb_1.IsChecked = True then
  137. begin
  138. t1:= TThread.CreateAnonymousThread(
  139. procedure
  140. var s: string;
  141. begin
  142. s := HttpGet('url_a', 'a');
  143. TThread.Synchronize(nil,
  144. procedure
  145. begin
  146. a := s;
  147. end);
  148. end);
  149. t1.Start;
  150. end;
  151.  
  152. if lb_2.IsChecked = True then
  153. begin
  154. t2:= TThread.CreateAnonymousThread(
  155. procedure
  156. var s: string;
  157. begin
  158. s := HttpGet('url_b', 'b');
  159. TThread.Synchronize(nil,
  160. procedure
  161. begin
  162. b := s;
  163. end);
  164. end);
  165. t2.Start;
  166. end;
  167.  
  168. if lb_3.IsChecked = True then
  169. begin
  170. t3:= TThread.CreateAnonymousThread(
  171. procedure
  172. var s: string;
  173. begin
  174. s := HttpGet('c', 'c');
  175. TThread.Synchronize(nil,
  176. procedure
  177. begin
  178. c := s;
  179. end);
  180. end);
  181. t3.Start;
  182. end;
  183. end;
Add Comment
Please, Sign In to add comment