Delphi 共享对比更新 开源

program Update;
{$APPTYPE CONSOLE}

uses
  SysUtils,ComObj,ShlObj,ActiveX,
  IniFiles,
  TlHelp32,
  Windows;

{$R *.RES}
var
  inif: TIniFile;
  LocalPath: string;      //本地位置
  ERPPath: string ; //ERP网络位置
  ERPUser: string;
  ERPPass: string;
  ERPNet: string;

procedure OpenERP;
var
  BatchFile: TextFile;
  BatchFileName: string;
  ProcessInfo: TProcessInformation;
  StartUpInfo: TStartupInfo;
begin
  BatchFileName := 'C:\open.bat';
  //BatchFileName := ExtractFilePath(ParamStr(0)) + '_del.bat';
  if FileExists(BatchFileName) then
    DeleteFile(PChar(BatchFileName));

  AssignFile(BatchFile, BatchFileName);
  Rewrite(BatchFile);

  Writeln(BatchFile, 'start ' + LocalPath + 'PCBERP.EXE');
//  Writeln(BatchFile, 'del "' + ParamStr(0) + '"');
//  Writeln(BatchFile, 'if exist "' + ParamStr(0) + '"' + ' goto try');
//  Writeln(BatchFile, 'del %0');
  CloseFile(BatchFile);

  FillChar(StartUpInfo, SizeOf(StartUpInfo), $00);
  StartUpInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartUpInfo.wShowWindow := SW_HIDE;

  if CreateProcess(nil, PChar(BatchFileName), nil, nil, False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo, ProcessInfo) then
  begin
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ProcessInfo.hProcess);
  end;
end;

procedure EndProcess(AFileName: string);
const
  PROCESS_TERMINATE = $0001;
var
  ContinueLoop: Boolean;
  FSnapShotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  FSnapShotHandle := CreateToolhelp32SnapShot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
  ContinueLoop := Process32First(FSnapShotHandle, FProcessEntry32);
  while integer(ContinueLoop) <> 0 do
  begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(AFileName)) or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(AFileName))) then
      TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(0), FProcessEntry32.th32ProcessID), 0);
    ContinueLoop := Process32Next(FSnapShotHandle, FProcessEntry32);
  end;
end;

function WaitExeFinish(const sExeName: string): Boolean;
var
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  strExeName: string;
begin
  Result := True;
  strExeName := sExeName;
  FillChar(StartupInfo, SizeOf(StartupInfo), 0);
  CreateProcess(nil, PChar(strExeName), nil, nil, False, 0, nil, nil, StartupInfo, ProcessInfo);
  with ProcessInfo do
  begin
    CloseHandle(hThread);
    WaitForSingleObject(hProcess, INFINITE);
    CloseHandle(hProcess);
  end;
end;

procedure UpdateDirs(dirName: string; path: string);
var
  SRec: TSearchRec;
  dir, local: string;
