Otomatik Sürüm Kontrol Örneği

Z.D. · Mesaj gönderen **Z.D.** » 24 Haz 2007 05:27

Mantık olarak @mkysoft hocanında belirttiği gibi internetteki web serverınıza koyacağınız bir ini dosyasıyla basit olarak programın yeni sürümünü kontrol edip gerektiğinde programını güncelleyebilirsiniz.

Ben bu yöntemi genelde html parsing için sık kullanıyorum. Çünkü sorgulama yaptığım web sitelerinin html tagları sürekli güncellendiği için parse kodunuda yenilemek zorunda kalıyorum. Pascal script kullanarak oluşturduğum bu dinamik yapı otomatik güncelleme modülü ile bir problem çıkarmıyor.

Örnek olarak

Update.xml (bu dosyayı web serverınıza upload edin, program başlarken internetten bu dosyayı kontrol edip yeni sürüm olup olmadığına karar vericek)

Kod: Tümünü seç

[Update]
ProgramName=Sürüm Kontrol
Version=1.0.0
UpdateDate=24.06.2007
Download=http://www.sitenizinadresi.com/setup.exe
Func=SHELL

bu section ve keyler olsun.
ProgramName : "Programınızın adı, isterseniz modülde gösterebilirsiniz"
Version : "Programınızın en güncel sürümü"
UpdateDate : "En son güncelleme tarihiniz"
Download : "Programınızın download adresi"
Func : "Bu paremetre önemli, çünkü eğer güncel bir sürüm varsa Yükle butonuna tıkladığınızda;

DIRECT değerini verirseniz programın yalnızca exe dosyasını indirip günceller
SHELL değerini verirseniz programın web sitesine shellexecute ile yönlendirebilirsiniz."

Peki niye bu parametreler?
- Setup dosyanız bazen epey büyük olabiliyor. Eğer yaptığınız güncellemeler yalnızca exe dosyanızdaysa kullanıcının sadece bunu download etmesi yeterli.

Resim

Örnek Taslakta kullanılan dosyalar

Kod: Tümünü seç

Project1.dpr
Unit1.pas
Unit1.dfm
UpdateUnt.pas
UpdateUnt.dfm
Global.pas
Update.xml

Project1.dpr

Kod: Tümünü seç

program Project1;

uses
  Messages,
  Windows,
  Dialogs,
  SysUtils,
  Forms,
  UpdateUnt in 'UpdateUnt.pas' {UpdateFrm},
  Unit1 in 'Unit1.pas' {Form1},
  Global in 'Global.pas';

{$R *.res}


begin

  Application.Initialize;
  MySet := TMySettings.Create;
  MySet.Load;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
  MySet.Save;
  MySet.Free;

end.

Unit1.pas

Kod: Tümünü seç

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ComCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    Dosya1:  TMenuItem;
    Grnm1:   TMenuItem;
    Aralar1: TMenuItem;
    sm_Help: TMenuItem;
    YardmKonular1: TMenuItem;
    N1:      TMenuItem;
    mi_checkupdate: TMenuItem;
    N2:      TMenuItem;
    Hakknda1: TMenuItem;
    Label1:  TLabel;
    Button1: TButton;
    StatusBar1: TStatusBar;
    RadioGroup1: TRadioGroup;
    Button2: TButton;
    Button3: TButton;
    procedure mi_checkupdateClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses UpdateUnt, Global;

{$R *.dfm}

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}

{--------------------------------------------
kullanıcı update butonuna tıklarsa ilk olarak
en son update tarigini güncelliyorum. Diloagu
oluşturuyorum, dialog createde birşey olmadığı için
creatten sonra değişkenleri ayarlayabilirim. Form createden sonra
alt satırdan programın en son sürümünü atıyorum.
daha sonra showmodal ile gösteriyorum.
--------------------------------------------}

procedure TForm1.Button1Click(Sender: TObject);
begin
  MySet.rSetting.LastUpdateDate := GetDateDays;
  UpdateFrm      := TUpdateFrm.Create(Application);
  UpdateFrm.ACurrentVersion := AVersion;
  UpdateFrm.AUrl := 'http://www.sitenizinadresi.com/Update.xml';
  UpdateFrm.ShowModal;
  UpdateFrm.Free;
  with MySet.rSetting do
    StatusBar1.Panels[1].Text := Format('En son güncelleme tarihi: %.2d.%.2d.%.4d', [LastUpdateDate mod 30, (LastUpdateDate mod 360) div 30, LastUpdateDate div 360]);
