delphi4arab منتديات دلفي للعرب

أرغب في إدراج ملف كسجل في ملف أخر حسب ماهو مكتوب في الكود الأتي

كود :
procedure TForm1.Button1Click(Sender: TObject);
type TAdresse =record
     nom:string[100];// une chaine de caractères de long max 100
     age:integer;
     MonFichier:TFile;
     end;
var
  Adresse: TAdresse;
  FichierAdresse:File of TAdresse;
  i:integer;
begin
  If SaveDialog1.Execute then
  begin
    AssignFile(FichierAdresse,SaveDialog1.FileName);
    ReWrite(FichierAdresse);
    For i:=1 to 10 do
    begin
      Adresse.nom:='toto';
      Adresse.age:=12;
      MonFichier.LoadFromFile('C:\Data.abs');
      Write(fichierAdresse,adresse);
    end;
    CloseFile(FichierAdresse);
  end;

end;

لكن توجد بعض الأخطاء لاأعرف كيف أصححها

السلام عليكم

كود :
procedure TForm1.Button1Click(Sender: TObject);

type TAdresse =record
     nom:string[100];// une chaine de caractères de long max 100
     age:integer;
     MonFichier:TextFile;//1
     end;
var
  Adresse: TAdresse;
  FichierAdresse:File of TAdresse;
  i:integer;
begin
  If SaveDialog1.Execute then
  begin
    AssignFile(FichierAdresse,SaveDialog1.FileName);
    ReWrite(FichierAdresse);
    For i:=1 to 10 do
    begin
      Adresse.nom:='toto';
      Adresse.age:=12;
      //2
      AssignFile(Adresse.MonFichier,'C:\Data.abs');
      ReSet(Adresse.MonFichier);

      Write(fichierAdresse,adresse);
      //3
      CloseFile(Adresse.MonFichier);
    end;
    CloseFile(FichierAdresse);
  end;
end;

أو :

كود :
procedure TForm1.Button1Click(Sender: TObject);

type TAdresse =record
     nom:string[100];// une chaine de caractères de long max 100
     age:integer;
     MonFichier:TStringList;//1
     end;
var
  Adresse: TAdresse;
  FichierAdresse:File of TAdresse;
  i:integer;
begin
  If SaveDialog1.Execute then
  begin
    AssignFile(FichierAdresse,SaveDialog1.FileName);
    ReWrite(FichierAdresse);
    For i:=1 to 10 do
    begin
     With Adresse Do
      Begin
       nom:='toto';
       age:=12;
       MonFichier:= TStringList.Create;
       MonFichier.LoadFromFile('C:\Data.abs');
       MonFichier.Free;
      End;
      Write(fichierAdresse,adresse);
    end;
    CloseFile(FichierAdresse);
  end;
end;

بالتوفيق,,

شكرا صديقي لكن هذا الكود صالح فقط للملفات من نوع texte او stringliste

و ما المشكلة أنت الذي تتحكم بالكود و ليس العكس , برمج دالة على حسب إحتياجك ...

كود :
{$WARNINGS OFF}{$HINTS OFF}
{$OPTIMIZATION ON}
Type
 TAdresse = Packed Record
   Name : String[100];
   Age  : Byte;
   _File: File;
  End;
Var
 mFile : File Of TAdresse;
 //pFile = ^TAdresse;

Procedure _LoadFromFile (Var _f: File;SrcFile: String);
 {$IFDEF VER 210}Inline;{$EndIf}
Begin
 {$I-}
  AssignFile(_f,SrcFile);
  ReSet(_f,1);//File Of Byte
 {$I+}
 If IoResult <> 0 Then
  Begin
   CloseFile(_f);
   MessageBoxA(0,PansiChar(Format('Error Code : $%X',[GetLastError]))
       ,Nil
       ,$2000);
   Exit;
  End;
End;

Procedure _CloseFile (Var _f: File);
 {$IFDEF VER 210}Inline;{$EndIf}
Begin
 {$I-}
  CloseFile(_f);
 {$I+}
 If IoResult <> 0 Then
  Begin
   MessageBoxA(0,PansiChar(Format('Error Code : $%X',[GetLastError]))
       ,Nil
       ,$2000);
   Exit;
  End;
End;

Function _WriteToFile (TrgFile,SrcFile: TFileName):Boolean;
 {$IFDEF VER 210}Inline;{$EndIf}
Var
 Adresse: TAdresse;
 _Index: Byte;
Begin
Result:= False;
 {$I-}
  AssignFile(mFile,TrgFile);
  ReWrite(mFile);
 {$I+}
 If IoResult <> 0 Then
  Begin
   CloseFile(mFile);
   MessageBoxA(0,PansiChar(Format('Error Code : $%X',[GetLastError]))
       ,Nil
       ,$2000);
   Exit;
  End;
 For _Index := 1 To 10 Do
 Begin
  With Adresse Do
   Begin
    Name := 'Delphi4Arab';
    Age  := 10;
    _LoadFromFile (_File,SrcFile);
   End;
 //Seek(mFile,0);//Eof(mFile)
 //TrunCate(mFile);
 Write(mFile,Adresse);
  _CloseFile (Adresse._File);
 End;
CloseFile(mFile);
Result:= True;
End;

طريقة الإستدعاء :

كود :
procedure TForm1.Button1Click(Sender: TObject);
begin
With SaveDialog Do
 Begin
  Execute;
  If FileName = '' Then Exit;
  If _WriteToFile (FileName,'C:\Data.abs') Then
  MessageBoxA(0,PansiChar(Format('Operation Code : $%X',[GetLastError]))
       ,Nil
       ,$2000);
 End;
end;

ملاحظة : بما أنك تريد كتابة نفس القيم فلا داعي لتكرار عملية الإنشاء / الغلق :

كود :
Function _WriteToFile (TrgFile,SrcFile: TFileName):Boolean;
 {$IFDEF VER 210}Inline;{$EndIf}
Var
 Adresse: TAdresse;
 _Index: Byte;
Begin
Result:= False;
 {$I-}
  AssignFile(mFile,TrgFile);
  ReWrite(mFile);
 {$I+}
 If IoResult <> 0 Then
  Begin
   CloseFile(mFile);
   MessageBoxA(0,PansiChar(Format('Error Code : $%X',[GetLastError]))
       ,Nil
       ,$2000);
   Exit;
  End;
 With Adresse Do
  Begin
   Name := 'Delphi4Arab';
   Age  := 10;
   _LoadFromFile (_File,SrcFile);
 End;
 //Seek(mFile,0);//Eof(mFile)
 //TrunCate(mFile);
 For _Index := 1 To 10 Do
   Write(mFile,Adresse);
_CloseFile (Adresse._File);
CloseFile(mFile);
Result:= True;
End;

بالتوفيق,,

alili mostafa

TF6M

alili mostafa

TF6M