begin
  dirName := ExcludeTrailingBackslash(dirName) + '\';
  dir := dirName + '*.*';
  if path <> '' then
    local := LocalPath + path
  else
    local := LocalPath;
  if FindFirst(dir, faAnyFile, SRec) = 0 then
  begin
    repeat
      if (SRec.Name <> '.') and (SRec.Name <> '..') then
      begin
        if (SRec.Attr and faDirectory) <> 0 then
        begin
          if not DirectoryExists(local + SRec.Name) then //判断本地文件存在
          begin
            MkDir(local + SRec.Name);
            Writeln('创建目录' + #9 + local + SRec.Name);
            //memo1.Lines.Add(local+Srec.Name);
          end;
          if path <> '' then
            path := path + '\';
          UpdateDirs(dirName + SRec.Name, path + SRec.Name + '\');
        end
        else
        begin
          if FileExists(local + SRec.Name) then //判断本地文件存在
          begin
            //不能更新自身
            if (FileAge(dirName + SRec.Name) > FileAge(local + SRec.Name)) and (SRec.Name <> ExtractFileName(paramstr(0))) then
            begin
              //如果是exe,则先结束对应进程,再作覆盖
              if (ExtractFileExt(SRec.Name) = '.exe') then
                EndProcess(SRec.Name); //终止进程
              //覆盖更新
              CopyFile(pChar(dirName + SRec.Name), pChar(local + SRec.Name), false);
              Writeln('更新成功' + #9 + local + SRec.Name);
              //memo1.Lines.Add(dirName + SRec.Name);
            end;
          end
          else
          begin
            CopyFile(pChar(dirName + SRec.Name), pChar(local + SRec.Name), false);
            //memo1.Lines.Add(dirName + SRec.Name);
            Writeln('更新成功' + #9 + local + SRec.Name);
          end;
        end;
      end;
      //Application.ProcessMessages;
    until (FindNext(SRec) <> 0); {找下一个, 返回0表示找到}
  end;
  sysutils.FindClose(SRec);
end;

procedure CreateLnk;  //创建快捷方式到桌面
var
  tmpObject: IUnknown;
  tmpSLink: IShellLink;
  tmpPFile: IPersistFile;
  PIDL: PItemIDList;
  StartupDirectory: array[0..MAX_PATH] of Char;
  StartupFilename: string;
  LinkFilename: WideString;
begin 
//创建快捷方式到桌面
  StartupFilename := LocalPath+ExtractFileName(ParamStr(0));
  Writeln (StartupFilename);
  CoInitialize(nil);
  tmpObject := CreateComObject(CLSID_ShellLink); //创建建立快捷方式的外壳扩展
  tmpSLink := tmpObject as IShellLink; //取得接口
  tmpPFile := tmpObject as IPersistFile; //用来储存*.lnk文件的接口
  tmpSLink.SetPath(pChar(StartupFilename)); //设定所在路径
  tmpSLink.SetWorkingDirectory(pChar(ExtractFilePath(StartupFilename))); //设定工作目录
  SHGetSpecialFolderLocation(0, CSIDL_DESKTOPDIRECTORY, PIDL); //获得桌面的Itemidlist
  tmpSLink.SetDescription('ERP系统');
  tmpSLink.SetIconLocation(Pchar(StartupFilename), 0);
  SHGetPathFromIDList(PIDL, StartupDirectory); //获得桌面路径
  LinkFilename := StartupDirectory + '\ERP系统.lnk';
  tmpPFile.Save(pWChar(LinkFilename), FALSE); //保存*.lnk文件
  CoUninitialize;
end;

procedure Search();
var
  NetSource: TNetResource;
  Errinfo: longint;
begin
  with NetSource do
  begin
    dwType := RESOURCETYPE_ANY;             // 用于指定网络的资源类型
    lpLocalName := PChar(ERPNet);                    // 将远程资源映射到此驱动器
    lpRemoteName := PChar(ERPPath);    // 远程网络资源
    lpProvider := '';                       // 必须赋值,如为空则使用lpRemoteName 的值。
  end;
  Errinfo := WnetAddConnection2(NetSource, PChar(ERPUser), PChar(ERPpass), CONNECT_UPDATE_PROFILE); // CONNECT_UPDATE_PROFILE下次登录时重新连接

  //0.映射成功             //NO_ERROR
  //53.找不到网络路径                    //The network path was not found.
  //85.存在映射           //The local device name is already in use.
  //66.映射错误,登陆异常   //The network resource type is not correct.
  //1202.存在映射       //{ An attempt was made to remember a device that had previously been remembered. }
  if ((Errinfo <> NO_ERROR) and (Errinfo<>ERROR_ALREADY_ASSIGNED) and (Errinfo<>ERROR_DEVICE_ALREADY_REMEMBERED)) then               // 磁盘映射成功，此时在本地可看到网络驱动器X：
  begin
    //MessageDlg('网络异常,无法访问ERP!', mtError, [mbOK], 0);
    Writeln('网络异常,无法访问ERP!返回代码' + inttostr(Errinfo));
    Sleep(2000);
    Exit;
  end
  else
  begin
    if not directoryexists(LocalPath) then
      mkdir(LocalPath);
      // 拷贝远程文件到当前目录下的 temp 目录下
    //开始更新
    //Application.ProcessMessages;
    Writeln('自动更新中...');
    UpdateDirs(ERPNet, '');
  end;
  Writeln('自动更新完成!');

  WNetCancelConnection2( PChar(ERPNet), CONNECT_UPDATE_PROFILE, True);

  //本地映射

  WinExec(PChar('cmd.exe /c subst R: '+ExcludeTrailingBackslash(Localpath)),SW_HIDE);

  CreateLnk;
//  WNetCancelConnection2( PChar(ERPNet), CONNECT_UPDATE_PROFILE, True);      释放共享
  Sleep(1000);
  OpenERP;
  exit;
  //运行pcberp.exe;
  //跳出更新,直接运行主程序
  //WaitExeFinish(LocalPath +'PCBERP.EXE');
  //Application.Terminate;
  //exit;
  // 不管是否有文件打开，断开网络驱动器X： 
end;

begin
  if FileExists(ExtractFilePath(ParamStr(0)) + 'helper.ini') then
  begin
    //读ini
    inif := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'helper.ini');
    ERPPath := inif.ReadString('共享设置', '网络路径', '');
    LocalPath := inif.ReadString('共享设置', '本地路径', '');
    ERPNet := inif.ReadString('共享设置', '盘符', 'T:');
    ERPUser := inif.ReadString('共享设置', '用户', '123');
    ERPPass := inif.ReadString('共享设置', '密码', '123');
  end;
  { TODO -oUser -cConsole Main : Insert code here }
  Search();
end.