Interface Delphi 6 et BDD HF7 (windev)

Question

Bonjour,


Je suis actuellement en train de travailler sur un projet devant réaliser l'interface entre une base de donnée HF7 (sous windev) et l'utilisateur en utilisant
Delphi6 comme moyen de communication avec la base de donnée.
Ce projet permet de remplacer une interface développé en pascal permettant la communication avec une base de donnée HF3.


Pour y parvenir, j'ai donc repris la philosophie du projet développé en Pascal. Cependant, j'ai un problème lorsque j'utilise
les fonctions hlit, hajoute... fournies par les biblio de delphi. Le problème est que l'utilisation de la fonction hlit semble modifier la valeur
du pointeur contenant l'adresse du fichier dans lequel l'enregistrement va être placé. De plus, une fois cette procédure exécutée,
la procédure suivante ne l'est plus. (procédure permettant de recopier l'enregistrement dans un fichier temporaire).


Voici mon code source.


D'avance Merci.

program test_Hlit;


{$APPTYPE CONSOLE}


uses
  SysUtils,
  wdhf;




type


TypeED=record //  Type venant du fichier "EDIT.pas"
    case byte of
    0:(
         hactif: char;
         rang: integer;
         ecretmin: real;
         ecretmax: real;
         unites:array [1..4] of byte;
         coeff:array [1..4] of real;
         optioned:array [1..4] of byte;
         optiontx:array [1..4] of integer;
         valusu1: real;
         valusu2: real;
         edchamps1: string[12];
         edchamps2: string[12];
         edchamps3: string[12];
         edchamps4: string[12];
     );
end;


//------------------------------------------------//


var
    recordFile : file;       // fichier recevant l'enregistrement
    size : integer;          // taille de l'enregistrement
    ptrRecord : pointer;     // pointeur contenant l'adresse du recordFile
    recno : integer;         // numéro d'enregistrement
    ED: TypeED;              // type d'enregistrement utilisé
    ficTransfert : string;   // nom du fichier de transfert
const
nomficTransfert = 'trans.bin';
nomfic = 'EDIT'; // fichier dans lequel on va récupérer les informations (edit.fic)
//------------------------------------------------//




(* --------------------------------------------------------------------------
 *  function SetRecordParam
 *                          renvoie true si la table demandée est valide.
 *
 *  Description : cette fonction affecte la taille du record, ainsi qu'un
 *                pointeur vers ce record suivant la table demandée
 *  Entrees     : nomfic : nom du fichier de la base (= nom de la table)
 *  Sorties     : size : taille de la structure de donnée associée à la table
 *                ptrRecord : pointeur vers le record associé à la table
 *
  --------------------------------------------------------------------------- *)


function setRecordParam(nomfic : string;
                         var size : integer;
                         var ptrRecord : pointer): boolean;
var fichierConnu : boolean;
begin
fichierconnu:=true;
     if (nomfic='EDIT') then
     begin
        size:= sizeof(typeED);
        ptrRecord := Addr(ED);
     end
     else
     begin
         fichierConnu := false;
     end;
     SetRecordParam := fichierConnu;
end;


 


(* --------------------------------------------------------------------------
 *  procedure ReadAndCopyToRecord
 *
 *  Description : Ouvre le fichier recordFile, en lit le contenu, l'écrit dans
 *                ptrRecord^ puis ferme le fichier.
 *  Entrees     : RecordFile : fichier utilisé pour transmettre un record
 *                ptrRecord : pointeur vers le record associé à la table
 *                size : taille de la structure de donnée associée à la table
 *
  --------------------------------------------------------------------------- *)
procedure ReadAndCopyToRecord(VAR RecordFile : File; ptrRecord : pointer; size : integer);


var
   i : integer;
const
   ntentative = 10;
