Problem beim Ausführen...

[tretmine]

Ich kann mein Problem leider nicht genauer spezifizieren:

Wenn ich mein Programm in der Delphi-Umgebung ausführe bleibt es gleich beim Start hängen. (Form friert einfach ein)
Endlosschleife?-Fehlanzeige
Ich habe mit F7 die Einzelschritte überprüft. Alles fehlerfrei. Er bleibt bei der Anweisung:

Application.Run;

hängen. Danach geht nichts mehr. Ich habe testweise die komplette Procedure FormActivate entfernt, die er wohl als nächstes nach
Application.Initialize; und Application.CreateForm(TForm1, Form1); durch
Application.Run; geladen hätte. Die Hilfe und Google brachte für mich nichts Helfendes.

Das Komische ist auch, dass ich fast nichts am Source geändert habe. Nur CheckBoxen eingefügt, deren Source aber erst nach dem Laden durch den Benutzer gelesen wird. Leider habe ich kein Backup für den Source um zu testen.
Andere Source laufen aber optimal.

Meine Frage also: Was macht der Compiler genau bei
Application.Run;? Welche procedure läd er gleich danach? Kann es auch an Delphi liegen? Hattet ihr mal das gleiche Problem? Wenn ja, wie habt ihr dieses gelöst?
Ich kann hier wohl nicht meinen kompletten Source posten, da wohl das meiste für euch unnötig wäre (und für mich peinlich :oops:) . Schreibt mir bitte, was ihr braucht, da ich (mal wieder) keinen Plan habe...

[Daniel B]

Hi,

recht interessant wären Prozeduren von Form1 wie OnShow, OnCreate, OnActivate, OnPaint. Je nachdem welche vorhanden sind.
Die werden schon ziemlich früh ausgeführt, je nach reihenfolge.

Grüsse, Daniel :hi:

[tretmine]

Zitat:

Zitat von Daniel B

Hi,

recht interessant wären Prozeduren von Form1 wie OnShow, OnCreate, OnActivate, OnPaint. Je nachdem welche vorhanden sind.
Die werden schon ziemlich früh ausgeführt, je nach reihenfolge.

Grüsse, Daniel :hi:

Diese habe ich zur Auswahl:

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);

FormCreate wird aber schon bei Application.CreateForm(TForm1, Form1);
geladen. Also vor Application.Run;

Trotzdem:

Delphi-Quellcode:

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;

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;

(Anmerkung: Ja, die Function ist aus einem FAQ kopiert, da mir für so etwas die nötigen Programmierkünste fehlen.)

MfG Phil
[/delphi]

[tretmine]

Ich weiß zwar nicht, warum das

var VerzListe : TStringList;

außerhalb der Function ist, aber bisher klappte dieser Source einwandfrei... Vielleicht ist es ja auch Absicht?!?

MfG Phil

[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?

[tretmine]

Falls auch noch benötigt:

Inhalt:
Data.txt:

Zielpfad:
E:\
Zu spiegelnde Pfad(e):
C:\temp\tretmine online\

MfG Phil[/quote]

[tretmine]

Zitat:

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

[Christian Seehase]

Moin Phil,

ich seh' da im Form Create zwei verdächtige Stellen.

Zum einen

Delphi-Quellcode:

cb_onstart.Checked:=true;

Ist der Checkbox auch ein OnClick Ereignis zugewiesen?
Dies wird nämlich beim ausführen dieser Zeile aufgerufen.

Zum anderen wird von eingelesenen Verzeichnissen die Verzeichnisgrösse ermittelt. Kann es sein, das das nur länger dauert, und deshalb scheinbar nichts passiert?

Den zweiten Punkt halte ich für wahrscheinlicher, auch wenn das mit einem Hänger bei Application.Run nicht so ganz passt.

Setz doch einfach mal einen Breakpoint auf die erste Zeile in FormCreate, und starte dann nochmal.

[EDIT]
Bei längeren Codepassagen wäre es durchaus sinnvoll die als Attachment anzuhängen
[/EDIT]

[tretmine]

Brachte beides nichts...

Die Datei die er Bearbeiten muss ist gerade mal 55KB gross.
Soll ich dir die kompletten Projekt-Dateien geben, damit du es dir mal anschauen kannst?

Das Problem ist, dass das Programm noch keine "Installationsroutine" hat.

Unter HKCU\Software -> Schlüssel mit Name "mirror". String erstellen mit name:'root' value:'Pfad des Installationsordners ohne \ am Ende'.

In den Ordner dann die Datei Data.txt kopieren. Form bitte beibehalten!

Data.txt:
Keine Zeile oben leer lassen
Zielpfad:
E:\
Zu spiegelnde Pfad(e):
C:\Programme\
Keine Zeile unten leer lassen

MfG Phil

Edit-----
Attatchment gelöscht...
---------

[Daniel B]

Hi,

Du hast in der FormCreate drei Reg.Create drin. Nur ein Free am ende der Prozedur. Setz jeden Block in einen try..finally..end Block.

Delphi-Quellcode:

  Reg.Create;
  try
    //Schlüssel lesen usw.
  finally
    Reg.Free; //oder FreeAndNil(Reg);
  end;

Grüsse, Daniel :hi: