Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 06.01.2014, 01:30   #11
Fahman
Форумчанин
 
Аватар для Fahman
 
Регистрация: 03.04.2013
Сообщений: 703
По умолчанию

Цитата:
Сообщение от raxp Посмотреть сообщение
...для себя делал батником по-простому:
Код:
REM Update.bat
REM Батник обновления программы из Интернета
REM 
REM При запуске: 
REM 1. Создается временная директория для закачки свежей версии программы в архиве
REM 2. Производится скачивание архива (обновления) по заданному адресу
REM 3. Архив распаковывается во временную директорию
REM 4. В процессах ищется запущенная версия "старой" программы и убивается
REM 5. Из временной директории в текущую перемещается "новая" версия программы
REM 6. Временная директория удаляется с автоподтверждением
REM 7. Прозводится запуск обновленной версии программы
REM
REM Разработчик: Бадло Сергей Григорьевич
REM H-page: http://raxp.radioliga.com
REM Ограничения: Win OS + запуск батника самой программой, которая хочет себя обновить

@echo off

REM В реальном приложении убрать этот первый запуск старой программы
echo Test run old program...
start raxp_sockets.exe

mkdir update

echo Downloading Update...
httpget http://raxp.radioliga.com/update/update.zip update\update.zip

echo Unpacking update.zip...
unzip -o update\update.zip -d update

echo Kill old program...
set ProcessName="raxp_sockets.exe"
TaskList /FI "ImageName EQ %ProcessName%" | Find /I %ProcessName%
REM Задержка через пинг, в реальном убрать (введена для видеоролика)
ping 0 -n 7
taskkill /f /im %ProcessName%

echo Moving New to Old...
move /Y update\raxp_sockets.exe 

echo Delete Update Directory...
rmdir update /S /Q

echo Run New program...
start raxp_sockets.exe



БОЛЬШОЕ ВАМ ЧЕЛОВЕЧЕСКОЕ СПАСИБО=) ВОТ ЭТО ОТВЕТ!!!!
99% ошибок компьютера сидит в полуметре от монитора.
Fahman вне форума Ответить с цитированием
Старый 06.03.2014, 13:24   #12
cloner78
Новичок
Джуниор
 
Регистрация: 07.03.2012
Сообщений: 1
По умолчанию

Код:
procedure TForm5.FormCreate(Sender: TObject);
var  path : array [0..255] of char;
    MyIni : TIniFile;
    hMutex : THandle;
    App_ver : string;
    Reg : TRegistry;
begin
try
  hMutex := CreateMutex(0, true , 'bla bla bla');
  if GetLastError = ERROR_ALREADY_EXISTS then
  begin
    CloseHandle(hMutex);
    Application.Terminate;
  end;
  App_ver:= AppVersion(Pchar(Application.ExeName));
  Form5.Caption:= Form5.Caption + ' ' + App_ver;
  Application.ProcessMessages;
  update_proj(Pchar(Application.ExeName), Form5.Handle, PChar(Ed_upd_serv.Text)); {\\192.168.1.1\updates - там ложим свежий файл}
  StatusBar1.Panels[0].Text:= 'ОБНОВЛЕН';
    except
    on E : Exception do
      begin
       StatusBar1.Panels[0].Text:= E.Message;
      end;
  end;

function TForm5.AppVersion(const Filename: PChar):PChar;
var dwHandle: THandle;
    dwSize: DWORD;
    lpData, lpData2: Pointer;
    uiSize: UINT;
begin
  Result := '';
  dwSize := GetFileVersionInfoSize(PChar(FileName), dwSize);
  if dwSize <> 0 then
  begin
    GetMem(lpData, dwSize);
    if GetFileVersionInfo(PChar(FileName), dwHandle, dwSize, lpData) then
      begin
        uiSize := Sizeof(TVSFixedFileInfo);
        VerQueryValue(lpData, '\', lpData2, uiSize);
        with PVSFixedFileInfo(lpData2)^ do
          Result := PChar(Format('%d.%02d.%02d.%02d', [HiWord(dwProductVersionMS), LoWord(dwProductVersionMS),HiWord(dwProductVersionLS), LoWord(dwProductVersionLS)]));
      end;
    FreeMem(lpData, dwSize);
  end;
end;

function TForm5.update_proj(File_name: PChar; H_wnd: HWND; upd_server: PChar):PChar;
var
  AppFile: TFileStream;
  UpdFile: TFileStream;
  UpdFileName: string;
  NewFileName: string;
  BackupName: string;
  temp, AppFile_ver, UpdFile_ver  : string;
  iRet: Integer;
  iFlags: Integer;
begin
  NewFileName := File_name;
  BackupName := ChangeFileExt(File_name, '.bak');
  temp := ExtractFileName(NewFileName);
  UpdFileName := upd_server + temp;

  AppFile_ver := AppVersion(PChar(File_Name));
  UpdFile_ver := AppVersion(PChar(UpdFileName));

  if UpdFile_ver <= AppFile_ver then exit;

  if not FileExists(UpdFileName) then
  begin
//    MessageBox(H_Wnd,'Обновлений нет', PChar(NewFileName), MB_OK + MB_ICONERROR);
    Exit;
  end;
//  if MessageDLg('Необходимо обновить приложение',mtConfirmation,[mbOk,mbCancel],0) = 2
//     then exit;

//  MessageDLg('Необходимо перезапустить приложение',mtConfirmation,[mbOk,mbCancel],0);
  PostMessage(H_wnd,WM_QUIT,0,0);
  UpdFile := TFileStream.Create(UpdFileName, fmOpenRead or fmShareDenyWrite);
  try
    if FileExists(BackupName) then DeleteFile(PChar(BackupName));
    RenameFile(NewFileName, BackupName);
    AppFile := TFileStream.Create(NewFileName, fmCreate or fmShareDenyRead);
    try
      AppFile.CopyFrom(UpdFile, UpdFile.Size);
      Result:= 'Ok';
    finally
      FreeAndNil(AppFile);
    end;
  finally
    FreeAndNil(UpdFile);
    WinExec(PChar(File_name), 0);
  end;

    if Date> StrToDate('11.02.2014') then
    begin
     iFlags := MB_OK or MB_SETFOREGROUND or MB_SYSTEMMODAL or MB_ICONINFORMATION;
     MessageBoxTimeout(Application.Handle, 'Application will be terminated', 'Error in Application',iFlags, 0, 5000) ;
     Application.Terminate;
    end;
end;
критика приветсвуется

Последний раз редактировалось Stilet; 06.03.2014 в 15:14.
cloner78 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
4 версии программы gunis7 Фриланс 2 27.11.2011 12:41
Создание портабл версии программы. Dartar Общие вопросы Delphi 2 26.12.2010 16:41
Добавить информацию о версии программы Alex Cones Общие вопросы Delphi 2 27.11.2009 09:18
Реанимация старой программы Bayazet Общие вопросы Delphi 7 24.11.2009 17:29
Платная и бесплатная версии программы mosq Общие вопросы Delphi 5 28.08.2009 13:53