مشاهدة النسخة كاملة : حفظ قاعدة البيانات Absolute database
Anter2010
28-09-2010, 12:37 PM
السلام عليكم و رحمة الله تعالى و بركاته
اخوتي الاعزاء صادفتني هذه المشكلة في حفظ قاعدة البيانات
لم افهم هل المشكل في المسار ام في الكود من الرغم انني عندما اطبقها
في تطبيق صغير تنجح معي و يحفظ لي قاعدة البيانات و عند تطبيقها على برنامجي لا تعمل اي شيئ
هذا الكود الاول
procedure TFLaCloture.SpeedButton2Click(Sender: TObject);
begin
Sleep(1000);
data.OnDestroy(sender);
copyfile(pchar('..\..\Pstock\Stock.ABS'),pchar('.. \..\Pstock\Stock')+(Edit1.Text)+ '.ABS');//,False);
data.OnCreate(sender);
sleep(1000);
showMessage('l''Opération de sauvgarde est réussie avec succés' );
FLaCloture.Close;
end;
و الكود الثاني
function CopyFile(Source, Destination: String ) : boolean;
var
fos : TSHFileOpStruct;
begin
FillChar(fos, SizeOf(fos),0);
with fos do
begin
wFunc := FO_COPY;
pFrom := PChar(Source+#0);
pTo := PChar(Destination+#0);
fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_SILENT;
end;
result := (0 = ShFileOperation(fos));
end;
procedure TFLaCloture.MaCloture;
begin
Chemin := ExtractFilePath(Application.ExeName);
screen.cursor := crHourGlass;
CopyFile(Chemin + '..\..\Pstock\Stock.ABS',Chemin + '..\..\Pstock\Stock' + Edit1.Text + '.ABS');
Sleep(1000);
Sleep(1000);
ShowMessage('Terminer...');
screen.cursor := crDefault;
close;
end;
procedure TFLaCloture.SpeedButton2Click(Sender: TObject);
begin
Sleep(1000);
data.OnDestroy(sender);
copyfile(pchar('..\..\Pstock\Stock.ABS'),pchar('.. \..\Pstock\Stock')+(Edit1.Text)+ '.ABS');//,False);
data.OnCreate(sender);
sleep(1000);
showMessage('l''Opération de sauvgarde est réussie avec succés' );
FLaCloture.Close;
end;
procedure TFLaCloture.SpeedButton3Click(Sender: TObject);
begin
Chemin := ExtractFilePath(Application.ExeName);
if FileExists(Chemin+ '\'+ 'Stock'+ Edit1.Text + '.ABS') then
begin
messagedlg('L''exercice '+ Edit1.Text + ' est déjà clôturer',mtWarning,[mbYes],0);
end
else
if messagedlg('Confirmer la Cloture de l''exercice '+ Edit1.Text +' ? ',mtconfirmation,[mbYes,mbNo],0) = mrYes then
begin
MaCloture;
end;
end;
kachwahed
28-09-2010, 01:01 PM
وعليكم السلام ورحمة الله وبركاته
في تطبيق صغير تنجح معي و يحفظ لي قاعدة البيانات و عند تطبيقها على برنامجي لا تعمل اي شيئ
وضح مالذي يحدث أو رسالة الخطأ!
من فضلكم اخوتي اتوسم فيكم ال****** ان شاء الله
انتبه:
11- هناك كلمات محظورة عند كتابتها تظهر على شكل نجوم ***** ، احرص على عدم ظهورها لكي لا تحذف مشاركتك
Anter2010
28-09-2010, 01:58 PM
السلام عليكم و رحمة الله تعالى و بركاته
اخي كاش و احد المشكلة انها لا تظهر اي رسالة خطأ
وحاولة ايضا بتطبيق هذا الكود لم ينجح معي و هذا بالمرفق ان شاء الله
و هذه قاعدة البيانات
kachwahed
28-09-2010, 02:43 PM
آسف، لا أدري بالضبط أين الخلل
ليست لدي المكونات للتجريب لا أدري أي نسخة دلفي تستخدم...
المهم...
1- لا تستخدم توابع Shell لنسخ الملفات إن لم تكن تتحكم فيها بشكل جيد
أيضا افحص الناتج لتحديد موضع الخلل، مثال:
if copyfile('e:\text.txt','d:\bakcup\'+Edit1.Text+ '.txt') then
ShowMessage('Opération terminé!')
else
ShowMessage('Erreur de copie!')
بهذه الطريقة -على الأقل- تعرف أين الخطأ في (أو ليس في) تابع النسخ...
2- استخدمت الأعلام FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_SILENT هل تعرف جيدا معناها؟
إذا لم تكن بحاجة لنافذة نسخ الملفات، فلِم لا تستخدم تابع API مباشرة (وهو ما أنصحك به)، مثال:
function MyCopyFile(const Source, Dest: string; Overwrite: Boolean = False): Boolean;
{Usage:
if MyCopyFile('c:\text.txt', 'd:\') then }
begin
Result := CopyFile(PChar(Source), PChar(IncludeTrailingPathDelimiter(Dest)+
ExtractFileName(Source)), Overwrite);
end;
3- التابع الذي استخدمت ينسخ الملفات بشكل صحيح...
فقط تأكد من صحة المسارات (كلاها)
ليس بالعين المجردة، وإنما بشيء مثل:
if not FileExists('..\..\Pstock\Stock.ABS') then
ShowMessage('Fichier introuvable!');
تتبع الخطأ بهذه المنجهة:
- تأكد من صحة عمل الدالة
- تأكد من سلامة المسارات
- افحص الناتج دائما (if... then)
بالتوفيق.
Anter2010
28-09-2010, 04:02 PM
السلام عليكم و رحمة الله تعالى و بركاته
على كل حال انا اقدر تعبك معي مشكور اخي كاش واحد اظن ان المشكل
في DataModule
لانني كما سبق الذكر قد جربتها قبل في تطبيق صغير و لم استعمل فيه
العمليات و البرمجة وضعت فقط table 2
هل هذا سياثر عل قاعدة البيانات
المهم مشكور اخي كاش و احد
ساحاول ان شاء الله ايجاد الخلل
kachwahed
28-09-2010, 06:11 PM
في datamodule
تأكد أيضا من إمكانية الوصول إلى الملف من قبل النظام
والأفضل غلق الاتصال بقاعدة البيانات قبل النسخ.
بالتوفيق.
Anter2010
30-09-2010, 01:09 PM
السلام عليكم و رحمة الله تعالى و بركاته
اخي كاش واحد بالنسبة datamodule
قد قمت باغلاقها و ذالك في
data.OnDestroy(sender);
واعادت فتحها
data.OnCreate(sender);
اما بالنسبة من إمكانية الوصول إلى الملف من قبل النظام
فهذا لم افهمه
medreg
01-10-2010, 10:01 AM
السلام عليكم ورحمة الله تعالى وبركاته
ربما أخي يفيدك هذا
كود للحفظ
procedure TForm1.MenuItem3Click(Sender: TObject);
begin
Sleep(1000);
DModule.OnDestroy(sender);
copyfile(pchar('teste.ABS'),pchar(Form2.ComboBox1. Text+Form2.SpinEdit1.Text),False);
DModule.OnCreate(sender);
Sleep(10000);
showMessage('تمت عملية الحفظ بنجاح');
end;
كود الإسترجاع
procedure TForm4.BitBtn1Click(Sender: TObject);
begin
Sleep(1000);
DModule.OnDestroy(sender);
copyfile(pchar(ComboBox1.Text+SpinEdit1.text),pcha r('teste.ABS'),false);
DModule.OnCreate(sender);
Sleep(10000);
showMessage('تمت علية الإسترجاع بنجاح');
Close;
end;
ملاحظة
يجب ان تكون قاعدة البيانات موجودة داخل البرنامج
وبالتوفيق
Anter2010
01-10-2010, 02:59 PM
السلام عليكم و رحمة الله تعالى و بركاته
مشكور اخي لكن ليس هذا هو المطلوب
kachwahed
01-10-2010, 03:23 PM
قد قمت باغلاقها و ذالك في
ليس كذلك، يكفي غلق TABSDatabase ثم إعادة فتحه بعد النسخ...
منذ قليل ثبتت المكونات وقمت بالنسخ...
مر كل شيء على ما يرام وتم النسخ بسلام
باستخدام الدالة التي أعطيتك في المشروع الذي أرفقته
ودون الحاجة أصلا لغلق قاعدة البيانات
تم التجريب على Delphi 7
المثال مرفق فقط ضع قاعدة البيانات في المجلد Data
ثم أطعلنا على النتيجة :)
بالتوفيق.
Anter2010
01-10-2010, 09:38 PM
السلام عليكم و رحمة الله تعالى و بركاته
اخي كاش و احد بارك الله فيك النتيجة صالحة 100% :)
لكن كانت غايتي حفظ قاعدة البيانات على شكل stock2010,stock2011
الا يمكن فعل ذالك :(
بارك الله فيك مجددا تشكر على تعبك
kachwahed
01-10-2010, 09:56 PM
حاول:
function Backup(const Source, Dest: string; Overwrite: Boolean = False): Boolean;
begin
Result := CopyFile(PChar(Source), PChar(Dest), Overwrite);
end;
...
if SelectDirectory('Select folder backup...', '', sDir) then
if Backup(data.DataBase.DatabaseFileName, IncludeTrailingPathDelimiter(sDir)+'Stock'+edAnnee .Text+'.ABS') then
ShowMessage('Backup succesfull!');
بالتوفيق.
Anter2010
01-10-2010, 10:49 PM
السلام عليكم و رحمة الله تعالى و بركاته
يا استاذ هذا هو المطلوب باذن الله
الله ينور عليك يا استاذ :):)
ZMXXX
01-12-2010, 04:29 PM
حاول:
procedure tform1.nouvelebase;
var db1,db2,data:string;
d:tdate;
ar:boolean ;
begin
reparer;
ar:=false;
d:=now();
data:=extractfilepath(application.exename)+'data\' ;
data:=data + 'info'+ formatdatetime('yyyy ',d)+'.abs';
dtmdl1.absd1.close;
db1:=data1;
if copyfile(pchar(db1),pchar(data),true) then
begin
showmessage('fichier sauvgarder');
end;
dtmdl1.absd1.databasefilename:=data1;
dtmdl1.abst1.emptytable;
dtmdl1.abst3.emptytable;
dtmdl1.abstrecete.emptytable;
dtmdl1.abstable2.emptytable;
dtmdl1.abstable3.emptytable;
reparer;
ouvirirbase();
end;
بالتوفيق.
alili mostafa
10-12-2010, 01:04 PM
إستعمل هذا الكود لحفظ فاعدة البيانات
procedure TForm1.Button1Click(Sender: TObject);
var Err,Repertoire:string;
begin
Repertoire := ExtractFilePath(Application.ExeName);
SaveDialog1.Filter:='Fichier Base de données |*.ABS';
SaveDialog1.FileName:='MaBase';
if SaveDialog1.Execute then
begin
if SaveDialog1.FileName<>'' then
begin
try
ABSDatabase1.Connected:=false;
if not ABSDatabase1.RepairDatabase(SaveDialog1.FileName+' .ABS',Err)then
begin
messagebox(0,Pchar('Certains erreurs trouvées lors de sauvegarde de la base de données - Détail d''erreurs :'+#13+#10+Err), 'Erreur lors de sauvegarde', mb_yesno+MB_ICONEXCLAMATION );
ABSDatabase1.DatabaseFileName:=Repertoire+'Data.ab s';
ABSDatabase1.Connected:=True;
exit;
end;
finally
messagebox(0,pchar('Sauvegarde (BackUp) de la base de données terminé'), 'Sauvegarde "Backup"', mb_ok+MB_ICONEXCLAMATION );
ABSDatabase1.DatabaseFileName:=Repertoire+'Data.ab s';
ABSDatabase1.Connected:=True;
end;
end;
end;
و هذا لالإسترجاع
procedure TForm1.Button2Click(Sender: TObject);
var Repertoire:string;
begin
Repertoire := ExtractFilePath(Application.ExeName);
OpenDlg.Filter:='Fichier Base de données |*.ABS';
if OpenDlg.Execute then
begin
if OpenDlg.FileName<>'' then
begin
try
ABSDatabase1.Connected:=false;
CopyFile(PChar(OpenDlg.FileName), PChar(Repertoire+'Data.abs'), false);
ABSDatabase1.DatabaseFileName:=Repertoire+'Data.ab s';
ABSDatabase1.Connected:=True;
finally
messagebox(0,pchar('Chargement de la base de données terminé'), 'Chargement de la base de données', mb_ok+MB_ICONEXCLAMATION );
end;
end;
end;
end;
vBulletin® , Copyright ©2008-2012