Posté le: 05 11 2002 20:32 Sujet du message: Delphi: Fusion |
|
|
Unité Ufichier: | Code: | unit UFichier;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons;
procedure OuvertureFichierEnLecture(var f:TextFile; var Success: Byte);
procedure OuvertureFichierEnEcriture(var f:TextFile; var Success: Byte);
procedure OuvertureFichierEnAppend(var f:TextFile; var Success: Byte);
procedure FermerFichier (var f:TextFile);
implementation
procedure OuvertureFichierEnLecture(var f:TextFile; var Success: Byte);
var S,Nomf:string;
CodeErreur:Integer;
begin
s:=InputBox('Nom fichier','Entrez le nom du fichier','o');
nomf:=s;
assignfile(f,nomf);
{$I-}
reset(f);
codeerreur:=ioresult;
{$I-}
if codeerreur<>0 then
case codeerreur of
1:showmessage('erreur # '+inttostr(CodeErreur)+' out of memory');
2:showmessage('erreur # '+inttostr(CodeErreur)+' Identificateur manquant');
3:showmessage('erreur # '+inttostr(CodeErreur)+' Identificateur inconnu');
4:showmessage('erreur # '+inttostr(CodeErreur)+' Identidficateur en double');
5:showmessage('erreur # '+inttostr(CodeErreur)+' Syntaxe erreur');
10:showmessage('erreur # '+inttostr(CodeErreur)+' Fin Fichier non attendu');
15:showmessage('erreur # '+inttostr(CodeErreur)+' Fichier non trouvé');
16:showmessage('erreur # '+inttostr(CodeErreur)+' Disque plein');
else showmessage('erreur # '+inttostr(CodeErreur)+' Erreur');
end
else
begin
showmessage ('Fichier ouvert en lecture');
end;
end;
procedure OuvertureFichierEnEcriture(var f:TextFile; var Success: Byte);
var S,Nomf:string;
CodeErreur:Integer;
begin
s:=InputBox('Nom fichier','Entrez le nom du fichier','o');
nomf:=s;
assignfile(f,nomf);
{$I-}
rewrite(f);
codeerreur:=ioresult;
{$I+}
if codeerreur<>0 then
case codeerreur of
1:showmessage('erreur # '+inttostr(CodeErreur)+' out of memory');
2:showmessage('erreur # '+inttostr(CodeErreur)+' Identificateur manquant');
3:showmessage('erreur # '+inttostr(CodeErreur)+' Identificateur inconnu');
4:showmessage('erreur # '+inttostr(CodeErreur)+' Identidficateur en double');
5:showmessage('erreur # '+inttostr(CodeErreur)+' Syntaxe erreur');
10:showmessage('erreur # '+inttostr(CodeErreur)+' Fin Fichier non attendu');
15:showmessage('erreur # '+inttostr(CodeErreur)+' Fichier non trouvé');
16:showmessage('erreur # '+inttostr(CodeErreur)+' Disque plein');
else showmessage('erreur # '+inttostr(CodeErreur)+' Erreur');
end
else
begin
showmessage ('Fichier ouvert en lecture');
end;
end;
procedure OuvertureFichierEnAppend(var f:TextFile; var Success: Byte);
var S,Nomf:string;
CodeErreur:Integer;
begin
s:=InputBox('Nom fichier','Entrez le nom du fichier','o');
nomf:=s;
assignfile(f,nomf);
{$I-}
append(f);
{$I-}
codeerreur:=ioresult;
if codeerreur<>0 then
case codeerreur of
1:showmessage('erreur # '+inttostr(CodeErreur)+' out of memory');
2:showmessage('erreur # '+inttostr(CodeErreur)+' Identificateur manquant');
3:showmessage('erreur # '+inttostr(CodeErreur)+' Identificateur inconnu');
4:showmessage('erreur # '+inttostr(CodeErreur)+' Identidficateur en double');
5:showmessage('erreur # '+inttostr(CodeErreur)+' Syntaxe erreur');
10:showmessage('erreur # '+inttostr(CodeErreur)+' Fin Fichier non attendu');
15:showmessage('erreur # '+inttostr(CodeErreur)+' Fichier non trouvé');
16:showmessage('erreur # '+inttostr(CodeErreur)+' Disque plein');
else showmessage('erreur # '+inttostr(CodeErreur)+' Erreur');
end
else
begin
showmessage ('Fichier ouvert en lecture');
end;
end;
procedure FermerFichier (var f:TextFile);
begin
closefile(f);
end;
end.
|
Unité Unit1: | Code: | unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons,Ufichier;
type
TFusion = class(TForm)
ListBox1: TListBox;
Fusion: TBitBtn;
Affichage: TBitBtn;
Quitter: TBitBtn;
procedure QuitterClick(Sender: TObject);
procedure AffichageClick(Sender: TObject);
procedure FusionClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
Const Sentinelle=32767;
var
Fusion: TFusion;
Source, Ajout, Resultat,f:textfile;
Success:Byte;
NomSource,NomAjout:string[30];
ValeurSource,ValeurAjout:integer;
Ligne:String ;
implementation
{$R *.dfm}
procedure TFusion.QuitterClick(Sender: TObject);
begin
application.terminate
end;
procedure TFusion.AffichageClick(Sender: TObject);
var f:textfile;
s:string;
success:byte;
begin
listBox1.clear;
ouvertureFichierEnLecture(f,success);
while not Eof(f)do
begin
readln(f,s);
listbox1.Items.Add(s)
end;
FermerFichier(f)
end;
procedure TFusion.FusionClick(Sender: TObject);
begin
OuvertureFichierEnLecture(Source,Success);
OuvertureFichierEnLecture(Ajout, Success);
OuvertureFichierEnEcriture(Resultat, Success);
readln (Source,NomSource,ValeurSource);
while not eof (Ajout)Do
begin
readln (Ajout,NomAjout,ValeurAjout);
while (ValeurSource < ValeurAjout) do
begin
writeln(resultat,NomSource:30,ValeurSource:4);
if not eof (source) then readln (Source,NomSource,valeurSource)
else ValeurSource:=Sentinelle
end;
writeln(resultat,NomAjout:30,ValeurAjout:4)
end;
if ValeurSource <>Sentinelle then
begin
while not eof (source)do
begin
writeln(resultat,NomSource:30,ValeurSource:4);
readln (resultat,NomSource,ValeurSource)
end;
writeln(resultat,NomSource:30,ValeurSource:4);
end;
end;
end. |
A utiliser sous Delphi 6  |
|
Kaizen Webmaster

Inscrit le: 07 Mar 2002 Messages: 2253 Localisation: Québec, France et ailleurs...
|