end;

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}


{--------------------------------------------
Programın ekrandaki konumlarını kaydediyoruz
--------------------------------------------}
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FormLastSize('Write', Self);
end;

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}
{--------------------------------------------
Programın kapanırken en son ekrandaki konumlarını yüklüyoruz
--------------------------------------------}
procedure TForm1.FormCreate(Sender: TObject);
begin
  FormLastSize('Read', Self);
end;

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}
{--------------------------------------------
burada ilk olarak update kontrol aralığını ayarlıyorum.
radiogroup olduğu için
0: 1 gün
1: 7 gün
2: 30 gün

daha sonra bugünün tarihini gün olarak hesaplayıp
kontrol periodunu karşılaştırıyorum. update formunda
"GetUpdateEp" isimli fonksiyonum var, bunun geri dönüş parametresine göre
true,false yeni bir sürüm olup olmadığını kullanıcya gösteriyorum.
varsa gösteriyorum, yoksa devam.
--------------------------------------------}
procedure TForm1.FormShow(Sender: TObject);
var
  i: integer;
begin
  with MySet.rSetting do begin
    case UpdatePeriod of
      0: i := 1;
      2: i := 30;
      else
        i := 7;
    end;

    if (LastUpdateDate > GetDateDays) or ((GetDateDays - LastUpdateDate) >= i) then begin
      LastUpdateDate := GetDateDays;
      UpdateFrm      := TUpdateFrm.Create(Application);
      UpdateFrm.ACurrentVersion := AVersion;
      UpdateFrm.AUrl := 'http://www.sitenizinadresi.com/Update.xml';
      if UpdateFrm.GetUpdateEp then
        UpdateFrm.ShowModal;
      UpdateFrm.Free;
    end;

    StatusBar1.Panels[1].Text := Format('En son güncelleme tarihi: %.2d.%.2d.%.4d', [LastUpdateDate mod 30, (LastUpdateDate mod 360) div 30, LastUpdateDate div 360]);
    RadioGroup1.ItemIndex     := UpdatePeriod;
  end;
end;

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}

procedure TForm1.Button2Click(Sender: TObject);
begin
  Button2.Enabled := False;
  with MySet.rSetting do
    UpdatePeriod := RadioGroup1.ItemIndex;
end;

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}

procedure TForm1.Button3Click(Sender: TObject);
begin
  Close;
end;

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}

procedure TForm1.mi_checkupdateClick(Sender: TObject);
begin
  Button1.Click;
end;

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}

end.

Unit1.dfm

Kod: Tümünü seç

