NewsUnit.pas 6.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250
  1. unit NewsUnit;
  2. interface
  3. uses
  4. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  5. ScktComp, StdCtrls;
  6. const
  7. NewsID = 'TIGCC News Format'#13#10#13#10;
  8. type
  9. TNewsForm = class(TForm)
  10. NewsClient: TClientSocket;
  11. NewsBox: TScrollBox;
  12. VisitButton: TButton;
  13. CloseButton: TButton;
  14. RetreiveLabel: TLabel;
  15. ProxyCheckBox: TCheckBox;
  16. ProxyNameEdit: TEdit;
  17. Label1: TLabel;
  18. ProxyPortEdit: TEdit;
  19. RefreshButton: TButton;
  20. procedure NewsClientError(Sender: TObject; Socket: TCustomWinSocket;
  21. ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  22. procedure FormActivate(Sender: TObject);
  23. procedure FormClose(Sender: TObject; var Action: TCloseAction);
  24. procedure NewsClientConnect(Sender: TObject; Socket: TCustomWinSocket);
  25. procedure NewsClientRead(Sender: TObject; Socket: TCustomWinSocket);
  26. procedure ProxyCheckBoxClick(Sender: TObject);
  27. procedure RefreshButtonClick(Sender: TObject);
  28. procedure FormCreate(Sender: TObject);
  29. private
  30. FSilentConnect: Boolean;
  31. public
  32. Labels: array of TLabel;
  33. procedure Connect;
  34. function Execute: Boolean;
  35. property SilentConnect: Boolean read FSilentConnect write FSilentConnect;
  36. end;
  37. implementation
  38. {$R *.DFM}
  39. uses
  40. MasterUnit, MainUnit,
  41. UtilsWin,
  42. ShellAPI, Registry;
  43. procedure TNewsForm.Connect;
  44. var
  45. I: Integer;
  46. begin
  47. if not NewsClient.Active then begin
  48. for I := High (Labels) downto Low (Labels) do
  49. Labels[I].Free;
  50. SetLength (Labels, 0);
  51. RetreiveLabel.Show;
  52. Update;
  53. try
  54. with NewsClient do begin
  55. if ProxyCheckBox.Checked then begin
  56. Host := '';
  57. Address := '';
  58. if (Pos ('.', ProxyNameEdit.Text) > 0) and (ProxyNameEdit.Text [1] in ['0'..'9']) then
  59. Address := ProxyNameEdit.Text
  60. else
  61. Host := ProxyNameEdit.Text;
  62. try
  63. Port := StrToInt (ProxyPortEdit.Text);
  64. except
  65. Port := 8080;
  66. end;
  67. end else begin
  68. Address := '';
  69. Host := 'tigcc.ticalc.org';
  70. Port := 80;
  71. end;
  72. NewsClient.Active := True;
  73. end;
  74. except
  75. RetreiveLabel.Hide;
  76. ShowDefaultMessageBox ('Error connecting to tigcc.ticalc.org. Please check your connection.', 'Error', mtProgramError);
  77. if not Visible then
  78. Free;
  79. end;
  80. end;
  81. end;
  82. function TNewsForm.Execute: Boolean;
  83. begin
  84. Result := ShowModal = mrOK;
  85. if Result then
  86. ShellExecute (0, nil, 'http://tigcc.ticalc.org/', nil, nil, sw_ShowMaximized);
  87. end;
  88. procedure TNewsForm.NewsClientError(Sender: TObject;
  89. Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  90. var ErrorCode: Integer);
  91. begin
  92. NewsClient.Active := False;
  93. RetreiveLabel.Hide;
  94. ShowDefaultMessageBox ('Error downloading news from tigcc.ticalc.org. Please check your connection.', 'Error', mtProgramError);
  95. if not Visible then
  96. Free;
  97. end;
  98. procedure TNewsForm.FormActivate(Sender: TObject);
  99. begin
  100. if not SilentConnect then
  101. Connect;
  102. end;
  103. procedure TNewsForm.FormClose(Sender: TObject; var Action: TCloseAction);
  104. begin
  105. NewsClient.Active := False;
  106. ProxyName := ProxyNameEdit.Text;
  107. try
  108. if Length (ProxyPortEdit.Text) > 0 then
  109. ProxyPort := StrToInt (ProxyPortEdit.Text)
  110. else
  111. ProxyPort := 0;
  112. except end;
  113. end;
  114. procedure TNewsForm.NewsClientConnect(Sender: TObject;
  115. Socket: TCustomWinSocket);
  116. var
  117. Line: string;
  118. begin
  119. Line := 'GET http://tigcc.ticalc.org/newsheadlines.txt';
  120. if ProxyCheckBox.Checked then
  121. Line := Line + ' HTTP/1.1'#13#10'Accept: */*'#13#10'Accept-Language: en'#13#10'User-Agent: TIGCC'#13#10'Host: tigcc.ticalc.org'#13#10'Proxy-Connection: Keep-Alive'#13#10;
  122. Line := Line + #13#10;
  123. Socket.SendText (Line);
  124. end;
  125. procedure TNewsForm.NewsClientRead(Sender: TObject;
  126. Socket: TCustomWinSocket);
  127. var
  128. S: string;
  129. Date,
  130. LastDate: Integer;
  131. CurLabel: TLabel;
  132. begin
  133. RetreiveLabel.Hide;
  134. S := Socket.ReceiveText;
  135. NewsClient.Active := False;
  136. if Pos (NewsID, S) > 0 then begin
  137. LastDate := 0;
  138. Delete (S, 1, Pos (NewsID, S) - 1 + Length (NewsID));
  139. while Pos (#13#10, S) > 0 do begin
  140. if S [1] = #13 then
  141. Break;
  142. CurLabel := TLabel.Create (Self);
  143. CurLabel.Left := 2;
  144. if Length (Labels) > 0 then
  145. with Labels [High (Labels)] do
  146. CurLabel.Top := Top + Height + 2
  147. else
  148. CurLabel.Top := 0;
  149. try
  150. Date := StrToInt (Copy (S, 1, Pos (#13#10, S) - 1));
  151. if LastDate = 0 then
  152. LastDate := Date;
  153. except
  154. Date := 0;
  155. end;
  156. Delete (S, 1, Pos (#13#10, S) + 1);
  157. with CurLabel.Font do begin
  158. Name := 'Arial';
  159. Size := 9;
  160. Style := [fsBold];
  161. if Date > LastNewsDate then
  162. Color := $0000C0
  163. else
  164. Color := $808080;
  165. end;
  166. CurLabel.Caption := Copy (S, 1, Pos (#13#10, S) - 1);
  167. Delete (S, 1, Pos (#13#10, S) + 1);
  168. Delete (S, 1, Pos (#13#10, S) + 1);
  169. CurLabel.Parent := NewsBox;
  170. CurLabel.Show;
  171. SetLength (Labels, Length (Labels) + 1);
  172. Labels [High (Labels)] := CurLabel;
  173. end;
  174. if (LastDate > LastNewsDate) and (not Visible) then
  175. Execute;
  176. if LastNewsDate <> LastDate then begin
  177. LastNewsDate := LastDate;
  178. MainForm.SavePreferences;
  179. end;
  180. end else
  181. ShowDefaultMessageBox ('Error in news format from tigcc.ticalc.org. Please contact the site administrator.', 'Error', mtProgramError);
  182. if not Visible then
  183. Free;
  184. end;
  185. procedure TNewsForm.ProxyCheckBoxClick(Sender: TObject);
  186. var
  187. NewProxy: string;
  188. begin
  189. ProxyNameEdit.Enabled := ProxyCheckBox.Checked;
  190. ProxyPortEdit.Enabled := ProxyCheckBox.Checked;
  191. if ProxyCheckBox.Checked then begin
  192. with TRegistry.Create do try
  193. RootKey := HKEY_CURRENT_USER;
  194. if OpenKeyReadOnly ('\Software\Microsoft\Windows\CurrentVersion\Internet Settings') then begin
  195. if ValueExists ('ProxyServer') then begin
  196. NewProxy := ReadString ('ProxyServer');
  197. if Pos ('http=', LowerCase (NewProxy)) > 0 then begin
  198. Delete (NewProxy, 1, Pos ('http=', LowerCase (NewProxy)) - 1 + Length ('http='));
  199. if Pos (';', NewProxy) > 0 then
  200. Delete (NewProxy, Pos (';', NewProxy), Length (NewProxy));
  201. end else
  202. if Pos (';', NewProxy) > 0 then
  203. NewProxy := '';
  204. if Pos (':', NewProxy) > 0 then begin
  205. ProxyNameEdit.Text := Copy (NewProxy, 1, Pos (':', NewProxy) - 1);
  206. ProxyPortEdit.Text := Copy (NewProxy, Pos (':', NewProxy) + 1, Length (NewProxy));
  207. end;
  208. end;
  209. end;
  210. finally
  211. Free;
  212. end;
  213. end else begin
  214. ProxyNameEdit.Text := '';
  215. ProxyPortEdit.Text := '';
  216. end;
  217. end;
  218. procedure TNewsForm.RefreshButtonClick(Sender: TObject);
  219. begin
  220. NewsClient.Active := False;
  221. Connect;
  222. end;
  223. procedure TNewsForm.FormCreate(Sender: TObject);
  224. begin
  225. ProxyCheckBox.Checked := Length (ProxyName) > 0;
  226. ProxyNameEdit.Text := ProxyName;
  227. if ProxyCheckBox.Checked then
  228. ProxyPortEdit.Text := IntToStr (ProxyPort)
  229. else
  230. ProxyPortEdit.Text := '';
  231. end;
  232. end.