publicfunction.~pas

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

unit PublicFunction;

interface
uses
  Windows, SysUtils, StrUtils, Classes, WinSvc, Controls, ShellAPI, IniFiles, DB, mySQLDbTables,
  IdBaseComponent,  IdComponent, IdUDPBase, IdUDPClient,IdTCPConnection, IdFTPCommon,IdTCPClient,
  IdExplicitTLSClientServerBase, IdFTP;
//全局函数
procedure LogAlarmToText(sContent: string);
function ChkDirectory(BFML:string;AZML:string):boolean;
function ServiceStart(sMachine,sService:String):Boolean;
function ServiceStop(sMachine, sService: String):Boolean;
procedure StarAllServices(sMachine:string;ServiceNum:Integer;ServiceName:array of string);
function StopAllServices(sMachine:string;ServiceNum:Integer;ServiceName:array of string):Boolean;
function CheckService(sMachine, sService:string):string;
function DelDirectory(const Source:string):boolean;
procedure DelBackUpFile(BackUpCopy:Integer;BFML:string);
function CopyDirectory(const Source, Dest: string): boolean;
procedure FreeSystemMemory;
procedure ReadIniFile;
procedure UploadPerFTP(sSourceDir,sTargetDir:string;FtpClient:TIdFTP);

//以下函数用于移动短信
function IM_Init(IM_IP,IM_UserName,IM_UserPassword,IM_ApiName:string):Integer;
function IM_SendSM(SmContent:string;WapSmUrl:string;SMID:LongInt;SmMobile:string):LongInt;

//定义全局常量
const
    SM_MOBILE_LEN = 16;    //手机号码最大长度
    SM_CONTEXT_LEN = 260; //短信内容最大长度
    SM_MT_DESC = 100;     //回执描述最大长度
// MT短信回执信息的消息体
type
    TRPT_BODY = packed record
    mobile : array[0..SM_MOBILE_LEN-1] of char;        // MT发送的手机号码
    smId : LongWord;                                   //MT短信唯一ID号或出错代码
    rptId : integer;                                   //MT的回执编码
    rptDesc : array[0..SM_MT_DESC-1] of char;          // MT的回执描述信息
end;
    pRPT_BODY = ^TRPT_BODY;

// MO短信信息消息体
type
    TMO_BODY = packed record
    mobile : array[0..SM_MOBILE_LEN-1] of char;        // 发送MO的手机号码
    smContent : array[0..SM_CONTEXT_LEN-1] of char;    // MO的短信内容
    smId : LongWord;                                   //MO短信唯一ID号或出错代码
end;
    pMO_BODY = ^TMO_BODY;


//申请函数原型
type
    //初始化
    TInit = function(const ip: pchar;
                     const username: pchar;
                     const password: pchar;
                     const apiCode: pchar
                     ): integer; stdcall;

    //释放
    TRelease = function () :integer; stdcall;

    //短信发送
    TApiSendSm = function (const mobile: pchar;
                           const content: pchar;
                           const smId: longint
                           ): Longint; stdcall;

    //Wap Push短信发送
    TApiSendWapPushSm = function (const mobile: pchar;
                                  const content: pchar;
                                  const smId: longint;
                                  const url: pchar
                                  ): Longint; stdcall;

    //接收回执，返回查询到的回执数，并删除这些回执
    TApiReceiveRPT = function (pRptBody: pRPT_BODY;
                               const retSize: integer
                               ): integer; stdcall;

    //接收短信，返回查询到的短信数，并删除这些短信
    TApiReceiveMO = function  (pMoBODY: pMO_BODY;
                               const retSize: integer
                               ): integer; stdcall;
var
  //备份是否在进行，进行时不转发短信
  pvbBackUpRunning:Boolean;
  //OA数据库是否已连接
  pvbOADBConnected:Boolean;
//以下变量用于短信网关配置
  //[IM_API]
  //#短信网关IP
  pvsIM_IP:string;
  //#接口名称
  pvsIM_ApiName:string;
  //#用户名
  pvsIM_UserName:string;
  //#用户密码
  pvsIM_UserPassword:string;
  //#接收短信号码
  pvsIM_Phone:string;

//以下变量用于移动短信网关
  init: TInit;
  ApiRelease: TRelease;
  ApiSendSm: TApiSendSm;
  ApiSendWapPushSm: TApiSendWapPushSm;
  ApiReceiveRPT: TApiReceiveRPT;
  ApiReceiveMO: TApiReceiveMO;
  DllHandle: THandle;
  nIMResult : integer;
  nCount : integer;
  