object Form1: TForm1
  Left = 0
  Top = 0
  BorderIcons = [biSystemMenu, biMinimize]
  BorderStyle = bsSingle
  Caption = 'Form1'
  ClientHeight = 311
  ClientWidth = 442
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  Menu = MainMenu1
  OldCreateOrder = False
  OnClose = FormClose
  OnCreate = FormCreate
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 56
    Top = 24
    Width = 288
    Height = 33
    Caption = 'Otomatik S'#252'r'#252'm Kontrol'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clBlue
    Font.Height = -27
    Font.Name = 'Tahoma'
    Font.Style = [fsUnderline]
    ParentFont = False
  end
  object Button1: TButton
    Left = 104
    Top = 79
    Width = 209
    Height = 25
    Caption = 'Yeni S'#252'r'#252'm Kontrol Et..'
    TabOrder = 0
    OnClick = Button1Click
  end
  object StatusBar1: TStatusBar
    Left = 0
    Top = 292
    Width = 442
    Height = 19
    Panels = <
      item
        Width = 200
      end
      item
        Width = 50
      end>
    ExplicitTop = 259
    ExplicitWidth = 399
  end
  object RadioGroup1: TRadioGroup
    Left = 104
    Top = 110
    Width = 209
    Height = 105
    Caption = 'S'#252'r'#252'm Kontrol Aral'#305#287#305
    ItemIndex = 0
    Items.Strings = (
      'G'#252'nl'#252'k'
      'Haftal'#305'k'
      'Ayl'#305'k')
    TabOrder = 2
  end
  object Button2: TButton
    Left = 104
    Top = 221
    Width = 75
    Height = 25
    Caption = 'Kaydet'
    TabOrder = 3
    OnClick = Button2Click
  end
  object Button3: TButton
    Left = 238
    Top = 221
    Width = 75
    Height = 25
    Caption = 'Vazge'#231
    TabOrder = 4
    OnClick = Button3Click
  end
  object MainMenu1: TMainMenu
    Left = 144
    Top = 24
    object Dosya1: TMenuItem
      Caption = 'Dosya'
      Enabled = False
    end
    object Grnm1: TMenuItem
      Caption = 'G'#246'r'#252'n'#252'm'
      Enabled = False
    end
    object Aralar1: TMenuItem
      Caption = 'Ara'#231'lar'
      Enabled = False
    end
    object sm_Help: TMenuItem
      Caption = 'Yard'#305'm'
      object YardmKonular1: TMenuItem
        Caption = 'Yard'#305'm Konular'#305
        Enabled = False
      end
      object N1: TMenuItem
        Caption = '-'
      end
      object mi_checkupdate: TMenuItem
        Caption = 'G'#252'ncellemeleri Kontrol Et..'
        OnClick = mi_checkupdateClick
      end
      object N2: TMenuItem
        Caption = '-'
      end
      object Hakknda1: TMenuItem
        Caption = 'Hakk'#305'nda'
        Enabled = False
      end
    end
  end
end

UpdateUnt.pas

Kod: Tümünü seç

unit UpdateUnt;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, ShellApi, IniFiles,
  //---------------------------------------------
  IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdHTTP, IdException;
//--------------------------------------------;

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}

type
  TDownloadAction = (daGetPage, daGetFile, daPostPage);
  TDownloadState  = (dsNone, dsBusy, dsFinished, dsFailed, dsCanceled);

  TUptDownloadThread = class(TThread)
  private
    FStatusText: string;
    procedure SetStatus;
    procedure httpStatus(axSender: TObject; const axStatus: TIdStatus; const asStatusText: string);
    procedure httpWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: integer);
  protected
    procedure Execute; override;
  public
    FResult: string;
    FState:  TDownloadState;
    FURL:    string;
    FParams: string;
    FStream: TStream;
    FToDo:   TDownloadAction;
    FHTTP:   TIdHTTP;

  end;

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}

