Save projet (v1.2.0.0)

Soyez le premier à donner votre avis sur cette source.

Vue 7 655 fois - Téléchargée 1 022 fois

Description

Sauvegarde dans un répertoire automatiquement nommé avec la date et l'heure du moment. 5 sélections de répertoires sources/destinations pré-programmables. Configurations via fichier txt.

Conclusion :


"Save projet" fonctionne tout à fait correctement maintenant. Merci de me faire connaître les bugs éventuels. Toutes remarques constructives sur le code sont les bienvenues. Je ne demande qu'à apprendre !

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
128
Date d'inscription
mercredi 8 janvier 2003
Statut
Membre
Dernière intervention
14 juillet 2008

il merite
Messages postés
4202
Date d'inscription
samedi 16 octobre 2004
Statut
Modérateur
Dernière intervention
13 juin 2020
35
fichier uPrincipale.pas :


function f_BackslashNoExist(path : string): boolean;
begin
result :Path[Length(Path)] '\';
end;

( il exists une fonction qui permet de l'ajouter au cas ou : IncludeTrailingBackslash ou encore IncludeTrailingPathDelimiter (voir l'aide pour les differences)



var
Dir : array[1..5] of string;
DirBack : array[1..5] of string;

procedure TFormPrincipale.p_ChoixDuBackup;
begin
DirSource := Dir[Flag];
DirDest := DirBack[Flag];
end;

procedure TFormPrincipale.BtnDirSourceClick(Sender: TObject);
begin
If SelectDirectory(DirSource,[sdAllowCreate,sdPerformCreate,sdPrompt],0) then
begin
IncludeTrailingBackSlash(dirSource);
Dir[Drapeau] := DirSource;
p_MiseAJourCaption;
end;
end;

procedure TFormPrincipale.BtnDirDestinationClick(Sender: TObject);
begin
If SelectDirectory(DirDest,[sdAllowCreate,sdPerformCreate,sdPrompt],0) Then
begin
IncludeTrailingBackSlash(dirDest);
DirBack[Drapeau] := DirDest;
p_MiseAJourCaption;
end;
end;

procedure TFormPrincipale.BtnQuitterClick(Sender: TObject);
begin
p_TableauCfgTmp;
p_EcritureFichierConfig;
Close;
end;

procedure TFormPrincipale.p_MiseAJourCaption;
begin
L_DirSource.Caption := Dir[Flag];
L_DirDestination.Caption := DirBack[Flag];
end;

procedure TFormPrincipale.p_TableauCfgTmp;
var N : integer;
begin
if Length(dirSource) > 2 then tablTmp[0] := dirSource;
if Length(dirDest) > 2 then tablTmp[1] := dirDest;

if Length(RadioButton1.Caption) > 2 then tablTmp[2] := RadioButton1.Caption;
if Length(RadioButton2.Caption) > 2 then tablTmp[3] := RadioButton2.Caption;
if Length(RadioButton3.Caption) > 2 then tablTmp[14] := RadioButton3.Caption;
if Length(RadioButton4.Caption) > 2 then tablTmp[15] := RadioButton4.Caption;
if Length(RadioButton5.Caption) > 2 then tablTmp[16] := RadioButton5.Caption;

for N := 1 to 5 do
begin
if Length(Dir[N]) > 2 then tablTmp[3+N] := Dir[N];
if Length(DirBack[N]) > 2 then tablTmp[4+N] := DirBack[N];
end;
end;

procedure TFormPrincipale.p_EcritureFichierConfig;
var
N : integer;
begin
with TStringList.Create do
try
For N := 0 to 16 do
Add(tablTmp[N]);
SaveToFile(ExtractFilePath(Application.ExeName)+fichierCFG);
finally
Free;
end;
end;

procedure TFormPrincipale.p_CfgInitialisation;
var
FLN : string;
N : integer;
begin
FLN := ExtractFilePath(Application.ExeName)+fichierCFG;
if not FileExists(FLN) then
begin
MessageDlg('Il n''existe pas encore de fichier de configuration !', mtWarning, [mbOk], 0);
exit;
end;

with TStringList.Create do
try
LoadFromFile(FLN);
dirSource := Strings[0];
dirDest := Strings[1];
RadioButton1.Caption := Strings[2];
RadioButton2.Caption := Strings[3];
RadioButton3.Caption := Strings[14];
RadioButton4.Caption := Strings[15];
RadioButton5.Caption := Strings[16];
for N := 1 to 5 do
begin
Dir[N] := IncludeTrailingBackSlash(Strings[3+N]);
DirBack[N] := IncludeTrailingBackSlash(Strings[4+N]);
end;
finally
Free;
end;
end;


et d'autres choses possible a ameliorer ...
Messages postés
13
Date d'inscription
vendredi 23 février 2007
Statut
Membre
Dernière intervention
26 avril 2007

Non, non, c'est ok maintenant sauf la partie fmxutils.pas mais là j'aurai besoin d'aide pour comprendre ce qui arrive car ici cela fonctionne bien sur mes deux pc's.

Je fais la mise à jour et j'attend les réactions (si il y en a).

Sorry pour le dérangement !
Messages postés
3824
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
18 décembre 2020
37
ps: je confirme ...
l'erreur est liée à l'utilisation de Delphi4 :

Déclaré dans Delphi4 dans l'unité Consts.pas :
SFCreateError = 'Impossible de créer le fichier %s';
SFOpenError = 'Impossible d''ouvrir le fichier %s';

Dans les versions plus récentes de Delphi elles se trouvent dans l'unité RTLConsts.pas

Voilà, rien d'insurmontable, le problème peut être réglé soit par un ajout des deux constantes dans l'unité principale soit par une compilation conditionnelle. ^_^
Messages postés
3824
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
18 décembre 2020
37
Salut,

confirme moi ton envie de suppression ... ici ou par MP et ce sera fait ...
Afficher les 10 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.