[Delphinic]

unit CopyIndicators;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cm_LSVGauges, ActiveX, ShlObj, ShellAPI;

type
TFcopy = class(TForm)
OneCopy: TLSVGauge;
procedure FormShow(Sender: TObject);
procedure FormDeactivate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Fcopy: TFcopy;
IMassive : Integer;
Dirs, MyDir : String;

implementation

uses SelectDir, PlayList;

{$R *.dfm}


function BrowseCallbackProc(hwnd: HWND; uMsg: UINT; lParam: LPARAM; lpData: LPARAM): integer; stdcall;
begin
Result := 0;
if uMsg = BFFM_INITIALIZED then
SendMessage( hwnd, BFFM_SETSELECTION, 1,
LongInt( PChar( myDir ) ) );
end;

/// Выбор каталога.
function SelectDirPlus(hWnd: HWND; const Caption: string; const Root: WideString): String;
var
WindowList: Pointer;
BrowseInfo : TBrowseInfo;
Buffer: PChar;
RootItemIDList, ItemIDList: PItemIDList;
ShellMalloc: IMalloc;
IDesktopFolder: IShellFolder;
Eaten, Flags: LongWord;
Cmd: Boolean;
begin
FillChar( BrowseInfo, SizeOf( BrowseInfo ), 0 );
if ( ShGetMalloc( ShellMalloc ) = S_OK ) and ( ShellMalloc <> nil ) then
begin
Buffer := ShellMalloc.Alloc( MAX_PATH );
try
RootItemIDList := nil;
if Root <> '' then
begin
SHGetDesktopFolder( IDesktopFolder );
IDesktopFolder.ParseDisplayName( hWnd, nil,
POleStr( Root ), Eaten, RootItemIDList, Flags );
end;
with BrowseInfo do
begin
hwndOwner := hWnd;
pidlRoot := RootItemIDList;
pszDisplayName := Buffer;
lpfn := BrowseCallbackProc;
lpszTitle := PChar( Caption );
ulFlags := BIF_RETURNONLYFSDIRS or $0040 or BIF_EDITBOX or BIF_STATUSTEXT;
end;
WindowList := DisableTaskWindows( 0 );
try
ItemIDList := ShBrowseForFolder( BrowseInfo );
finally
EnableTaskWindows( WindowList );
end;
Cmd := ItemIDList <> nil;
if Cmd then
begin
ShGetPathFromIDList( ItemIDList, Buffer );
ShellMalloc.Free( ItemIDList );
Result:= Buffer;
end;
finally
ShellMalloc.Free( Buffer );
end;
end;
end;

// Процедура копирования.
procedure FastFileCopy(const InfileName, OutFileName: string; SizeDone, SizeFile: LongInt);
const
BufSize = 3*4*4096;
type
PBuffer = ^TBuffer;
TBuffer = array [1..BufSize] of Byte;
var
Size : integer;
Buffer : PBuffer;
infile, outfile : file;
// SizeDone, SizeFile: Longint;
begin
if (InFileName <> OutFileName) then
begin
buffer := nil;
AssignFile(infile, InFileName);
System.Reset(infile, 1);
try
SizeFile := FileSize(infile);
AssignFile(outfile, OutFileName);
System.Rewrite(outfile, 1);
try
SizeDone := 0; New(Buffer);
repeat
BlockRead(infile, Buffer^, BufSize, Size);
Inc(SizeDone, Size);
FCopy.OneCopy.Progress := SizeDone; // Индикатор копирования. Gauge.
FCopy.OneCopy.MaxValue := SizeFile; // Максимальное значение Gauge.
BlockWrite(outfile,Buffer^, Size)
until Size < BufSize;
FileSetDate(TFileRec(outfile).Handle,
FileGetDate(TFileRec(infile).Handle));
finally
if Buffer <> nil then
Dispose(Buffer);
System.close(outfile)
end;
finally
System.close(infile);
end;
end
else
raise EInOutError.Create('File cannot be copied into itself');
end;



procedure TFcopy.FormShow(Sender: TObject);
begin
FCopy.Visible := True; // Пытался добиться видимости формы.
Dirs := SelectDirPlus( Handle, 'Выбор каталога', 'd:\' ); /// Выбор каталога
Imassive := 0;
Repeat
If ListF.CLB.Count = 0 Then Exit; // ListF Список файлов MP3. CheckListBox (CLB)
If ListF.CLB.Selected[Imassive] = True Then
Begin
FileSetAttr(ListF.CLB.items[IMassive],FaArchive);
FastFileCopy(ListF.CLB.items.Strings[IMassive],Dirs+'\'+ExtractFileName(ListF.CLB.items.Strings[Imassive]),int1,int); //Обращение к процедуре копирования файлов .
End;
IMAssive := Imassive + 1;
//Form1.Caption := IntToStr(CLB.Count);
Until IMassive = ListF.CLB.Count;
IMassive := 0;
Repeat
If ListF.CLB.Count = 0 Then Exit;
If ListF.CLB.Checked[Imassive] = True Then
Begin
FileSetAttr(ListF.CLB.Items.Strings[Imassive],FaArchive);
FastFileCopy(ListF.CLB.items[IMassive],Dirs+'\'+ExtractFileName(ListF.CLB.items[Imassive]),int1,int);
ListF.CLB.Checked[IMassive] := False;
End;
Inc(Imassive);
Until Imassive = ListF.CLB.Count;
end;

procedure TFcopy.FormDeactivate(Sender: TObject);
begin
ShowWindow(Fcopy.Handle, SW_Hide); // Типа скрывается форма. Но по кривому.
end;

end.