type
  TUpdateFrm = class(TForm)
    Bevel1:    TBevel;
    btnCancel: TButton;
    PPosition: TProgressBar;
    LStatus:   TStaticText;
    LPosition: TLabel;
    http:      TIdHTTP;
    Timer1:    TTimer;
    Button1:   TButton;
    procedure FormShow(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    //------ PROGRESS WIN ------------------------
    FMaximum: integer;
    FOnCancel: TNotifyEvent;
    ProgramName: string;
    Version: string;
    UpdateDate: string;
    DownloadAddress: string;
    Func: string;
    procedure SetStatus(const NewStatus: string);
    procedure SetMaximum(const NewMaximum: integer);
    procedure SetIntProgress(const NewPosition: integer);
    procedure SetProgress(const NewText: string);
    procedure SetOnCancel(const Value: TNotifyEvent);
    function GetIntProgress: integer;
    function GetPage(const address, referer: string): string;
    procedure OnCancelDownload(Sender: TObject);
    procedure OnThreadEnd(Sender: TObject);

    procedure GetFile_EP(address: string);
    //------------------------------------------
  public
    { Public declarations }
    //--- PROGRESS WIN -------------------------
    ACurrentVersion: string;
    AUrl: string;
    function GetUpdateEp: boolean;
    procedure Execute(Sender: TForm);
    property Status: string Write SetStatus;
    property IntProgress: integer Read GetIntProgress Write SetIntProgress;
    property Maximum: integer Read FMaximum Write SetMaximum;
    property Progress: string Write SetProgress;
    property OnCancel: TNotifyEvent Read FOnCancel Write SetOnCancel;
    procedure StepIt;
    //------------------------------------------
  end;

const
  CRLF = #13#10;

var
  UpdateFrm: TUpdateFrm;

implementation

{$R *.dfm}

var
  DownloadThread: TUptDownloadThread;
  DownloadState:  TDownloadState;
  DownloadResult: string;


{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}


procedure TUpdateFrm.OnThreadEnd(Sender: TObject);
begin
  if Assigned(DownloadThread) then
    with DownloadThread do begin
      DownloadState  := FState;
      DownloadResult := '';
      case FState of
        dsFinished: DownloadResult := FResult;
        dsFailed: MessageDlg(FResult, mtError, [mbOK], 0);
      end;
    end;
  DownloadThread := nil;
end;

  {-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}

procedure TUpdateFrm.OnCancelDownload(Sender: TObject);
begin
  if Assigned(DownloadThread) then
    http.Disconnect;
  if Assigned(UpdateFrm) then
    OnCancel := nil;
  Application.ProcessMessages;
  DownloadState := dsCanceled;
end;


{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}

function TUpdateFrm.GetPage(const address, referer: string): string;
begin
  http.Request.ContentType := '*/*';
  http.Request.Referer := referer;
  http.HTTPOptions := http.HTTPOptions - [hoKeepOrigProtocol];
  Result      := '';
  Maximum     := 1;
  IntProgress := 0;
  //Status      := 'Internetten bilgiler alınıyor...';
  Execute(UpdateFrm);
  try
    Application.ProcessMessages;
    DownloadThread := TUptDownloadThread.Create(True);
    with DownloadThread do begin
      FState   := dsNone;
      FURL     := address;
      FToDo    := daGetPage;
      FHTTP    := http;
      OnTerminate := OnThreadEnd;
      OnCancel := OnCancelDownload;
      DownloadState := dsBusy;
      Resume;
    end;
    IntProgress := 1;
    while DownloadState = dsBusy do
      Application.HandleMessage;
    if DownloadState = dsFinished then
      Result := AdjustLineBreaks(DownloadResult);
  finally
    OnCancel := nil;
    Application.ProcessMessages;
  end;
end;

procedure TUpdateFrm.GetFile_EP(address: string);
var
  Stream:    TMemoryStream;
  AFileName: string;
  AResult:   boolean;
  ATimer:    integer;
begin
  Maximum     := 1;
  IntProgress := 0;
  LPosition.Caption := 'Güncel sürüm yükleniyor...';
  AResult     := False;
  Stream      := TMemoryStream.Create;
  Execute(UpdateFrm);
  try
    LPosition.Visible := True;
    PPosition.Visible := True;
    LStatus.Height    := 114;
    Application.ProcessMessages;
    DownloadThread := TUptDownloadThread.Create(True);
    with DownloadThread do begin
      FState   := dsNone;
      FURL     := address;
      FToDo    := daGetFile;
      FHTTP    := http;
      FStream  := Stream;
      OnTerminate := OnThreadEnd;
      OnCancel := OnCancelDownload;
      DownloadState := dsBusy;
      Resume;
    end;
    IntProgress := 1;
    while DownloadState = dsBusy do
      Application.HandleMessage;
    if DownloadState = dsFinished then begin
      Stream.SaveToFile(ExtractFilePath(Application.ExeName) + 'Temp.up');
      LStatus.Caption := ' Yeni sürüm yüklendi' + CRLF + CRLF + ' Programın en güncel sürümünü kullanıyorsunuz';
      AResult := True;
      Application.ProcessMessages;
    end;
  finally
    Stream.Free;
    LPosition.Visible := False;
    PPosition.Visible := False;
    LStatus.Height    := 154;
    Application.ProcessMessages;
  end;


  if AResult = True then begin

    if not FileExists(ExtractFilePath(Application.ExeName) + 'Temp.up') then
      exit;

    AFileName := Application.ExeName;


    AResult := True;
    ATimer  := 0;
    while AResult do begin
      AResult := deletefile(ChangeFileExt(AFileName, '.BAK'));
      Sleep(100);
      Inc(ATimer);
      if ATimer > 20 then
        exit;
    end;

    AResult := True;
    ATimer  := 0;
    while AResult do begin
      AResult := RenameFile(AFileName, ChangeFileExt(AFileName, '.BAK'));
      Sleep(100);
      Inc(ATimer);
      if ATimer > 20 then
        exit;
    end;

    AResult := True;
    ATimer  := 0;
    while AResult do begin
      AResult := RenameFile(ExtractFilePath(Application.ExeName) + 'Temp.up', AFileName);
      Sleep(100);
      Inc(ATimer);
      if ATimer > 20 then
        exit;
    end;

    ShellExecute(Handle, 'open', PChar(AFileName), nil, nil, SW_SHOWNORMAL);
    Application.Terminate;
  end;

end;

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}

