1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
| unit CheckVersion;
interface
uses
Windows, Messages, SysUtils, Classes, URLMon, ShellAPI, ActiveX, Forms;
const
WM_NEWVERSION = WM_USER; //Message Nouvelle version disponible
WM_DOWNLOADCOMPLETE = WM_USER +1; //Téléchargement terminé (ou erreur)
WM_DOWNLOADPROGRESS = WM_USER +2; //Progression
type
//Tâche contrôle de version
TCheckVersionThread = class(TThread)
private
Wnd :hWnd; //Fenêtre qui reçoit les notifications
RemoteFile :string; //HTTP://... fichier distant contenant le numéro de version
CurrentVersion :string; //Version actuellement installée
protected
function CompareVersion(aFileName :TFileName) :boolean;
procedure Execute; override;
public
constructor Create(const aWnd :hWnd; const aRemoteFile, aCurrentVersion :string);
end;
//Notifications
TDownloadStatus = class(TInterfacedObject, IBindStatusCallback)
private
Wnd :hWnd;
public
function OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult; stdcall;
function GetPriority(out nPriority): HResult; stdcall;
function OnLowResource(reserved: DWORD): HResult; stdcall;
function OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult; stdcall;
function OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult; stdcall;
function GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult; stdcall;
function OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc; stgmed: PStgMedium): HResult; stdcall;
function OnObjectAvailable(const iid: TGUID; punk: IUnknown): HResult; stdcall;
public
Constructor Create(const aWnd :hWnd);
end;
//Tâche téléchargement
TDownloadNewVersionThread = class(TThread)
private
Wnd :hWnd; //Fenêtre qui reçoit les notifications
RemoteFile :string; //HTTP://... fichier nouvelle version
Status :TDownloadStatus;
protected
procedure Execute; override;
public
constructor Create(const aWnd :hWnd; const aRemoteFile :string);
end;
implementation
{ TCheckVersionThread }
function TCheckVersionThread.CompareVersion(aFileName: TFileName): boolean;
begin
//A toi d'implémenter ton contrôle de version :-)
//Pour la demo, renvoi toujours vrai !
Result := TRUE;
end;
constructor TCheckVersionThread.Create(const aWnd :hWnd; const aRemoteFile, aCurrentVersion: string);
begin
inherited Create(FALSE);
Wnd := aWnd;
RemoteFile := aRemoteFile;
CurrentVersion := aCurrentVersion;
//Libération automatique à la fin du thread
FreeOnTerminate := TRUE;
end;
procedure TCheckVersionThread.Execute;
var
TempFileName :array[0..MAX_PATH] of Char;
begin
//Télécharge dans le cache internet.
//On aurait aussi pu récupérer directement une chaîne
//avec un idHttp sans passer par un fichier
if URLDownloadToCacheFile(nil, PChar(RemoteFile), TempFileName, MAX_PATH, 0, nil) = S_OK then
//Comparaison...
if CompareVersion(TempFileName) then
//...et le cas échéant, notifie la fiche principale
PostMessage(Wnd, WM_NEWVERSION, 0, 0);
end;
{ TDownloadNewVersionThread }
constructor TDownloadNewVersionThread.Create(const aWnd: hWnd; const aRemoteFile: string);
begin
inherited Create(FALSE);
Wnd := aWnd;
RemoteFile := aRemoteFile;
Status := TDownloadStatus.Create(Wnd);
//Libération automatique à la fin du thread
FreeOnTerminate := TRUE;
end;
procedure TDownloadNewVersionThread.Execute;
var
TempFileName :array[0..MAX_PATH] of Char;
Result :integer;
begin
//Télécharge dans le cache internet...
Result := URLDownloadToCacheFile(nil, PChar(RemoteFile), TempFileName, MAX_PATH, 0, Status);
//...et notifie la fiche principale, même en cas d'erreur !
//Attend la décision de la tâche principale (installation (ID_YES) ou non)
if SendMessage(Wnd, WM_DOWNLOADCOMPLETE, Result, integer(@TempFileName)) = ID_YES then
begin
ShellExecute(0, 'open', TempFileName, nil, nil, SW_SHOWNORMAL);
PostMessage(Application.MainForm.Handle, WM_CLOSE, 0, 0);
end;
end;
{ TDownloadStatus }
constructor TDownloadStatus.Create(const aWnd: hWnd);
begin
Wnd := aWnd;
end;
function TDownloadStatus.OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult;
begin
PostMessage(Wnd, WM_DOWNLOADPROGRESS, ulProgress, ulProgressMax);
end;
function TDownloadStatus.GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult;
begin
end;
function TDownloadStatus.GetPriority(out nPriority): HResult;
begin
end;
function TDownloadStatus.OnDataAvailable(grfBSCF, dwSize: DWORD; formatetc: PFormatEtc; stgmed: PStgMedium): HResult;
begin
end;
function TDownloadStatus.OnLowResource(reserved: DWORD): HResult;
begin
end;
function TDownloadStatus.OnObjectAvailable(const iid: TGUID; punk: IInterface): HResult;
begin
end;
function TDownloadStatus.OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult;
begin
end;
function TDownloadStatus.OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult;
begin
end;
end. |
Thread DownLoad / CheckVersion
Répondre avec citation
Envoyé par ouiouioui
...
.
.
.
Partager