unit Unit8;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,ShellApi,DateUtils, ComCtrls, ShellCtrls, ExtCtrls, StdCtrls, Menus;
type
TForm8 =
class(TForm)
StatusBar1: TStatusBar;
Panel1: TPanel;
Button3: TButton;
PopupMenu1: TPopupMenu;
Privatexpotieren: TMenuItem;
Button1: TButton;
GroupBox1: TGroupBox;
Panel3: TPanel;
ShellTreeView1: TShellTreeView;
GroupBox2: TGroupBox;
Panel2: TPanel;
ShellTreeView2: TShellTreeView;
procedure Button3Click(Sender: TObject);
procedure ShellTreeView1Expanding(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
procedure FormShow(Sender: TObject);
procedure ShellTreeView1Click(Sender: TObject);
procedure ShellTreeView2Expanding(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
procedure PrivatexpotierenClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure ShellTreeView2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
sVonPfadangabe,sNachPfadangabe,sPfadordner :
string;
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
type
TShellTv=
class(TShellTreeView);
var
Form8: TForm8;
implementation
uses Unit1, Unit7;
{$R *.dfm}
//===================Dateien Kopieren===========================================
function CopyFiles (
const fromDir, toDir:
string): Boolean;
var fos: TSHFileOpStruct;
begin
ZeroMemory(@fos, SizeOf(fos));
with fos
do
begin
wFunc := FO_COPY;
wnd := Application.Handle;
fFlags := 0;
fFlags := FOF_NOCONFIRMATION;
// keine bestätigung zum überschreiben
pFrom := PChar(fromDir + #0);
pTo := PChar(toDir + #0)
end;
Result := (0 = ShFileOperation(fos));
end;
//==========================schließen==========================================
procedure TForm8.Button3Click(Sender: TObject);
begin
ShellTreeView1.Refresh(ShellTreeView1.Items[0]);
// Medium auf das Eportiert werden soll
ShellTreeView2.Refresh(ShellTreeView2.Items[0]);
// Ordner der Expotiert werden soll
close;
end;
procedure TForm8.FormShow(Sender: TObject);
begin
Form8.Top:= Form7.Top + 200;
Form8.Left:= Form7.left + 200;
ShellTreeView1.Refresh(ShellTreeView1.Items[0]);
ShellTreeView2.Refresh(ShellTreeView2.Items[0]);
TShellTv(Self.ShellTreeView1).
ReadOnly:= true;
TShellTv(Self.ShellTreeView2).
ReadOnly:= true;
sVonPfadangabe:= (Form1.ServerPfad + '
Privat\');
StatusBar1.Panels[1].Text:= '
Von: '+ sVonPfadangabe;
sPfadordner:= (Form1.ServerPfad + '
Privat\');
// Pfad setzen zu den Privat
ShellTreeview2.Root:= sPfadordner;
end;
procedure TForm8.ShellTreeView1Click(Sender: TObject);
begin
sNachPfadangabe:= ShellTreeView1.Path;
StatusBar1.Panels[0].Text:= '
Nach: ' + sNachPfadangabe;
ShellTreeView1.Refresh(ShellTreeView1.Items[0]);
end;
//====================nur bis "USB" zulassen======================================
procedure TForm8.ShellTreeView1Expanding(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
begin
if Node <> ShellTreeView1.Items.Item[0]
then
AllowExpansion:= False;
end;
//==================nur bis \Privat (Server)==============================
procedure TForm8.ShellTreeView2Expanding(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
begin
if Node <> ShellTreeView2.Items.Item[0]
then
AllowExpansion:= False;
end;
//=============================mit rechts ordner öffnen============================
procedure TForm8.ShellTreeView2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var node: TTreeNode;
begin
if Button = mbRight
then
begin
node := ShellTreeView2.GetNodeAt(X, Y);
if Assigned(node)
then
begin
node.Selected := True;
end;
end;
end;
procedure TForm8.PrivatexpotierenClick(Sender: TObject);
begin
try
if not FileExists (sNachPfadangabe + '
Privat_Mobil\')
then
begin
ForceDirectories(sNachPfadangabe + '
Privat_Mobil\');
if CopyFiles (Form1.ServerPfad + '
Privat\' + ExtractFileName(ShellTreeView2.Path),sNachPfadangabe + '
Privat_Mobil\'+ ExtractFileName(ShellTreeView2.Path))
then
Form1.MessageDlgPos2('
Ordner ' +ExtractFileName(ShellTreeView2.Path) + '
Expotiert', mtInformation,[mbOk], self);
end;
except
Form1.MessageDlgPos2('
Fehler, bitte überprüfen Sie Ihre Eingaben', mtWarning,[mbOk], self);
end;
end;
end.