home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 31
/
CDASC_31_1996_juillet_aout.iso
/
index
/
source
/
main.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-05-05
|
34KB
|
1,020 lines
{ Voici l'unitΘ principale du programme qui gΦre toute la partie algorithmique (et donc les bugs)
de ce programme, on y trouve toutes les variables partagΘes ainsi que les algorithmes de
recherche ainsi que les parcours d'arborescence. }
unit Main;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Menus;
{ Nombre maximum de ligne d'une description. }
const MaxDescription = 200 ;
type
TMainForm = class(TForm)
StatusLine: TPanel;
Critere2: TGroupBox;
NonCheck2: TCheckBox;
EtRadio2: TRadioButton;
OuRadio2: TRadioButton;
TexteCritere2: TEdit;
Critere3: TGroupBox;
NonCheck3: TCheckBox;
EtRadio3: TRadioButton;
OuRadio3: TRadioButton;
TexteCritere3: TEdit;
Critere1: TGroupBox;
NonCheck1: TCheckBox;
TexteCritere1: TEdit;
RechercheBtn: TButton;
QuitterBtn: TButton;
ListeBox: TListBox;
AscCheck: TCheckBox;
VracCheck: TCheckBox;
AutreCheck: TCheckBox;
ChargerBtn: TButton;
SauveBtn: TButton;
OptBtn: TButton;
AnnexeCheck: TCheckBox;
Edit1: TEdit; { Quelqu'un peut me dire comment afficher des }
Edit2: TEdit; { contr⌠les label dans cette boεte? }
Edit3: TEdit; { Moi j'arrive pas! Ils sont Visibles, Enabled! }
procedure FormCreate(Sender: TObject);
procedure ShowHint(Sender: TObject);
procedure QuitterBtnClick(Sender: TObject);
procedure TexteCritere1Change(Sender: TObject);
procedure TexteCritere2Change(Sender: TObject);
procedure AscCheckClick(Sender: TObject);
procedure VracCheckClick(Sender: TObject);
procedure AutreCheckClick(Sender: TObject);
procedure ListeBoxClick(Sender: TObject);
procedure RechercheBtnClick(Sender: TObject);
procedure ChargerBtnClick(Sender: TObject);
procedure SauveBtnClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure OptBtnClick(Sender: TObject);
end;
type { Type contenant les informations de la configuration. }
TConfiguration = record
IgnoreMAJmin,
AnnexeDAbord,
ChargeTotal : boolean ;
RepertoireDefaut : String ;
Fichiers : TStrings ;
end ;
{ Il y a quatre sections diffΘrentes. }
TSection = (Asc, Vrac, Autre, Annexe) ;
var
MainForm: TMainForm ;
TailleDescription : byte ; { Nombre de ligne dans la description courante. }
SectionSuivante, FichierSuivant, Quitte : boolean ; { On a choisi le bouton }
Configuration : TConfiguration ;
{ Tableau contenant le texte de la description. }
Description : TStrings ;
implementation
{$IFDEF Final}
{$A+,B-,D-,G+,I-,K+,L-,R-,Y-,Z-}
{$ELSE}
{$D+,L+,Y+}
{$ENDIF}
{$R *.DFM}
uses IniFiles, Affiche, Scan, Option ;
{ Taille totale des fichiers sΘlectionnΘs dans chaque section et au total.
Ces nombres sont dΘterminΘs dans la procΘdure ScruteTaille et jamais modifiΘs
par la suite et servent pour les barres de progression. }
var TailleAsc, TailleVrac, TailleAnnexe,
TailleAutre, TailleTotale : Longint ;
NbAsc, NbVrac : byte ; { Nombre de fichiers dans la section Asc et Vrac. }
{ Renvoie la taille d'un fichier. }
function Taille (nom : String) : longint;
var fic : TSearchRec ;
begin
if findfirst(nom, 21, fic) = 0
then
Taille := fic. Size
else
Taille := 0 ;
end ;
{ Convertit une chaεne en nombre. }
function Val2 (chaine : string) : byte ;
var i,code : integer ;
begin
for i := 1 to length(chaine) do
if not (chaine[i] in ['0'..'9']) then
delete(chaine,i,1) ;
Val(Chaine, I, Code);
Val2 := i ;
end ;
{ Convertit un nombre en chaεne }
function Str2(nombre : Integer) : string ;
var s : string ;
begin
Str(nombre, s) ;
Str2 := s ;
end ;
{ Cette procΘdure rΘcupΦre les informations stockΘs dans le .INI. }
Procedure ChargementPartiel ;
var TrouveIni : TIniFile ;
Chaine : String ;
combien,
i, j : Word ;
begin
{ On cherche l'entrΘe "Nombre" }
TrouveIni := TIniFile.Create(ExtractFilePath(application.exename)+'trouve.ini') ;
with configuration do
begin
IgnoreMAJmin := TrouveIni. ReadBool('WinTrouve', 'IgnoreMAJmin',true) ;
AnnexeDAbord := TrouveIni. ReadBool('WinTrouve', 'AnnexeDAbord',true) ;
end ;
Combien := TrouveIni. ReadInteger('Fichiers standards','Nombre',0) ;
{ Si l'entrΘe existe on scanne les entrΘes Itemx }
If Combien <> 0 Then
begin
{ On met toute la liste α faux }
For i := 0 To MainForm.ListeBox.Items. Count - 1 do
MainForm.ListeBox.Selected[i] := False ;
For i := 1 To combien do
begin
{ On lit une entrΘe... }
Chaine:=TrouveIni.ReadString('Fichiers standards','Item'+str2(i),'') ;
{ On met α vrai son Θquivalent dans la liste }
j := 0 ;
While (j < MainForm.ListeBox.Items.Count)
And (MainForm.ListeBox.Items[j] <> Chaine) do
inc(j) ;
If j < MainForm.ListeBox.Items.Count Then
MainForm.ListeBox.Selected[j] := True ;
end ;
End ;
{ On s'occupe maintenant des fichiers annexes. }
With configuration do
begin
try
{ On cherche combien il y en a. }
Combien := trouveini. ReadInteger ('Fichiers annexes','Nombre',0) ;
{ Si la liste est dΘjα pleine on la vide avant d'en rajouter d'autres. }
if Fichiers. Count <> 0 then
Fichiers. Clear ;
{ On parcourt tous les ΘlΘments. }
for i:=1 to Combien do
begin
Chaine := TrouveIni.ReadString('Fichiers annexes','Item'+str2(i),'') ;
{ On ajoute le fichier dans la liste s'il existe. }
if (chaine <>'') and (taille(chaine)>0) then
Fichiers. Add(chaine) ;
end ;
finally
end ;
end ;
{ On ferme le .INI. }
TrouveIni. free;
end ;
{ Cette procΘdure a l'action inverse de la procΘdure prΘcΘdente. Elle sauvegarde dans le .INI
l'ensemble des rΘglages du programme. }
procedure SauvegardePartielle ;
var i, combien : Word ;
TrouveIni : TIniFile ;
begin
TrouveIni := TIniFile. Create (ExtractFilePath(application.exename)+'trouve.ini') ;
{ Enregistre les paramΦtres gΘnΘraux du programme. }
With Configuration do
begin
trouveini. WriteString('WinTrouve', 'RepertoireDefaut',RepertoireDefaut) ;
trouveini. WriteBool('WinTrouve', 'IgnoreMAJmin',IgnoreMAJmin) ;
trouveini. WriteBool('WinTrouve', 'ChargeTotal',ChargeTotal) ;
trouveini. WriteBool('WinTrouve', 'AnnexeDAbord',AnnexeDAbord) ;
end ;
{ Enregistre les paramΦtres annexes s'il y en a. }
With configuration do
begin
if Fichiers. Count > 0 then
begin
TrouveIni.WriteInteger('Fichiers annexes','Nombre',Fichiers. Count) ;
for i:=1 to Fichiers. Count do
TrouveIni.WriteString('Fichiers annexes','Item'+str2(i), Fichiers[i-1]) ;
end
else
trouveIni. EraseSection ('Fichiers annexes') ;
end ;
{ On parcourt la liste... }
i := 0 ;
combien := 0;
While i <> MainForm.ListeBox.Items.Count do
begin
{ Et pour chaque ΘlΘment choisit.... }
If MainForm.ListeBox.Selected[i] Then
begin
{ On ajoute son entrΘe dans le .ini }
inc(combien) ;
TrouveIni.WriteString('Fichiers standards','Item'+str2(combien),MainForm.ListeBox.Items[i]) ;
End ;
inc(i) ;
end;
{ Enregistre le nombre de composants de section standard. }
If combien > 0 Then
TrouveIni.WriteInteger('Fichiers standards','Nombre',combien)
else
trouveIni. EraseSection ('Fichiers standards') ;
{ Ferme le .INI. }
TrouveIni. free;
end ;
{ Tri les noms dans la liste pour les mettre dans l'ordre chronologique inverse.
ordre indique le sens de tri jamais utilisΘ dans l'autre sens ,
offset indique le dΘcalage des mots 3 pour ASC, 4 pour VRAC,
debut et fin donne les indices dans la liste des sections asc et vrac. }
procedure tri (ordre : boolean; offset, debut, fini : byte ) ;
var i, j : integer ;
Valeur2,
Valeur : Byte ;
begin
{ Algorithme de tri immonde mais vu qu'il n'y a qu'une vingtaine de chaεne et
que cette procΘdure et utilisΘe qu'une fois, c'est pas la peine de faire un
algo de tri par petits tas pour liste chaεnΘes (salut fred!, private joke). }
j := fini ;
while j > debut do
begin
i := debut ;
while i < j do
begin
Valeur := Val2(Copy(MainForm.ListeBox.Items[i+1], offset, 2)) ;
Valeur2 := Val2(Copy(MainForm.ListeBox.Items[i], offset, 2));
If ((valeur < valeur2) And (ordre)) Or
((Valeur > Valeur2) And Not ordre) Then
MainForm. ListeBox. Items.Exchange(i,i+1) ;
inc (i) ;
end;
dec(j) ;
end ;
end ;
procedure trie( ordre : boolean) ;
begin
if NbAsc > 0 then
{ tri les asc. }
tri(ordre, 4, 0, NbAsc - 1) ;
if NbVrac > NbAsc then
{ tri les vrac. }
tri(ordre, 5, NbAsc, NbVrac - 1) ;
end ;
{ DΘtermine si les boutons sont cochΘs, ou non voire grisΘs. }
procedure DetermineEtat (tipe: byte) ;
var debut, fin,
i, etat : byte ;
Style : TCheckBoxState;
begin
case tipe of
0 : begin
debut := 0 ;
fin := nbAsc -1 ;
end ;
1 : begin
debut := nbAsc ;
fin := nbVrac -1 ;
end ;
2 : begin
debut := nbVrac ;
fin := MainForm. ListeBox. Items. Count - 1 ;
end ;
end ;
with MainForm. ListeBox do
begin
if Selected[debut] then
etat := 1
else
etat := 2 ;
for i := Debut + 1 to fin do
if (Selected[i] and (etat = 2)) or (not selected[i] and (etat = 1))
then etat := 3 ;
end ;
case etat of
1 : Style := cbChecked;
2 : Style := cbUnchecked;
3 : Style := cbGrayed;
end ;
case tipe of
0 : MainForm. AscCheck. State := Style ;
1 : MainForm. VracCheck. State := Style ;
2 : MainForm. AutreCheck. State := Style ;
end ;
end ;
Procedure CheckState ;
begin
if MainForm.AscCheck. Enabled then
DetermineEtat(0) ;
if MainForm.VracCheck. Enabled then
DetermineEtat(1) ;
if MainForm.AutreCheck. Enabled then
DetermineEtat(2) ;
if Configuration. Fichiers. Count > 0 then
MainForm.AnnexeCheck. Checked := true
else
MainForm.AnnexeCheck. Checked := false ;
end;
{ Cette procΘdure analyse le rΘpertoire par dΘfaut et inspecte tous les fichiers susceptible
d'Ωtre des descriptions. }
Procedure ScanRepDefaut ;
var fichier : tsearchrec ;
DosError,
i : integer ;
begin
ChDir(configuration. RepertoireDefaut) ;
if MainForm. ListeBox <> Nil
then
MainForm. ListeBox. Clear ;
{ Parcours des Asc }
FindFirst('ASC*.ASC', $21, fichier) ;
i := 0 ;
DosError := 0 ;
While DosError=0 do
begin
If fichier.Attr and 16 = 16 Then
DosError:=FindNext (fichier)
Else
begin
{ On ajoute le fichier α la liste. }
MainForm. ListeBox.Items.Add(fichier. name) ;
inc(i) ;
DosError:=FindNext (fichier) ;
End ;
end ;
NbAsc := i ;
{ Parcours des Vrac }
FindFirst('VRAC*.BBS', $21, fichier);
i := 0 ;
DosError := 0 ;
While DosError=0 do
begin
If fichier.Attr and 16 = 16 Then { C'est un rΘpertoire... }
DosError:=FindNext (fichier)
Else
begin
MainForm. ListeBox.Items.Add(fichier. name) ;
inc(i) ;
DosError:=FindNext (fichier) ;
End ;
end ;
NbVrac := i + NbAsc ;
{ Parcours des Autres }
FindFirst('*.BBS', $21, fichier) ;
i := 0 ;
DosError := 0 ;
While DosError=0 do
begin
If (fichier.Attr and 16 = 16) or (copy(fichier.name,1,4) ='VRAC') Then
DosError:=FindNext (fichier)
Else
begin
MainForm. ListeBox.Items.Add(fichier. name) ;
DosError:=FindNext (fichier) ;
End ;
end ;
trie (false);
For i := 0 To MainForm. ListeBox.Items.Count - 1 do
MainForm. ListeBox.Selected[i] := True ;
If MainForm. ListeBox.Items.Count > 0 Then
MainForm. ListeBox.TopIndex := 0 ;
if NbAsc = 0 then
MainForm. AscCheck. Enabled := False ;
if NbAsc = NbVrac then
MainForm. VrAcCheck. Enabled := False ;
if NbVrac = MainForm. ListeBox. Items. Count then
MainForm. AutreCheck. Enabled := False ;
MainForm. ListeBox. TopIndex := 0 ;
end ;
{ Cherche s'il existe un fichier d'initialisation de faτon α avoir le rΘpertoire
par dΘfaut qui est le minimum pour Θviter le plantage (mon dieu que de bug!). }
Procedure ChercheINI ;
var TrouveINI : TINIFile ;
begin
if Taille('TROUVE.INI')=0 then
with Configuration do
begin
RepertoireDefaut := ExtractFilepath(Application. EXENAME) ;
{ Supprime le '\' α la fin de la chaine. }
Delete(RepertoireDefaut,length(RepertoireDefaut),1) ;
{ Bien que fichiers soit de type TStrings il faut appeler le constructeur de
TStringList sinon vous aurez droit α des bug que Delphi n'arrive mΩme pas α
intercepter. }
Fichiers := TStringList. Create ;
ScanRepDefaut ;
CheckState ;
ChargeTotal := false ;
IgnoreMAJmin := true ;
AnnexeDAbord := true ;
SauvegardePartielle ;
end
else
begin
TrouveIni := TIniFile.Create('.\trouve.ini') ;
with Configuration do
begin
RepertoireDefaut := TrouveIni. ReadString('WinTrouve',
'RepertoireDefaut',ExtractFilepath(Application. EXENAME)) ;
ScanRepDefaut ;
ChargeTotal := TrouveIni. ReadBool('WinTrouve', 'ChargeTotal',false) ;
Fichiers := TStringList. Create ;
if ChargeTotal then
ChargementPartiel ;
CheckState ;
MainForm. ListeBox. TopIndex := 0 ;
end ;
TrouveIni. Free ;
end ;
end ;
{ Calcul la taille de chaque section et le total. }
procedure ScruteTaille ;
var i : integer ;
begin
TailleAsc := 0 ;
TailleVrac := 0 ;
TailleAutre := 0 ;
TailleAnnexe := 0 ;
ChDir(Configuration. RepertoireDefaut) ;
{ Pour tous les ASC et s'ils sont sΘlectionnΘs... }
for i := 0 to NbAsc - 1 do
begin
if MainForm. ListeBox. Selected[i] then
Inc(TailleAsc,Taille(MainForm. ListeBox. Items[i])) ;
end ;
{ VRAC... }
for i := NbAsc to NbVrac - 1 do
begin
if MainForm. ListeBox. Selected[i] then
Inc(TailleVrac,Taille(MainForm. ListeBox. Items[i])) ;
end ;
{ Autres... }
for i := NbVrac to MainForm. ListeBox. Items. Count - 1 do
begin
if MainForm. ListeBox. Selected[i] then
Inc(TailleAutre,Taille(MainForm. ListeBox. Items[i])) ;
end ;
{ Annexes... }
if MainForm. AnnexeCheck. Checked then
for i := 0 to Configuration.Fichiers. Count - 1 do
Inc(TailleAnnexe,Taille(Configuration. Fichiers[i])) ;
{ Ce qui donne en tout. }
TailleTotale := TailleAsc + TailleVrac + TailleAutre + TailleAnnexe ;
end ;
{ RAZ mΘmoire de la description et de l'afficheur. }
procedure RazDescription ;
begin
if Description. count <> 0 then
Description. Clear ;
TailleDescription := 0 ;
DescForm. ListeDesc. Lines. Clear ;
end ;
{ DΘtermine si on atteint la fin d'une description suivant le type du fichier
voire le type (NEWS ou MAJ). }
Function fin (phrase : String; tipe : Integer) : Boolean ;
begin
fin := False ;
if length(phrase)=0 then exit ;
Case tipe of
0 { Cas des BBS }
: If phrase[1] <> ' ' Then
fin := True ;
1, 2 {Cas des Asc News ou Maj }
: If (Copy(phrase, 1, 3) = ' ═') or
(Copy(phrase, 1, 3) = ' ■') Then
fin := True
End;
End ;
{ Transfert la description dans l'afficheur et lui passe le focus. }
Procedure AfficheDesc ;
var i : integer ;
begin
{ On Θlimine les lignes orpheline de la fin de la description. }
i := TailleDescription ;
While Description[i-1] = '' do
i := i - 1 ;
TailleDescription := i ;
{ On transfert la description dans la liste. }
For i := 1 To TailleDescription do
DescForm. ListeDesc. Lines. Add(Description[i-1]) ;
{ On passe le focus en modal α l'afficheur. }
DescForm. ShowModal ;
end ;
{ Cherche si une chaεne est dans une description. }
Function Scrute (chaine : String) : boolean ;
{ Passe une chaine en majuscule. }
Function UpString ( Str : string ) : String ;
var ch : string[255] ;
i : byte ;
begin
{ Passe chaque caractΦre en majuscule. }
for i := 1 to length(str) do
ch[i] := UpCase(Str[i]) ;
{ Transfert la longueur. }
SetLength(ch,length(Str)) ;
UpString := Ch ;
end ;
var i : word ;
Trouve2 : Boolean ;
begin
if Configuration. IgnoreMAJmin then
chaine := UpString(chaine) ;
Trouve2 := False ;
i := 1 ;
While ((i <= TailleDescription) And (Trouve2 = False)) do
begin
if Configuration. IgnoreMAJmin then
Trouve2 := (Pos(Chaine,UpString(Description[i-1])) <> 0)
else
Trouve2 := (Pos(Chaine,Description[i-1]) <> 0) ;
inc(i) ;
end ;
Scrute := Trouve2 ;
End ;
{ Cherche si une description correspond aux critΦres de recherche. C'est un peu spaghetti mais
τa tourne bien et parfois il faut faire un peu de code "gΘnΘrΘ" pour grossir la taille du
source! }
Function Search : Boolean ;
var Found,
Found2 : Boolean ;
temp : String ;
begin
{ Analyse du premier critΦre. }
temp := MainForm.TexteCritere1.Text ;
Found := Scrute(temp) ;
If MainForm.NonCheck1.Checked Then
Found := Not Found ;
If ((MainForm.TexteCritere2.Text <> '') and (MainForm.TexteCritere2.Enabled)) Then
begin
{ Analyse du second critΦre. }
temp := MainForm.TexteCritere2.Text ;
Found2 := Scrute(temp) ;
If MainForm.NonCheck2.Checked Then
Found2 := Not Found2 ;
If MainForm.EtRadio2.Checked Then
Found := Found And Found2
Else
Found := Found Or Found2 ;
{ Analyse du troisiΦme critΦre. }
If ((MainForm.TexteCritere3.Text <> '') and (MainForm.TexteCritere3.Enabled)) Then
begin
temp := MainForm.TexteCritere3.Text ;
Found2 := Scrute(temp) ;
If MainForm.NonCheck3.Checked Then
Found2 := Not Found2 ;
If MainForm.EtRadio3.Checked Then
Found := Found And Found2
Else
Found := Found Or Found2 ;
End ;
End ;
Search := Found ;
End ;
{ Analyse tout un fichier et mets α jour le tipe de fichier. }
procedure ScanFichier (nom : string; tipe : byte) ;
var Resultat : boolean ;
TailleFichier,
TailleTemp : longint ;
phrase : string ;
temp : PChar ;
fichier : Text ;
{ Ajoute une ligne dans une description, si c'est possible. }
procedure ajoute (chaine : string) ;
begin
if chaine<>'' then
begin
Description. Add(chaine) ;
Inc(TailleDescription) ;
end ;
end ;
{ Ajoute une ligne dans la description suivant le type du fichier. }
procedure ajouteLigne ;
begin
{ Suivant le type de fichier on garde toute la ligne, soit on oublie
les 32 premiers caractΦres (qui sont des espaces). }
if (tipe = 0) then
begin
if (TailleDescription = 0) then
Ajoute(copy (phrase, 1, 31)) ;
if (length(phrase) > 31) then
Ajoute(copy (phrase, 32, length(phrase)-31)) ;
end
else
Ajoute(phrase) ;
end ;
begin
Resultat := False ;
{ TailleTemp indique o∙ en est rendu la recherche. }
TailleTemp := 0 ;
assign (fichier, nom );
reset(fichier) ;
readln(fichier, phrase) ;
TailleTemp := length(phrase) + 2 ; { 2 pour le CR LF! }
RazDescription ;
AjouteLigne ;
TailleFichier := taille(nom) ;
while not eof(fichier) and not quitte and not SectionSuivante
and not FichierSuivant do
begin
readln(fichier, phrase) ;
Inc(TailleTemp, length(phrase)+2) ;
{ Rends la main α Windows. }
Application. ProcessMessages ;
{ Si on a fini la description. }
if fin(phrase, tipe) then
begin
ScanForm. FicGauge. Progress := Round(TailleTemp*100/TailleFichier) ;
{ On passe de la section News α la section MAJ? }
if ((tipe = 1) and (copy (phrase, 1, 3) =' ■')) then
tipe := 2;
{ Si on a trouvΘ le(s) critΦre(s) de recherche. }
if Search then
begin
case tipe of
0 : DescForm. DescLabel. Caption := nom+' fichier type BBS' ;
1 : DescForm. DescLabel. Caption := nom+' fichier type DP Tool Club, section NEWS' ;
2 : DescForm. DescLabel. Caption := nom+' fichier type DP Tool Club, section MAJ' ;
end ;
AfficheDesc ;
end ;
RazDescription ;
end ;
{ On vΘrifie que la description n'est pas trop longue. }
if TailleDescription >= MaxDescription then
begin
temp := StrAlloc(60) ;
StrPCopy(temp, 'Fichier: '+nom+' invalide.') ;
Application. MessageBox(temp,'Erreur format',0);
StrDispose (temp) ;
close (fichier) ;
RazDescription ;
Exit ;
end ;
AjouteLigne ;
end ;
close(fichier) ;
end ; { ScanFichier }
{ Cette procΘdure rΘcupΦre les informations de la configuration pour mettre α jour les valeurs
des diffΘrentes champs de la boεte. }
procedure InitialiseOnglet;
var i : Integer ;
begin
with Configuration do
begin
OptionForm. RepEdit. Text := RepertoireDefaut;
OptionForm. DifCheck. Checked := IgnoreMAJmin;
OptionForm. TotalCheck. Checked := ChargeTotal;
OptionForm. AnnexeCheck. Checked := AnnexeDAbord;
if Fichiers. Count > 0 then
begin
OptionForm. ListBox. Items. Clear ;
for i := 0 to Fichiers. Count - 1 do
OptionForm. ListBox. Items. Add(Fichiers[i]) ;
end ;
end ;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
Application.OnHint := ShowHint;
ChercheINI ;
Description := TStringList. Create ;
end;
procedure TMainForm.ShowHint(Sender: TObject);
begin
StatusLine.Caption := Application.Hint;
end;
procedure TMainForm.QuitterBtnClick(Sender: TObject);
begin
Close ;
end;
procedure TMainForm.TexteCritere1Change(Sender: TObject);
begin
{ Lorsque l'on modifie la valeur du champ, s'il devient vide, il
faut dΘactiver les autres champs. }
Critere2. Enabled := TexteCritere1. Text<>'';
Critere2. Visible := Critere2. Enabled ;
Critere3. Visible := (Critere2. Visible) and (TexteCritere2. Text<>'');
RechercheBtn. Enabled := Critere2. Enabled ;
end;
procedure TMainForm.TexteCritere2Change(Sender: TObject);
begin
{ Voir ci-dessus. }
Critere3. Enabled := (TexteCritere2. Text<>'') and (Critere2.enabled);
Critere3. Visible := Critere3. Enabled ;
end;
procedure TMainForm.AscCheckClick(Sender: TObject);
var i : integer ;
begin
if AscCheck. State = cbGrayed then exit ;
{ Change l'Θtat de toute la section ASC. }
for i:= 0 to nbAsc-1 do
ListeBox.Selected[i] := AscCheck.Checked ;
end;
procedure TMainForm.VracCheckClick(Sender: TObject);
var i : integer ;
begin
if VracCheck. State = cbGrayed then exit ;
for i:= nbAsc to nbVrac-1 do
ListeBox.Selected[i] := VracCheck.Checked ;
end;
procedure TMainForm.AutreCheckClick(Sender: TObject);
var i : integer ;
begin
if AutreCheck. State = cbGrayed then exit ;
for i:= nbVrac to ListeBox.Items.Count-1 do
ListeBox.Selected[i] := AutreCheck.Checked ;
end;
procedure TMainForm.ListeBoxClick(Sender: TObject);
begin
CheckState ;
end ;
{ Voici la procΘdure la plus bugΘe du programme! C'est la procΘdure qui gΦre la recherche,
elle parcourt l'ensemble des fichiers en commenτant soit par les annexes ou les ASC et gΦre
les interruptions ordonnΘes par l'utilisateurs (fichier suivant, section suivante ou Exit!).
C'est la procΘdure qui a ΘtΘ rΘΘcrite le plus de fois (au moins quatre), quand je dis rΘΘcrit
c'est rΘΘcrit de la premiΦre α la derniΦre ligne! Car au fur et α mesure que le programme
avanτait les possibilitΘs se sont accrues et ont quasiment toujours concernΘs cette procΘdure. }
procedure TMainForm.RechercheBtnClick(Sender: TObject);
var i, j : integer ;
temp : string ;
Section : TSection ;
tipe : byte ;
TailleTemp : LongInt ;
Procedure ChangeSection (i:integer) ;
begin
if i >= NbAsc then Section := Vrac ;
if i >= NbVrac then Section := Autre ;
end ;
{ Cette procΘdure cherche le prochain fichier a analysΘ, sachant que pour les ASC, VRAC et Autre
il faut qu'il soit sΘlectionnΘs et que les annexes il faut tous les analysΘs. }
function ChercheFichier : String ;
var temp : string ;
begin
case Section of
Asc, Vrac, Autre : begin
while (i<ListeBox. Items. Count) and
(not ListeBox.Selected[i]) do
inc (i) ;
ChangeSection(i) ;
if i < ListeBox. Items. Count then
begin
temp := ListeBox.Items[i] ;
inc (i) ;
end
else
if not Configuration. AnnexeDAbord
and (Configuration. Fichiers. count <> 0)
and (MainForm. AnnexeCheck. Checked)
then
begin
Section := Annexe ;
i := 0 ;
temp := Configuration. Fichiers[i] ;
end
else
temp := '' ;
end ;
Annexe : begin
if (i < Configuration. Fichiers. Count) and
(MainForm. AnnexeCheck. Checked) then
begin
temp := Configuration. Fichiers[i] ;
inc (i) ;
end
else
if Configuration. AnnexeDAbord
then
begin
Section := Asc ;
i := 0 ;
temp := ChercheFichier ;
end
else
temp := '' ;
end ;
end ;
if temp = '' then quitte := true ;
ChercheFichier := temp ;
end ;
{ Cette procΘdure renvoie le type du fichier suivant son extention BBS ou ASC. }
function TypeFichier (nom : string) : byte ;
var temp : string ;
tipe : byte ;
begin
temp := ExtractFileExt(UpperCase(nom)) ;
if temp='.BBS' then
tipe := 0
else
tipe := 1 ;
TypeFichier := tipe ;
end ;
procedure SauterSection ;
var k : integer ;
begin
SectionSuivante := False ;
{ On teste s'il reste une section.. }
if ((Section = Annexe) and (not configuration. AnnexeDAbord))
or
((Section = Autre) and (configuration. AnnexeDAbord))
then
quitte := true
else
begin
{ On saute une section. }
case Section of
Asc : begin
j := NbAsc - 1 ;
Section := Vrac ;
end ;
Vrac : begin
j := NbVrac -1 ;
Section := Autre ;
end ;
Annexe : begin
j := 0;
for k := i to Configuration. Fichiers. Count - 1 do
inc(TailleTemp,taille(Configuration. Fichiers[k]));
Section := Asc ;
i:= 0 ;
end ;
Autre : begin
j := MainForm. ListeBox. Items. Count - 1 ;
Section := Annexe ;
end ;
end ;
{ On calcule la masse de donnΘes que l'on vient de sauter. }
while (i <= j) and (j<>0) do
begin
if MainForm. ListeBox. Selected[i] then
begin
temp := MainForm. ListeBox. Items[i] ;
inc (TailleTemp, taille(temp)) ;
end ;
inc (i) ;
end ;
{ On rafraεchit la gauge. }
ScanForm. TotalGauge. Progress := round (TailleTemp*100/TailleTotale) ;
end ;
end ;
begin
{ Parcours tous les fichiers α analyser pour dΘterminer les tailles de chaque section. }
ScruteTaille ;
i := 0 ;
tipe := 1 ;
{ On commence par quoi? }
if Configuration. AnnexeDAbord then
Section := Annexe
else
Section := Asc ;
TailleDescription := 0 ;
{ On cache la fenΩtre principale. }
MainForm. Hide ;
{ On affiche la fenΩtre de progression. }
ScanForm. Show ;
TailleTemp := 0 ;
ScanForm.TotalGauge. Progress := 0 ;
{ On initialise les drapeaux. }
quitte := false ;
SectionSuivante := false ;
{ On cherche un fichier. }
temp := ChercheFichier ;
While not quitte do
begin
{ On prΘpare la boεte de progression. }
ScanForm.FicGroup. Caption := 'Fichier: ' + ExtractFileName(temp) ;
ScanForm.FicGauge. Progress := 0 ;
FichierSuivant := false ;
{ On cherche le type du fichier. }
tipe := TypeFichier (temp) ;
{ On parcourt le fichier courant. }
ScanFichier(temp, tipe) ;
{ On rafraεchit la barre de progression. }
TailleTemp := TailleTemp + Taille(temp) ;
ScanForm. TotalGauge. Progress := Round(TailleTemp*100/TailleTotale) ;
{ Si on veut sauter la section courante. }
if SectionSuivante then
SauterSection ;
{ On cherche un fichier. }
temp := ChercheFichier ;
end ;
ScanForm. Hide ;
MainForm. Show ;
end;
procedure TMainForm.ChargerBtnClick(Sender: TObject);
begin
ChargementPartiel ;
end;
procedure TMainForm.SauveBtnClick(Sender: TObject);
begin
SauvegardePartielle ;
end ;
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
SauvegardePartielle ;
Description. Free ;
Configuration. Fichiers. Free ;
end;
procedure TMainForm.OptBtnClick(Sender: TObject);
var sauvegarde : string ;
begin
Sauvegarde := configuration. RepertoireDefaut ;
InitialiseOnglet ;
OptionForm. Onglet. PageIndex := 0 ;
OptionForm. ShowModal ;
if configuration. RepertoireDefaut <> Sauvegarde
then
ScanRepDefaut ;
end;
end.