Subversion Repositories spacemission

Rev

Rev 61 | Rev 72 | Go to most recent revision | Show entire file | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 61 Rev 63
Line 73... Line 73...
73 
  FOLDERID_SavedGames: TGuid = '{4C5C32FF-BB9D-43b0-B5B4-2D72E54EAAA4}';
 73 
  FOLDERID_SavedGames: TGuid = '{4C5C32FF-BB9D-43b0-B5B4-2D72E54EAAA4}';
74 
 
 74 
 
75 
// Useful functions
 75 
// Useful functions
76 
function GetKnownFolderPath(const rfid: TGUID): string;
 76 
function GetKnownFolderPath(const rfid: TGUID): string;
77 
function KillTask(ExeFileName: string): Integer;
 77 
function KillTask(ExeFileName: string): Integer;
- 
 
 78 
procedure CheckForUpdates(ViaThinkSoftProjectName: string);
78 
 
 79 
 
79 
implementation
 80 
implementation
80 
 
 81 
 
81 
uses
 82 
uses
82 
  Windows, SysUtils, ActiveX, ShlObj, TlHelp32;
 83 
  Windows, SysUtils, ActiveX, ShlObj, TlHelp32, wininet, Forms, ShellAPI;
83 
 
 84 
 
84 
function GetKnownFolderPath(const rfid: TGUID): string;
 85 
function GetKnownFolderPath(const rfid: TGUID): string;
85 
var
 86 
var
86 
  OutPath: PWideChar;
 87 
  OutPath: PWideChar;
87 
begin
 88 
begin
Line 135... Line 136...
135 
function OwnDirectory: string;
 136 
function OwnDirectory: string;
136 
begin
 137 
begin
137 
  result := extractfilepath(paramstr(0));
 138 
  result := extractfilepath(paramstr(0));
138 
end;
 139 
end;
139 
 
 140 
 
- 
 
 141 
// https://www.delphipraxis.net/post43515.html
- 
 
 142 
function GetHTML(AUrl: string): string;
- 
 
 143 
var
- 
 
 144 
  databuffer : array[0..4095] of char;
- 
 
 145 
  ResStr : string;
- 
 
 146 
  hSession, hfile: hInternet;
- 
 
 147 
  dwindex,dwcodelen,dwread,dwNumber: cardinal;
- 
 
 148 
  dwcode : array[1..20] of char;
- 
 
 149 
  res    : pchar;
- 
 
 150 
  Str    : pchar;
- 
 
 151 
begin
- 
 
 152 
  ResStr:='';
- 
 
 153 
  if (system.pos('http://',lowercase(AUrl))=0) and
- 
 
 154 
     (system.pos('https://',lowercase(AUrl))=0) then
- 
 
 155 
     AUrl:='http://'+AUrl;
- 
 
 156 
 
- 
 
 157 
  // Hinzugefügt
- 
 
 158 
  if Assigned(Application) then Application.ProcessMessages;
- 
 
 159 
 
- 
 
 160 
  hSession:=InternetOpen('InetURL:/1.0',
- 
 
 161 
                         INTERNET_OPEN_TYPE_PRECONFIG,
- 
 
 162 
                         nil,
- 
 
 163 
                         nil,
- 
 
 164 
                         0);
- 
 
 165 
  if assigned(hsession) then
- 
 
 166 
  begin
- 
 
 167 
    // Hinzugefügt
- 
 
 168 
    if Assigned(Application) then application.ProcessMessages;
- 
 
 169 
 
- 
 
 170 
    hfile:=InternetOpenUrl(
- 
 
 171 
           hsession,
- 
 
 172 
           pchar(AUrl),
- 
 
 173 
           nil,
- 
 
 174 
           0,
- 
 
 175 
           INTERNET_FLAG_RELOAD,
- 
 
 176 
           0);
- 
 
 177 
    dwIndex  := 0;
- 
 
 178 
    dwCodeLen := 10;
- 
 
 179 
 
- 
 
 180 
    // Hinzugefügt
- 
 
 181 
    if Assigned(Application) then application.ProcessMessages;
- 
 
 182 
 
- 
 
 183 
    HttpQueryInfo(hfile,
- 
 
 184 
                  HTTP_QUERY_STATUS_CODE,
- 
 
 185 
                  @dwcode,
- 
 
 186 
                  dwcodeLen,
- 
 
 187 
                  dwIndex);
- 
 
 188 
    res := pchar(@dwcode);
- 
 
 189 
    dwNumber := sizeof(databuffer)-1;
- 
 
 190 
    if (res ='200') or (res ='302') then
- 
 
 191 
    begin
- 
 
 192 
      while (InternetReadfile(hfile,
- 
 
 193 
                              @databuffer,
- 
 
 194 
                              dwNumber,
- 
 
 195 
                              DwRead)) do
- 
 
 196 
      begin
- 
 
 197 
 
- 
 
 198 
        // Hinzugefügt
- 
 
 199 
        if Assigned(Application) then application.ProcessMessages;
- 
 
 200 
 
- 
 
 201 
        if dwRead =0 then
- 
 
 202 
          break;
- 
 
 203 
        databuffer[dwread]:=#0;
- 
 
 204 
        Str := pchar(@databuffer);
- 
 
 205 
        resStr := resStr + Str;
- 
 
 206 
      end;
- 
 
 207 
    end
- 
 
 208 
    else
- 
 
 209 
      ResStr := 'Status:'+res;
- 
 
 210 
    if assigned(hfile) then
- 
 
 211 
      InternetCloseHandle(hfile);
- 
 
 212 
  end;
- 
 
 213 
 
- 
 
 214 
  // Hinzugefügt
- 
 
 215 
  if Assigned(Application) then application.ProcessMessages;
- 
 
 216 
 
- 
 
 217 
  InternetCloseHandle(hsession);
- 
 
 218 
  Result := resStr;
- 
 
 219 
end;
- 
 
 220 
 
- 
 
 221 
procedure CheckForUpdates(ViaThinkSoftProjectName: string);
- 
 
 222 
var
- 
 
 223 
  cont: string;
- 
 
 224 
begin
- 
 
 225 
  cont := GetHTML('https://www.viathinksoft.de/update/?id='+ViaThinkSoftProjectName);
- 
 
 226 
  if copy(cont, 0, 7) = 'Status:' then
- 
 
 227 
  begin
- 
 
 228 
    Application.MessageBox('Ein Fehler ist aufgetreten. Wahrscheinlich ist keine Internetverbindung aufgebaut, oder der der ViaThinkSoft-Server vorübergehend offline.', 'Fehler', MB_OK + MB_ICONERROR)
- 
 
 229 
  end
- 
 
 230 
  else
- 
 
 231 
  begin
- 
 
 232 
    if cont <> ProgramVersion then
- 
 
 233 
    begin
- 
 
 234 
      if Application.MessageBox('Eine neue Programmversion ist vorhanden. Möchten Sie diese jetzt herunterladen?', 'Information', MB_YESNO + MB_ICONASTERISK) = ID_YES then
- 
 
 235 
        shellexecute(application.handle, 'open', pchar('https://www.viathinksoft.de/update/?id=@'+ViaThinkSoftProjectName), '', '', sw_normal);
- 
 
 236 
    end
- 
 
 237 
    else
- 
 
 238 
    begin
- 
 
 239 
      Application.MessageBox('Es ist keine neue Programmversion vorhanden.', 'Information', MB_OK + MB_ICONASTERISK);
- 
 
 240 
    end;
- 
 
 241 
  end;
- 
 
 242 
end;
- 
 
 243 
 
140 
end.
 244 
end.