WebSVN – spacemission – Diff – /Global.pas



  FOLDERID_SavedGames: TGuid = '{4C5C32FF-BB9D-43b0-B5B4-2D72E54EAAA4}';
 
// Useful functions
function GetKnownFolderPath(const rfid: TGUID): string;
function KillTask(ExeFileName: string): Integer;
procedure CheckForUpdates(ViaThinkSoftProjectName: string; AVersion: string);
 
implementation
 
uses
  Windows, SysUtils, ActiveX, ShlObj, TlHelp32, wininet, Forms, ShellAPI;

function OwnDirectory: string;
begin
  result := extractfilepath(paramstr(0));
end;
 
// https://www.delphipraxis.net/post43515.html , fixed , works for Delphi 12 Athens
function GetHTML(AUrl: string): RawByteString;
var
  databuffer : array[0..4095] of ansichar; // SIC! ansichar!
  ResStr : ansistring; // SIC! ansistring
  hSession, hfile: hInternet;
  dwindex,dwcodelen,dwread,dwNumber: cardinal;
  dwcode : array[1..20] of char;
  res    : pchar;
  Str    : pansichar; // SIC! pansichar
begin
  ResStr:='';
  if (system.pos('http://',lowercase(AUrl))=0) and
     (system.pos('https://',lowercase(AUrl))=0) then
     AUrl:='http://'+AUrl;

        if Assigned(Application) then application.ProcessMessages;
 
        if dwRead =0 then
          break;
        databuffer[dwread]:=#0;
        Str := pansichar(@databuffer);
        resStr := resStr + Str;
      end;
    end
    else
      ResStr := 'Status:'+AnsiString(res);
    if assigned(hfile) then
      InternetCloseHandle(hfile);
  end;
 
  // Hinzugefügt

 
  InternetCloseHandle(hsession);
  Result := resStr;
end;
 
procedure CheckForUpdates(ViaThinkSoftProjectName: string; AVersion: string);
var
  cont: RawByteString;
begin
  cont := GetHTML('https://www.viathinksoft.de/update/?id='+ViaThinkSoftProjectName);
  if copy(cont, 0, 7) = 'Status:' then
  begin
    Application.MessageBox('Ein Fehler ist aufgetreten. Wahrscheinlich ist keine Internetverbindung aufgebaut, oder der der ViaThinkSoft-Server vorübergehend offline.', 'Fehler', MB_OK + MB_ICONERROR)
  end
  else
  begin
    if string(cont) <> AVersion then
    begin
      if Application.MessageBox('Eine neue Programmversion ist vorhanden. Möchten Sie diese jetzt herunterladen?', 'Information', MB_YESNO + MB_ICONASTERISK) = ID_YES then
        shellexecute(application.handle, 'open', pchar('https://www.viathinksoft.de/update/?id=@'+ViaThinkSoftProjectName), '', '', sw_normal);
    end
    else