{-------------------------------------------------------------------------------
********************* THREAD START ********************************************
-------------------------------------------------------------------------------}

procedure TUptDownloadThread.Execute;
var
  sl: TStringList;
begin
  FState      := dsNone;
  FStatusText := 'Idle';
  Synchronize(SetStatus);
  FHTTP.OnWork   := httpWork;
  FHTTP.OnStatus := httpStatus;
  try
    try
      case FToDo of
        daGetPage: begin
          FState  := dsBusy;
          FResult := FHTTP.Get(FURL);
          FState  := dsFinished;
        end;
        daGetFile: begin
          FResult := '';
          FState  := dsBusy;
          FHTTP.Get(FURL, FStream);
          FState := dsFinished;
        end;
        daPostPage: begin
          sl := TStringList.Create;
          try
            sl.Text := FParams;
            FState  := dsBusy;
            FResult := FHTTP.Post(FURL, sl);
            FState  := dsFinished;
          finally
            sl.Free;
          end;
        end;
      end;
    finally
      try
        if FHTTP.Connected then
          FHTTP.Disconnect;
      except
      end;
    end;
  except
    on E: EidException do begin
      FState  := dsCanceled;
      FResult := '';
    end;
    on E: Exception do begin
      FState  := dsFailed;
      FResult := E.Message;
    end;
  end;
end;

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}

procedure TUptDownloadThread.httpStatus(axSender: TObject; const axStatus: TIdStatus; const asStatusText: string);
begin
  FStatusText := asStatusText;
  Synchronize(SetStatus);
end;

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}

procedure TUptDownloadThread.httpWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: integer);
begin
  if AWorkMode = wmRead then begin
    FStatusText := Format('Yükleniyor: %d bytes', [AWorkCount]);

    if UpdateFrm.PPosition.Position <= 1 then
      if TIdHTTP(ASender).Response.ContentLength > 0 then
        UpdateFrm.PPosition.Max := TIdHTTP(ASender).Response.ContentLength;
    UpdateFrm.PPosition.Position := AWorkCount;

    Synchronize(SetStatus);
  end;
end;

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}

procedure TUptDownloadThread.SetStatus;
begin
  with UpdateFrm do
    if Visible then
      Progress := FStatusText;
end;

{-------------------------------------------------------------------------------
*************   THREAD END  ****************************************************
-------------------------------------------------------------------------------}



{-------------------------------------------------------------------------------
***************** PROGRESS START **********************************************
-------------------------------------------------------------------------------}

procedure TUpdateFrm.SetStatus(const NewStatus: string);
begin
  LStatus.Caption := NewStatus;
  Application.ProcessMessages;
end;

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}

procedure TUpdateFrm.SetIntProgress(const NewPosition: integer);
begin
  if (FMaximum > 0) and (NewPosition <= FMaximum) then begin
    LPosition.Caption  := Format('%02d %%', [Round((NewPosition / FMaximum) * 100)]);
    PPosition.Position := NewPosition;
    Application.ProcessMessages;
  end;
end;

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}

procedure TUpdateFrm.SetProgress(const NewText: string);
begin
  LPosition.Caption := NewText;
  Application.ProcessMessages;
end;

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}

procedure TUpdateFrm.SetMaximum(const NewMaximum: integer);
begin
  FMaximum      := NewMaximum;
  PPosition.Max := NewMaximum;
end;


{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}



procedure TUpdateFrm.Button1Click(Sender: TObject);
begin

  if Func = 'DIRECT' then
    GetFile_EP(DownloadAddress)
  else if Func = 'SHELL' then
    ShellExecute(GetDesktopWindow, 'open', PChar(DownloadAddress), nil, nil, sw_ShowNormal);

end;

