/Delphi/akMediaAdmin/Source/UtilsUnit.pas |
---|
0,0 → 1,145 |
// akMediaAdmin v. 1.1 |
// Copyright (c) 1999-2000 Anatoli Klassen |
unit UtilsUnit; |
interface |
uses MPlayer, MPlayerUnit; |
function AddSlash(Path : string) : string; |
function ShowTime(T : longint) : string; |
function ExtrFileName(const FileName : string) : string; |
type |
// This class stores information about one item in the list: |
// file name, title and duration |
TFileInfo = class |
private |
FFileName : string; |
FName : string; |
FTime : longint; |
FTimeString : string; |
function GetLength : longint; |
public |
constructor Create(const AFileName, AName : string); |
property FileName : string read FFileName; |
property Name : string read FName; |
property Time : longint read FTime; |
property TimeString : string read FTimeString; |
end; |
implementation |
uses SysUtils; |
// Add slash to end of string if there is no one yet |
function AddSlash(Path : string) : string; |
begin |
if Path = '' then Result := Path |
else |
if Path[Length(Path)] = '\' then Result := Path |
else Result := Path + '\'; |
end; |
// Convert duration from integer to string |
function ShowTime(T : longint) : string; |
var |
a : longint; |
begin |
if T < 0 then |
ShowTime := '00:00.0' |
else begin |
a := T div 1000 div 60; // minutes |
Result := FormatFloat('00:', a); |
T := T - a * 1000 * 60; |
a := T div 1000; // seconds |
Result := Result + FormatFloat('00"."', a); |
T := T - a * 1000; |
a := T div 100; // hundredths of seconds |
Result := Result + FormatFloat('0', a); |
end; |
end; |
// Extract file name without extention from full path |
function ExtrFileName(const FileName : string) : string; |
var |
i : longint; |
begin |
Result := ExtractFileName(FileName); |
i := Length(Result); |
while (i > 0) and (Result[i] <> '.') do Dec(i); |
if i > 0 then Result := Copy(Result, 1, i-1); |
end; |
// = TFileInfo ================================================================= |
constructor TFileInfo.Create(const AFileName, AName : string); |
var |
T : longint; |
begin |
FFileName := AFileName; |
FName := AName; |
if FName = '' then |
FName := ExtrFileName(FFileName); |
FTime := 0; |
T := GetLength; |
case T of |
-1 : FTimeString := 'not found'; |
-2 : FTimeString := 'unknown type'; |
-3 : FTimeString := 'error'; |
else |
FTime := T; |
FTimeString := '<' + ShowTime(FTime) + '>'; |
end; |
end; |
// Returns: |
// >= 0 - length |
// -1 - file not found |
// -2 - unknown format |
// -3 - error |
function TFileInfo.GetLength; |
var |
FPlayer : TPlayer; |
begin |
Result := -3; |
if not FileExists(FFileName) then begin |
Result := -1; |
end |
else |
try |
FPlayer := TPlayer.Create; |
FPlayer.FileName := FFileName; |
// find correct type of the file with 'cut and try' method |
FPlayer.DeviceType := dtAutoSelect; |
repeat |
try |
FPlayer.Open; |
FPlayer.TimeFormat := tfMilliseconds; |
Result := FPlayer.Length; |
Break; |
except |
if FPlayer.DeviceType < dtWaveAudio then |
FPlayer.DeviceType := Succ(FPlayer.DeviceType) |
else begin |
Result := -2; |
end; |
end; |
until False; |
FPlayer.Free; |
except |
end; |
end; |
end. |
/Delphi/akMediaAdmin/Source/akmadmin.dpr |
---|
0,0 → 1,33 |
// akMediaAdmin v. 1.1 |
// Copyright (c) 1999-2000 Anatoli Klassen |
// The program and its source code are provided |
// "AS IS", no any warranties. |
// You may use this source codes in any way, |
// but please make a reference to me. |
// Home page: www.aksoft.net/progs/akmediaadmin |
// or mail me: akmediaadmin@aksoft.net |
program akmadmin; |
uses |
Forms, |
MainUnit in 'MainUnit.pas' {MainForm}, |
AboutUnit in 'AboutUnit.pas' {AboutBox}, |
LoadUnit in 'LoadUnit.pas', |
UtilsUnit in 'UtilsUnit.pas', |
MPlayerUnit in 'MPlayerUnit.pas', |
WaitUnit in 'WaitUnit.pas' {WaitForm}; |
{$R *.RES} |
begin |
Application.Initialize; |
Application.Title := 'akMediaAdmin'; |
Application.HelpFile := 'AKMADMIN.HLP'; |
Application.CreateForm(TMainForm, MainForm); |
Application.CreateForm(TAboutBox, AboutBox); |
Application.CreateForm(TWaitForm, WaitForm); |
Application.Run; |
end. |
/Delphi/akMediaAdmin/Source/MainUnit.pas |
---|
0,0 → 1,353 |
// akMediaAdmin v. 1.1 |
// Copyright (c) 1999-2000 Anatoli Klassen |
// Main Unit |
unit MainUnit; |
interface |
uses |
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, |
ExtCtrls, ComCtrls, StdCtrls, ImgList, ToolWin, MPlayer, ShellAPI, LoadUnit; |
type |
TMainForm = class(TForm) |
FilesBox: TListBox; |
StatusBar: TStatusBar; |
ToolBar: TToolBar; |
AddButton: TToolButton; |
ToolHotImages: TImageList; |
AboutButton: TToolButton; |
ToolImages: TImageList; |
ToolDisabledImages: TImageList; |
ToolSeparator1: TToolButton; |
MPlayer: TMediaPlayer; |
OpenDialog: TOpenDialog; |
PlayBar: TProgressBar; |
ToolSeparator2: TToolButton; |
PlayButton: TToolButton; |
StopButton: TToolButton; |
ToolSeparator3: TToolButton; |
PlayTimer: TTimer; |
ClearButton: TToolButton; |
HelpButton: TToolButton; |
procedure FilesBoxDrawItem(Control: TWinControl; Index: Integer; |
Rect: TRect; State: TOwnerDrawState); |
procedure AddButtonClick(Sender: TObject); |
procedure FormCreate(Sender: TObject); |
procedure FilesBoxClick(Sender: TObject); |
procedure FilesBoxKeyPress(Sender: TObject; var Key: Char); |
procedure AboutButtonClick(Sender: TObject); |
procedure FormResize(Sender: TObject); |
procedure PlayButtonClick(Sender: TObject); |
procedure StopButtonClick(Sender: TObject); |
procedure PlayTimerTimer(Sender: TObject); |
procedure ClearButtonClick(Sender: TObject); |
procedure FormDestroy(Sender: TObject); |
procedure FilesBoxKeyDown(Sender: TObject; var Key: Word; |
Shift: TShiftState); |
procedure HelpButtonClick(Sender: TObject); |
procedure FormShow(Sender: TObject); |
procedure PlayBarMouseUp(Sender: TObject; Button: TMouseButton; |
Shift: TShiftState; X, Y: Integer); |
private |
function CalcTimes : longint; |
procedure CalcSelectedTimes; |
procedure Load(Files : TStrings); |
procedure ClearList; |
procedure WMDropFiles(var Msg: TMessage); message WM_DROPFILES; |
procedure PlayerStart; |
procedure PlayerStop; |
procedure UpdatePlayerState; |
public |
end; |
var |
MainForm: TMainForm; |
implementation |
uses AboutUnit, UtilsUnit, FileCtrl, WaitUnit; |
{$R *.DFM} |
procedure TMainForm.FormCreate(Sender: TObject); |
begin |
Application.HelpFile := |
AddSlash(ExtractFileDir(Application.ExeName)) + 'akmadmin.hlp'; |
DragAcceptFiles(Handle, True); |
UpdatePlayerState; |
end; |
procedure TMainForm.FormShow(Sender: TObject); |
var |
i : longint; |
S : TStringList; |
begin |
// load files from command line |
S := TStringList.Create; |
for i := 1 to ParamCount do |
S.Add(ParamStr(i)); |
Load(S); |
S.Free; |
end; |
procedure TMainForm.FormDestroy(Sender: TObject); |
begin |
ClearList; |
end; |
procedure TMainForm.AddButtonClick(Sender: TObject); |
begin |
if OpenDialog.Execute then |
Load(OpenDialog.Files); |
end; |
procedure TMainForm.HelpButtonClick(Sender: TObject); |
begin |
Application.HelpJump('main'); |
end; |
procedure TMainForm.AboutButtonClick(Sender: TObject); |
begin |
AboutBox.ShowModal; |
end; |
procedure TMainForm.FilesBoxClick(Sender: TObject); |
begin |
CalcSelectedTimes; |
UpdatePlayerState; |
end; |
procedure TMainForm.FilesBoxKeyPress(Sender: TObject; var Key: Char); |
begin |
CalcSelectedTimes; |
UpdatePlayerState; |
end; |
procedure TMainForm.PlayButtonClick(Sender: TObject); |
begin |
PlayerStart; |
end; |
procedure TMainForm.StopButtonClick(Sender: TObject); |
begin |
PlayerStop; |
end; |
procedure TMainForm.ClearButtonClick(Sender: TObject); |
begin |
ClearList; |
StatusBar.Panels[1].Text := 'Total: 0; time: ' + ShowTime(0); |
UpdatePlayerState; |
ClearButton.Enabled := False; |
end; |
procedure TMainForm.FilesBoxDrawItem(Control: TWinControl; Index: Integer; |
Rect: TRect; State: TOwnerDrawState); |
var |
R : TRect; |
FI : TFileInfo; |
begin |
with FilesBox.Canvas do begin |
FI := TFileInfo(FilesBox.Items.Objects[Index]); |
TextRect(Rect, Rect.Left, Rect.Top, FI.Name); |
R := Rect; |
R.Left := R.Right - TextWidth(FI.TimeString) - 2; |
TextRect(R, R.Left, R.Top, FI.TimeString); |
end; |
end; |
procedure TMainForm.FilesBoxKeyDown(Sender: TObject; var Key: Word; |
Shift: TShiftState); |
begin |
if Key = VK_DELETE then begin // if 'delete' key was pressed |
// delete corresponded TFileInfo for current item |
if FilesBox.Items.Objects[FilesBox.ItemIndex] <> nil then |
FilesBox.Items.Objects[FilesBox.ItemIndex].Free; |
FilesBox.Items.Objects[FilesBox.ItemIndex] := nil; |
FilesBox.Items.Delete(FilesBox.ItemIndex); |
StatusBar.Panels[1].Text := 'Total: ' + IntToStr(FilesBox.Items.Count) |
+ '; time: ' + ShowTime(CalcTimes); |
ClearButton.Enabled := (FilesBox.Items.Count > 0); |
UpdatePlayerState; |
end; |
end; |
function TMainForm.CalcTimes : longint; |
var |
i : longint; |
begin |
Result := 0; |
for i := 0 to FilesBox.Items.Count - 1 do |
Result := Result + TFileInfo(FilesBox.Items.Objects[i]).Time; |
end; |
procedure TMainForm.CalcSelectedTimes; |
var |
i, t : longint; |
begin |
t := 0; |
for i := 0 to FilesBox.Items.Count - 1 do |
if FilesBox.Selected[i] then begin |
t := t + TFileInfo(FilesBox.Items.Objects[i]).Time; |
end; |
StatusBar.Panels[0].Text := 'Selected: ' + IntToStr(FilesBox.SelCount) |
+ '; time: ' + ShowTime(t); |
end; |
// Handle Windows message for drop files |
procedure TMainForm.WMDropFiles; |
var |
FileName : array[0 .. 256] of Char; |
Count, i : integer; |
S : TStringList; |
begin |
Count := DragQueryFile(Msg.WParam, $FFFFFFFF, nil, 0); |
S := TStringList.Create; |
for i := 0 to Count-1 do begin |
DragQueryFile(Msg.WParam, i, FileName, SizeOf(FileName)); |
S.Add(String(FileName)); |
end; |
Load(S); |
S.Free; |
DragFinish(Msg.WParam); |
end; |
procedure TMainForm.FormResize(Sender: TObject); |
begin |
FilesBox.Repaint; // the TListBox does not repaint itself correctly |
StatusBar.Panels[0].Width := StatusBar.Width div 2; |
end; |
procedure TMainForm.PlayerStart; |
begin |
if MPlayer.FileName <> '' then begin |
MPlayer.Play; |
PlayTimer.Enabled := True; |
PlayButton.Enabled := False; |
StopButton.Enabled := True; |
end |
else begin |
PlayButton.Enabled := False; |
StopButton.Enabled := False; |
end; |
end; |
procedure TMainForm.PlayerStop; |
begin |
PlayTimer.Enabled := False; |
if MPlayer.FileName <> '' then begin |
MPlayer.Stop; |
PlayButton.Enabled := True; |
StopButton.Enabled := False; |
end |
else begin |
PlayButton.Enabled := False; |
StopButton.Enabled := False; |
end; |
end; |
procedure TMainForm.UpdatePlayerState; |
begin |
MPlayer.Close; |
PlayBar.Position := 0; |
PlayTimer.Enabled := False; |
PlayButton.Enabled := False; |
StopButton.Enabled := False; |
if (FilesBox.ItemIndex < 0) or (FilesBox.Items.Count = 0) then |
MPlayer.FileName := '' |
else begin |
if FileExists(TFileInfo(FilesBox.Items.Objects[FilesBox.ItemIndex]).FileName) |
then |
try |
MPlayer.FileName := |
TFileInfo(FilesBox.Items.Objects[FilesBox.ItemIndex]).FileName; |
// find correct type of the file with 'cut and try' method |
MPlayer.DeviceType := dtAutoSelect; |
repeat |
try |
MPlayer.Open; |
PlayBar.Max := MPlayer.Length; |
PlayTimer.Enabled := True; |
PlayButton.Enabled := True; |
Break; |
except |
if MPlayer.DeviceType < dtWaveAudio then |
MPlayer.DeviceType := Succ(MPlayer.DeviceType) |
else |
Break; |
end; |
until False; |
except |
end |
else begin |
PlayBar.Max := 100; |
end; |
end; |
end; |
procedure TMainForm.PlayTimerTimer(Sender: TObject); |
begin |
PlayBar.Position := MPlayer.Position; |
if MPlayer.Mode = mpStopped then begin |
PlayerStop; |
MPlayer.Position := 0; |
end; |
end; |
procedure TMainForm.ClearList; |
var |
i : longint; |
begin |
// delete corresponded TFileInfo's for all items |
for i := 0 to FilesBox.Items.Count - 1 do begin |
if FilesBox.Items.Objects[i] <> nil then |
FilesBox.Items.Objects[i].Free; |
FilesBox.Items.Objects[i] := nil; |
end; |
FilesBox.Items.Clear; |
end; |
procedure TMainForm.Load(Files : TStrings); |
var |
Result : TStrings; |
begin |
if Files.Count = 0 then Exit; |
Result := WaitForm.Execute(Files); |
FilesBox.Items.BeginUpdate; |
FilesBox.Items.AddStrings(Result); |
FilesBox.Items.EndUpdate; |
Result.Free; |
StatusBar.Panels[1].Text := 'Total: ' + IntToStr(FilesBox.Items.Count) |
+ '; time: ' + ShowTime(CalcTimes); |
ClearButton.Enabled := (FilesBox.Items.Count > 0); |
UpdatePlayerState; |
end; |
procedure TMainForm.PlayBarMouseUp(Sender: TObject; Button: TMouseButton; |
Shift: TShiftState; X, Y: Integer); |
begin |
if MPlayer.Mode <> mpPlaying then Exit; |
PlayTimer.Enabled := False; |
MPlayer.Position := Trunc(X/PlayBar.Width*PlayBar.Max); |
MPlayer.Play; |
PlayTimer.Enabled := True; |
end; |
end. |
/Delphi/akMediaAdmin/Source/WaitUnit.pas |
---|
0,0 → 1,86 |
// akMediaAdmin v. 1.1 |
// Copyright (c) 1999-2000 Anatoli Klassen |
unit WaitUnit; |
interface |
uses |
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, |
StdCtrls, LoadUnit, ExtCtrls; |
type |
TWaitForm = class(TForm) |
AbortButton: TButton; |
WaitLabel: TLabel; |
Timer: TTimer; |
procedure AbortButtonClick(Sender: TObject); |
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); |
procedure TimerTimer(Sender: TObject); |
private |
FLoadThread : TLoadThread; |
FDone : boolean; |
public |
procedure Terminated(Sender : TObject); |
function Execute(Files : TStrings) : TStrings; |
procedure ShowState(Current, Total : longint); |
end; |
var |
WaitForm: TWaitForm; |
implementation |
{$R *.DFM} |
function TWaitForm.Execute(Files : TStrings) : TStrings; |
begin |
WaitLabel.Caption := 'Loading...'; |
AbortButton.Enabled := True; |
Application.BringToFront; |
FDone := False; |
FLoadThread := TLoadThread.Create(Files); |
FLoadThread.OnTerminate := WaitForm.Terminated; |
FLoadThread.FreeOnTerminate := False; |
ShowModal; |
Result := TStringList.Create; |
Result.AddStrings(FLoadThread.Result); |
FLoadThread.Free; |
end; |
procedure TWaitForm.AbortButtonClick(Sender: TObject); |
begin |
WaitLabel.Caption := 'Aborting...'; |
AbortButton.Enabled := False; |
FLoadThread.Terminate; |
end; |
procedure TWaitForm.Terminated; |
begin |
FDone := True; |
Close; |
end; |
procedure TWaitForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); |
begin |
CanClose := FDone; |
end; |
procedure TWaitForm.ShowState(Current, Total : longint); |
begin |
WaitLabel.Caption := Format('Load %d of %d', [Current, Total]); |
end; |
procedure TWaitForm.TimerTimer(Sender: TObject); |
begin |
// just to produce an event at end of loading - elsewise the form will be |
// displayed unlimited time :( |
end; |
end. |
/Delphi/akMediaAdmin/Source/akmadmin.dof |
---|
0,0 → 1,84 |
[FileVersion] |
Version=6.0 |
[Compiler] |
A=8 |
B=0 |
C=1 |
D=1 |
E=0 |
F=0 |
G=1 |
H=1 |
I=1 |
J=1 |
K=0 |
L=1 |
M=0 |
N=1 |
O=1 |
P=1 |
Q=0 |
R=0 |
S=0 |
T=0 |
U=0 |
V=1 |
W=0 |
X=1 |
Y=1 |
Z=1 |
ShowHints=1 |
ShowWarnings=1 |
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; |
[Linker] |
MapFile=0 |
OutputObjs=0 |
ConsoleApp=1 |
DebugInfo=0 |
RemoteSymbols=0 |
MinStackSize=16384 |
MaxStackSize=1048576 |
ImageBase=4194304 |
ExeDescription= |
[Directories] |
OutputDir=..\Exe |
UnitOutputDir=..\Units |
PackageDLLOutputDir= |
PackageDCPOutputDir= |
SearchPath=..\Units |
Packages=VCL40;VCLX40;VCLDB40;VCLDBX40;VCLSMP40;QRPT40;TEEUI40;TEEDB40;TEE40;ibevnt40;nmfast40 |
Conditionals= |
DebugSourceDirs= |
UsePackages=0 |
[Parameters] |
RunParams= |
HostApplication= |
Launcher= |
UseLauncher=0 |
DebugCWD= |
[Version Info] |
IncludeVerInfo=1 |
AutoIncBuild=1 |
MajorVer=1 |
MinorVer=1 |
Release=1 |
Build=1 |
Debug=0 |
PreRelease=0 |
Special=0 |
Private=0 |
DLL=0 |
Locale=1033 |
CodePage=1252 |
[Version Info Keys] |
CompanyName=Anatoli Klassen |
FileDescription= |
FileVersion=1.1.1.1 |
InternalName= |
LegalCopyright=(c) 1999-2000 Anatoli Klassen |
LegalTrademarks= |
OriginalFilename= |
ProductName=akMediaAdmin |
ProductVersion=1.1.1.0 |
Comments=freeware |
Home Page=www.aksoft.net/progs/akmediaadmin |
/Delphi/akMediaAdmin/Source/MainUnit.dfm |
---|
Cannot display: file marked as a binary type. |
svn:mime-type = application/octet-stream |
Property changes: |
Added: svn:mime-type |
+application/octet-stream |
\ No newline at end of property |
/Delphi/akMediaAdmin/Source/WaitUnit.dfm |
---|
0,0 → 1,47 |
object WaitForm: TWaitForm |
Left = 191 |
Top = 107 |
BorderStyle = bsDialog |
Caption = 'WaitForm' |
ClientHeight = 60 |
ClientWidth = 172 |
Color = clBtnFace |
Font.Charset = DEFAULT_CHARSET |
Font.Color = clWindowText |
Font.Height = -11 |
Font.Name = 'MS Sans Serif' |
Font.Style = [] |
OldCreateOrder = False |
Position = poMainFormCenter |
OnCloseQuery = FormCloseQuery |
PixelsPerInch = 96 |
TextHeight = 13 |
object WaitLabel: TLabel |
Left = 2 |
Top = 8 |
Width = 168 |
Height = 13 |
Alignment = taCenter |
Anchors = [akLeft, akTop, akRight] |
AutoSize = False |
Caption = 'Loading...' |
end |
object AbortButton: TButton |
Left = 48 |
Top = 30 |
Width = 75 |
Height = 25 |
Anchors = [akBottom] |
Cancel = True |
Caption = '&Abort' |
Default = True |
TabOrder = 0 |
OnClick = AbortButtonClick |
end |
object Timer: TTimer |
Interval = 100 |
OnTimer = TimerTimer |
Left = 136 |
Top = 2 |
end |
end |
/Delphi/akMediaAdmin/Source/akmadmin.res |
---|
Cannot display: file marked as a binary type. |
svn:mime-type = application/octet-stream |
Property changes: |
Added: svn:mime-type |
+application/octet-stream |
\ No newline at end of property |
/Delphi/akMediaAdmin/Source/MPlayerUnit.pas |
---|
0,0 → 1,160 |
// akMediaAdmin v. 1.1 |
// Copyright (c) 1999-2000 Anatoli Klassen |
// Based on TMediaPlayer from Borland |
unit MPlayerUnit; |
interface |
uses MMSystem, SysUtils; |
type |
TMPDeviceTypes = (dtAutoSelect, dtAVIVideo, dtCDAudio, dtDAT, dtDigitalVideo, dtMMMovie, |
dtOther, dtOverlay, dtScanner, dtSequencer, dtVCR, dtVideodisc, dtWaveAudio); |
TMPTimeFormats = (tfMilliseconds, tfHMS, tfMSF, tfFrames, tfSMPTE24, tfSMPTE25, |
tfSMPTE30, tfSMPTE30Drop, tfBytes, tfSamples, tfTMSF); |
TPlayer = class |
private |
MCIOpened: Boolean; |
FDeviceID: Word; |
FDeviceType: TMPDeviceTypes; |
FElementName: string; |
FFlags: Longint; |
FError: Longint; |
function GetLength: Longint; |
procedure CheckIfOpen; |
procedure SetDeviceType(Value: TMPDeviceTypes); |
function GetTimeFormat: TMPTimeFormats; |
procedure SetTimeFormat(Value: TMPTimeFormats); |
public |
constructor Create; |
destructor Destroy; override; |
procedure Open; |
procedure Close; |
property Length: Longint read GetLength; |
property FileName: string read FElementName write FElementName; |
property DeviceType: TMPDeviceTypes read FDeviceType write SetDeviceType; |
property TimeFormat: TMPTimeFormats read GetTimeFormat write SetTimeFormat; |
end; |
EMCIDeviceError = class(Exception); |
implementation |
constructor TPlayer.Create; |
begin |
inherited Create; |
FDeviceType := dtAutoSelect; {select through file name extension} |
end; |
destructor TPlayer.Destroy; |
var |
GenParm: TMCI_Generic_Parms; |
begin |
if FDeviceID <> 0 then |
mciSendCommand(FDeviceID, mci_Close, mci_Wait, Longint(@GenParm)); |
inherited Destroy; |
end; |
procedure TPlayer.SetDeviceType(Value: TMPDeviceTypes); |
begin |
if Value <> FDeviceType then FDeviceType := Value; |
end; |
function TPlayer.GetTimeFormat: TMPTimeFormats; |
var |
StatusParm: TMCI_Status_Parms; |
begin |
CheckIfOpen; {raises exception if device is not open} |
FFlags := mci_Wait or mci_Status_Item; |
StatusParm.dwItem := mci_Status_Time_Format; |
FError := mciSendCommand( FDeviceID, mci_Status, FFlags, Longint(@StatusParm)); |
Result := TMPTimeFormats(StatusParm.dwReturn); |
end; |
procedure TPlayer.SetTimeFormat(Value: TMPTimeFormats); |
var |
SetParm: TMCI_Set_Parms; |
begin |
begin |
FFlags := mci_Notify or mci_Set_Time_Format; |
SetParm.dwTimeFormat := Longint(Value); |
FError := mciSendCommand( FDeviceID, mci_Set, FFlags, Longint(@SetParm) ); |
end; |
end; |
procedure TPlayer.Open; |
const |
DeviceName: array[TMPDeviceTypes] of PChar = ('', 'AVIVideo', 'CDAudio', 'DAT', |
'DigitalVideo', 'MMMovie', 'Other', 'Overlay', 'Scanner', 'Sequencer', |
'VCR', 'Videodisc', 'WaveAudio'); |
var |
OpenParm: TMCI_Open_Parms; |
begin |
{ zero out memory } |
FillChar(OpenParm, SizeOf(TMCI_Open_Parms), 0); |
if MCIOpened then Close; {must close MCI Device first before opening another} |
OpenParm.lpstrDeviceType := DeviceName[FDeviceType]; |
OpenParm.lpstrElementName := PChar(FElementName); |
FFlags := mci_Wait; |
if FDeviceType <> dtAutoSelect then |
FFlags := FFlags or mci_Open_Type |
else |
FFlags := FFlags or MCI_OPEN_ELEMENT; |
OpenParm.dwCallback := 0; //Handle; |
FError := mciSendCommand(0, mci_Open, FFlags, Longint(@OpenParm)); |
if FError <> 0 then {problem opening device} |
raise EMCIDeviceError.Create('Can not open file') |
else {device successfully opened} |
begin |
MCIOpened := True; |
FDeviceID := OpenParm.wDeviceID; |
end; |
end; |
procedure TPlayer.Close; |
var |
GenParm: TMCI_Generic_Parms; |
begin |
if FDeviceID <> 0 then |
begin |
FFlags := 0; |
FFlags := mci_Wait; |
GenParm.dwCallback := 0; //Handle; |
FError := mciSendCommand( FDeviceID, mci_Close, FFlags, Longint(@GenParm)); |
if FError = 0 then |
begin |
MCIOpened := False; |
FDeviceID := 0; |
end; |
end; {if DeviceID <> 0} |
end; |
procedure TPlayer.CheckIfOpen; |
begin |
if not MCIOpened then raise EMCIDeviceError.Create('Not open'); |
end; |
function TPlayer.GetLength: Longint; |
var |
StatusParm: TMCI_Status_Parms; |
begin |
CheckIfOpen; {raises exception if device is not open} |
FFlags := mci_Wait or mci_Status_Item; |
StatusParm.dwItem := mci_Status_Length; |
FError := mciSendCommand(FDeviceID, mci_Status, FFlags, Longint(@StatusParm)); |
Result := StatusParm.dwReturn; |
end; |
end. |
/Delphi/akMediaAdmin/Source/readme.txt |
---|
0,0 → 1,14 |
There is source code of akMediaAdmin (for Delphi 6). |
You can download the program itself from |
www.aksoft.net/progs/akmediaadmin |
The program and its source code are provided |
"AS IS", no any warranties. |
You may use this source code in any way, |
but please make a reference to me. |
Feel free to ask me if you have any questions: |
akmediaadmin@aksoft.net |
/Delphi/akMediaAdmin/Source/AboutUnit.pas |
---|
0,0 → 1,48 |
// akMediaAdmin v. 1.1 |
// Copyright (c) 1999-2000 Anatoli Klassen |
// About Box |
unit AboutUnit; |
interface |
uses |
Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls, |
Buttons, ExtCtrls, ShellAPI; |
type |
TAboutBox = class(TForm) |
OkButton : TBitBtn; |
ProgramIcon : TImage; |
Version : TLabel; |
ProductName : TLabel; |
Copyright : TLabel; |
WebLabel : TLabel; |
MailLabel : TLabel; |
HTMLLabel : TLabel; |
MailtoLabel : TLabel; |
FreewareLabel : TLabel; |
procedure HTMLLabelClick(Sender: TObject); |
procedure MailtoLabelClick(Sender: TObject); |
private |
public |
end; |
var |
AboutBox : TAboutBox; |
implementation |
{$R *.DFM} |
procedure TAboutBox.HTMLLabelClick(Sender: TObject); |
begin |
ShellExecute(0, nil, PChar(HTMLLabel.Caption), nil, nil, 0); |
end; |
procedure TAboutBox.MailtoLabelClick(Sender: TObject); |
begin |
ShellExecute(0, nil, PChar('mailto:' + MailtoLabel.Caption), nil, nil, 0); |
end; |
end. |
/Delphi/akMediaAdmin/Source/akMediaAdmin.ico |
---|
Cannot display: file marked as a binary type. |
svn:mime-type = application/octet-stream |
Property changes: |
Added: svn:mime-type |
+application/octet-stream |
\ No newline at end of property |
/Delphi/akMediaAdmin/Source/AboutUnit.dfm |
---|
Cannot display: file marked as a binary type. |
svn:mime-type = application/octet-stream |
Property changes: |
Added: svn:mime-type |
+application/octet-stream |
\ No newline at end of property |
/Delphi/akMediaAdmin/Source/akmadmin.cfg |
---|
0,0 → 1,39 |
-$A8 |
-$B- |
-$C+ |
-$D+ |
-$E- |
-$F- |
-$G+ |
-$H+ |
-$I+ |
-$J+ |
-$K- |
-$L+ |
-$M- |
-$N+ |
-$O+ |
-$P+ |
-$Q- |
-$R- |
-$S- |
-$T- |
-$U- |
-$V+ |
-$W- |
-$X+ |
-$YD |
-$Z1 |
-cg |
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; |
-H+ |
-W+ |
-M |
-$M16384,1048576 |
-K$00400000 |
-E"..\Exe" |
-N"..\Units" |
-U"..\Units" |
-O"..\Units" |
-I"..\Units" |
-R"..\Units" |
/Delphi/akMediaAdmin/Source/LoadUnit.pas |
---|
0,0 → 1,117 |
// akMediaAdmin v. 1.1 |
// Copyright (c) 1999-2000 Anatoli Klassen |
unit LoadUnit; |
interface |
uses |
Classes; |
type |
TLoadThread = class(TThread) |
private |
FSource : TStringList; |
FResult : TStringList; |
FCurrent : longint; |
FTotal : longint; |
procedure Load(const FileName : string); |
procedure ShowState; |
protected |
procedure Execute; override; |
public |
property Result : TStringList read FResult; |
constructor Create(List : TStrings); |
destructor Destroy; override; |
end; |
implementation |
uses UtilsUnit, SysUtils, FileCtrl, WaitUnit; |
procedure TLoadThread.Load(const FileName : string); |
var |
S : TStringList; |
i, p : longint; |
st : string; |
FI : TFileInfo; |
SR : TSearchRec; |
begin |
if DirectoryExists(FileName) then begin |
if FindFirst(AddSlash(FileName)+'*.*', faAnyFile, SR) = 0 then begin |
while FindNext(SR) = 0 do |
if SR.Name[1] <> '.' then // skip parent and directory itself |
Load(AddSlash(FileName)+SR.Name); // recurcive call of the procedure |
// for nested directories |
FindClose(SR); |
end; |
end |
else if UpperCase(ExtractFileExt(FileName)) = '.PLT' then begin |
S := TStringList.Create; |
try |
S.LoadFromFile(FileName); |
except |
S.Clear; |
end; |
for i := 0 to S.Count - 1 do begin // Split file's names and captions |
st := S[i]; |
Delete(st, 1, Pos('=', st)); |
p := Pos(#9, st); |
if p = 0 then p := Pos(#8, st); |
FI := TFileInfo.Create(Copy(st, 1, p - 1), |
Copy(st, p + 1, Length(st) - p)); |
FResult.AddObject(FI.Name, FI); |
end; |
S.Free; |
end |
else begin |
FI := TFileInfo.Create(FileName, ''); |
FResult.AddObject(FI.Name, FI); |
end; |
end; |
constructor TLoadThread.Create(List : TStrings); |
begin |
FSource := TStringList.Create; |
FSource.AddStrings(List); |
FResult := TStringList.Create; |
inherited Create(False); |
end; |
destructor TLoadThread.Destroy; |
begin |
FSource.Free; |
FResult.Free; |
inherited Destroy; |
end; |
procedure TLoadThread.Execute; |
var |
i : longint; |
begin |
FResult.BeginUpdate; |
FTotal := FSource.Count; |
for i := 0 to FSource.Count-1 do |
if Terminated then |
Break |
else begin |
FCurrent := i+1; |
Synchronize(ShowState); |
Load(FSource[i]); |
end; |
FResult.EndUpdate; |
end; |
procedure TLoadThread.ShowState; |
begin |
WaitForm.ShowState(FCurrent, FTotal); |
end; |
end. |