unit CheckFrm;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Menus,
  Forms, Dialogs, StdCtrls, Extctrls, ComCtrls,
  wininet, Buttons, marsCap, Version;

type
  TCheckForm = class(TForm)
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    L: TLabel;
    Label3: TLabel;
    Memo: TMemo;
    MarsCaption1: TMarsCaption;
    Release: TLabel;
    Need_version: TLabel;
    Label4: TLabel;
    SiteList: TListBox;
    BitBtn1: TBitBtn;
    procedure BitBtn1Click(Sender: TObject);
    procedure SiteListDblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    FirstStart: Boolean;
  public
    Link : string;
    { Déclarations publiques }
  end;

var
  CheckForm: TCheckForm;

const URL = 'http://www.bloodshed.net/dev/update-pas.txt';
const LocalFileName = 'update.txt';

type
  TCheckForUpdate = class(TObject)
  private
    NetHandle: HINTERNET;
    UrlHandle: HINTERNET;
    Buffer: array[0..1024] of char;
    BytesRead: {$ifdef ver100}integer{$else}cardinal{$endif};
  public
    UpdateFile, VersionName, Needed_package, Description : string;
    constructor Create;
    function  Connect: boolean;
    procedure Disconnect;
    procedure Download;
    procedure Check;
  end;

implementation

{$R *.DFM}

uses
  Registry, ShellApi, Main;

constructor TCheckForUpdate.Create;
begin
  inherited Create;
  Application.ProcessMessages;
end;

function TCheckForUpdate.Connect;
begin
  if Assigned(NetHandle) then
     Disconnect;

  UpdateFile := '';

  NetHandle := InternetOpen('Dev-Pascal Check for Update', INTERNET_OPEN_TYPE_PRECONFIG,
                            nil, nil, 0);

  if Assigned(NetHandle) then begin
     UrlHandle := InternetOpenUrl(NetHandle, PChar(Url), nil, 0,
                                  INTERNET_FLAG_RELOAD, 0);
     Result := True;
  end
  else begin
     raise Exception.Create('Dev-Pascal was not able to download update file. Please see http://www.bloodshed.net/dev/');
     Result := False;
  end;
end;

procedure TCheckForUpdate.Disconnect;
begin
  InternetCloseHandle(UrlHandle);
  UrlHandle := nil;
end;

procedure TCheckForUpdate.Download;
var F : TextFile;
begin
  if Assigned(UrlHandle) then
     { UrlHandle valid? Proceed with download }
  begin
     FillChar(Buffer, SizeOf(Buffer), 0);
     repeat
        UpdateFile := UpdateFile + Buffer;
        FillChar(Buffer, SizeOf(Buffer), 0);
        InternetReadFile(UrlHandle, @Buffer, SizeOf(Buffer), BytesRead);
     until BytesRead = 0;
     Disconnect;

     AssignFile(F,LocalFileName);
     Rewrite(F);
     Write(F, UpdateFile);
     CloseFile(F);
  end
  else begin
     { UrlHandle is not valid. Raise an exception. }
     raise Exception.CreateFmt('Cannot open URL %s, please see http://www.bloodshed.net/dev/pascal.html', [Url]);
     Disconnect;
  end;
end;

procedure TCheckForUpdate.Check;
var F : TextFile;
    c     : char;
    tmp : string;
    i   : integer;
begin
  if not FileExists(LocalFileName) then begin
     MessageDlg('Dev-Pascal was not able to download the update file. Please see http://www.bloodshed.net/dev/pascal.html', mtError, [mbOK],0);
     Exit;
  end;

  AssignFile(F, LocalFileName);
  Reset(F);

  CheckForm.Link := '';

  repeat
    Read(F,c)
  until c = '$';

  repeat
    Read(F,c);
    VersionName := versionname + c;
  until c = '$';
  while Pos('$',VersionName)<>0 do Delete(VersionName, Pos('$', VersionName), 1);

  repeat
    Read(F,c);
    Needed_package := Needed_package + c;
  until c = '$';
  while Pos('$',Needed_package)<>0 do Delete(Needed_package, Pos('$', Needed_package), 1);

  repeat
    Read(F,c);
    Description := Description + c;
  until c = '$';
  while Pos('$',Description)<>0 do Delete(Description, Pos('$', Description), 1);

  i := 0;

  repeat
    repeat
     Read(F,c);
     tmp := tmp + c;
    until (c = '$') or eof(F);
    while Pos('$',tmp)<>0 do
          Delete(tmp, Pos('$', tmp), 1);
    while Pos(#$A,tmp)<>0 do
          Delete(tmp, Pos(#$A, tmp), 3);
    CheckForm.SiteList.Items.Strings[i] := tmp;
    tmp := '';
    inc(i);
  until eof(F); // end of file

  CheckForm.SiteList.Items.Delete(CheckForm.SiteList.Items.Count-1);
  CheckForm.Memo.Lines.Clear;
  CheckForm.Release.Caption := VersionName;
  CheckForm.Need_Version.Caption := Needed_package;
  CheckForm.Memo.Lines.Add(description);
  CheckForm.Memo.SelStart := 0;

  MessageBeep($77777);

  if VersionName = DevPasVersion then
     MessageDlg('You are currently using the newest release, there is no need to download it.',MtInformation,[mbOK],0)
  else
     MessageDlg('There is a new Dev-Pascal version available: '+VersionName,MtInformation,[mbok],0);

  CloseFile(F);
  DeleteFile(LocalFileName);
end;


procedure TCheckForm.BitBtn1Click(Sender: TObject);
begin
  Close;
end;

procedure TCheckForm.SiteListDblClick(Sender: TObject);
var i : integer;
begin
  for i := 0 to SiteList.Items.Count-1 do
      if SiteList.Selected[i] then
         ShellExecute(GetDesktopWindow, 'open',
                      pChar(SiteList.Items.Strings[i]),
                      nil, nil, SW_SHOWNORMAL);
end;

procedure TCheckForm.FormCreate(Sender: TObject);
begin
  FirstStart := True;
end;

procedure TCheckForm.FormActivate(Sender: TObject);
var
  Check: TCheckForUpdate;
begin
  if not FirstStart then Exit;
  FirstStart := False;
  Check := TCheckForUpdate.Create;
  Application.ProcessMessages;
  with Check do begin
     L.Caption := 'Connecting...';
     Application.ProcessMessages;
     Connect;
     L.Caption := 'Downloading update file...';
     Application.ProcessMessages;
     Download;
     Application.ProcessMessages;
     L.Caption := 'Disconnecting...';
     Application.ProcessMessages;
     Disconnect;
     L.Caption := 'Checking update file...';
     Application.ProcessMessages;
     Check;
     L.Caption := 'Done';
     Application.ProcessMessages;
  end;
end;

end.
