unit Unit3;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls,ShellApi, ShellCtrls,commctrl, ExtCtrls, StdCtrls;
type
TForm3 =
class(TForm)
GroupBox1: TGroupBox;
RadioGroup1: TRadioGroup;
Button1: TButton;
Button2: TButton;
Panel1: TPanel;
StatusBar1: TStatusBar;
Panel2: TPanel;
Button3: TButton;
ShellTreeView1: TShellTreeView;
ProgressBar1: TProgressBar;
procedure RadioGroup1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure ShellTreeView1Change(Sender: TObject; Node: TTreeNode);
procedure ShellTreeView1Expanding(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
procedure FormResize(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ShellTreeView1Click(Sender: TObject);
private
sPfadangabe :
string;
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
type
TShellTv=
class(TShellTreeView);
var
Form3: TForm3;
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 := FOF_FILESONLY;
fFlags := 0;
fFlags := 0;
fFlags := FOF_NOCONFIRMATION;
// keine bestätigung zum überschreiben
pFrom := PChar(fromDir + #0);
pTo := PChar(toDir)
end;
Result := (0 = ShFileOperation(fos));
end;
//===================Daten Export===============================================
procedure TForm3.Button1Click(Sender: TObject);
begin
try
if not FileExists (sPfadangabe + '
USB_Mobil')
then
begin
ForceDirectories(sPfadangabe + '
USB_Mobil');
CopyFiles (Form1.ServerPfad + '
Local\*.*',sPfadangabe + '
Vertretungsplan_Mobil');
end;
except
Form1.MessageDlgPos2('
Fehler, bitte überprüfen Sie Ihre Eingaben', mtWarning,[mbOk], self);
end;
end;
//=================Daten import=================================================
procedure TForm3.Button2Click(Sender: TObject);
begin
try
if not directoryExists (sPfadangabe + '
USB_Mobil')
then
begin
Form1.MessageDlgPos2('
Es existieren in dem Verzeichnis keine Dateien zum Impotieren', mtInformation,[mbOk], self);
end
else
begin
CopyFiles (sPfadangabe + '
USB_Mobil\*.*',Form1.ServerPfad + '
Local\');
end;
except
Form1.MessageDlgPos2('
Fehler, bitte überprüfen Sie Ihre Eingaben', mtWarning,[mbOk], self);
end;
Form7.ShellTreeView1.Refresh(Form7.ShellTreeView1.Items[0]);
end;
//==========================schließen==========================================
procedure TForm3.Button3Click(Sender: TObject);
begin
ShellTreeView1.Refresh(ShellTreeView1.Items[0]);
close;
end;
procedure TForm3.FormResize(Sender: TObject);
var PanelRect: TRect;
begin
// Progressbar in die Statusbar setzen (0 für das erste Panel, 1 für das zweite usw.)
SendMessage(StatusBar1.Handle, SB_GETRECT, 2, Integer(@PanelRect));
// Position the progressbar over the panel on the statusbar
with PanelRect
do
ProgressBar1.SetBounds(Left, Top, Right-Left, Bottom-Top);
end;
procedure TForm3.FormShow(Sender: TObject);
begin
Form3.Top:= Form7.Top + 200;
Form3.Left:= Form7.left + 200;
ProgressBar1.Parent := StatusBar1;
ShellTreeView1.Refresh(ShellTreeView1.Items[0]);
TShellTv(Self.ShellTreeView1).
ReadOnly:= true;
end;
//===auswahl Import und Export==================================================
procedure TForm3.RadioGroup1Click(Sender: TObject);
begin
case RadioGroup1.ItemIndex
of
0:
begin
Button2.Visible:= True;
// Import
Button1.Visible:= False;
StatusBar1.Panels[0].Text:= '
Von: '+ sPfadangabe;
StatusBar1.Panels[1].Text:= '
Nach: Local_Server';
end;
1:
begin
Button1.Visible:= True;
// Export
Button2.Visible:= False;
StatusBar1.Panels[0].Text:= '
Von: Local_Server';
StatusBar1.Panels[1].Text:= '
Nach: ' + sPfadangabe;
end;
end;
end;
procedure TForm3.ShellTreeView1Change(Sender: TObject; Node: TTreeNode);
begin
sPfadangabe:= ShellTreeView1.Path;
if Radiogroup1.ItemIndex = 0
then
begin
StatusBar1.Panels[0].Text:= '
Von: '+ sPfadangabe;
end;
if Radiogroup1.ItemIndex = 1
then
begin
StatusBar1.Panels[1].Text:= '
Nach: ' + sPfadangabe;
end;
end;
//===========================Refrsh bei klick==================================
procedure TForm3.ShellTreeView1Click(Sender: TObject);
begin
ShellTreeView1.Refresh(ShellTreeView1.Items[0]);
end;
//====================nur bis USB Zulassen======================================
procedure TForm3.ShellTreeView1Expanding(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
Var i: integer;
begin
for i := 0
to TShellTreeView(Sender).Items.Count - 1
do
if TShellTreeView(Sender).Items.Item[i]= Node
then
if TShellTreeView(Sender).Folders[i].PathName= (Form1.ServerPfad + sPfadangabe + ExtractFileName(ShellTreeView1.Path))
then
exit;
AllowExpansion:= Node= TShellTreeView(Sender).Items.Item[0];
end;
end.