Discussion :

[BuzzLeclaire]

Bonjour à toutes et à tous,

J'ai un problème dans le téléchargement de mon fichier à l'aide de idftp.

Pendant mon spalshscreen je teste si une version est disponible, ensuite je propose le téléchargement si besoin et pour finir après le téléchargement je propose d'executer le fichier, mais j'ai un problèmes.

Je ne recoit pas le fichier dans son intégralité, il n'est pas reçu complétement.

Le fichier ne fait que 15Mo.

Voici ce que je fais :

Dans mon DPR (splashscreen)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
// ...
 
{$R *.res}
 
begin
 
  FSplashScreen := TFSplashScreen.Create(Application); // On crée la fenetre de Splash
 
  FSplashScreen.Show; // affichage de cette fenetre
 
  FSplashScreen.Update; // On force l'affichage de la fenetre (sinon elle n'apparait que partiellement)
 
  Application.Initialize;
  FSplashScreen.Version(nil); // <= Ici on test si nouvelle version et on télécharge et/ou installation
 
  Application.Title := 'Monprog';
 
  Application.CreateForm(TFData, FData);
 
  FSplashScreen.Close;  // Fermeture la fenêtre de Splash
  FSplashScreen.Release;  // Destruction de la fenêtre
 
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TFPrincipal, FPrincipal);
 
  Application.Run;
 
end.

Dans Mon FSplashscreen

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
procedure TFSplashScreen.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if Telechargement then Application.Terminate;
end;
 
procedure TFSplashScreen.Version(Sender: TObject);
Var
  Versionning: String;
begin
  sLabel2.Caption := 'Recherche nouvelle version...';
  sLabel2.Visible := True;
  Update;
  Versionning := Logiciel.Version;
  Versionning := AnsiReplaceStr(VersionPrg,'-','.');
  if Versionning <> 'erreur' then
  Begin
    if Versionning = Logiciel.Version then
    Begin
      sLabel2.Caption := 'Votre version est à jour.';
    end
    else
    begin
      sLabel2.Caption := 'Mise à jour disponible.';
      Sleep(1000);
      if  Application.MessageBox(PWideChar(
      'Une nouvelle version est disponible.'+#13+
      'Version n° '+ Versionning+#13+
      'Voulez-vous la téléchargée ?'),
      PWideChar('Nouvelle version n° '+Versionning),
      MB_ICONQUESTION + MB_YESNO) = mrYes
      then
      Begin
        // On télécharge la nouvelle version
        Cas := 2;
        Download('xxxxxxx.exe');
      end
      else
        sLabel2.Caption := 'Téléchargement annulé.';
    end;
  end
  else
    sLabel2.Caption := 'Info sur la version indisponible';
end;
 
procedure TFSplashScreen.Download(const Entry: string);
Var
  Filename : String;
begin
  if SaveDialog1.Execute then
  begin
    With TIdFTP.Create(nil) do
    Begin
      Host        := 'xxxxxxxxxxxxxxx';
      Username    := returnra_u;
      Password    := returnra_m;
      OnWork      := IdFTP1Work;
      OnWorkBegin := IdFTP1WorkBegin;
      OnWorkEnd   := idFTP1WorkEnd;
      try
        try
        Connect;
        ChangeDir('xxxxxxx/version');
        FileSizeDown := Size(Entry); // Variable global privée
        FileName := SaveDialog1.FileName;
        Get(Entry,FileName,True);
        Except
          Begin
          Application.MessageBox(
          'Impossible de télécharger la nouvelle version.'+#13+
          'Veuillez réessayer ultérieurement.',
          'Information',
          MB_ICONWARNING + MB_OK);
          sLabel2.Caption := 'Téléchargement abordé.';
          End;
        End;
      finally
        Free;
      end;
    end;
  end;
end;
 
procedure TFSplashScreen.IdFTP1Work(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Int64);
begin
  if cas = 2 then // On est en téléchargement dans ce cas
  begin
    sGaugeDownload.Progress := AWorkCount;
    application.ProcessMessages;
  end;
end;
 
procedure TFSplashScreen.IdFTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCountMax: Int64);
begin
  if cas = 2 then // On est en téléchargement dans ce cas
  begin
    With sGaugeDownload do
    Begin
    Visible  := True;
    Progress := 0;
    MaxValue := FileSizeDown;
    end;
    sLabelDownload.Visible := true;
    application.ProcessMessages;
  end;
end;
 
procedure TFSplashScreen.IdFTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
  if cas = 2 then // On est en téléchargement dans ce cas
  begin
    Telechargement := False;
    CheminFileDown := '';
    sGaugeDownload.Progress := sGaugeDownload.MaxValue;
    sLabelDownload.Caption := 'Téléchargement terminé.';
    Application.ProcessMessages;
    If Application.MessageBox('Voulez-vous installer la nouvelle version ?',
    'Installation...',
    MB_ICONQUESTION + MB_YESNO) = 6 then
    Begin
      CheminFileDown := SaveDialog1.FileName; // Variable globale pour le formPrincipal déclarée dans commun.pas
      Telechargement := True; 
      Self.Close;
    end;
  end;
end;

Dans mon FPrincipal

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
procedure TFPrincipal.FormCreate(Sender: TObject);
begin
  if Telechargement then Close;
// ...
end;
 
procedure TFPrincipal.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 
  if Telechargement Then ShellExecute(Application.Handle, 'open', PWideChar(CheminFileDown), '', '',  SW_SHOWNORMAL);
  Application.Terminate;
 
end;

Je ne vois pas mon erreur, le téléchargement n'est pas complet et évidement le close de FPrincipal n'execute rien.
Je n'ai pas de message d'erreur.

Merci à vous.

[BuzzLeclaire]

Je me réponds.

J'ai remplacer le Idftp dynamique par un composant sur la fiche, j'ai ajouté un disconnect et j'ai paramétré le type en ftBinary.