servicecwbackup.pas

一个定时备份资料的服务程序。有涉及需停止服务时可自动停止服务并在备份结束后自动启动服务。并可将压缩后的文件或目录FTP备份。内含移动短信机接口代码备份情况可短信通知。

unit ServiceCWBackUp;

interface

uses
  Windows, SysUtils, Controls, SvcMgr, VCLZip, VCLUnZip, IniFiles, DateUtils,
  PublicFunction, Classes, IdBaseComponent,
  IdComponent, IdUDPBase, IdUDPClient,IdTCPConnection, IdFTPCommon,
  IdTCPClient, IdExplicitTLSClientServerBase, IdFTP, StrUtils;
type
  TCW_Auto_Backup = class(TService)
    VCLZipCW: TVCLZip;
    CWFtpClient: TIdFTP;
    procedure VCLZipCWFileNameForSplitPart(Sender: TObject;
      var FName: String; PartNum: Integer; SplitType: TSplitPartType);
    procedure ServiceCreate(Sender: TObject);
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure CWFtpClientStatus(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: String);
    procedure CWFtpClientWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCountMax: Integer);
    procedure CWFtpClientWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
  private
    { Private declarations }
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

type
  MyBackUp = class(TThread)
  private
    { Private declarations }
    MyVCLZIP: TVCLZip;
    MyFtpClient: TIdFTP;
    function BackUP:Boolean;
  protected
    procedure Execute; override;
  public
    constructor Create(CWVCLZIP:TVCLZip;FtpClient:TIdFTP;BackupRun: Boolean);
  end;

type
  MyWatch = class(TThread)
  private
    { Private declarations }
    MyVCLZIP: TVCLZip;
    MyFtpClient : TIdFTP;
  protected
    procedure Execute; override;
  public
    constructor Create(CWVCLZIP:TVCLZip;FtpClient:TIdFTP;ARPRun:Boolean);
  end;

type
  MyFtpClient = class(TThread)
  private
    { Private declarations }
    FtpClient: TIdFTP;
  protected
    procedure Execute; override;
  public
    constructor Create(CWFtpClient:TIdFTP;FtpRun:Boolean);
  end;

var
  CW_Auto_Backup: TCW_Auto_Backup;
  BackUpThread: MyBackUp;
  WatchThread: MyWatch;
  FtpClientThread: MyFtpClient;

implementation

{$R *.DFM}

constructor MyFtpClient.Create(CWFtpClient:TIdFTP;FtpRun:Boolean);
begin
  FtpClient := CWFtpClient;
  inherited Create(FtpRun);
end;

procedure MyFtpClient.Execute;
var
  Hour, Min, Sec, MSec: Word;
  I:Integer;
  bReturn: Boolean;
begin
  while not Terminated do
  begin
    DecodeTime(Now,Hour,Min,Sec,MSec);
    //指定时间到开始FTP备份 //1是星期天
    if pvb_Ftp_Action and (DayOfWeek(Now) = 1) and (Hour = pvi_Ftp_Hour) and (Min = pvi_Ftp_Minute) then begin
      pvbBackUpRunning := True;
      //停止所有相关服务
      bReturn := StopAllServices(sRemoveHost,iServiceNUM,sServiceName);
      if not bReturn then begin
        StarAllServices(sRemoveHost,iServiceNum,sServiceName);
        pvbBackUpRunning := False;
        Exit;
      end;
      for i:=0 to pvs_Ftp_Num -1 do begin
        LogAlarmToText('上传本机目录:' + pvs_Ftp_LocalDir[i] + '到Ftp服务器目录:' + pvs_Ftp_FtpDir[i]);
        UploadPerFTP(pvs_Ftp_LocalDir[i],pvs_Ftp_FtpDir[i],FtpClient);
      end;
      //启动所有相关服务
      StarAllServices(sRemoveHost,iServiceNum,sServiceName);
      pvbBackUpRunning := False;
    end;
    Sleep(30000);
  end;
end;

constructor MyWatch.Create(CWVCLZIP:TVCLZip;FtpClient:TIdFTP;ARPRun:Boolean);
begin
  MyVCLZIP := CWVCLZIP;
  MyFtpClient := FtpClient;
  inherited Create(ARPRun);//False线程建立立即执行
end;

procedure MyWatch.Execute;
var
  Hour, Min, Sec, MSec: Word;
  i :Integer;
  sResult:string;
  bResult:Boolean;
