1. Aperçu
Lors de l'écriture de programmes de base de données dans Delphi, des opérations d'importation et d'exportation de données sont souvent impliquées, telles que : stocker des données dans une grande base de données sous forme de fichiers portables pour une lecture facile à l'extérieur ; importer des informations de données stockées dans des fichiers dans une autre base de données ; la base de données sous forme de fichiers de données, il est plus facile d'échanger des données au sein et entre les programmes et d'éviter les étapes fastidieuses d'échange de données via la mémoire. Par exemple, dans le programme de rapport général écrit par l'auteur, ce contrôle est utilisé comme support d'informations de données. livraison.
2. Idées de base
En tant que contrôle de stockage de datagramme, il doit être capable de stocker et de lire les informations de base de l'ensemble de données (telles que : nom du champ, nom d'affichage du champ, type de données du champ, nombre d'enregistrements, nombre de champs, valeur actuelle du champ spécifié). dans le dossier spécifié, etc.), et devrait pouvoir fournir de meilleures caractéristiques d'emballage pour une utilisation plus facile.
Sur cette base, l'auteur a utilisé les caractéristiques orientées objet de Delphi5.0 pour concevoir et développer le contrôle de stockage des datagrammes.
3. Modalités de mise en œuvre
Écrivez l'unité de code suivante :
unité IbDbFichier ;
interface
Utilise Windows, SysUtils, Classes, Forms, Db, DbTables, Dialogs ;
Const
Indicateur = 'Datagram-Jixing Software Studio' ;
Taper
TDsException = Classe (Exception);
TIbStorage = classe (TComponent)
Privé
FRptTitle : string ; //Description du datagramme de stockage
FPageHead : chaîne ; //Description de l'en-tête de page
FPageFoot : string ; //Description des pieds
FFieldNames : TStrings ; //Table des noms de champs
FStreamIndex : TStrings ; //index du champ
FStream : TStream ; //Stream qui stocke le contenu du champ
FFieldCount : Entier ; //Nombre de champs
FRecordCount : Entier ; //Nombre d'enregistrements
FOpenFlag: Boolean; // Indicateur indiquant si le flux est créé
protégé
procédure Reset ; //Réinitialiser---effacer le contenu du flux
procédure SaveHead (ADataSet: TDataSet; Fp: TStream); // Informations d'en-tête du rapport de stockage
procédure LoadTableToStream (ADataSet: TDataSet); // Données d'enregistrement de stockage
procédure IndexFields(ADataSet: TDataSet); //Enregistre les noms de champs de l'ensemble de données dans la liste
procédure GetHead(Fp: TFileStream); //Enregistrer les informations d'en-tête du rapport
procédure GetIndex(Fp: TFileStream); //Créer un index de flux d'enregistrement
procédure GetFieldNames(Fp: TFileStream); //Lire la table des noms de champs à partir du flux
function GetFieldName(AIndex: Integer): string; //Obtenir le nom du champ
fonction GetFieldDataType (AIndex : Integer) : TFieldType ;
function GetDisplayLabel(AIndex: Integer): string; //Obtenir le nom d'affichage du champ
procédure SaveFieldToStream(AStream: TStream; AField: TField //Enregistre le champ dans le flux);
function GetFieldValue(ARecordNo, FieldNo : Integer) : chaîne //Contenu du champ
publique
Constructeur Create(AOwner : TComponent);
Destructeur Détruire ;
procédure Open; //Créer un flux pour préparer le stockage des données
procédure SaveToFile (ADataSet: TDataSet; AFileName: string); //Méthode de stockage);
procédure LoadFromFile(AFileName: string); //Charger les données
procédure FieldStream(ARecordNo, FieldNo : Integer ; var AStream : TStream) ;
propriété FieldNames[Index : Integer] : chaîne lue GetFieldName ; //nom du champ
propriété FieldDataTypes[Index : Integer] : TFieldType lire GetFieldDataType ;
propriété FieldDisplayLabels[Index : Integer] : chaîne lue GetDisplayLabel ;
propriété Fields[RecNo, FieldIndex : Integer] : chaîne lue GetFieldValue ;
//propriété FieldStreams[RecNo, FieldIndex : Integer] : TStream lit GetFieldStream ;
propriété RecordCount : entier lu FRecordCount écrit FRecordCount ;
propriété FieldCount : Entier lire FFieldCount écrire FFieldCount ;
publié
propriété RptTitle : chaîne de lecture FRptTitle écriture de FRptTitle ;
propriété PageHead : chaîne de lecture FPageHead écriture de FPageHead ;
propriété PageFoot : chaîne de lecture FPageFoot écriture de FPageFoot ;
fin;
fonction ReadAChar(AStream : TStream) : Char ;
fonction ReadAStr(AStream : TStream) : chaîne ;
fonction ReadBStr(AStream : TStream; Taille : Integer) : chaîne ;
fonction ReadAInteger(AStream : TStream) : Entier ;
procédure WriteAStr(AStream : TStream ; AStr : chaîne) ;
procédure WriteBStr(AStream : TStream ; AStr : chaîne) ;
procédure WriteAInteger(AStream : TStream ; AInteger : Integer) ;
registre de procédure ;
mise en œuvre
registre de procédure ;
commencer
RegisterComponents('Accès aux données', [TIbStorage]);
fin;
fonction ReadAChar(AStream : TStream) : Char ;
Var
AChar : Caractère ;
commencer
AStream.Read(AChar, 1);
Résultat := AChar;
fin;
fonction ReadAStr(AStream : TStream) : chaîne ;
var
Chaîne : chaîne ;
C:Char;
commencer
Str := '';
C := ReadAChar(AStream);
Tandis que C <> #0 fait
commencer
Str := Str + C;
C := ReadAChar(AStream);
fin;
Résultat := Str;
fin;
fonction ReadBStr(AStream : TStream; Taille : Integer) : chaîne ;
var
Chaîne : chaîne ;
C:Char;
I : Entier ;
commencer
Str := '';
Pour I := 1 à la taille faire
commencer
C := ReadAChar(AStream);
Str := Str + C;
fin;
Résultat := Str;
fin;
fonction ReadAInteger(AStream : TStream) : Entier ;
var
Chaîne : chaîne ;
C:Char;
commencer
Résultat := MaxInt;
Str := '';
C := ReadAChar(AStream);
Tandis que C <> #0 fait
commencer
Str := Str + C;
C := ReadAChar(AStream);
fin;
essayer
Résultat := StrToInt(Str);
sauf
application.MessageBox('La chaîne actuelle ne peut pas être convertie en entier !', 'Erreur',
Mb_Ok + Mb_IconError);
fin;
fin;
procédure WriteAStr(AStream : TStream ; AStr : chaîne) ;
commencer
AStream.Write(Pointeur(AStr)^, Longueur(AStr) + 1);
fin;
procédure WriteBStr(AStream : TStream ; AStr : chaîne) ;
commencer
AStream.Write(Pointeur(AStr)^, Longueur(AStr));
fin;
procédure WriteAInteger(AStream : TStream ; AInteger : Integer) ;
var
S : chaîne ;
commencer
S := IntVersStr(AInteger);
WriteAstr(AStream, S);
fin;
Constructeur TIbStorage.Create(AOwner : TComponent);
commencer
hérité Create(AOwner);
FOpenFlag := False; //Drapeau pour déterminer si le flux est créé
fin;
Destructeur TIbStorage.Destroy ;
commencer
si FOpenFlag alors
commencer
FStream.Gratuit ;
FStreamIndex.Free ;
FFieldNames.Free;
fin;
hérité Détruire;
fin;
procédure TIbStorage.Open;
commencer
FOpenFlag := Vrai ;
FStream := TMemoryStream.Create;
FStreamIndex := TStringList.Create;
FFieldNames := TStringList.Create;
Réinitialiser;
fin;
procédure TIbStorage.Reset; //reset
commencer
si FOpenFlag alors
commencer
FFieldNames.Clear;
FStreamIndex.Clear;
FStream.Size := 0;
FRptTitre := '';
FPageHead := '';
FPageFoot := '';
FFieldCount := 0 ;
FRecordCount := 0 ;
fin;
fin;
//-------Enregistrer la partie des données
procédure TIbStorage.SaveToFile(ADataSet: TDataSet; AFileName: string);
var
Fp : TFileStream ;
I : Entier ;
Ch : Char ;
T1, T2 : TDateHeure ;
Chaîne : chaîne ;
commencer
si ce n'est pas FOpenFlag alors
commencer
showmessage('L'objet n'est pas ouvert');
Sortie;
fin;
essayer
si FileExists(AFileName) alors DeleteFile(AFileName);
Fp := TFileStream.Create(AFileName, fmCreate);
Réinitialiser;
SaveHead(ADataSet, Fp); //Enregistrer les informations d'en-tête---Instructions supplémentaires
IndexFields(ADataSet); //Enregistre les informations de champ de l'ensemble de données dans FFieldName
LoadTableToStream(ADataSet); //Enregistrer les informations sur les données de l'ensemble de données
WriteAStr(Fp, FFieldNames.Text); //Informations sur le nom du champ de stockage
Ch := '@';
Fp.Write(Ch, 1);
WriteAStr(Fp, FStreamIndex.Text); //Liste d'index des champs de stockage
Ch := '@';
Fp.Write(Ch, 1);
Fp.CopyFrom(FStream, 0);
enfin
Fp.Gratuit ;
fin;
fin;
procédure TIbStorage.SaveHead(ADataSet : TDataSet ; Fp : TStream) ;
Var
I : Entier ;
Ch : Char ;
commencer
si ce n'est pas ADataSet.Active alors ADataSet.Active := True ;
WriteAStr(Fp, Drapeau);
WriteAStr(Fp, FRptTitre);
WriteAStr(Fp, FPageHead);
WriteAStr(Fp, FPageFoot);
FFieldCount := ADataSet.Fields.Count;
FRecordCount := ADataSet.RecordCount;
WriteAStr(Fp, IntToStr(ADataSet.Fields.Count));
WriteAStr(Fp, IntToStr(ADataSet.RecordCount));
Ch := '@';
Fp.Write(Ch, 1);
fin;
procédure TIbStorage.IndexFields(ADataSet: TDataSet);
var
I : Entier ;
Champ : Champ ;
commencer
Pour I := 0 à ADataSet.Fields.Count - 1 faire
commencer
AField := ADataSet.Fields[I];
//Ne pas utiliser FFieldNames.Values[AField.FieldName] := AField.DisplayLabel revient à prendre en compte l'efficacité ;
FFieldNames.Add(AField.FieldName + '=' + AField.DisplayLabel);
FFieldNames.Add(AField.FieldName + 'DataType=' + IntToStr(Ord(AField.DataType)));
fin;
fin;
procédure TIbStorage.LoadTableToStream(ADataSet: TDataSet);
var
Non : Entier ;
I, J, taille : entier ;
Tmp, Id, Str : chaîne; //id=chaîne(RecNO) + chaîne(FieldNo)
Len : entier ;
Ch : Char ;
BlobStream : TBlobStream ;
commencer
si ce n'est pas FOpenFlag alors
commencer
showmessage('L'objet n'est pas ouvert');
Sortie;
fin;
essayer
ADataSet.DisableControls ;
ADataSet.First;
Non := 0;
FStreamIndex.Clear;
FStream.Size := 0;
Bien que ce ne soit pas ADataSet.Eof
commencer
Non := Non + 1 ;
Pour J := 0 à ADataSet.Fields.Count - 1 faire
commencer
Id := Inttostr(NO) + '_' + IntToStr(J);
//Créer un index de la position du flux, l'index pointe vers : Size#0Content
FStreamIndex.Add(Id + '=' + IntToStr(FStream.Position));
//Stocker les informations du champ dans le flux
SaveFieldToStream(FStream, ADataSet.Fields[J]);
fin;
ADataSet.Next ;
fin;
enfin
ADataSet.EnableControls ;
fin;
fin;
//Si le contenu actuel d'un champ est vide ou BlobSize<=0, seule la taille du champ est 0 et aucun contenu n'est écrit.
procédure TIbStorage.SaveFieldToStream(AStream : TStream ; AField : TField) ;
var
Taille : entier ;
Ch : Char ;
XF : TStream ;
Chaîne : chaîne ;
commencer
si AField.IsBlob alors
commencer
//Comment stocker le contenu d'un champ TBlobField sous forme de flux
Xf := TBlobStream.Create(TBlobField(AField), bmread);
essayer
si Xf.Size > 0 alors
commencer
Taille := Xf.Taille;
WriteAInteger(AStream, Taille);
AStream.CopyFrom(Xf, Xf.Size);
fin
autre
WriteAInteger(AStream, 0);
enfin
XF.Gratuit ;
fin;
fin
autre
commencer
Str := AField.AsString;
Taille := Longueur (Str);
WriteAInteger(AStream, Taille);
si Taille <> 0 alors
AStream.Write(Pointeur(Str)^, Taille);
//EcrireAstr(AStream, Str);
fin;
Ch := '@';
AStream.Write(Ch, 1);
fin;
//------------Charger les données
procédure TIbStorage.LoadFromFile(AFileName: string);
var
Fp : TFileStream ;
Vérifiez : chaîne ;
commencer
Réinitialiser;
essayer
si ce n'est pas FileExists (AFileName) alors
commencer
showmessage('Le fichier n'existe pas :' + AFileName);
Sortie;
fin;
Fp := TFileStream.Create(AFileName, fmOpenRead);
Vérifiez := ReadAStr(Fp);
si Vérifier <> Indicateur alors
commencer
Application.MessageBox('Format de fichier illégal', 'Erreur', Mb_Ok + Mb_IconError);
Sortie;
fin;
GetHead(Fp);
GetFieldNames(Fp);
GetIndex(Fp);
FStream.CopyFrom(Fp, Fp.Size-Fp.Position);
enfin
Fp.Gratuit ;
fin;
fin;
procédure TIbStorage.GetHead(Fp: TFileStream);
commencer
FRptTitle := ReadAStr(Fp);
FPageHead := ReadAstr(Fp);
FPageFoot := ReadAstr(Fp);
FFieldCount := ReadAInteger(Fp);
FRecordCount := ReadAInteger(Fp);
si ReadAChar(Fp) <> '@' alors showmessage('GetHead File Error');
fin;
procédure TIbStorage.GetFieldNames(Fp: TFileStream);
var
Ch : Char ;
Chaîne : chaîne ;
commencer
Str := '';
Str := ReadAStr(Fp);
FFieldNames.CommaText := Str;
Ch := LireAChar(Fp);
if Ch <> '@' then Showmessage('Quand obtenir l'erreur des noms de champs');
fin;
procédure TIbStorage.GetIndex(Fp: TFileStream);
var
Ch : Char ;
Chaîne : chaîne ;
commencer
Str := '';
Str := ReadAStr(Fp);
FStreamIndex.CommaText := Str;
Ch := LireAChar(Fp);
if Ch <> '@' then Showmessage('When Get Field Position Index Error');
fin;
//-------------Lire la partie valeur du champ
fonction TIbStorage.GetFieldValue(ARecordNo, FieldNo : Integer) : chaîne ;
var
Id, T : chaîne ;
Pos : entier ;
Len, I : Entier;
Euh : booléen ;
commencer
Résultat := '';
Euh := Faux;
si ARecordNo > FRecordCount alors
Euh := vrai; //ARecordNo := FRecordCount;
si ARecordNo < 1 alors
Euh := Vrai; // ARecordNo := 1;
si FieldNo >= FFieldCount alors
Euh := Vrai ; // FieldNo := FFieldCount - 1 ;
siFieldNo < 0 alors
Euh := Vrai; //FieldNo := 0;
si euh alors
commencer
Showmessage('Le numéro d'enregistrement ou l'étiquette du champ est hors limites');
Sortie;
fin;
si FFieldCount = 0 alors Quittez ;
Id := Inttostr(ARecordNO) + '_' + IntToStr(FieldNo);
Pos := StrToInt(FStreamIndex.Values[Id]);
FStream.Position := Pos;
//Obtenir la longueur du contenu du champ
Longueur := ReadAInteger(FStream);
si Len > 0 alors
Résultat := ReadBStr(FStream, Len);
si ReadAChar(FStream) <> '@' alors
Showmessage('Lors de la lecture du champ, rechercher l'erreur de format d'enregistrement');
fin;
procédure TIbStorage.FieldStream(ARecordNo, FieldNo : Integer ; var AStream : TStream) ;
var
Id, T : chaîne ;
Pos : entier ;
Len, I : Entier;
Euh : booléen ;
commencer
Euh := Faux;
si ARecordNo > FRecordCount alors
Euh := vrai; //ARecordNo := FRecordCount;
si ARecordNo < 1 alors
Euh := Vrai; // ARecordNo := 1;
si FieldNo >= FFieldCount alors
Euh := Vrai ; // FieldNo := FFieldCount - 1 ;
siFieldNo < 0 alors
Euh := Vrai; //FieldNo := 0;
si euh alors
commencer
TDsException.Create('Indice d'index de fonction GetFieldValue hors limites');
Sortie;
fin;
si FFieldCount = 0 alors Quittez ;
Id := Inttostr(ARecordNO) + IntToStr(FieldNo);
Pos := StrToInt(FStreamIndex.Values[Id]);
FStream.Position := Pos;
Longueur := ReadAInteger(FStream);
AStream.CopyFrom(FStream, Len);
fin;
function TIbStorage.GetFieldName(AIndex: Integer): string //Obtenir le nom du champ
commencer
//Les champs et types de données stockés représentent chacun la moitié
si ((AIndex < 0) ou (AIndex >= FFieldNames.Count div 2)) alors
Application.MessageBox('Index du nom de champ hors limites', 'Erreur de programme',
Mb_Ok + Mb_IconError)
autre
Résultat := FFieldNames.Names[AIndex*2];
fin;
function TIbStorage.GetFieldDataType(AIndex: Integer): TFieldType ; //Obtenir le nom du champ ;
commencer
//Les champs et types de données stockés représentent chacun la moitié
si ((AIndex < 0) ou (AIndex >= FFieldNames.Count div 2)) alors
Application.MessageBox('L'index du type de données du champ est hors limites', 'Erreur de programme',
Mb_Ok + Mb_IconError)
autre
Résultat := TFieldType(StrToInt(FFieldNames.Values[FFieldNames.Names[AIndex*2+1]]));
fin;
function TIbStorage.GetDisplayLabel(AIndex: Integer): string; //Obtenir le nom d'affichage du champ
commencer
si ((AIndex < 0) ou (AIndex >= FFieldNames.Count)) alors
Application.MessageBox('Index du nom de champ hors limites', 'Erreur de programme',
Mb_Ok + Mb_IconError)
autre
Résultat := FFieldNames.Values[GetFieldName(AIndex)];
fin;
fin.
Grâce aux tests, ce contrôle prend en charge les contrôles d'ensembles de données couramment utilisés tels que Ttable, Tquery, TaodTable, TadoQuery, TibTable, TibQuery, etc., et a une bonne efficacité (test : 1 100 dossiers personnels, 23 champs stockés sous forme de fichier prend environ 2 heures). secondes).
4. Utilisation de base des contrôles
1. Stocker les données d'un ensemble de données dans un fichier
IbStorage1.Open; //Créer un flux de stockage
IbStorage1.SaveToFile (AdataSet, Afilename);
2. Lire les informations sur les données du fichier
IbStorage1.Open;
IbStorage1.LoadFromFile(AfileName);
3. Accès aux données dans le contrôle de stockage du datagramme
Valeur := IbStorage1.Fields[ArecNo, AfieldNo] ; //Type de chaîne
D'autres sont omis.
5. Conclusion
En écrivant cette commande de stockage de datagrammes, le problème du stockage et de l'échange de données dans des programmes de bases de données est mieux résolu, et un contrôle pratique est fourni pour le développement de programmes de bases de données.
Le contrôle a réussi le débogage sous l’environnement de développement Windows98 et Delphi5.