procedure TUpdateFrm.Execute(Sender: TForm);
begin
  PPosition.Position := 0;
  FMaximum      := 1;
  PPosition.Max := 1;
end;


{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}

procedure TUpdateFrm.SetOnCancel(const Value: TNotifyEvent);
begin
  FOnCancel := Value;
end;

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}

procedure TUpdateFrm.btnCancelClick(Sender: TObject);
begin
  if Assigned(FOnCancel) then
    FOnCancel(Self);
  Close;
end;

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}

procedure TUpdateFrm.StepIt;
begin
  SetIntProgress(PPosition.Position + 1);
end;


{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}

function TUpdateFrm.GetIntProgress: integer;
begin
  Result := PPosition.Position;
end;

{-------------------------------------------------------------------------------
********************* PROGRESS END **************************
-------------------------------------------------------------------------------}

function TUpdateFrm.GetUpdateEp: boolean;
var
  AResult: boolean;
  DefaultPath, IniPath: string;
  Ini:     TIniFile;
  SL:      TStringList;
begin
  Timer1.Tag := 1;
  AResult    := False;
  try
    SL := TStringList.Create;
    LPosition.Visible := True;
    PPosition.Visible := True;
    LStatus.Height := 114;

    SL.Text := GetPage(AUrl, '');
    if pos('Resolving hostname', LPosition.Caption) > 0 then begin
      LStatus.Caption := ' Web sitesine bağlanılamıyor!' + CRLF + CRLF + ' Lütfen Internet bağlantınızı kontrol ediniz.';
      Result := AResult;
      exit;
    end;

    if SL.Text <> '' then begin
      DefaultPath := ExtractFilePath(Application.ExeName);
      IniPath     := DefaultPath + 'Update.ini';
      SL.SaveToFile(IniPath);
      Ini := TIniFile.Create(IniPath);
      try
        ProgramName := Ini.ReadString('Update', 'ProgramName', '');
        Version := Ini.ReadString('Update', 'Version', '');
        UpdateDate := Ini.ReadString('Update', 'UpdateDate', '');
        DownloadAddress := Ini.ReadString('Update', 'Download', '');
        Func := Ini.ReadString('Update', 'Func', '');
      finally
        Ini.Free;
      end;
      if Version = '' then begin
        LStatus.Caption := ' Güncelleme değerleri bulunamıyor!' + CRLF + CRLF + ' Lütfen programın sürüm kontrol dosyasını kontrol edin.' +
          CRLF + CRLF + ' (' + AUrl + ')';
        AResult := False;
      end else if Version > ACurrentVersion then begin
        AResult := True;
        Button1.Visible := True;
        LStatus.Caption := ' Programın yeni bir sürümü mevcut.' + CRLF + CRLF +
          ' Bilgisayarınıza indirmek için lütfen "Yükle" butonuna tıklayın.';
        if Func = 'SHELL' then begin
          Result := AResult;
          exit;
        end;
      end else
        LStatus.Caption := ' Programın en güncel sürümünü kullanıyorsunuz';

    end else
      LStatus.Caption := ' Hata!';


  finally
    LPosition.Visible := False;
    PPosition.Visible := False;
    LStatus.Height    := 154;
    SL.Free;
    Result := AResult;
  end;

end;

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}


procedure TUpdateFrm.FormShow(Sender: TObject);
begin
  Timer1.Enabled := True;
end;

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}

procedure TUpdateFrm.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled := False;
  if Timer1.Tag = 0 then
    GetUpdateEp;

end;


end.

UpdateUnt.dfm

Kod: Tümünü seç

