Konuyu Paylaş : facebook gplus twitter

Konuyu Oyla:
  • Derecelendirme: 5/5 - 1 oy
  • 1
  • 2
  • 3
  • 4
  • 5
MSSQL Veri Tabanı Yedekleme Sıkıştırma ve FTP ye Gönderim - Delphi Konsol Uygulaması
#1
Merhaba,

MSSQL veri tabanını otomatik olarak yedekleyip, sıkıştırıp, bir FTP sunucuya da yedekleyebileceğiniz ve bu tanımların tamamının parametrik olduğu, her şekilde çalıştırabileceğiniz Smile (komut satırı, zamanlanmış görev, elle)  bir konsol uygulamasını paylaşıyorum. Faydalı olacağını umarım. 

Proje;
program madbcs;

{$APPTYPE CONSOLE}

uses
 SysUtils, IniFiles, Forms, DB, DBAccess, Uni, UniProvider, SQLServerUniProvider,
 ShellAPI, Windows, Controls, Classes,
 idftp, IdFTPListTypes, IdFTPCommon, IdFTPList;

var
 conn : TUniConnection;

 madINIFile  : TIniFile;
 FirstRun        : string;

 db_host         : string;
 db_port         : integer;
 database        : string;
 db_user         : string;
 db_password     : string;

 ftp_host        : string;
 ftp_port        : integer;
 ftp_user        : string;
 ftp_password    : string;
 ftp_path        : string;
 ftp_status      : integer;
 ftp_send_on_compression_error : integer;

 backup_file     : string;
 backup_file_full  : string;
 compressed_file : string;
 upload_file     : string;

 backup_path     : string;
 backup_database : string;
 backup_status   : integer;
 backup_compression : integer;
 backup_delete_original_when_compression_success : integer;

 compression_result : Boolean;

 ErrMsg : String;
 msg : String;

 function Encrypt(const AText: WideString; APassword : WideString): WideString; external 'Rijndael.dll';
 function Decrypt(const AText: WideString; APassword : WideString): WideString; external 'Rijndael.dll';

 function getIniParam(caption : String; param : String; defvalue : String = ''; hashed : Boolean = false) : String;
 var
   _INIFile : TIniFile;
   ret : String;
 begin
   try
     _INIFile := TIniFile.Create(ExtractFilePath(Application.ExeName)+
        'mad.ini');
     ret := _INIFile.ReadString(caption,param,defvalue);
     if hashed then begin
       ret := Decrypt(ret,'852357jMl???');
     end;
   except
     //
   end;

   _INIFile.Free;

   result := ret;
 end;

 function SearchAndReplace(
   sSrc, sLookFor, sReplaceWith
   : string )
     : string;
 var
   nPos,
   nLenLookFor : integer;
 begin
   nPos        := Pos( sLookFor, sSrc );
   nLenLookFor := Length( sLookFor );
   while(nPos > 0)do
   begin
     Delete( sSrc, nPos, nLenLookFor );
     Insert( sReplaceWith, sSrc, nPos );
     nPos := Pos( sLookFor, sSrc );
   end;
   Result := sSrc;
 end;

 procedure Split(const Delimiter: Char; Input: string; const Strings: TStrings) ;
 begin
   Assert(Assigned(Strings)) ;
   Strings.Clear;
   Strings.Delimiter := Delimiter;
   Strings.DelimitedText := Input;
 end;

 procedure connectDB;
 begin
   conn := TUniConnection.Create(nil);
   conn.ProviderName := 'SQL Server';
   conn.Server       := db_host;
   conn.Port         := db_port;
   conn.Database     := database;
   conn.Username     := db_user;
   conn.Password     := db_password;
   conn.LoginPrompt  := false;

   try
     conn.Connect;
     Writeln('SQL Server Baglantisi Kuruldu');
   except
     Writeln('SQL Server Baglantisi Kurulamadi');
   end;
 end;

 procedure disconnectDB;
 begin
   if conn.Connected then begin
     conn.Connected := false;
     Writeln('SQL Server Baglantisi Kapatildi');
   end;
 end;

 procedure backup;
 var
   dset_backup : TUniQuery;
   backup_query : string;
   simdi : tdatetime;
   saniye, dakika, saat, gun, ay, yil : string;
   formatstring : string;
 begin
   simdi := now;

   saniye := FormatDateTime('ss', simdi);
   dakika := FormatDateTime('nn', simdi);
   saat := FormatDateTime('hh', simdi);
   gun := FormatDateTime('dd', simdi);
   ay := FormatDateTime('mm', simdi);
   yil := FormatDateTime('yyyy', simdi);

   formatstring := gun + '_' + ay + '_' + yil + '_' + saat + '_' + dakika + '_' + saniye;

   dset_backup := TUniQuery.Create(nil);
   dset_backup.Connection := conn;

   dset_backup.SQL.Clear;
   dset_backup.SQL.Add('use master');
   dset_backup.Execute;

   dset_backup.SQL.Clear;
   dset_backup.SQL.Add('select * from master..sysdevices where status=16 and name=''MAD_BACKUP_DEVICE''');
   dset_backup.Execute;

   if dset_backup.RecordCount > 0 then begin
     dset_backup.SQL.Clear;
     dset_backup.SQL.Add('exec sp_dropdevice ''MAD_BACKUP_DEVICE''');
     dset_backup.Execute;
   end;

   backup_file := backup_database + '_' + formatstring + '.bak';
   compressed_file := backup_database + '_' + formatstring + '.rar';
   backup_file_full := backup_path + backup_file;
   backup_query := 'BACKUP DATABASE ' + backup_database + ' TO MAD_BACKUP_DEVICE;';

   dset_backup.SQL.Clear;
   dset_backup.SQL.Add('exec sp_addumpdevice ''disk'',''MAD_BACKUP_DEVICE'',''' + backup_file_full + '''');
   dset_backup.Execute;

   WriteLn('Yedekleme Basladi...');

   dset_backup.SQL.Clear;
   dset_backup.SQL.Add(backup_query);
   dset_backup.Execute;

   WriteLn('Yedekleme Tamamlandi...');

   FreeAndNil(dset_backup);
 end;

 function ShellExecute_AndWait(FileName: string; Params: string): bool;
 var
   exInfo: TShellExecuteInfo;
   Ph: DWORD;
 begin

   FillChar(exInfo, SizeOf(exInfo), 0);
   with exInfo do
   begin
     cbSize := SizeOf(exInfo);
     fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
     Wnd := GetActiveWindow();
     exInfo.lpVerb := 'open';
     exInfo.lpParameters := PChar(Params);
     lpFile := PChar(FileName);
     nShow := SW_HIDE;
   end;
   if ShellExecuteEx(@exInfo) then
     Ph := exInfo.hProcess
   else
   begin
     Writeln(SysErrorMessage(GetLastError));
     Result := true;
     exit;
   end;
   while WaitForSingleObject(exInfo.hProcess, 50) <> WAIT_OBJECT_0 do
     Application.ProcessMessages;
   CloseHandle(Ph);

   Result := true;

 end;

 procedure compress;
 var
   filename : string;
   parameters : string;
   full_params : PansiChar;
 begin
   filename := 'rar.exe';
   parameters := 'a ' + backup_path + compressed_file + ' ' + backup_file_full;
   full_params := pansichar(AnsiString(filename + ' ' + parameters));

   WriteLn('SIKISTIRMA Basladi...');

   // ShellExecute(0, 'open', pchar(filename), pchar(parameters), '',SW_HIDE);

     // WinExec(full_params, SW_HIDE);

   // ShellExecute(0, nil, pchar('cmd.exe'), pchar('/C ' + filename + ' ' + parameters), nil, SW_HIDE);

   if ShellExecute_AndWait(filename, parameters) then
   begin
     WriteLn('SIKISTIRMA Tamamlandi...');
     compression_result := true;
     if backup_delete_original_when_compression_success = 1 then
     begin
       DeleteFile(PWideChar(backup_file_full));
       WriteLn('Orjinal Yedek Dosyasi Silindi...');
     end;
   end else begin
     WriteLn('SIKISTIRMA Basarisiz...');
     compression_result := false;
   end;
 end;

 procedure sendFTP;
 var
   madftp : TIdFTP;
   mes : string;
 begin
   if backup_compression = 1 then
   begin
     if compression_result then
     begin
       // sıkıştırılmış dosyayı gönder
       upload_file := compressed_file;
     end else begin
       if ftp_send_on_compression_error = 1 then
       begin
         // Orjinal dosyayı gönder.
         upload_file := backup_file;
       end else begin
         WriteLn('SIKISTIRMA Hatali Oldugundan FTP ye Gonderilmedi...');
         exit;
       end;
     end;
   end else begin
     upload_file := backup_file;
   end;

   madftp := TIdFTP.Create(nil);
   madftp.Host := ftp_host;
   madftp.Port := ftp_port;
   madftp.Passive := true;
   madftp.authcmd := tAuto;
   madftp.transfertype := ftBinary;
   madftp.Username := ftp_user;
   madftp.Password := ftp_password;
   madftp.Connect;

   Writeln('FTP Sunucu Baglantisi Kuruldu');

   // madftp.ChangeDir('public_html/stokimages');
   if length(trim(ftp_path)) > 0 then begin
     madftp.ChangeDir(ftp_path);
   end;

   Writeln('VT Yedegi FTP ye Yukleniyor -> ' + upload_file);

   madftp.Put(backup_path + upload_file,upload_file,false);
   Writeln('VT Yedegi FTP ye Yuklendi -> ' + upload_file);

   madftp.Disconnect;
   Writeln('FTP Sunucu Baglantisi Kapatildi');

   madftp.Free;
 end;

begin
 try
   { TODO -oUser -cConsole Main : Insert code here }
   Writeln('*** Mahmut Dokumaci - MS SQL Server Backup, Compress and FTP Upload Tool v1.0 ***');
   
   if not FileExists(ExtractFilePath(Application.ExeName)+'mad.ini') then begin
     WriteLn('Yapilandirma Dosyasi Eksik');
     exit;
   end;

   madINIFile    := TIniFile.Create(ExtractFilePath(Application.ExeName)+'mad.ini');

   FirstRun      := madINIFile.ReadString('MAD','FirstRun','0');

   db_host       := madINIFile.ReadString('DB','Server','');
   db_port       := StrToInt(madINIFile.ReadString('DB','Port','0'));
   database      := madINIFile.ReadString('DB','Database','');
   db_user       := madINIFile.ReadString('DB','User','');

   ftp_host      := madINIFile.ReadString('FTP','Server','');
   ftp_port      := StrToInt(madINIFile.ReadString('FTP','Port','0'));
   ftp_path      := madINIFile.ReadString('FTP','Path','');
   ftp_user      := madINIFile.ReadString('FTP','User','');
   ftp_status    := StrToInt(madINIFile.ReadString('FTP','Status','0'));
   ftp_send_on_compression_error    := StrToInt(madINIFile.ReadString('FTP','SendOnCompressionError','0'));

   backup_path         := madINIFile.ReadString('Backup','Path','');
   backup_database     := madINIFile.ReadString('Backup','Database','');
   backup_status       := StrToInt(madINIFile.ReadString('Backup','Status','0'));

   backup_compression  := StrToInt(madINIFile.ReadString('Compression','Status','0'));
   backup_delete_original_when_compression_success  := StrToInt(madINIFile.ReadString('Compression','DeleteOriginalWhenSuccess','0'));

   if FirstRun = '1' then
   begin
     db_password   := madINIFile.ReadString('DB','Password','-');
     ftp_password  := madINIFile.ReadString('FTP','Password','-');
     Writeln('ilk Yapilandirma Ayarlari Algilandi ve Uyarlandi');
     madINIFile.WriteString('MAD','FirstRun','0');
     madINIFile.WriteString('DB','Password',Encrypt(db_password,'852357jMl???'));
     madINIFile.WriteString('FTP','Password',Encrypt(ftp_password,'852357jMl???'));
     exit;
   end;

   db_password   := Decrypt(madINIFile.ReadString('DB','Password','-'),'852357jMl???');
   ftp_password  := Decrypt(madINIFile.ReadString('FTP','Password','-'),'852357jMl???');

   connectDB;

   if backup_status = 1 then
   begin
     backup;
   end else begin
     Writeln('Yedekleme Pasif Oldugu icin islem iptal edildi...');
     disconnectDB;
     exit;
   end;

   disconnectDB;

   if backup_compression = 1 then
   begin
     compress;
   end else begin
     Writeln('SIKISTIRMA Pasif...');
   end;

   if ftp_status = 1 then
   begin
     sendFTP;
   end else begin
     Writeln('FTP Gonderimi Pasif...');
   end;
 except
   on E: Exception do
   begin
     disconnectDB;
     Writeln(E.ClassName, ': ', E.Message);
   end;
 end;
end.

mad.ini dosyası içeriği;

[DB]
Server=x.y.z.t
Port=1433
Database=xyz
User=abc
Password=AAjcM0WrUSlfbBR5EtcPS8sxyBrqiyZRBwDh3XBBOxCSm4X2OSA=

[MAD]
FirstRun=1

[FTP]
Server=ftp.adres.com
Port=21
Path=/
User=abc
Password=6l7GU7LYt04pVHc/00d7JuGgEUC0pLPPpGaEAQOqivUMl5PVxeCdDiwO
Status=0
SendOnCompressionError=0

[Backup]
Path=C:\MADBCS\
Database=xyz
Status=1

[Compression]
Status=1
DeleteOriginalWhenSuccess=0
Cevapla
#2
Teşekkürler.
Cevapla
#3
Ellerinize sağlık ancak gönderdiğiniz örneklerde memory leak var Wink 

connectDB 'de %100
backup,
sendFTP 'de çok yüksek oranda ve program body'sinde de %100 memory leak söz konusu. Sızıntıları gidermeniz temennisi ile :-)
Mal sahibi, mülk sahibi
Hani bunun ilk sahibi ?
Mal da yalan mülk de yalan
Var biraz da sen oyalan...
WWW
Cevapla

Konuyu Paylaş : facebook gplus twitter



Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Son Yorum
  MSSQL Insert Türkçe Karakter Sorunu hi_selamlar 17 459 02-09-2018, Saat: 22:28
Son Yorum: hi_selamlar
  MSSQL Sistem Taşıması Hakkında adelphiforumz 8 452 21-04-2018, Saat: 02:30
Son Yorum: FiRewaLL
  MSSQL Server Hakkında Bilmek İstedikleriniz esrehmaan 23 2.639 19-02-2018, Saat: 09:57
Son Yorum: klavye
  MSSQL Server 2008 R2 Express Mail Göndermek pro_imaj 14 1.880 29-04-2017, Saat: 15:14
Son Yorum: DelphiCanR
Photo Sql Management'da çalışan komut Delphi'de çalışmıyor. cinarbil 9 1.294 08-04-2017, Saat: 09:01
Son Yorum: esistem



Konuyu Okuyanlar: 1 Ziyaretçi