begin
     i := 1;
   {$IOChecks Off}
    repeat                        {on essaye d'ouvrir le fichier plusieurs fois}
          sleep(1);               {avec un delai, car il faut que le fichier   }
          Reset(RecordFile,size); {soit crée par l'executable dos              }
          Inc(i);
    until (IOResult = 0) or (i > ntentative);
   {$IOChecks On}
    if(i > ntentative) then
    begin
         writeln('erreur ouverture du fichier de transfert');
    end;
//begin


    Reset(RecordFile,size);
    BlockRead(recordFile,ptrRecord^,1);
    Close(recordFile);


end;


//---------------------------------------------------------------------------//
//---------------------------------------------------------------------------//




procedure GeneriqueLectureHF(VAR recordFile : file;
                             ptrRecord : pointer;
                             size : integer );




begin
recno:=1;


hlit(nomfic+'.fic',recno);
     //permet de se positionner dans la base pour y effectuer la lecture.


     // le problème se situe ici ou le programme n'exécute pas la fonction ReadAndCopyToRecord
     // la valeur de ptrRecord est nil depuis que l'on a utilisé la fonction wdhf.hlit
ReadAndCopyToRecord(recordFile,ptrRecord,size); {copie du résultat dans le record corrrespondant}


end;




//---------------------------------------------------------------------------//
//---------------------------------------------------------------------------//


///// PROGRAMME PRINCIPAL /////


begin


fictransfert:=getcurrentdir+'\'+nomficTransfert;
Assign(recordFile,ficTransfert);
// on assigne le nomficTransfert (trans.bin) au fichier recordfile


if(setRecordParam(nomfic,size, ptrRecord)) then
   begin
        GeneriqueLectureHF(recordFile, ptrRecord, size);
   end
   else
   begin
   writeln('nom de fichier inconnu');
   end;
;
end.

f0xi · Answer

uses
  Windows, SysUtils, Classes;

type
  TypeReal = double; // Real // Single // Real48
  TypeED=record
    hactif    : char;
    rang      : integer;
    ecretmin  : TypeReal;
    ecretmax  : TypeReal;
    unites    : array [1..4] of byte;
    coeff     : array [1..4] of TypeReal;
    optioned  : array [1..4] of byte;
    optiontx  : array [1..4] of integer;
    valusu1   : TypeReal;
    valusu2   : TypeReal;
    edchamps1 : string[12];
    edchamps2 : string[12];
    edchamps3 : string[12];
    edchamps4 : string[12];
  end;
  pTypeED = ^TypeED;

const
  TypeEDSize = SizeOf(TypeED); // 160 Bytes

{ memory / disk usage :
  1 000 records     : 160 000 bytes (153 KB)
  10 000 records    : 1 600 000 bytes (1.53 MB)
  100 000 records   : 16 000 000 bytes (15.3 MB)
  1 000 000 records : 160 000 000 bytes (153 MB)
  10 000 000 records: 1 600 000 000 bytes (1.53 GB)
}

type
  THFFile = class(TObject)
  private
    FList  : TList;
    FStream: TFileStream;
    procedure SetItem(index: integer; value: TypeED);
    function GetItem(index: integer): TypeED;
  public
    // list of items in file
    property Items[index: integer]: TypeED read GetItem write SetItem;
    // add an item
    function Add(const ED: TypeED): integer;
    // delete an item
    procedure Delete(const Index: integer);
    // exchange indexs of items
    procedure Exchange(const Index1, Index2: integer);
    // count items
    function Count: integer;
    // called on THFFile.Create
    procedure ReadFile;
    // called on THFFile.Free (destroy)
    procedure SaveFile;
  public
    // create or open file
    constructor Create(const FileName: string);
    destructor Destroy; override;
  end;

{ THFFile }

function THFFile.Count: integer;
begin
  result := FList.Count;
end;

constructor THFFile.Create(const FileName: string);
begin
  FList := TList.Create;
  if FileExists(FileName) then
    FStream := TFileStream.Create(FileName, fmOpenReadWrite)
  else
    FStream := TFileStream.Create(FileName, fmCreate);

  // read
  ReadFile;
end;

destructor THFFile.Destroy;
var N : integer;
    ptr: pTypeED;
begin
  // Save
  SaveFile;

  FStream.Free;
  for N := FList.Count-1 downto 0 do
  begin
    ptr := pTypeED(FList.Items[N]);
    dispose(ptr);
    FList.Delete(N);
  end;
  FList.Free;
  inherited;
end;

procedure THFFile.SetItem(index: integer; value: TypeED);
begin
  pTypeED(FList.Items[index])^ := Value;
end;

function THFFile.GetItem(index: integer): TypeED;
begin
  result := pTypeED(FList.Items[index])^;
end;

procedure THFFile.ReadFile;
var N  : integer;
    TE : TypeED;
    ptr: pTypeED;
begin
  FStream.Position := 0;
  for N := 0 to (FStream.Size div TypeEDSize)-1 do
  begin
    FStream.Read(TE, TypeEDSize);
    New(ptr);
    ptr^ := TE;
    FList.Add(pointer(ptr));
  end;
end;

procedure THFFile.SaveFile;
var N  : integer;
    TE : TypeED;
begin
  FStream.Position := 0;
  for N := 0 to FList.Count-1 do
  begin
    TE := pTypeED(FList.Items[N])^;
    FStream.Write(TE, TypeEDSize);
  end;
end;

function THFFile.Add(const ED: TypeED): integer;
var ptr : pTypeED;
begin
  new(ptr);
  ptr^ := ED;
  result := FList.Add(ptr);
end;

procedure THFFile.Delete(const Index: integer);
var ptr: pTypeED;
begin
  ptr := pTypeED(FList.Items[index]);
  Dispose(ptr);
  FList.Delete(index);
end;

procedure THFFile.Exchange(const Index1, Index2: integer);
begin
  FList.Exchange(Index1, Index2);
end;

<hr size="2" width="100%" />

Interface Delphi 6 et BDD HF7 (windev)

1 réponse

Votre réponse

Discussions similaires