Subversion Repositories general

Compare Revisions

No changes between revisions

Ignore whitespace Rev 1077 → Rev 1078

/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.