publicfunction.~pas

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

  end;
  Result := (SHFileOperation(fo) = 0);
end;

//删除过期的备份
procedure DelBackUpFile(BackUpCopy:Integer;BFML:string);
var
  dDate:TDate;
  sDir : string;
begin
  dDate := Date - BackUpCopy;

  //删除备份目录
  sDir := BFML + '\' + FormatDateTime('yyyy-mm-dd',dDate);
  while DirectoryExists(sDir) do
  begin
    DelDirectory(sDir);
    dDate := dDate - 1;
    sDir := BFML + '\' + FormatDateTime('yyyy-mm-dd',dDate);
  end;
  //单个文件也放到日期目录里
{
  //删除压缩备份文件,压缩成一个文件或压缩成多个文件
  dDate := dTemp;
  sFileName := BFML + '\OA' + DateToStr(dDate) + '.ZIP';
  while FileExists(sFileName) do
  begin
    DeleteFile(sFileName);
    dDate := dDate - 1;
    sFileName := BFML + '\OA' + DateToStr(dDate) + '.ZIP';
  end;
}
end;

//目录拷贝，目标目录不存在会自动创建
function CopyDirectory(const Source, Dest: string): boolean;
var
  fo: TSHFILEOPSTRUCT;
begin
  FillChar(fo, SizeOf(fo), 0);
  with fo do
  begin
    Wnd := 0;
    wFunc := FO_COPY;
    pFrom := PChar(source+#0);
    pTo := PChar(Dest+#0);
    fFlags := FOF_NOCONFIRMATION+FOF_NOCONFIRMMKDIR+FOF_SILENT;
  end;
  Result := (SHFileOperation(fo) = 0);
end;

{
VER_PLATFORM_WIN32s	System is Win32s.
VER_PLATFORM_WIN32_WINDOWS	System is Windows 95.
VER_PLATFORM_WIN32_NT	System is Windows NT.
Win32Platform is available on Windows only.
}
//动态释放内存
procedure FreeSystemMemory;
begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
    SetProcessWorkingSetSize(GetCurrentProcess, $FFFFFFFF, $FFFFFFFF);
  end;
end;

//短信网关初始化
function IM_Init(IM_IP,IM_UserName,IM_UserPassword,IM_ApiName:string):Integer;
begin
    // 装载DLL
    if FileExists('ImApi.dll') then begin
      DllHandle := LoadLibrary(Pchar('ImApi.dll'));// 实际中用绝对路径
      Result := DllHandle;
      if DllHandle = 0 then
        begin
          //ShowMessage('装载ImApi.DLL 失败');
          Exit;
        end
      else
        begin
           // 得到函数入口地址
          init := GetProcAddress(DllHandle, PChar('init'));
          ApiRelease := GetProcAddress(DllHandle, PChar('release'));
          ApiSendSm := GetProcAddress(DllHandle, PChar('sendSM'));
          ApiSendWapPushSm := GetProcAddress(DllHandle, PChar('sendWapPushSM'));
          ApiReceiveRPT := GetProcAddress(DllHandle, PChar('receiveRPT'));
          ApiReceiveMO := GetProcAddress(DllHandle, PChar('receiveSM'));
        end;
      //初始化
      nIMResult := init(PChar(IM_IP),PChar(IM_UserName),PChar(IM_UserPassword),PChar(IM_ApiName));
      end
    else
      Result := -999;
end;

//通过短信网关发送短信
function IM_SendSM(SmContent:string;WapSmUrl:string;SMID:LongInt;SmMobile:string):LongInt;
begin
    if (WapSmUrl = '') then
      begin
        //发送一般短信
        Result:= ApiSendSm(PChar(SmMobile),PChar(Smcontent),smid);
      end
    else
      begin
        //发送Wap Push 短信
        Result:= ApiSendWapPushSm(PChar(SmMobile),PChar(Smcontent),smid,PChar(WapSmUrl));
      end;
  //Result <0 发送失败
end;

procedure ReadIniFile;
var
  MyIniFile:TIniFile;
  sFileName,sTemp:string;
  i:Integer;
begin
  //参数文件
  sFileName:=ExtractFilePath(Paramstr(0))+'Config.ini';
  MyIniFile:=TiniFile.Create(sFileName);
  
  //是否动态释放内存
  bFreeMemory := MyIniFile.ReadBool('System','FreeMemory',True);

  //CW自动备份参数
  //CW安装目录,默认备份本程序目录-会出错
  sAZML := MyIniFile.ReadString('BackUp','InstallDir',ExtractFilePath(Paramstr(0)));
  //CW备份目录
  sBFML := MyIniFile.ReadString('BackUp','BackupDir','C:\');
  //是否压缩备份
  bCompress := MyIniFile.ReadBool('BackUp','Compress',True);
  //是否分卷压缩
  bBackUpMulti := MyIniFile.ReadBool('BackUp','MultiZip',True);
  //分卷文件大小Byes
  iBlockSize := MyIniFile.ReadInteger('BackUp','BlockSize',1024000000);
  //是否自动备份
  bAutoBackUp := MyIniFile.ReadBool('BackUp','AutoBackUp',True);
  //自动备份时间
  iBackUpHour := MyIniFile.ReadInteger('BackUp','Hour',5);
  iBackUpMinute := MyIniFile.ReadInteger('BackUp','Minute',0);
  //备份频次,默认每天备份
  iBackUpScheme := MyIniFile.ReadInteger('BackUp','Scheme',0);
  //是否将压缩文件上传到FTP服务器
  bPutFtp := MyIniFile.ReadBool('BackUp','PutFtp',True);
  //备份前需要停止的服务数
  iServiceNUM := MyIniFile.ReadInteger('BackUp','ServiceNum',1);
  SetLength(sServiceName,iServiceNUM);
  //备份过程需要停止的系统服务
  for i:=0 to iServiceNUM -1  do
  begin
    sTemp := 'ServiceName' + IntToStr(i);
    sServiceName[i] := MyIniFile.ReadString('BackUp',sTemp,'MYSQL');
  end;
  //保留的不重复备份样本数
  iBackUpCopy := MyIniFile.ReadInteger('BackUp','Copy',1);

  //[IM_API]
  //#短信网关IP
  pvsIM_IP := MyIniFile.ReadString('IM_API','IM_IP','172.30.226.2');
  //#接口名称
  pvsIM_ApiName := MyIniFile.ReadString('IM_API','IM_ApiName','OA');
  //#用户名
  pvsIM_UserName := MyIniFile.ReadString('IM_API','IM_UserName','OA');
  //#用户密码
  pvsIM_UserPassword := MyIniFile.ReadString('IM_API','IM_UserPassword','OAAdmin');
  //#接收短信号码
  pvsIM_Phone := MyIniFile.ReadString('IM_API','IM_Phone','059586381555');

//以下用于传送数据到FTP服务器
  pvb_Ftp_Action:= MyIniFile.ReadBool('FTP','Action',False);
  pvi_Ftp_Hour:= MyIniFile.ReadInteger('FTP','Hour',2);
  pvi_Ftp_Minute:= MyIniFile.ReadInteger('FTP','Minute',0);
  pvs_Ftp_Host:= MyIniFile.ReadString('FTP','Host','172.30.226.8');
  pvs_Ftp_userName:= MyIniFile.ReadString('FTP','UserName','设备维护中心');
  pvs_Ftp_Password:= MyIniFile.ReadString('FTP','Password','sbwhzx');
  pvs_Ftp_Num:= MyIniFile.ReadInteger('FTP','DirNum',1);
  SetLength(pvs_Ftp_LocalDir,pvs_Ftp_Num);
  SetLength(pvs_Ftp_FtpDir,pvs_Ftp_Num);
  for i:=0 to pvs_Ftp_Num -1  do
  begin
    sTemp := 'DIR' + IntToStr(i);
    pvs_Ftp_LocalDir[i]:= MyIniFile.ReadString('FTP',sTemp,'D:\ORANT\DataBase');
    sTemp := 'FtpDir' + IntToStr(i);
    pvs_Ftp_FtpDir[i]:= MyIniFile.ReadString('FTP',sTemp,'CW_BackUp');
  end;

  //释放资源
  MyIniFile.Destroy;
end;

//检查指定的服务状态
function CheckService(sMachine, sService:string):string;
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
          //服务是否已经在运行,//服务已经在运行SERVICE_STOPPED服务启动中SERVICE_STOP_PENDING//SERVICE_START_PENDING
          QueryServiceStatus(schS, ss);
          if (ss.dwCurrentState = SERVICE_RUNNING) then Result := 'SERVICE_RUNNING';
          if (ss.dwCurrentState = SERVICE_STOPPED) then Result := 'SERVICE_STOPPED';
          if (ss.dwCurrentState = SERVICE_START_PENDING) then Result := 'SERVICE_START_PENDING';
          if (ss.dwCurrentState = SERVICE_STOP_PENDING) then Result := 'SERVICE_STOP_PENDING';
          if (ss.dwCurrentState = SERVICE_CONTINUE_PENDING) then Result := 'SERVICE_CONTINUE_PENDING';
          if (ss.dwCurrentState = SERVICE_PAUSE_PENDING) then Result := 'SERVICE_PAUSE_PENDING';
          if (ss.dwCurrentState = SERVICE_PAUSED) then Result := 'SERVICE_PAUSED';
          //关闭打开的服务句柄
          CloseServiceHandle(schs);
        end
      else
        Result := 'Connect Service Fault.';
      //关闭打开的服务句柄
      CloseServiceHandle(schm);
    end
  else
    Result := 'Connect Server Fault.';
end;

//上传本地目录到FTP服务器指定目录
procedure UploadPerFTP(sSourceDir,sTargetDir:string;FtpClient:TidFtp);
  procedure GetDir(dir: string);
  var
    SearchRec: TSearchRec;
    details, nodetails: TStringList;
    k: Integer;
    s:string;
  begin
    //检测给定的目录iterate through directory given
    if FindFirst(dir + '*.*', faAnyFile, SearchRec) = 0 then
    begin
      //循环将源目录及子目录文件上传服务器
      repeat
        //删除空目录和'.''..'目录get rid of the both "dummy-directories" ’.’ and ’..’
        if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
        begin
          //找到源目录的一个子目录if we found a folder
          if (SearchRec.Attr and faDirectory) = faDirectory then
          begin
            //从服务器取当前目录内容get folder contents from ftp. one with details, one without
            details   := TStringList.Create;
            nodetails := TStringList.Create;
            FTPClient.List(details, '', True);
            //FTPClient.List(nodetails, '', False);

            //获取没有'.''..'目录的目录列表we only want to have directories in the list (without ’.’ and ’..’)
            for k := details.Count - 1 downto 0 do
            begin
              if details.Strings[k] <> '' then
              begin
                if (details.Strings[k][1] = 'd') then //目录
                begin
                  s := Copy(details.Strings[k],56,1000);//取目录名
                  if (s <> '.') and (s <> '..') then
                    nodetails.Add(s);
                end;
              end;
            end;

            //如果目录在服务器不存在则创建if our directory does not exists on the server, create it
            if nodetails.IndexOf(SearchRec.Name) = -1 then
            begin
              FTPClient.MakeDir(SearchRec.Name);
            end;

            //进入创建的目录change into next directory on server
            FTPClient.ChangeDir(SearchRec.Name);
            nodetails.Free;

            //继续处理子目录and also locally go into the next subfolder
            GetDir(dir + SearchRec.Name + '\');

            //离开递归调用必需回到//上一级目录we have to go one directory up after leaving the recursion
            FTPClient.ChangeDirUp;
          end
          else
          begin
            //文件，上传到当前目录if it’s only a file, upload it to the current directory
            FTPClient.Put(dir + SearchRec.Name, SearchRec.Name);
          end;
        end;
      until FindNext(SearchRec) <> 0;
      FindClose(SearchRec);
    end;
  end;
var
  dir: string;
  details, nodetails: TStringList;
  k: Integer;
  s: string;
begin
  //对IdFTPClient控件设置一些基本参数
  if FTPClient.Connected then FTPClient.Disconnect;
  with FTPClient do
  begin
    AutoLogin := True;
    Passive := True;
    Host := pvs_Ftp_Host;
    Username := pvs_Ftp_userName;
    Password := pvs_Ftp_Password;
    TransferType := ftBinary;
  end;
  try
    FTPClient.Connect;
  except
    LogAlarmToText('连接FTP服务器错误!');
    Exit;
  end;

  //如果想上传数据到远程目录，指定目录（格式'dir dir' 或 'dir/dir'）
  dir := StringReplace(sTargetDir,' ', '/', [rfReplaceAll]);
  dir := StringReplace(sTargetDir,'\', '/', [rfReplaceAll]);

  //以下代码用于在服务器上创建指定的目标目录
  //************************************************************
  //移除第一个'/' remove first ’/’ if there’s one
  if dir <> '' then
  begin
    if dir[1] = '/' then Delete(dir, 1, 1);
    //增加一个'/'在目录最后面（如果没有'/'） but add a '/' at the end
    if dir[Length(dir)] <> '/' then dir := dir + '/';

    //遍历远程目录loop through our remote-directories
    while Pos('/', dir) > 0 do
    begin
      //从FTP取目录内容get folder contents from ftp. one with details, one without
      details   := TStringList.Create;
      nodetails := TStringList.Create;
      FTPClient.List(details, '', True);
      //FTPClient.List(nodetails, '', False);

      //获取没有'.''..'目录的目录列表we only want to have directories in the list (without ’.’ and ’..’)
      for k := details.Count - 1 downto 0 do
      begin
        if details.Strings[k] <> '' then
        begin
          if (details.Strings[k][1] = 'd') then //目录
          begin
            s := Copy(details.Strings[k],56,1000);
            if (s <> '.') and (s <> '..') then
              nodetails.Add(s);
          end;
        end;
      end;

      //如果服务器目标目录不存在则创建if our directory does not exists on the server, create it
      if nodetails.IndexOf(Copy(dir, 1, Pos('/', dir) - 1)) = -1 then
      begin
        FTPClient.MakeDir(Copy(dir, 1, Pos('/', dir) - 1));
      end;

      //进入创建的目标目录change to our directory on server
      FTPClient.ChangeDir(Copy(dir, 1, Pos('/', dir) - 1));

      //删除第一层目录remove first directory from path (’your/directory/subdir/’ --> ’directory/subdir/’)
      Delete(dir, 1, Pos('/', dir));//循环处理目录下的子目录
      nodetails.Free;
    end;
  end;
  //******************************************************************
  //创建服务器目标目录完毕

  //服务器远程目录已经准备完毕ftp client is ready in your remote-directory
  //开始上传本地目录begin to upload our local directory
  dir := sSourceDir;//'C:\OA_Backup_Server';
  //if dir[Length(dir)] <> ' ' then dir := dir + ' ';//在目录串后面加一个空格（？）
  if RightStr(dir,1) <> '\' then dir := dir + '\';
  GetDir(dir);
  FTPClient.Disconnect;
end;

end.