unit Mirror_U;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, StdCtrls, Registry, shlobj, ShellAPI, OleCtrls, SHDocVw_TLB,
ActiveX;
type
TForm1 =
class(TForm)
MainMenu1: TMainMenu;
MM_Datei: TMenuItem;
MM_Close: TMenuItem;
Label1: TLabel;
GroupBox1: TGroupBox;
Bu_start: TButton;
LB_tomirror: TListBox;
GroupBox2: TGroupBox;
Ed_add: TEdit;
Bu_add: TButton;
Bu_delete: TButton;
Bu_opt: TButton;
Bu_enter: TButton;
MM_Help: TMenuItem;
MM_ueber: TMenuItem;
Label2: TLabel;
GroupBox3: TGroupBox;
CB_onstart: TCheckBox;
CB_time: TCheckBox;
Ed_time: TEdit;
LB_list: TListBox;
Label4: TLabel;
WebBrowser1: TWebBrowser;
Bu_update: TButton;
Me_update: TMemo;
CB_mirroronstart: TCheckBox;
Bu_timer: TButton;
procedure Bu_startClick(Sender: TObject);
procedure modificationdate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure LB_tomirrorClick(Sender: TObject);
procedure MM_CloseClick(Sender: TObject);
procedure Bu_deleteClick(Sender: TObject);
procedure Bu_enterClick(Sender: TObject);
procedure Bu_optClick(Sender: TObject);
procedure Bu_addClick(Sender: TObject);
procedure MM_ueberClick(Sender: TObject);
procedure CB_onstartClick(Sender: TObject);
//procedure FormActivate(Sender: TObject);
procedure Bu_updateClick(Sender: TObject);
procedure CB_mirroronstartClick(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
path, Quelle, Ziel :
string;
mirrorpath:
string;
fileindex: integer;
data:
string;
end;
var
Form1: TForm1;
FUNCTION QuickCopy ( Quelle, Ziel :
STRING ) : BOOLEAN;
function VerzGroesse(Verzeichnis:
string):longint;
function OpenFolder(root: Integer; Caption:
string):
string;
//Verzeichnis-Öffnen-Dialog-Funktion
function WB_GetHTMLCode(WebBrowser: TWebBrowser; ACode: TStrings): Boolean;
implementation
{$R *.DFM}
var VerzListe : TStringList;
function VerzGroesse(Verzeichnis:
string):longint;
var SR : TSearchRec;
Groesse : longint;
begin
Groesse:=0;
if Verzeichnis[length(Verzeichnis)]<>'
\'
then
Verzeichnis:=Verzeichnis+'
\';
if FindFirst(Verzeichnis+'
*.*',$3F,SR)=0
then begin
repeat
if ((SR.Attr
and faDirectory)>0)
and (SR.
Name<>'
.')
and (SR.
Name<>'
..')
then
Groesse:=Groesse+VerzGroesse(Verzeichnis+SR.
Name)
else
Groesse:=Groesse+SR.Size;
if (SR.
Name<>'
.')
and (SR.
Name<>'
..')
then
VerzListe.Add(Verzeichnis+SR.
Name);
until FindNext(SR)<>0;
FindClose(SR);
end;
Result:=Groesse;
end;
procedure TForm1.Bu_startClick(Sender: TObject);
var
s: integer;
loadpath:
string;
begin
// Load Directions
LB_tomirror.Items.LoadFromFile(path+'
\Data.txt');
If LB_tomirror.items.Count<=3
then
begin
showmessage('
Keine Mirrors ausgewählt!');
end
else
begin
for s := 3
to LB_tomirror.Items.count-1
do
begin
loadpath:=LB_tomirror.Items[s];
if loadpath='
'
then
begin
end
else
begin
VerzListe:=TStringList.Create;
Label1.Caption:=IntToStr(VerzGroesse(loadpath))+'
Byte';
LB_list.Items.assign(VerzListe);
modificationdate(
nil);
end;
end;
VerzListe.Free;
end;
end;
procedure TForm1.modificationdate(Sender: TObject);
var DosDate_new : integer;
Dosdate_old : integer;
posit: integer;
s: integer;
begin
s:=0;
posit:=1;
if LB_list.items.count <> 0
then
begin
for s := 0
to LB_list.Items.count-1
do
begin
data:= LB_list.items[s];
posit:=1;
while posit<>0
do
begin
posit:=pos('
\',data);
data:=copy(data,posit+1,length(data));
posit:=pos('
\',data);
end;
if fileexists(LB_toMirror.Items[1]+data)
then
begin
DosDate_new:=FileAge(LB_list.items[s]);
DosDate_old:=FileAge(LB_toMirror.Items[1]+data);
if DosDate_new<DosDate_old
then
begin
quelle:=LB_list.items[s];
ziel:=LB_toMirror.Items[1]+data;
quickcopy(quelle, ziel);
end;
end
else
begin
quelle:=LB_list.items[s];
ziel:=LB_toMirror.Items[1]+data;
quickcopy(quelle, ziel);
end;
end;
end;
end;
FUNCTION QuickCopy ( Quelle, Ziel :
STRING ) : BOOLEAN;
VAR
S, T: TFileStream;
BEGIN
Result := TRUE;
S := TFileStream.Create( Quelle, fmOpenRead );
TRY
TRY
T := TFileStream.Create( Ziel, fmOpenWrite
OR fmCreate );
EXCEPT
Screen.Cursor := crDefault;
MessageDlg('
Fehler beim Erzeugen der Zieldatei'+#13+Ziel, mtError, [mbOK], 0);
Result := FALSE;
END;
TRY
TRY
T.CopyFrom( S, S.Size ) ;
//if Config.CopyDat then
// FileSetDate( T.Handle, FileGetDate( S.Handle ) )
//else
FileSetDate( T.Handle, DateTimeToFileDate(Now) );
{ Dateizeit setzen }
EXCEPT
Screen.Cursor := crDefault;
MessageDlg('
Fehler beim Kopieren der Zieldatei'+#13+Ziel, mtError, [mbOK], 0);
Result := FALSE
END;
FINALLY
T.Free
END;
FINALLY
S.Free
END
END;
{QuickCopy}
procedure TForm1.FormCreate(Sender: TObject);
var
Registry: TRegistry;
s: integer;
t:
String;
loadpath:
string;
begin
//load registry install-Path
Registry:=TRegistry.Create;
Registry.RootKey:=HKEY_CURRENT_USER;
Registry.OpenKey('
Software\Mirror',false);
path:=Registry.ReadString('
root');
//--------------------------
//Load Directions
LB_tomirror.Items.LoadFromFile(path+'
\Data.txt');
for s := 3
to LB_tomirror.Items.count-1
do
begin
loadpath:=LB_tomirror.Items[s];
if loadpath='
'
then
begin
end
else
begin
VerzListe:=TStringList.Create;
Label1.Caption:=IntToStr(VerzGroesse(loadpath))+'
Byte';
LB_list.Items.assign(VerzListe);
VerzListe.Free;
end;
Registry:=TRegistry.Create;
Registry.OpenKey('
Software\Mirror',false);
t:=Registry.ReadString('
start');
If t='
yes'
then
begin
CB_mirroronstart.Checked:=true;
//Bu_startclick(nil);
end;
end;
Registry:=TRegistry.Create;
Registry.OpenKey('
Software\Microsoft\Windows\CurrentVersion\Run',false);
t:=Registry.ReadString('
mirror');
if t=path+'
\mirror.exe'
then
begin
cb_onstart.Checked:=true;
end;
registry.free;
end;
procedure TForm1.LB_tomirrorClick(Sender: TObject);
begin
Bu_delete.Enabled:=true;
end;
procedure TForm1.MM_CloseClick(Sender: TObject);
begin
close;
end;
procedure TForm1.Bu_deleteClick(Sender: TObject);
var
index: integer;
s: integer;
begin
for index:=2
to LB_tomirror.items.count-1
do
begin
if LB_tomirror.Selected[
index]=true
then
begin
LB_tomirror.items[
index]:='
';
LB_tomirror.items[0]:='
Zielpfad:';
LB_tomirror.items[2]:='
Zu spiegelnde Pfad(e):';
for s:=index
to LB_tomirror.items.count-2
do
begin
LB_tomirror.items[s]:=LB_tomirror.items[s+1];
end;
if LB_tomirror.Items[LB_tomirror.items.count-1]='
'
then
begin
LB_tomirror.Items.Delete(LB_tomirror.items.count-1);
end;
end;
end;
LB_tomirror.Items.SaveToFile(path+'
\Data.txt');
FormCreate(
nil);
end;
procedure TForm1.Bu_enterClick(Sender: TObject);
begin
if ed_add.text<>'
'
then
begin
LB_tomirror.items.Add(ed_add.text);
LB_tomirror.Items.SaveToFile(path+'
\Data.txt');
FormCreate(
nil);
ed_add.Clear;
end;
end;
procedure TForm1.Bu_optClick(Sender: TObject);
begin
LB_tomirror.Items[1]:= OpenFolder(CSIDL_DRIVES, '
Verzeichnis wählen');
//Übergabe des gewählten Verzeichnisses
LB_tomirror.Items.SaveToFile(path+'
\Data.txt');
end;
procedure TForm1.Bu_addClick(Sender: TObject);
begin
Ed_add.text := OpenFolder(CSIDL_DRIVES, '
Verzeichnis wählen');
//Übergabe des gewählten Verzeichnisses
end;
function OpenFolder(root: Integer; Caption:
string):
string;
//Verzeichnis-Öffnen-Dialog-Funktion
var
bi: TBrowseInfo;
lpBuffer: PChar;
pidlPrograms, pidlBrowse: PItemIDList;
begin
if (
not SUCCEEDED(SHGetSpecialFolderLocation(GetActiveWindow, root,
pidlPrograms)))
then
exit;
lpBuffer := StrAlloc(MAX_PATH);
bi.hwndOwner := GetActiveWindow;
bi.pidlRoot := pidlPrograms;
bi.pszDisplayName := lpBuffer;
bi.lpszTitle := PChar(Caption);
bi.ulFlags := BIF_RETURNONLYFSDIRS;
bi.lpfn :=
nil;
bi.lParam := 0;
pidlBrowse := SHBrowseForFolder(bi);
if (pidlBrowse <>
nil)
then
if SHGetPathFromIDList(pidlBrowse, lpBuffer)
then
if length(lpBuffer)=3
then
begin
Result :=lpBuffer;
end
else
begin
Result := lpBuffer+'
\';
end;
StrDispose(lpBuffer);
end;
procedure TForm1.MM_ueberClick(Sender: TObject);
begin
ShellExecute(0, '
open', '
http://www.tretmine.net',
nil,
nil, SW_SHOW);
end;
procedure TForm1.CB_onstartClick(Sender: TObject);
var
Registry: TRegistry;
begin
if CB_onstart.Checked=true
then
begin
Registry:=TRegistry.Create;
Registry.RootKey:=HKEY_CURRENT_USER;
Registry.OpenKey('
Software\Microsoft\Windows\CurrentVersion\Run',false);
Registry.WriteString('
mirror',path+'
\mirror.exe');
Registry.Free;
end
else
begin
Registry:=TRegistry.Create;
Registry.RootKey:=HKEY_CURRENT_USER;
Registry.OpenKey('
Software\Microsoft\Windows\CurrentVersion\Run',false);
Registry.DeleteValue('
mirror');
Registry.Free;
end;
end;
//procedure TForm1.FormActivate(Sender: TObject);
//var
// OV: OleVariant;
//begin
// OV := varEmpty;
// webbrowser1.Navigate('http://www.tretmine.net',ov,ov,ov,ov);
//end;
function WB_GetHTMLCode(WebBrowser: TWebBrowser; ACode: TStrings): Boolean;
var
ps: IPersistStreamInit;
ss: TStringStream;
sa: IStream;
s:
string;
begin
ps := WebBrowser.Document
as IPersistStreamInit;
s := '
';
ss := TStringStream.Create(s);
try
sa := TStreamAdapter.Create(ss, soReference)
as IStream;
Result := Succeeded(ps.Save(sa, True));
if Result
then ACode.Add(ss.Datastring);
finally
ss.Free;
end;
end;
procedure TForm1.Bu_updateClick(Sender: TObject);
var
OV: OleVariant;
begin
OV := varEmpty;
Me_update.Clear;
WB_GetHTMLCode(Webbrowser1, Me_Update.Lines);
end;
procedure TForm1.CB_mirroronstartClick(Sender: TObject);
var
Registry: TRegistry;
begin
if CB_mirroronstart.Checked=true
then
begin
Registry:=TRegistry.Create;
Registry.RootKey:=HKEY_CURRENT_USER;
Registry.OpenKey('
Software\Mirror',true);
Registry.WriteString('
start','
yes');
Registry.Free;
end
else
begin
Registry:=TRegistry.Create;
Registry.RootKey:=HKEY_CURRENT_USER;
Registry.OpenKey('
Software\Mirror',false);
Registry.WriteString('
start','
no');
Registry.Free;
end;
end;
end.