//以下变量用于OA备份
  sAZML: string;//OA安装目录
  sBFML: string;//OA备份目录
  bCompress: Boolean;//是否压缩备份
  bBackUpMulti: Boolean;//是否分卷压缩
  iBlockSize: Int64;//分卷文件大小Bytes
  bAutoBackUp: Boolean;//是否自动备份
  iBackUpHour,iBackUpMinute: Integer;//自动备份时间
  iBackUpScheme: Integer;//自动备份计划
  bPutFtp: Boolean;//将压缩文件上传到FTP服务器
  iServiceNUM: Integer;//备份过程需要停止的系统服务数
  sServiceName: array of string;//备份过程需要停止的系统服务名
  bFreeMemory: Boolean;//是否动态释放内存
  iBackUpCopy: Integer;//系统保留几个备份
  sRemoveHost: string;//远程主机名-可以停止远程主机的服务

//以下用于传送数据到FTP服务器
  pvb_Ftp_Action:Boolean;
  pvi_Ftp_Hour:Integer;
  pvi_Ftp_Minute:Integer;
  pvs_Ftp_Host:string;
  pvs_Ftp_userName:string;
  pvs_Ftp_Password:string;
  pvs_Ftp_Num:Integer;
  pvs_Ftp_LocalDir:array of string;
  pvs_Ftp_FtpDir:array of string;

implementation

//将字符串写入文本文件
procedure LogAlarmToText(sContent: string);
var
  f: TextFile;
  sFileName: string;
//  Year, Month, Day, Hour, Min, Sec, MSec: Word;
  Year, Month, Day: Word;
begin
  if sContent = '' then Exit;
  DecodeDate(Now,Year,Month,Day);
  sFileName := 'CW-AutoBackup-' + FormatDateTime('yyyy-mm',Now) + '.log';
  if FileExists(sFileName) then
    begin
      AssignFile(f, sFileName);
      Append(f);
    end
  else begin
      AssignFile(f, sFileName);
      Rewrite(f);
  end;
//  Writeln(f, DateTimeToStr(Now) + ' ' + sContent);
  Writeln(f, FormatDateTime('yyyy-mm-dd hh:nn:ss',Now) + ' ' + sContent);
  Flush(f);
  CloseFile(f);
end;

//检查源、目标目录，目标目录不存在则创建
function ChkDirectory(BFML:string;AZML:string):boolean;
var
  sDir,sTemp,s: WideString;
  nTemp: Integer;