object UpdateFrm: TUpdateFrm
  Left = 0
  Top = 0
  BorderIcons = [biSystemMenu]
  BorderStyle = bsDialog
  Caption = 'Yeni S'#252'r'#252'm Kontrol'
  ClientHeight = 208
  ClientWidth = 343
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object Bevel1: TBevel
    Left = 8
    Top = 168
    Width = 325
    Height = 40
    Shape = bsTopLine
  end
  object LPosition: TLabel
    Left = 8
    Top = 128
    Width = 325
    Height = 13
    Alignment = taCenter
    AutoSize = False
  end
  object btnCancel: TButton
    Left = 256
    Top = 175
    Width = 75
    Height = 25
    Caption = 'Kapat'
    TabOrder = 0
    OnClick = btnCancelClick
  end
  object PPosition: TProgressBar
    Left = 8
    Top = 143
    Width = 325
    Height = 19
    Smooth = True
    TabOrder = 1
  end
  object LStatus: TStaticText
    Left = 8
    Top = 8
    Width = 325
    Height = 114
    AutoSize = False
    BevelInner = bvNone
    BevelOuter = bvNone
    BorderStyle = sbsSunken
    Caption = ' G'#252'ncellemeler Kontrol Ediliyor...'
    Color = 16316664
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'Tahoma'
    Font.Style = []
    ParentColor = False
    ParentFont = False
    TabOrder = 2
    Transparent = False
  end
  object Button1: TButton
    Left = 168
    Top = 175
    Width = 75
    Height = 25
    Caption = 'Y'#252'kle'
    TabOrder = 3
    Visible = False
    OnClick = Button1Click
  end
  object http: TIdHTTP
    AllowCookies = True
    ProxyParams.BasicAuthentication = False
    ProxyParams.ProxyPort = 0
    Request.ContentLength = -1
    Request.Accept = 'text/html, */*'
    Request.BasicAuthentication = False
    Request.UserAgent = 'Mozilla/3.0 (compatible; Indy Library)'
    HTTPOptions = [hoForceEncodeParams]
    Left = 304
    Top = 16
  end
  object Timer1: TTimer
    Enabled = False
    Interval = 500
    OnTimer = Timer1Timer
    Left = 272
    Top = 16
  end
end

Global.pas

Kod: Tümünü seç

unit Global;

interface

uses
  Windows, Inifiles, Forms, SysUtils;

const
  AProgramName: string = 'Yeni Sürüm Kontrol Taslağı';
  AVersion: string     = '1.0.0';

type
  TMySettings = class(TObject)
  private
    Ini: TIniFile;
  public
    rSetting: record
      LastUpdateDate: integer;
      UpdatePeriod:   integer;
    end;
    constructor Create;
    destructor Destroy; override;
    procedure Load;
    procedure Save;
  end;

function GetDateDays: integer;
procedure FormLastSize(ppFunc: string; pSelf: TCustomform);


var
  MySet:   TMySettings;
  IniPath: string;
  DefaultPath: string;

implementation

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}
constructor TMySettings.Create;
begin
  inherited Create;
end;

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}
destructor TMySettings.Destroy;
begin
  inherited;
end;

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}


procedure TMySettings.Load;
begin
  with MySet do begin
    DefaultPath := ExtractFilePath(Application.ExeName);
    IniPath := DefaultPath + 'Option.ini';
    Ini := TIniFile.Create(IniPath);
    try
      with rSetting do begin
        LastUpdateDate := Ini.ReadInteger('Setting', 'LastUpdateDate', 0);
        UpdatePeriod   := Ini.ReadInteger('Setting', 'UpdatePeriod', 0);
      end;
    finally
      Ini.Free;
    end;
  end;
end;

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}

procedure TMySettings.Save;
begin
  with MySet do begin
    Ini := TIniFile.Create(IniPath);
    try
      with rSetting do begin
        Ini.WriteInteger('Setting', 'LastUpdateDate', LastUpdateDate);
        Ini.WriteInteger('Setting', 'UpdatePeriod', UpdatePeriod);
      end;
    finally
      Ini.Free;
    end;
  end;

end;

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}

function GetDateDays: integer;
var
  Yil, Ay, Gun: word;
begin
  DecodeDate(Date, Yil, Ay, Gun);
  Result := Yil * 12 * 30 + Ay * 30 + Gun;
end;

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}

procedure FormLastSize(ppFunc: string; pSelf: TCustomform);
var
  lState: integer;
  Pl:     TWindowPlacement;
  R:      TRect;
  Ini:    TIniFile;