begin
  while not Terminated do begin
    //检查服务是否在运行，若停止则运行
    if not pvbBackUpRunning then begin //备份过程中不检查服务状态
      for i := iServiceNUM - 1 downto 0 do begin
        sResult := CheckService(sRemoveHost,sServiceName[i]);//检查服务
        //记录服务状态日志
//        if (sResult <> 'SERVICE_RUNNING') and (not pvbBackUpRunning) then
        if (sResult <> 'SERVICE_RUNNING') then LogAlarmToText(sServiceName[i] + '服务状态:' + sResult);
        if sResult = 'SERVICE_STOPPED' then begin
          LogAlarmToText('开始重新启动' + sServiceName[i] + '服务...');
          bResult := ServiceStart(sRemoveHost,sServiceName[i]);//启动服务
          if bResult then
              LogAlarmToText(sServiceName[i] + '服务重新启动完毕!')
          else
              LogAlarmToText(sServiceName[i] + '服务重新启动失败!');
        end;//服务重新启动完毕
      end;//所有服务检查完毕！
    end;
    
    //过7点30分备份线程还未结束，重新启动备份线程及所有服务
    DecodeTime(Now,Hour,Min,Sec,MSec);
    if pvbBackUpRunning and ((Hour > 6 ) and (Min >= 30)) then begin
        BackUpThread.Terminate;
        Sleep(3000);
        BackUpThread := nil;
        BackUpThread := MyBackUp.Create(MyVCLZIP,MyFtpClient,False);
        if BackUpThread <> nil then LogAlarmToText('CW自动备份线程重新启动。') else LogAlarmToText('CW自动备份线程重新启动失败!');
        pvbBackUpRunning := False;
        Continue;//立即检查服务状态
    end;//过7点30分强行启动服务

    Sleep(30000);//30秒检查一次
    ReadIniFile;//30秒重新读取一次配置文件
  end;
  LogAlarmToText('CW服务守护线程停止。');
end;

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  CW_Auto_Backup.Controller(CtrlCode);
end;

function TCW_Auto_Backup.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

function MyBackUp.BackUP:Boolean;
var
  sDir: string;
  nTemp: Integer;
  iRet  : LongInt;
begin
  //检查源、目标目录是否存在.源目录不存在无法执行备份
  Result := ChkDirectory(sBFML,sAZML);
  if not Result  then begin
    LogAlarmToText('源目录不存在，备份中止！');
    Exit;
  end;
  //停止所有指定的服务
  Result := StopAllServices(sRemoveHost,iServiceNUM,sServiceName);
  if not Result then begin
    StarAllServices(sRemoveHost,iServiceNum,sServiceName);
    Exit;
  end;

  //开始备份
  sDir := sBFML + '\' + DateToStr(Date);
  //压缩备份
  if bCompress then begin
      LogAlarmToText('开始压缩备份' + sAZML + '目录到' + sDir + '目录...');
      with MyVCLZIP do begin
        BlockMode := bmStandard;//影响压缩文件扩展名
        //是否分卷压缩
        if bBackUpMulti then
          begin
            ZipName := sDir + '\CW_Oracle_BackUp';
            MultiZipInfo.MultiMode := mmBlocks;
            MultiZipInfo.FirstBlockSize := iBlockSize;//第一个压缩文件1G
            MultiZipInfo.BlockSize := iBlockSize;//从第二个文件开始每个压缩文件也1G
          end
        else
          begin
            ZipName := sDir + '\CW_Oracle_BackUp.ZIP';
            //BlockMode := bmStandard;
            MultiZipInfo.MultiMode := mmNone;
          end;
        RootDir := sAZML;
        FilesList.Add('*.*'); //	/* Zip all .PAS files */
        Recurse := True;//	/* Recurse directories */
        RelativePaths := True; //带子目录压缩
        StorePaths := True;//	/* Keep path information */
        PackLevel := 9;//	/* Highest level of compression */
        DoProcessMessages := True;//允许处理主程序请求
        nTemp := Zip;//	/* Return value of Zip is the actual number of files zipped */
      end;
      if (nTemp > 0) then
        begin
          Result := True;
          LogAlarmToText('压缩备份完毕。');
          //备份成功检查已经备份的份数，删除过期的备份
          DelBackUpFile(iBackUpCopy,sBFML);
          //上传到FTP
          if bPutFtp then begin
            LogAlarmToText('上传压缩文件到FTP服务器.');
            UploadPerFTP(sDir,pvs_Ftp_FtpDir[0],MyFtpClient);
            LogAlarmToText('压缩文件上传完毕。');
          end;
        end
      else
        begin
          Result := False;
          LogAlarmToText('压缩备份失败。');