begin
  {$I-}
  sDir := Trim(BFML) + '\' + FormatDateTime('yyyy-mm-dd',Date);
  //检查安装目录是否存在,不存在则中止
  if not DirectoryExists(Trim(AZML)) then
    begin
      Result := False;
      Exit;
    end;
  //检查备份目录是否存在，不存在则创建
  if not DirectoryExists(sDir) then
    begin
      nTemp := Pos('\',sDir);
      if nTemp = 0 then
        begin
          Result := False;
          Exit;
        end
      else begin
        while nTemp > 0 do begin
          s := RightStr(sDir,(Length(sDir) - nTemp));
          sTemp := Copy(sDir,1,nTemp-1);
          if not DirectoryExists(sTemp) then begin
            MkDir(sTemp);
            if IOResult <> 0 then//创建目录失败
              begin
                Result := False;
                Exit;
              end;
          end;
          if Pos('\',s) > 0 then
            nTemp := nTemp + Pos('\',s)
          else begin
            MkDir(sDir);
            if IOResult <> 0 then
              begin
                Result := False;
                Exit;
              end;
            nTemp := 0;//break;退出循环
          end;
        end;
      end;
    end;
    Result := True;//能执行到这里说明源、目标目录均存在或创建成功
end;

{
ServiceStart('','MSSQLSERVER')
this would be local services
ServiceStart('\\computername','Alerter');
this would be for remote services
}
//启动指定的系统服务
function ServiceStart(sMachine,sService:String):Boolean;
var
  schm,schs :SC_Handle;
  ss :TServiceStatus;
  psTemp: PChar;
begin
  schm := OpenSCManager(PChar(sMachine), nil, SC_MANAGER_CONNECT);
  if (schm>0) then
    begin
      schs := OpenService(schm,PChar(sService),SERVICE_START or SERVICE_QUERY_STATUS);
      if (schs>0) then
        begin
          //服务是否已经在运行
          QueryServiceStatus(schS, ss);
          if (ss.dwCurrentState = SERVICE_RUNNING) then//服务已经在运行
            begin
              Result := True;
            end
          else begin
              psTemp := nil;
              //服务不在运行状态，启动
              if (StartService(schs, 0, psTemp)) then
                begin
                  //延时3秒后循环检查服务状态
                  Sleep(3000);
                  while (QueryServiceStatus(schS,ss)) do
                  begin
                    if (ss.dwCurrentState = SERVICE_START_PENDING) then//服务启动中
                      Sleep(1000)
                    else
                      break;
                  end;
                  //判断是否启动成功
                  if (ss.dwCurrentState = SERVICE_RUNNING) then
                    Result := True
                  else
                    Result := False;
                end
              else
                Result := False;
          end;
          //关闭打开的服务句柄
          CloseServiceHandle(schs);
        end
      else
        Result := False;
      //关闭打开的服务句柄
      CloseServiceHandle(schm);
    end
  else
    Result := False;
end;

function ServiceStop(sMachine,sService:String):Boolean;
var
  schm,schs: SC_Handle;
  ss: TServiceStatus;
begin
  Result := True;
  schm := OpenSCManager(PChar(sMachine), nil, SC_MANAGER_CONNECT);
  if (schm>0) then
    begin
      schs := OpenService(schm, PChar(sService), SERVICE_STOP or SERVICE_QUERY_STATUS);
      if (schs>0) then
        begin
          //服务是否已经在运行
          QueryServiceStatus(schS, ss);
          if (ss.dwCurrentState = SERVICE_STOPPED) then
            Result := True//服务已经停止
          else begin
            //服务正在运行，发送停止命令
            if (ControlService(schs, SERVICE_CONTROL_STOP, ss)) then
              begin
                //3秒后循环检查服务停止状态
                Sleep(3000);
                while (QueryServiceStatus(schs,ss)) do
                begin
                  if (ss.dwCurrentState = SERVICE_STOP_PENDING) then
                    Sleep(1000)//正在停止服务
                  else
                    break;
                end;
                if (ss.dwCurrentState = SERVICE_STOPPED) then
                  Result :=True//正常停止
                else
                  Result := False;//其它未知状态
              end;
          end;
          //关闭打开的服务句柄
          CloseServiceHandle(schs);
        end
      else
        Result := False;
      //关闭打开的服务句柄
      CloseServiceHandle(schm);
    end
  else
    Result := False;
end;

//启动所有指定的服务
procedure StarAllServices(sMachine:string;ServiceNum:Integer;ServiceName:array of string);
var
  i:Integer;
  bResult:Boolean;
begin
  //后停止的服务先启动
  for i := ServiceNUM - 1 downto 0 do begin
    LogAlarmToText('开始启动' + ServiceName[i] + '服务...');
    bResult := ServiceStart(sMachine,ServiceName[i]);//启动服务
    if bResult then
        LogAlarmToText(ServiceName[i] + '服务启动完毕!')
    else
        LogAlarmToText(ServiceName[i] + '服务启动失败!');
  end;
end;

//停止所有指定的服务
function StopAllServices(sMachine:string;ServiceNum:Integer;ServiceName:array of string):Boolean;
var
  i :Integer;
begin
  Result := True;
  for i := 0 to ServiceNUM - 1 do begin
    LogAlarmToText('开始停止' + ServiceName[i] + '服务...');
    Result := ServiceStop(sMachine,ServiceName[i]);//停止服务
    if Result then
      LogAlarmToText(ServiceName[i] + '服务停止完毕!')
    else
      begin
        LogAlarmToText(ServiceName[i] + '服务停止失败，备份计划中断!');
        //注意这里要处理比如第二个服务无法停止情况下要重新启动第一个服务
        //StarAllServices(sMachine,ServiceNum,ServiceName);//尝试启动停止错误的服务
        Break;//跳出循环，检查是否有服务需要重新启动
      end;
  end;
end;

//目录删除
function DelDirectory(const Source:string):boolean;
var
  fo: TSHFILEOPSTRUCT;
begin
  FillChar(fo, SizeOf(fo), 0);
  with fo do
  begin
    Wnd := 0;
    wFunc := FO_DELETE;
    pFrom := PChar(source+#0);
    pTo := #0#0;
    fFlags := FOF_NOCONFIRMATION+FOF_SILENT;//删除目录不提示