begin
  if ppFunc = 'Write' then begin
    Pl.Length := SizeOf(TWindowPlacement);
    GetWindowPlacement(pSelf.Handle, @Pl);
    R   := Pl.rcNormalPosition;
    Ini := TIniFile.Create(IniPath);
    try
      Ini.WriteInteger(pSelf.Name, 'Width', R.Right - R.Left);
      Ini.WriteInteger(pSelf.Name, 'Height', R.Bottom - R.Top);
      Ini.WriteInteger(pSelf.Name, 'Left', R.Left);
      Ini.WriteInteger(pSelf.Name, 'Top', R.Top);
      if IsIconic(Application.Handle) then
        lState := Ord(wsMinimized)
      else
        lState := Ord(pSelf.WindowState);
      Ini.WriteInteger(pSelf.Name, 'State', lState);
    finally
      Ini.Free;
    end;
    {=============================================================}
  end else
  begin
    Ini := TIniFile.Create(IniPath);
    try
      if not Ini.SectionExists(pSelf.Name) then begin
        TForm(pSelf).Position := poDesktopCenter;
        exit;
      end;
      pSelf.Width := Ini.ReadInteger(pSelf.Name, 'Width', pSelf.Width);
      pSelf.Height := Ini.ReadInteger(pSelf.Name, 'Height', pSelf.Height);
      pSelf.Left := Ini.ReadInteger(pSelf.Name, 'Left', pSelf.Left);
      pSelf.Top := Ini.ReadInteger(pSelf.Name, 'Top', pSelf.Top);
      lState := Ini.ReadInteger(pSelf.Name, 'State', Ord(wsNormal));
      if lState = Ord(wsMinimized) then //        pSelf.Visible := True;
      //        Application.Minimize;
      else
        pSelf.WindowState := TWindowState(lState);
    finally
      Ini.Free;
    end;
  end;
end;

{-------------------------------------------------------------------------------
-------------------------------------------------------------------------------}

end.

Update.xml

Kod: Tümünü seç

[Update]
ProgramName=Sürüm Kontrol
Version=1.0.0
UpdateDate=24.06.2007
Download=http://www.sitenizinadresi.com/setup.exe
Func=SHELL

============================

Yukarıdaki taslağın derlenmiş hali ve kaynak kodları
http://rapidshare.com/files/38988059/Up ... 2.zip.html

Bu update modülünü kendi projelerimde kullandığım için sizin ihtiyaçlarınızı karşılayamıyor olabilir. Bu yüzden isterseniz kodu geliştirip ihtiyaçlarınız doğrultusunda özelleştirip kullanabilirsiniz. İçinde IdHttp thread örneğide olduğu için de ayrıca paylaşmak istedim.

http://www.antp.be/software/moviecatalog bu adreste "Ant Movie Catalog" programının da kaynak kodlarını incelerseniz konu hakkında daha fazla bilgi sahibi olabilirsiniz.

Merchant · Mesaj gönderen **Merchant** » 24 Haz 2007 01:44

Elinize sağlık. Güzel bir çalışma.

Mesaj gönderen **rsimsek** » 29 Haz 2007 06:41

Teşekkürler, faydalı bir eser olmuş

umutcanster · Mesaj gönderen **umutcanster** » 14 Ara 2008 04:02

FHTTP.OnWork := httpWork;

bu satırda hata verıyor.

Mesaj gönderen **aslangeri** » 14 Ara 2008 05:27

s.a.
arkadaşım hata veriyor bizim için bir anlam ifade etmiyor.
hata mesajını yazarsanız daha iyi olur.

umutcanster · Mesaj gönderen **umutcanster** » 14 Ara 2008 06:00

Hata şu hocam ;

" Parameter lists Differ "

Z.D. · Mesaj gönderen **Z.D.** » 15 Ara 2008 12:00

şuan o tarihinde yazdığım koda bakıyorumda, bir sürü mantık hatası, bir sürü gereksiz kod ve çok acemice kodlamışım

kusura bakma @umutcanster, bu kod üzerinden daha fazla devam etmicem. google code search'da benden kat be kat daha iyi coderlerin kodlarını inceleyebilirsin.

http://www.google.com/codesearch/advanc ... ang:pascal

Delphi Forum

Otomatik Sürüm Kontrol Örneği

Otomatik Sürüm Kontrol Örneği

Re: Otomatik Sürüm Kontrol Örneği

Re: Otomatik Sürüm Kontrol Örneği

Re: Otomatik Sürüm Kontrol Örneği

Re: Otomatik Sürüm Kontrol Örneği