NewBoard.pas

   1 unit NewBoard;
   2
   3 interface
   4
   5 uses
   6         Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   7         Dialogs, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent, IdComponent,
   8         IdTCPConnection, IdTCPClient, IdHTTP, IDException, StdCtrls, IniFiles,
   9         GikoSystem, BoardGroup;
  10
  11 type
  12         TNewBoardItem = record
  13                 FResponseCode: Integer;
  14                 FContent: string;
  15         end;
  16
  17         TNewBoardDialog = class(TForm)
  18                 Label1: TLabel;
  19                 MessageMemo: TMemo;
  20                 UpdateButton: TButton;
  21     CloseButton: TButton;
  22                 Indy: TIdHTTP;
  23                 IdAntiFreeze: TIdAntiFreeze;
  24                 StopButton: TButton;
  25                 Label2: TLabel;
  26                 procedure UpdateButtonClick(Sender: TObject);
  27                 procedure StopButtonClick(Sender: TObject);
  28                 procedure CloseButtonClick(Sender: TObject);
  29                 procedure FormCreate(Sender: TObject);
  30         private
  31                 { Private \90é\8c¾ }
  32                 FAbort: Boolean;
  33                 function BoardDownload: TNewBoardItem;
  34                 procedure UpdateURL(s: string);
  35         public
  36                 { Public \90é\8c¾ }
  37         end;
  38
  39 var
  40         NewBoardDialog: TNewBoardDialog;
  41
  42 implementation
  43
  44 uses Giko, IdHeaderList;
  45
  46 {$R *.dfm}
  47
  48 procedure TNewBoardDialog.UpdateButtonClick(Sender: TObject);
  49 var
  50         Item: TNewBoardItem;
  51 begin
  52         try
  53                 FAbort := False;
  54                 UpdateButton.Enabled := False;
  55                 StopButton.Enabled := True;
  56                 CloseButton.Enabled := False;
  57                 Item := BoardDownload;
  58                 StopButton.Enabled := False;
  59                 if FAbort then
  60                         Exit;
  61                 if Item.FContent <> '' then begin
  62                         UpdateURL(Item.FContent);
  63                         GikoForm.ReloadBBS;
  64                 end else
  65                         MessageMemo.Lines.Add('\83_\83E\83\93\83\8d\81[\83h\82ª\8e¸\94s\82µ\82Ü\82µ\82½[' + IntToStr(Item.FResponseCode) + ']');
  66         finally
  67                 UpdateButton.Enabled := True;
  68                 StopButton.Enabled := False;
  69                 CloseButton.Enabled := True;
  70         end;
  71 end;
  72
  73 procedure TNewBoardDialog.StopButtonClick(Sender: TObject);
  74 begin
  75         FAbort := True;
  76         Indy.DisconnectSocket;
  77 end;
  78
  79 procedure TNewBoardDialog.CloseButtonClick(Sender: TObject);
  80 begin
  81         Close;
  82 end;
  83
  84 function TNewBoardDialog.BoardDownload: TNewBoardItem;
  85 var
  86         URL: string;
  87         Stream: TMemoryStream;
  88         s: string;
  89         i: Integer;
  90 begin
  91         MessageMemo.Clear;
  92         Indy.Request.Clear;
  93         Indy.RecvBufferSize := Gikosys.Setting.RecvBufferSize;
  94         Indy.ProxyParams.BasicAuthentication := False;
  95         if GikoSys.Setting.ReadProxy then begin
  96                 if GikoSys.Setting.ProxyProtocol then
  97                         Indy.ProtocolVersion := pv1_1
  98                 else
  99                         Indy.ProtocolVersion := pv1_0;
 100                 Indy.ProxyParams.ProxyServer := GikoSys.Setting.ReadProxyAddress;
 101                 Indy.ProxyParams.ProxyPort := GikoSys.Setting.ReadProxyPort;
 102                 Indy.ProxyParams.ProxyUsername := GikoSys.Setting.ReadProxyUserID;
 103                 Indy.ProxyParams.ProxyPassword := GikoSys.Setting.ReadProxyPassword;
 104                 if GikoSys.Setting.ReadProxyUserID <> '' then
 105                         Indy.ProxyParams.BasicAuthentication := True;
 106         end else begin
 107                 if GikoSys.Setting.Protocol then
 108                         Indy.ProtocolVersion := pv1_1
 109                 else
 110                         Indy.ProtocolVersion := pv1_0;
 111                 Indy.ProxyParams.ProxyServer := '';
 112                 Indy.ProxyParams.ProxyPort := 80;
 113                 Indy.ProxyParams.ProxyUsername := '';
 114                 Indy.ProxyParams.ProxyPassword := '';
 115         end;
 116         URL := GikoSys.Setting.BoardURL2ch;
 117         Indy.Request.UserAgent := GikoSys.GetUserAgent;
 118         Indy.Request.Referer := '';
 119         Indy.Request.AcceptEncoding := 'gzip';
 120
 121         Indy.Request.CacheControl := 'no-cache';
 122         Indy.Request.CustomHeaders.Add('Pragma: no-cache');
 123
 124 //      s := '';
 125         Stream := TMemoryStream.Create;
 126         try
 127                 try
 128                         MessageMemo.Lines.Add('\88È\89º\82Ì\8fê\8f\8a\82©\82ç\8eæ\93¾\82µ\82Ü\82·');
 129                         MessageMemo.Lines.Add(GikoSys.Setting.BoardURL2ch);
 130                         MessageMemo.Lines.Add('\83_\83E\83\93\83\8d\81[\83h\82ð\8aJ\8en\82µ\82Ü\82·');
 131                         Indy.Get(URL, Stream);
 132                         Result.FContent := GikoSys.GzipDecompress(Stream, Indy.Response.ContentEncoding);
 133                         MessageMemo.Lines.Add('\83_\83E\83\93\83\8d\81[\83h\82ª\8a®\97¹\82µ\82Ü\82µ\82½');
 134                 except
 135                         on E: EIdConnectException do begin
 136                                 MessageMemo.Lines.Add('');
 137                                 MessageMemo.Lines.Add('\90Ú\91±\82ª\8e¸\94s\82µ\82Ü\82µ\82½ \89ñ\90ü\82â\83v\83\8d\83L\83V\81AFW\82Ì\8fó\91Ô\82ð\92²\82×\82Ä\82\82¾\82³\82¢');
 138                                 MessageMemo.Lines.Add('FW\82ð\93ü\82ê\82Ä\82¢\82é\90l\82Í\90Ý\92è\82ð\8am\94F\82µ\82Ä\82\82¾\82³\82¢');
 139                                 MessageMemo.Lines.Add('NEC\82ÌPC\82Ì\8fê\8d\87\82ÍPC GATE\82ª\88«\82³\82ð\82µ\82Ä\82¢\82é\89Â\94\\90«\82ª\8d\82\82¢\82Å\82·');
 140                                 MessageMemo.Lines.Add('Message: ' + E.Message);
 141                         end;
 142                         on E: Exception do begin
 143                                 if FAbort then
 144                                         MessageMemo.Lines.Add('\83_\83E\83\93\83\8d\81[\83h\82ð\92\86\92f\82µ\82Ü\82µ\82½')
 145                                 else begin
 146                                         MessageMemo.Lines.Add('\83_\83E\83\93\83\8d\81[\83h\82ª\8e¸\94s\82µ\82Ü\82µ\82½');
 147                                         MessageMemo.Lines.Add('ResponseCode: ' + IntToStr(Indy.ResponseCode));
 148                                         MessageMemo.Lines.Add('Message: ' + E.Message);
 149                                         MessageMemo.Lines.Add('------------------------');
 150                                         for i := 0 to Indy.Response.RawHeaders.Count - 1 do begin
 151                                                 s := Indy.Response.RawHeaders.Names[i];
 152                                                 s := s + ': ' + Indy.Response.RawHeaders.Values[s];
 153                                                 MessageMemo.Lines.Add(s);
 154                                         end;
 155                                         MessageMemo.Lines.Add('------------------------');
 156                                 end;
 157                         end;
 158                 end;
 159                 Result.FResponseCode := Indy.ResponseCode;
 160         finally
 161                 Stream.Free;
 162         end;
 163 end;
 164
 165 procedure TNewBoardDialog.UpdateURL(s: string);
 166 var
 167         i: Integer;
 168         idx: Integer;
 169         idx1: Integer;
 170         idx2: Integer;
 171         tmp: string;
 172         URL: string;
 173         Title: string;
 174         cate: string;
 175         Board: TBoard;
 176         Change: Boolean;
 177         ini: TMemIniFile;
 178 begin
 179         Change := False;
 180         MessageMemo.Lines.Add('\90V\94Â\81A\94ÂURL\95Ï\8dX\83`\83F\83b\83N\82ð\8aJ\8en\82µ\82Ü\82·');
 181         MessageMemo.Lines.Add('');
 182         s := StringReplace(s, '<B>', '<b>', [rfReplaceAll, rfIgnoreCase]);
 183         s := StringReplace(s, '<BR>', '<br>', [rfReplaceAll, rfIgnoreCase]);
 184         s := StringReplace(s, '</B>', '</b>', [rfReplaceAll, rfIgnoreCase]);
 185         s := StringReplace(s, '<A HREF', '<a href', [rfReplaceAll, rfIgnoreCase]);
 186         s := StringReplace(s, '</A', '</a', [rfReplaceAll, rfIgnoreCase]);
 187         cate := '';
 188         GikoSys.ForceDirectoriesEx(GikoSys.GetConfigDir);
 189         ini := TMemIniFile.Create(GikoSys.GetBoardFileName);
 190         try
 191                 //
 192                 //\8dí\8f\9c\83I\83v\83V\83\87\83\93\82ª\91I\91ð\82³\82ê\82Ä\82¢\82é\8fê\8d\87\82Í\83N\83\8a\83A
 193
 194                 ini.Clear;
 195                 while True do begin
 196                         idx1 := AnsiPos('<b>', s);
 197                         idx2 := AnsiPos('<a', s);
 198                         if (idx1 = 0) and (idx2 = 0) then Break;
 199
 200                         if idx1 < idx2 then begin
 201                                 //<br>
 202                                 idx := AnsiPos('</b>', s);
 203                                 if idx = 0 then begin
 204                                         s := Copy(s, idx1 + 4, Length(s));
 205                                         continue;
 206                                 end;
 207                                 tmp := Copy(s, idx1, (idx - idx1) + 4);
 208                                 tmp := StringReplace(tmp, '<b>', '', [rfReplaceAll]);
 209                                 tmp := StringReplace(tmp, '</b>', '', [rfReplaceAll]);
 210
 211                                 if (tmp = '\82¨\82·\82·\82ß') or
 212                                          (tmp = '\93Á\95Ê\8aé\89æ') or
 213                                          (tmp = '\82Ü\82¿\82a\82a\82r') or
 214                                          (tmp = '\83`\83\83\83b\83g') or
 215                                          (tmp = '\82¨\8aG\82©\82«') or
 216                                          (tmp = '\89^\89c') or
 217                                          (tmp = '\83c\81[\83\8b\97Þ') or
 218                                          (tmp = '\91¼\82Ì\83T\83C\83g') then begin
 219                                         cate := '';
 220                                         s := Copy(s, idx + 5, Length(s));
 221                                         Continue;
 222                                 end;
 223                                 s := Copy(s, idx + 5, Length(s));
 224                                 cate := tmp;
 225                         end else begin
 226                                 //<a href=
 227                                 if cate = '' then begin
 228                                         s := Copy(s, idx2 + 2, Length(s));
 229                                 end else begin
 230                                         idx := AnsiPos('</a>', s);
 231                                         tmp := Copy(s, idx2, (idx - idx2) + 4);
 232                                         tmp := StringReplace(tmp, '<a href=', '', [rfReplaceAll]);
 233                                         tmp := StringReplace(tmp, '</a>', '', [rfReplaceAll]);
 234                                         i := AnsiPos('>', tmp);
 235                                         if i <> 0 then begin
 236                                                 URL := Copy(tmp, 1, i - 1);
 237                                                 Title := Copy(tmp, i + 1, Length(tmp));
 238                                                 Board := BBS2ch.FindBoardFromTitle(Title);
 239                                                 if Board = nil then begin
 240                                                         MessageMemo.Lines.Add('\90V\94Â\92Ç\89Á\81u' + Title + '(' + URL + ')\81v');
 241                                                         ini.WriteString(cate, Title, URL);
 242                                                         Change := True;
 243                                                 end else begin
 244                                                         if Board.URL <> URL then begin
 245                                                                 MessageMemo.Lines.Add('URL\95Ï\8dX\81u' + Board.Title + '(' + URL +')\81v');
 246                                                                 ini.WriteString(cate, Title, URL);
 247                                                                 Change := True;
 248                                                         end else begin
 249                                                                 ini.WriteString(cate, Title, URL);
 250                                                         end;
 251                                                 end;
 252                                         end else begin
 253                                                 s := Copy(s, idx2 + 2, Length(s));
 254                                                 Continue;
 255                                         end;
 256                                         s := Copy(s, idx + 5, Length(s));
 257                                 end;
 258                         end;
 259                 end;
 260         finally
 261                 if Change then
 262                         ini.UpdateFile;
 263                 ini.Free;
 264         end;
 265         MessageMemo.Lines.Add('');
 266         if Change then begin
 267                 MessageMemo.Lines.Add('\90V\94Â\81A\94ÂURL\95Ï\8dX\83`\83F\83b\83N\82ª\8a®\97¹\82µ\82Ü\82µ\82½');
 268                 MessageMemo.Lines.Add('\81u\95Â\82¶\82é\81v\83{\83^\83\93\82ð\89\9f\82µ\82Ä\82\82¾\82³\82¢');
 269         end else
 270                 MessageMemo.Lines.Add('\90V\94Â\81A\94ÂURL\95Ï\8dX\82Í \82 \82è\82Ü\82¹\82ñ\82Å\82µ\82½');
 271 end;
 272
 273 procedure TNewBoardDialog.FormCreate(Sender: TObject);
 274 begin
 275         StopButton.Enabled := False;
 276 end;
 277
 278 end.