Einzelnen Beitrag anzeigen

Benutzerbild von SaFu
SaFu

Registriert seit: 8. Nov 2006
1.360 Beiträge
 
Delphi 10.3 Rio
 
#6

Re: Ordner Kopieren funzt net richtig

  Alt 6. Mai 2008, 14:48
Vielleicht kann mir doch nochmal jemand einen Tipp geben ich versuche Ordner zu Exportiern hat jemand ne anhnung wo da ein Fehler sein könnte.

Komplette Unit

Delphi-Quellcode:
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.
"... Wie gesagt, die Nutzer von 10, 12, 14 Zoll Display's werden deine Seite nicht in voller Pracht sehen können, ...

Surft Ihr mit dem Taschenrechner?"
  Mit Zitat antworten Zitat