Problem beim Ausführen...

[tretmine]

Zitat von Christian Seehase:

Moin Phil,

Zitat:

Nur CheckBoxen eingefügt, deren Source aber erst nach dem Laden durch den Benutzer gelesen wird.

Was hab' ich mir darunter vorzustellen?

Das ist fast der gesamte Rest der Source. Ich poste mal doch die gesamte Source.
Der Quelltext ist wenig strukturiert und nicht sehr übersichtlich. Also fragt bitte, wenn etwas unklar ist und brütet nicht ewig darüber. (Es wäre der Aufwand nicht wert *lach*)

Delphi-Quellcode:

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.

Edit----------------------
Ach ja, die von mir durchgeführten (kleinen) Änderungen an den Functions sind schon länger darin. An ihnen dürfte es wohl nicht liegen.
--------------------------

MfG Phil