NewsUnit.pas 7.2 KB

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