ark-tomsk-logbook/unit1.pas

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, EditBtn,
  StdCtrls, LCLProc, Buttons, ExtCtrls, ComCtrls, Grids, UTF8Process, process,
  ShellApi, httpsend;

type
  TPlayThread = class(TThread)
  private
    fBusy: boolean;
    fIdx: integer;
    fTimeStamp: string;
    fTimeStampShow: boolean;
    procedure Hint;
    procedure Busy;
    procedure Play;
    procedure CheckBusy;
    procedure ThreadTerminate;
    procedure DownloadMessage;
  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended: boolean);
  end;

type

  { TForm1 }

  TForm1 = class(TForm)
    btnSave: TButton;
    chkAlwaysOnTop: TCheckBox;
    chkAutoRefresh: TCheckBox;
    chkAutoPlay: TCheckBox;
    DateEdit1: TDateEdit;
    intervalEdit: TEdit;
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    SaveDialog1: TSaveDialog;
    btnRefresh: TSpeedButton;
    btnToday: TSpeedButton;
    StatusBar1: TStatusBar;
    StringGrid1: TStringGrid;
    Timer1: TTimer;
    TrayIcon1: TTrayIcon;
    UpDown1: TUpDown;
    procedure btnSaveClick(Sender: TObject);
    procedure chkAlwaysOnTopChange(Sender: TObject);
    procedure chkAutoRefreshChange(Sender: TObject);
    procedure DateEdit1Change(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btnRefreshClick(Sender: TObject);
    procedure btnTodayClick(Sender: TObject);
    procedure FormWindowStateChange(Sender: TObject);
    procedure StringGrid1DblClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure TrayIcon1DblClick(Sender: TObject);
    procedure UpdateMessages(date: string);
    procedure DownloadMessage(fIdx: integer; fName: string);
    procedure UpDown1ChangingEx(Sender: TObject; var AllowChange: Boolean;
      NewValue: SmallInt; Direction: TUpDownDirection);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;
  count_prev, count_current: integer;
  PlayQueue: integer;
  PlayBusy: boolean;
  PlayThread: TPlayThread;
  PlayList: TStringList;

implementation

{$R *.lfm}

{ TForm1 }


procedure TForm1.UpdateMessages(date: string);
var
  url: string;
  csv: TStringList;
begin
  url := 'http://tomsk.cb-radio.ru/archive.php?date='; //2015-02-27
  csv := TStringList.Create;
  with THTTPSend.Create do
  begin
    if HTTPMethod('GET', url + date) then
      try
        csv.LoadFromStream(Document);
        csv.Text := StringReplace(csv.Text, '''', '', [rfReplaceAll]);
        csv.SaveToFile(GetTempDir(False) + 'playlist.csv');
        if not Assigned(PlayList) then
          PlayList := TStringList.Create;
        count_prev := count_current;
        PlayList.Clear;
        PlayList.LoadFromFile(GetTempDir(False) + 'playlist.csv');
        StringGrid1.Clean;
        StringGrid1.RowCount := 0;
        StringGrid1.LoadFromCSVFile(GetTempDir(False) + 'playlist.csv');
        StringGrid1.InsertRowWithValues(0, ['Дата', 'Время', 'Длит', 'Путь']);
        StringGrid1.DeleteCol(0);
        StringGrid1.DeleteCol(2);
        StringGrid1.Row := 0;
        count_current := PlayList.Count;
        Label5.Caption := IntToStr(PlayList.Count);
        StatusBar1.Panels[0].Text := TimeToStr(now()) + ' Скачан список файлов';
      except
        //Application.MessageBox('Ошибка при скачивании списка воспроизведения','Error', 0);
      end;
    Free;
  end;
  csv.Free;
  if PlayList.Count > 0 then
  begin
    btnSave.Enabled := True;
  end
  else
  begin
    btnSave.Enabled := False;
  end;
  if chkAutoRefresh.Checked then
    DateEdit1.Text := FormatDateTime('DD.MM.YYYY', Now);
  if (DateToStr(DateEdit1.Date) = DateToStr(Now)) then
  begin
    btnRefresh.Enabled := True;
    chkAutoRefresh.Enabled := True;
    //chkAutoRefresh.Checked := False;
    //chkAutoPlay.Enabled := False;
    //chkAutoPlay.Checked := False;
  end
  else
  begin
    btnRefresh.Enabled := False;
    chkAutoRefresh.Enabled := False;
    chkAutoRefresh.Checked := False;
    chkAutoPlay.Enabled := False;
    chkAutoPlay.Checked := False;
  end;
end;

function get_value(item, Value: integer): string;
var
  params: TStringList;
begin
  params := TStringList.Create;
  params.Delimiter := ',';
  params.DelimitedText := PlayList[item - 1];
  Result := params[Value];
  params.Free;
end;

procedure TForm1.DownloadMessage(fIdx: integer; fName: string);
var
  url, path: string;
  memstream: TMemoryStream;
begin
  url := 'http://tomsk.cb-radio.ru/archive/';
  path := get_value(fIdx, 3);
  with THTTPSend.Create do
  begin
    if HTTPMethod('GET', url + path) then
      try
        memstream := TMemoryStream.Create;
        memstream := Document;
        memstream.SaveToFile(UTF8ToSys(fName));
        memstream.Free;
      except
        Application.MessageBox('Ошибка при скачивании файла', 'Error', 0);
      end;
  end;
end;


procedure TForm1.UpDown1ChangingEx(Sender: TObject; var AllowChange: Boolean;
  NewValue: SmallInt; Direction: TUpDownDirection);
begin
  Timer1.Interval:=NewValue * 1000;
end;

procedure TPlayThread.DownloadMessage();
var
  url, path: string;
  memstream: TMemoryStream;
begin
  url := 'http://tomsk.cb-radio.ru/archive/';
  path := get_value(fIdx, 3);
  with THTTPSend.Create do
  begin
    if HTTPMethod('GET', url + path) then
      try
        memstream := TMemoryStream.Create;
        memstream := Document;
        memstream.SaveToFile(SysToUTF8(GetTempDir(False) + 'ak47.mp3'));
        memstream.Free;
      except
        Application.MessageBox('Ошибка при скачивании файла', 'Error', 0);
      end;
  end;
end;

constructor TPlayThread.Create(CreateSuspended: boolean);
begin
  FreeOnTerminate := True;
  inherited Create(CreateSuspended);
  Inc(PlayQueue);
end;

procedure TPlayThread.ThreadTerminate;
begin
  Dec(PlayQueue);
end;


procedure TplayThread.Busy;
begin
  if fBusy = True then
  begin
    PlayBusy := True;
  end
  else
  begin
    PlayBusy := False;
  end;
end;

procedure TPlayThread.CheckBusy;
begin
  if PlayBusy = True then
  begin
    fBusy := True;
  end
  else
  begin
    fBusy := False;
  end;
end;

procedure TPlayThread.Hint;
begin
  Form1.TrayIcon1.BalloonHint := fTimeStamp;
  Form1.TrayIcon1.ShowBalloonHint;
end;

procedure TPlayThread.Execute;
begin
  Synchronize(@CheckBusy);
  while (not Terminated) and (fBusy = True) do
  begin
    sleep(2000);
    Synchronize(@CheckBusy);
  end;
  fBusy := True;
  Synchronize(@Busy);
  if fTimeStampShow then
    Synchronize(@Hint);
  Play();
  fBusy := False;
  Synchronize(@Busy);
  Synchronize(@ThreadTerminate);
  Terminate;
end;

procedure TPlayThread.play();
var
  tmp: ansistring;
  Player: TProcessUTF8;
  PlayerPath: ansistring;
  PlayerParams: ansistring;
begin
  //tmp := GetTempDir(False) + 'ak47.mp3';
  //Synchronize(@DownloadMessage);
  PlayerPath := SysToUTF8(ExtractFileDir(Application.ExeName) + '\mpg123.exe');
  //PlayerParams := SysToUTF8(' -q "' + tmp + '"');
  PlayerParams := '-q http://tomsk.cb-radio.ru/archive/' + get_value(fIdx, 3);
  Player := TProcessUTF8.Create(nil);
  Form1.StatusBar1.Panels.Items[0].Text := 'Играет запись от ' + fTimeStamp;
  Form1.StatusBar1.Panels.Items[1].Text := 'В очереди  ' + IntToStr(PlayQueue);
  try
    Player.CommandLine := PlayerPath + ' ' + PlayerParams;
    Player.Options := Player.Options + [poNoConsole, poWaitOnExit];
    Player.Execute;
  finally
    Player.Free;
  end;
  Form1.StatusBar1.Panels.Items[0].Text := '';
  Form1.StatusBar1.Panels.Items[1].Text := '';
end;

procedure TForm1.DateEdit1Change(Sender: TObject);
begin
  try
    UpdateMessages(FormatDateTime('YYYY-MM-DD', DateEdit1.Date));
  except
  end;
end;

procedure TForm1.btnSaveClick(Sender: TObject);
begin
  SaveDialog1.FileName := StringReplace(get_value(StringGrid1.Row, 0) +
    ' ' + get_value(StringGrid1.Row, 1), ':', '_', [rfReplaceAll]);
  if SaveDialog1.Execute then
  begin
    DownloadMessage(StringGrid1.Row, SaveDialog1.FileName);
  end;
end;

procedure TForm1.chkAlwaysOnTopChange(Sender: TObject);
begin
  if chkAlwaysOnTop.Checked then
    Form1.FormStyle := fsSystemStayOnTop
  else
    Form1.FormStyle := fsNormal;
end;

procedure TForm1.chkAutoRefreshChange(Sender: TObject);
begin
  if chkAutoRefresh.Checked then
    chkAutoPlay.Enabled := True
  else
    chkAutoPlay.Enabled := False;
end;

procedure TForm1.FormShow(Sender: TObject);
var
  v: TStringList;
begin
  try
    v := TStringList.Create;
    DateEdit1.Date := now();
    UpdateMessages(FormatDateTime('YYYY-MM-DD', DateEdit1.Date));
    v.LoadFromFile('version');
    Label3.Caption := 'Версия ' + v.Text;
    v.Free;
    if FileExists(ExtractFileDir(Application.ExeName) + '\ark_laucher.new') then
    begin
      DeleteFileUTF8(ExtractFileDir(Application.ExeName) + '\ark_laucher.exe');
      RenameFileUTF8(ExtractFileDir(Application.ExeName) + '\ark_laucher.new',
        ExtractFileDir(Application.ExeName) + '\ark_laucher.exe');
    end;
  except

  end;
end;

procedure TForm1.FormWindowStateChange(Sender: TObject);
begin
  if Form1.WindowState = wsMinimized then
  begin
    form1.WindowState := wsNormal;
    form1.Hide;
    Form1.ShowInTaskBar := stNever;
    Form1.TrayIcon1.BalloonHint :=
      'Программа все еще запущена. Чтобы отключить вместо сворачивания закройте её.';
    Form1.TrayIcon1.ShowBalloonHint;
  end;
end;

procedure TForm1.StringGrid1DblClick(Sender: TObject);
begin
  PlayThread := TPlayThread.Create(True);
  PlayThread.fIdx := StringGrid1.row;
  PlayThread.fTimeStamp := get_value(StringGrid1.row, 1);
  PlayThread.fTimeStampShow := True;
  PlayThread.Resume;
end;

procedure TForm1.TrayIcon1DblClick(Sender: TObject);
begin
  Form1.Show;
end;

procedure TForm1.btnRefreshClick(Sender: TObject);
begin
  UpdateMessages(FormatDateTime('YYYY-MM-DD', DateEdit1.Date));
  count_current := PlayList.Count;
  count_prev := count_current;
end;

procedure TForm1.btnTodayClick(Sender: TObject);
begin
  DateEdit1.Date := now();
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  p, raznica: integer;
begin
  if ((chkAutoRefresh.Checked) and (chkAutoRefresh.Enabled)) then
  begin
    Timer1.Enabled := False;
    UpdateMessages(FormatDateTime('YYYY-MM-DD', Now));
    DateEdit1.Date := Now;
    raznica := count_current - count_prev;
    if ((count_current > count_prev) and (chkAutoPlay.Checked) and
      (chkAutoPlay.Enabled)) then
    begin
      for p := 0 to raznica - 1 do
      begin
        PlayThread := TPlayThread.Create(True);
        PlayThread.fIdx := count_current - count_prev - p;
        PlayThread.fTimeStamp := get_value(count_current - count_prev - p, 1);
        PlayThread.fTimeStampShow := True;
        PlayThread.Resume;
      end;
    end;
    Timer1.Enabled := True;
  end;
end;

end.