Программа для прослушивания журнала АРК Томск
http://blindage.org/?p=6627
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
425 rivejä
11 KiB
425 rivejä
11 KiB
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.
|