Delphi ile Firebird Yedekleme ve Sweep yapın
Not: fbclient.dll, gbak.exe ve gfix.exe projenin olduğu yerde bulunmalı
unit1.pas
project1.dpr
Not: fbclient.dll, gbak.exe ve gfix.exe projenin olduğu yerde bulunmalı
unit1.pas
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, ExtCtrls, ShellApi, FileCtrl;
type
TForm1 = class(TForm)
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
edtServer: TComboBox;
edtPort: TComboBox;
edtDBPath: TComboBox;
edtUsername: TComboBox;
edtPassword: TComboBox;
edtBackupDir: TComboBox;
btnBrowseBackupDir: TButton;
MemoLog: TMemo;
ProgressBar1: TProgressBar;
btnBackup: TButton;
btnCheckFiles: TButton;
btnSweep: TButton;
procedure btnBackupClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnBrowseBackupDirClick(Sender: TObject);
procedure btnCheckFilesClick(Sender: TObject);
procedure btnSweepClick(Sender: TObject);
private
{ Private declarations }
function CheckRequiredFiles: Boolean;
function ExecuteCommand(const Command, Params: string): Integer;
function FormatFileSize(FileSize: Int64): string;
function GetTimestamp: string;
procedure Log(const Msg: string);
procedure LogError(const Msg: string);
procedure LogSuccess(const Msg: string);
procedure LogWarning(const Msg: string);
function PerformSweep: Boolean;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
// Varsayılan değerleri ayarla
edtServer.Text := '10.0.0.30';
edtPort.Text := '3050';
edtDBPath.Text := '10.0.0.30/3050:E:\KAYITLAR\DATA.FDB';
edtUsername.Text := 'SYSDBA';
edtPassword.Text := 'masterkey';
edtBackupDir.Text := 'E:\YEDEKLER';
// Combobox öğelerini ekle
edtServer.Items.Add('10.0.0.30');
edtServer.Items.Add('localhost');
edtServer.Items.Add('127.0.0.1');
edtPort.Items.Add('3050');
edtPort.Items.Add('3051');
edtDBPath.Items.Add('10.0.0.30/3050:E:\KAYITLAR\DATA.FDB');
edtDBPath.Items.Add('localhost/3050:C:\Data\DATABASE.FDB');
edtUsername.Items.Add('SYSDBA');
edtPassword.Items.Add('ZARGANA');
edtPassword.Items.Add('masterkey');
edtBackupDir.Items.Add('E:\YEDEKLER');
edtBackupDir.Items.Add('C:\Backup');
edtBackupDir.Items.Add('D:\FirebirdBackup');
MemoLog.Clear;
Log('Firebird Yedekleme Uygulaması Başlatıldı');
end;
procedure TForm1.Log(const Msg: string);
begin
MemoLog.Lines.Add(FormatDateTime('hh:nn:ss', Now) + ' - ' + Msg);
Application.ProcessMessages;
end;
procedure TForm1.LogError(const Msg: string);
begin
MemoLog.Lines.Add(FormatDateTime('hh:nn:ss', Now) + ' - ? HATA: ' + Msg);
Application.ProcessMessages;
end;
procedure TForm1.LogSuccess(const Msg: string);
begin
MemoLog.Lines.Add(FormatDateTime('hh:nn:ss', Now) + ' - ? ' + Msg);
Application.ProcessMessages;
end;
procedure TForm1.LogWarning(const Msg: string);
begin
MemoLog.Lines.Add(FormatDateTime('hh:nn:ss', Now) + ' - ! UYARI: ' + Msg);
Application.ProcessMessages;
end;
function TForm1.CheckRequiredFiles: Boolean;
var
MissingFiles: TStringList;
begin
Result := True;
MissingFiles := TStringList.Create;
try
Log('Gerekli Firebird dosyaları kontrol ediliyor...');
if not FileExists('gbak.exe') then
begin
MissingFiles.Add('gbak.exe');
LogError('gbak.exe bulunamadı!');
end;
if not FileExists('gfix.exe') then
begin
MissingFiles.Add('gfix.exe');
LogError('gfix.exe bulunamadı!');
end;
if not FileExists('fbclient.dll') then
begin
MissingFiles.Add('fbclient.dll');
LogError('fbclient.dll bulunamadı!');
end;
// Opsiyonel DLL'ler için uyarı
if not FileExists('icudt30.dll') then
LogWarning('icudt30.dll bulunamadı! (gerekli olabilir)');
if not FileExists('icuin30.dll') then
LogWarning('icuin30.dll bulunamadı! (gerekli olabilir)');
if not FileExists('icuuc30.dll') then
LogWarning('icuuc30.dll bulunamadı! (gerekli olabilir)');
if MissingFiles.Count > 0 then
begin
Result := False;
Log('');
Log('========================================');
Log('EKSİK DOSYA HATASI');
Log('========================================');
Log('Eksik dosyalar: ' + MissingFiles.CommaText);
Log('');
Log('ÇÖZÜM YOLLARI:');
Log('1. Firebird 2.5''in bin klasöründen şu dosyaları kopyalayın:');
Log(' - gbak.exe, gfix.exe, fbclient.dll');
Log(' - icudt30.dll, icuin30.dll, icuuc30.dll');
Log('');
Log('2. Tüm dosyalar şu klasöre kopyalanmalı:');
Log(' ' + GetCurrentDir);
end
else
begin
LogSuccess('Tüm gerekli dosyalar bulundu: gbak.exe, gfix.exe, fbclient.dll');
end;
finally
MissingFiles.Free;
end;
end;
function TForm1.ExecuteCommand(const Command, Params: string): Integer;
var
StartInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
begin
FillChar(StartInfo, SizeOf(TStartupInfo), 0);
FillChar(ProcessInfo, SizeOf(TProcessInformation), 0);
StartInfo.cb := SizeOf(TStartupInfo);
StartInfo.dwFlags := STARTF_USESHOWWINDOW;
StartInfo.wShowWindow := SW_SHOW;
if CreateProcess(nil, PChar(Command + ' ' + Params), nil, nil, False,
CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil,
StartInfo, ProcessInfo) then
begin
WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
GetExitCodeProcess(ProcessInfo.hProcess, Cardinal(Result));
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
end
else
Result := -1;
end;
function TForm1.FormatFileSize(FileSize: Int64): string;
var
SizeMB, SizeKB: Integer;
begin
if FileSize < 1024 then
Result := IntToStr(FileSize) + ' bytes'
else if FileSize < 1048576 then
begin
SizeKB := FileSize div 1024;
Result := IntToStr(SizeKB) + ' KB';
end
else
begin
SizeMB := FileSize div 1048576;
SizeKB := (FileSize mod 1048576) div 1024;
Result := Format('%d MB %d KB', [SizeMB, SizeKB]);
end;
end;
function TForm1.GetTimestamp: string;
begin
Result := FormatDateTime('yyyymmdd_hhnnss', Now);
end;
function TForm1.PerformSweep: Boolean;
var
Server, Port, DBPath, Username, Password: string;
SweepError: Integer;
begin
Result := False;
// Değişkenleri combobox'lardan al
Server := edtServer.Text;
Port := edtPort.Text;
DBPath := edtDBPath.Text;
Username := edtUsername.Text;
Password := edtPassword.Text;
Log('');
Log('*** VERİTABANI SWEEP İŞLEMİ ***');
Log('Sunucu: ' + Server + ':' + Port);
Log('Veritabanı: ' + DBPath);
Log('Sweep başlatılıyor...');
ProgressBar1.Position := 30;
Application.ProcessMessages;
// Sweep işlemi
SweepError := ExecuteCommand('gfix.exe',
Format('-user "%s" -password "%s" -sweep "%s"',
[Username, Password, DBPath]));
ProgressBar1.Position := 80;
Application.ProcessMessages;
if SweepError = 0 then
begin
LogSuccess('Sweep işlemi başarıyla tamamlandı');
Result := True;
end
else
begin
LogError('Sweep işlemi başarısız! Hata kodu: ' + IntToStr(SweepError));
// Hata analizi
case SweepError of
1: LogError('Veritabanı dosyası bulunamadı');
2: LogError('Yetki hatası - Kullanıcı adı veya şifre hatalı');
3: LogError('Ağ bağlantı hatası');
5: LogError('Veritabanı kilitli veya kullanımda');
else LogError('Bilinmeyen hata');
end;
end;
ProgressBar1.Position := 100;
Application.ProcessMessages;
end;
procedure TForm1.btnCheckFilesClick(Sender: TObject);
begin
memolog.Clear;
CheckRequiredFiles;
end;
procedure TForm1.btnBrowseBackupDirClick(Sender: TObject);
var
Dir: string;
begin
Dir := edtBackupDir.Text;
if SelectDirectory('Yedek Klasörünü Seçin', '', Dir) then
edtBackupDir.Text := Dir;
end;
procedure TForm1.btnSweepClick(Sender: TObject);
var
Server, DBPath: string;
begin
memolog.Clear;
// Değişkenleri combobox'lardan al
Server := edtServer.Text;
DBPath := edtDBPath.Text;
// Giriş kontrolleri
if Trim(Server) = '' then
begin
MessageDlg('Sunucu adı boş olamaz!', mtError, [mbOK], 0);
Exit;
end;
if Trim(DBPath) = '' then
begin
MessageDlg('Veritabanı yolu boş olamaz!', mtError, [mbOK], 0);
Exit;
end;
MemoLog.Clear;
Log('Firebird Sweep İşlemi Başladı...');
Log('===============================');
// Gerekli dosyaları kontrol et
if not CheckRequiredFiles then
begin
MessageDlg('Gerekli Firebird dosyaları bulunamadı! Lütfen kontrol edin.', mtError, [mbOK], 0);
Exit;
end;
btnSweep.Enabled := False;
btnBackup.Enabled := False;
btnCheckFiles.Enabled := False;
try
ProgressBar1.Position := 10;
Application.ProcessMessages;
if PerformSweep then
begin
Log('');
Log('========================================');
Log('*** SWEEP İŞLEMİ BAŞARIYLA TAMAMLANDI ***');
Log('========================================');
MessageDlg('Sweep işlemi başarıyla tamamlandı!', mtInformation, [mbOK], 0);
end
else
begin
Log('');
Log('========================================');
Log('*** SWEEP İŞLEMİ BAŞARISIZ ***');
Log('========================================');
MessageDlg('Sweep işlemi başarısız!', mtError, [mbOK], 0);
end;
Log('');
Log('========================================');
Log('İŞLEM TAMAMLANDI');
Log('========================================');
finally
btnSweep.Enabled := True;
btnBackup.Enabled := True;
btnCheckFiles.Enabled := True;
ProgressBar1.Position := 0;
end;
end;
procedure TForm1.btnBackupClick(Sender: TObject);
var
Server, Port, DBPath, Username, Password, BackupDir: string;
BackupFile, Timestamp: string;
BackupError: Integer;
FileSize: Int64;
FileHandle: Integer;
PerformSweepBeforeBackup: Boolean;
begin
memolog.Clear;
// Değişkenleri combobox'lardan al
Server := edtServer.Text;
Port := edtPort.Text;
DBPath := edtDBPath.Text;
Username := edtUsername.Text;
Password := edtPassword.Text;
BackupDir := edtBackupDir.Text;
// Giriş kontrolleri
if Trim(Server) = '' then
begin
MessageDlg('Sunucu adı boş olamaz!', mtError, [mbOK], 0);
Exit;
end;
if Trim(Port) = '' then
begin
MessageDlg('Port numarası boş olamaz!', mtError, [mbOK], 0);
Exit;
end;
if Trim(DBPath) = '' then
begin
MessageDlg('Veritabanı yolu boş olamaz!', mtError, [mbOK], 0);
Exit;
end;
if Trim(Username) = '' then
begin
MessageDlg('Kullanıcı adı boş olamaz!', mtError, [mbOK], 0);
Exit;
end;
if Trim(BackupDir) = '' then
begin
MessageDlg('Yedek klasörü boş olamaz!', mtError, [mbOK], 0);
Exit;
end;
// Kullanıcıya sweep yapıp yapmak istemediğini sor
PerformSweepBeforeBackup := (MessageDlg('Yedekleme öncesi veritabanı sweep işlemi yapılsın mı?',
mtConfirmation, [mbYes, mbNo], 0) = mrYes);
MemoLog.Clear;
Log('Firebird Yedekleme Başladı...');
Log('============================');
// Gerekli dosyaları kontrol et
if not CheckRequiredFiles then
begin
MessageDlg('Gerekli Firebird dosyaları bulunamadı! Lütfen kontrol edin.', mtError, [mbOK], 0);
Exit;
end;
btnBackup.Enabled := False;
btnCheckFiles.Enabled := False;
btnSweep.Enabled := False;
try
// 0. İsteğe bağlı sweep işlemi
if PerformSweepBeforeBackup then
begin
Log('0. Veritabanı sweep işlemi yapılıyor...');
ProgressBar1.Position := 10;
Application.ProcessMessages;
if not PerformSweep then
LogWarning('Sweep işlemi başarısız, yine de yedeklemeye devam ediliyor...')
else
LogSuccess('Sweep işlemi tamamlandı');
Sleep(2000); // 2 saniye bekle
ProgressBar1.Position := 0;
end;
// Timestamp oluştur
Timestamp := GetTimestamp;
BackupFile := IncludeTrailingPathDelimiter(BackupDir) + 'DATA_' + Timestamp + '.fbk';
// Yedek dizini yoksa oluştur
if not DirectoryExists(BackupDir) then
begin
Log('Yedek dizini oluşturuluyor: ' + BackupDir);
if not ForceDirectories(BackupDir) then
begin
LogError('Yedek dizini oluşturulamadı!');
MessageDlg('Yedek dizini oluşturulamadı!', mtError, [mbOK], 0);
Exit;
end;
end
else
begin
Log('Yedek dizini mevcut: ' + BackupDir);
end;
Log('');
Log('*** FIREBIRD UZAK VERİTABANI YEDEKLEME ***');
Log('Çalışma Klasörü: ' + GetCurrentDir);
Log('Sunucu: ' + Server + ':' + Port);
Log('Tarih: ' + DateToStr(Date));
Log('Saat: ' + TimeToStr(Time));
Log('Veritabanı: ' + DBPath);
Log('Yedek Dosyası: ' + BackupFile);
Log('');
ProgressBar1.Position := 10;
Application.ProcessMessages;
// 1. Önce uzak veritabanı bağlantılarını kes
Log('1. Uzak sunucudaki aktif bağlantılar sonlandırılıyor...');
BackupError := ExecuteCommand('gfix.exe',
Format('-user "%s" -password "%s" -shut -force 0 "%s"',
[Username, Password, DBPath]));
if BackupError <> 0 then
LogWarning('Bağlantılar sonlandırılamadı, yine de devam ediliyor...');
ProgressBar1.Position := 30;
Application.ProcessMessages;
Sleep(3000); // 3 saniye bekle
// 2. Yedekleme işlemi - UZAK SUNUCUDAN
Log('2. Uzak sunucudan yedekleme yapılıyor...');
Log('Komut: gbak -b -user "' + Username + '" -password "***" -v "' + DBPath + '" "' + BackupFile + '"');
ProgressBar1.Position := 50;
Application.ProcessMessages;
BackupError := ExecuteCommand('gbak.exe',
Format('-b -user "%s" -password "%s" -v "%s" "%s"',
[Username, Password, DBPath, BackupFile]));
ProgressBar1.Position := 80;
Application.ProcessMessages;
if BackupError = 0 then
begin
LogSuccess('Yedekleme başarıyla tamamlandı: ' + BackupFile);
// Yedek dosya boyutunu göster
if FileExists(BackupFile) then
begin
FileHandle := FileOpen(BackupFile, fmOpenRead);
try
FileSize := FileSeek(FileHandle, 0, 2);
LogSuccess('Yedek dosya boyutu: ' + FormatFileSize(FileSize));
finally
FileClose(FileHandle);
end;
end;
end
else
begin
LogError('Yedekleme başarısız! Hata kodu: ' + IntToStr(BackupError));
end;
// 3. Uzak veritabanını tekrar aç
Log('3. Uzak veritabanı tekrar açılıyor...');
ExecuteCommand('gfix.exe',
Format('-user "%s" -password "%s" -online "%s"',
[Username, Password, DBPath]));
if BackupError <> 0 then
LogWarning('Uzak veritabanı online moda alınamadı!')
else
LogSuccess('Uzak veritabanı online moda alındı.');
ProgressBar1.Position := 100;
Application.ProcessMessages;
// Sonuçları göster
Log('');
if BackupError = 0 then
begin
Log('========================================');
Log('*** UZAK YEDEKLEME İŞLEMİ BAŞARIYLA TAMAMLANDI ***');
Log('========================================');
MessageDlg('Yedekleme işlemi başarıyla tamamlandı!', mtInformation, [mbOK], 0);
end
else
begin
Log('========================================');
Log('*** UZAK YEDEKLEME İŞLEMİ BAŞARISIZ ***');
Log('========================================');
Log('');
Log('DETAYLI HATA ANALİZİ:');
Log('====================');
case BackupError of
1:
begin
Log('HATA 1: Veritabanı dosyası bulunamadı');
Log('ÇÖZÜM: Uzak sunucuda veritabanı dosyasının varlığını kontrol edin');
end;
2:
begin
Log('HATA 2: Yetki hatası - Kullanıcı adı veya şifre hatalı');
Log('ÇÖZÜM: Kullanıcı bilgilerini kontrol edin');
end;
3:
begin
Log('HATA 3: Ağ bağlantı hatası');
Log('ÇÖZÜM:');
Log(' - ' + Server + ':' + Port + ' adresine ping atın');
Log(' - Firewall ayarlarını kontrol edin');
Log(' - Firebird servisinin çalıştığını kontrol edin');
end;
4:
begin
Log('HATA 4: Disk dolu veya dosya yazma hatası');
Log('ÇÖZÜM:');
Log(' - ' + BackupDir + ' klasöründe yeterli alan olduğunu kontrol edin');
Log(' - Yazma yetkilerini kontrol edin');
end;
5:
begin
Log('HATA 5: Veritabanı kilitli veya kullanımda');
Log('ÇÖZÜM: Tüm bağlantıların kapandığından emin olun');
end;
else
begin
Log('HATA ' + IntToStr(BackupError) + ': Bilinmeyen hata');
Log('ÇÖZÜM: Firebird log dosyalarını kontrol edin');
end;
end;
Log('');
Log('GENEL ÇÖZÜM ÖNERİLERİ:');
Log('1. Uzak Firebird servisi çalışıyor mu?');
Log('2. Ağ bağlantısı ve port erişimi var mı? (' + Server + ':' + Port + ')');
Log('3. Kullanıcı adı ve şifre doğru mu?');
Log('4. Uzak sunucuda veritabanı dosyası mevcut mu?');
Log('5. Yerel diskte yeterli alan var mı?');
Log('6. Firebird conf dosyasında RemoteAccess=true ayarı var mı?');
Log('7. Antivirus/firewall engeli var mı?');
MessageDlg('Yedekleme işlemi başarısız! Hata kodu: ' + IntToStr(BackupError), mtError, [mbOK], 0);
end;
Log('');
Log('========================================');
Log('İŞLEM TAMAMLANDI');
Log('========================================');
finally
btnBackup.Enabled := True;
btnCheckFiles.Enabled := True;
btnSweep.Enabled := True;
ProgressBar1.Position := 0;
end;
end;
unit1.dfm
end.
object Form1: TForm1 Left = 286 Top = 50 Width = 708 Height = 595 Caption = 'Firebird Yedekleme ve Sweep Uygulamas'#305 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False OnCreate = FormCreate PixelsPerInch = 96 TextHeight = 13 object GroupBox1: TGroupBox Left = 8 Top = 8 Width = 684 Height = 177 Caption = ' Veritaban'#305' Ba'#287'lant'#305' Ayarlar'#305' ' TabOrder = 0 object Label1: TLabel Left = 16 Top = 24 Width = 39 Height = 13 Caption = 'Sunucu:' end object Label2: TLabel Left = 16 Top = 51 Width = 24 Height = 13 Caption = 'Port:' end object Label3: TLabel Left = 16 Top = 78 Width = 75 Height = 13 Caption = 'Veritaban'#305' Yolu:' end object Label4: TLabel Left = 16 Top = 105 Width = 59 Height = 13 Caption = 'Kullan'#305'c'#305' Ad'#305':' end object Label5: TLabel Left = 16 Top = 132 Width = 26 Height = 13 Caption = #350'ifre:' end object Label6: TLabel Left = 328 Top = 24 Width = 71 Height = 13 Caption = 'Yedek Klas'#246'r'#252':' end object edtServer: TComboBox Left = 96 Top = 21 Width = 200 Height = 21 ItemHeight = 13 TabOrder = 0 Text = '10.0.0.30' end object edtPort: TComboBox Left = 96 Top = 48 Width = 200 Height = 21 ItemHeight = 13 TabOrder = 1 Text = '3050' end object edtDBPath: TComboBox Left = 96 Top = 75 Width = 577 Height = 21 ItemHeight = 13 TabOrder = 2 Text = '10.0.0.30/3050:E:\KAYITLAR\DATA.FDB' end object edtUsername: TComboBox Left = 96 Top = 102 Width = 200 Height = 21 ItemHeight = 13 TabOrder = 3 Text = 'SYSDBA' end object edtPassword: TComboBox Left = 96 Top = 129 Width = 200 Height = 21 ItemHeight = 13 TabOrder = 4 Text = 'masterkey' end object edtBackupDir: TComboBox Left = 408 Top = 21 Width = 225 Height = 21 ItemHeight = 13 TabOrder = 5 Text = 'E:\YEDEKLER' end object btnBrowseBackupDir: TButton Left = 639 Top = 19 Width = 34 Height = 25 Caption = '...' TabOrder = 6 OnClick = btnBrowseBackupDirClick end object btnBackup: TButton Left = 320 Top = 136 Width = 353 Height = 33 Caption = 'YEDEKLEMEY'#304' BA'#350'LAT' Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -16 Font.Name = 'Tahoma' Font.Style = [fsBold] ParentFont = False TabOrder = 7 OnClick = btnBackupClick end object btnCheckFiles: TButton Left = 320 Top = 99 Width = 161 Height = 25 Caption = 'Dosyalar'#305' Kontrol Et' TabOrder = 8 OnClick = btnCheckFilesClick end object btnSweep: TButton Left = 513 Top = 99 Width = 161 Height = 25 Caption = 'Sweep '#304#351'lemi Yap' TabOrder = 9 OnClick = btnSweepClick end end object MemoLog: TMemo Left = 0 Top = 226 Width = 700 Height = 342 Align = alBottom Color = clNone Font.Charset = TURKISH_CHARSET Font.Color = clYellow Font.Height = -11 Font.Name = 'Courier New' Font.Style = [] ParentFont = False ReadOnly = True ScrollBars = ssVertical TabOrder = 1 end object ProgressBar1: TProgressBar Left = 8 Top = 189 Width = 684 Height = 25 TabOrder = 2 end end
project1.dpr
program Project1;
uses
Forms,
Unit1 in 'Unit1.pas' {Form1};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
__________________________
From Now I will only Reading.
From Now I will only Reading.
..