Rev 72	Rev 74
Line 71...	Line 71...
71	FOLDERID_SavedGames: TGuid = '{4C5C32FF-BB9D-43b0-B5B4-2D72E54EAAA4}';	71	FOLDERID_SavedGames: TGuid = '{4C5C32FF-BB9D-43b0-B5B4-2D72E54EAAA4}';
72		72
73	// Useful functions	73	// Useful functions
74	function GetKnownFolderPath(const rfid: TGUID): string;	74	function GetKnownFolderPath(const rfid: TGUID): string;
75	function KillTask(ExeFileName: string): Integer;	75	function KillTask(ExeFileName: string): Integer;
76	procedure CheckForUpdates(ViaThinkSoftProjectName: string);	76	procedure CheckForUpdates(ViaThinkSoftProjectName: string; AVersion: string);
77		77
78	implementation	78	implementation
79		79
80	uses	80	uses
81	Windows, SysUtils, ActiveX, ShlObj, TlHelp32, wininet, Forms, ShellAPI;	81	Windows, SysUtils, ActiveX, ShlObj, TlHelp32, wininet, Forms, ShellAPI;
Line 134...	Line 134...
134	function OwnDirectory: string;	134	function OwnDirectory: string;
135	begin	135	begin
136	result := extractfilepath(paramstr(0));	136	result := extractfilepath(paramstr(0));
137	end;	137	end;
138		138
139	// https://www.delphipraxis.net/post43515.html	139	// https://www.delphipraxis.net/post43515.html , fixed , works for Delphi 12 Athens
140	function GetHTML(AUrl: string): string;	140	function GetHTML(AUrl: string): RawByteString;
141	var	141	var
142	databuffer : array[0..4095] of char;	142	databuffer : array[0..4095] of ansichar; // SIC! ansichar!
143	ResStr : string;	143	ResStr : ansistring; // SIC! ansistring
144	hSession, hfile: hInternet;	144	hSession, hfile: hInternet;
145	dwindex,dwcodelen,dwread,dwNumber: cardinal;	145	dwindex,dwcodelen,dwread,dwNumber: cardinal;
146	dwcode : array[1..20] of char;	146	dwcode : array[1..20] of char;
147	res : pchar;	147	res : pchar;
148	Str : pchar;	148	Str : pansichar; // SIC! pansichar
149	begin	149	begin
150	ResStr:='';	150	ResStr:='';
151	if (system.pos('http://',lowercase(AUrl))=0) and	151	if (system.pos('http://',lowercase(AUrl))=0) and
152	(system.pos('https://',lowercase(AUrl))=0) then	152	(system.pos('https://',lowercase(AUrl))=0) then
153	AUrl:='http://'+AUrl;	153	AUrl:='http://'+AUrl;
Line 197...	Line 197...
197	if Assigned(Application) then application.ProcessMessages;	197	if Assigned(Application) then application.ProcessMessages;
198		198
199	if dwRead =0 then	199	if dwRead =0 then
200	break;	200	break;
201	databuffer[dwread]:=#0;	201	databuffer[dwread]:=#0;
202	Str := pchar(@databuffer);	202	Str := pansichar(@databuffer);
203	resStr := resStr + Str;	203	resStr := resStr + Str;
204	end;	204	end;
205	end	205	end
206	else	206	else
207	ResStr := 'Status:'+res;	207	ResStr := 'Status:'+AnsiString(res);
208	if assigned(hfile) then	208	if assigned(hfile) then
209	InternetCloseHandle(hfile);	209	InternetCloseHandle(hfile);
210	end;	210	end;
211		211
212	// Hinzugefügt	212	// Hinzugefügt
Line 214...	Line 214...
214		214
215	InternetCloseHandle(hsession);	215	InternetCloseHandle(hsession);
216	Result := resStr;	216	Result := resStr;
217	end;	217	end;
218		218
219	procedure CheckForUpdates(ViaThinkSoftProjectName: string);	219	procedure CheckForUpdates(ViaThinkSoftProjectName: string; AVersion: string);
220	var	220	var
221	cont: string;	221	cont: RawByteString;
222	begin	222	begin
223	cont := GetHTML('https://www.viathinksoft.de/update/?id='+ViaThinkSoftProjectName);	223	cont := GetHTML('https://www.viathinksoft.de/update/?id='+ViaThinkSoftProjectName);
224	if copy(cont, 0, 7) = 'Status:' then	224	if copy(cont, 0, 7) = 'Status:' then
225	begin	225	begin
226	Application.MessageBox('Ein Fehler ist aufgetreten. Wahrscheinlich ist keine Internetverbindung aufgebaut, oder der der ViaThinkSoft-Server vorübergehend offline.', 'Fehler', MB_OK + MB_ICONERROR)	226	Application.MessageBox('Ein Fehler ist aufgetreten. Wahrscheinlich ist keine Internetverbindung aufgebaut, oder der der ViaThinkSoft-Server vorübergehend offline.', 'Fehler', MB_OK + MB_ICONERROR)
227	end	227	end
228	else	228	else
229	begin	229	begin
230	if cont <> ProgramVersion then	230	if string(cont) <> AVersion then
231	begin	231	begin
232	if Application.MessageBox('Eine neue Programmversion ist vorhanden. Möchten Sie diese jetzt herunterladen?', 'Information', MB_YESNO + MB_ICONASTERISK) = ID_YES then	232	if Application.MessageBox('Eine neue Programmversion ist vorhanden. Möchten Sie diese jetzt herunterladen?', 'Information', MB_YESNO + MB_ICONASTERISK) = ID_YES then
233	shellexecute(application.handle, 'open', pchar('https://www.viathinksoft.de/update/?id=@'+ViaThinkSoftProjectName), '', '', sw_normal);	233	shellexecute(application.handle, 'open', pchar('https://www.viathinksoft.de/update/?id=@'+ViaThinkSoftProjectName), '', '', sw_normal);
234	end	234	end
235	else	235	else

Subversion Repositories spacemission

spacemission/Global.pas – Rev 72 → 74