Subversion Repositories musikbox

Rev

Rev 6 | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. unit Info;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, SysUtils, Classes, Forms, StdCtrls, ExtCtrls, ShellApi,
  7.   Graphics, Controls, wininet;
  8.  
  9. type
  10.   TInfoForm = class(TForm)
  11.     lblInfo1: TLabel;
  12.     lblInfo2: TLabel;
  13.     lblInfo3: TLabel;
  14.     lblInfo4: TLabel;
  15.     imgCD: TImage;
  16.     imgWeb: TImage;
  17.     lblWeb1: TLabel;
  18.     lblWeb2: TLabel;
  19.     lblClose: TButton;
  20.     Button1: TButton;
  21.     procedure lblCloseClick(Sender: TObject);
  22.     procedure lblWeb1Click(Sender: TObject);
  23.     procedure lblWeb2Click(Sender: TObject);
  24.     procedure Button1Click(Sender: TObject);
  25.   end;
  26.  
  27. var
  28.   InfoForm: TInfoForm;
  29.  
  30. implementation
  31.  
  32. {$R *.dfm}
  33.  
  34. const
  35.   ProgrammVersion = '1.5';
  36.  
  37. // https://www.delphipraxis.net/post43515.html , fixed , works for Delphi 12 Athens
  38. function GetHTML(AUrl: string): RawByteString;
  39. var
  40.   databuffer : array[0..4095] of ansichar; // SIC! ansichar!
  41.   ResStr : ansistring; // SIC! ansistring
  42.   hSession, hfile: hInternet;
  43.   dwindex,dwcodelen,dwread,dwNumber: cardinal;
  44.   dwcode : array[1..20] of char;
  45.   res    : pchar;
  46.   Str    : pansichar; // SIC! pansichar
  47. begin
  48.   ResStr:='';
  49.   if (system.pos('http://',lowercase(AUrl))=0) and
  50.      (system.pos('https://',lowercase(AUrl))=0) then
  51.      AUrl:='http://'+AUrl;
  52.  
  53.   // Hinzugefügt
  54.   if Assigned(Application) then Application.ProcessMessages;
  55.  
  56.   hSession:=InternetOpen('InetURL:/1.0',
  57.                          INTERNET_OPEN_TYPE_PRECONFIG,
  58.                          nil,
  59.                          nil,
  60.                          0);
  61.   if assigned(hsession) then
  62.   begin
  63.     // Hinzugefügt
  64.     if Assigned(Application) then application.ProcessMessages;
  65.  
  66.     hfile:=InternetOpenUrl(
  67.            hsession,
  68.            pchar(AUrl),
  69.            nil,
  70.            0,
  71.            INTERNET_FLAG_RELOAD,
  72.            0);
  73.     dwIndex  := 0;
  74.     dwCodeLen := 10;
  75.  
  76.     // Hinzugefügt
  77.     if Assigned(Application) then application.ProcessMessages;
  78.  
  79.     HttpQueryInfo(hfile,
  80.                   HTTP_QUERY_STATUS_CODE,
  81.                   @dwcode,
  82.                   dwcodeLen,
  83.                   dwIndex);
  84.     res := pchar(@dwcode);
  85.     dwNumber := sizeof(databuffer)-1;
  86.     if (res ='200') or (res = '302') then
  87.     begin
  88.       while (InternetReadfile(hfile,
  89.                               @databuffer,
  90.                               dwNumber,
  91.                               DwRead)) do
  92.       begin
  93.  
  94.         // Hinzugefügt
  95.         if Assigned(Application) then application.ProcessMessages;
  96.  
  97.         if dwRead =0 then
  98.           break;
  99.         databuffer[dwread]:=#0;
  100.         Str := pansichar(@databuffer);
  101.         resStr := resStr + Str;
  102.       end;
  103.     end
  104.     else
  105.       ResStr := 'Status:'+AnsiString(res);
  106.     if assigned(hfile) then
  107.       InternetCloseHandle(hfile);
  108.   end;
  109.  
  110.   // Hinzugefügt
  111.   if Assigned(Application) then application.ProcessMessages;
  112.  
  113.   InternetCloseHandle(hsession);
  114.   Result := resStr;
  115. end;
  116.  
  117. procedure TInfoForm.Button1Click(Sender: TObject);
  118. var
  119.   temp: RawByteString;
  120. begin
  121.   temp := GetHTML('https://www.viathinksoft.de/update/?id=musikbox');
  122.   if copy(temp, 0, 7) = 'Status:' then
  123.   begin
  124.     Application.MessageBox('Ein Fehler ist aufgetreten. Wahrscheinlich ist keine Internetverbindung aufgebaut, oder der der ViaThinkSoft-Server temporär offline.', 'Fehler', MB_OK + MB_ICONERROR)
  125.   end
  126.   else
  127.   begin
  128.     if GetHTML('https://www.viathinksoft.de/update/?id=musikbox') <> ProgrammVersion then
  129.     begin
  130.       if Application.MessageBox('Eine neue Programmversion ist vorhanden. Möchten Sie diese jetzt herunterladen?', 'Information', MB_YESNO + MB_ICONASTERISK) = ID_YES then
  131.         shellexecute(application.handle, 'open', pchar('https://www.viathinksoft.de/update/?id=@musikbox'), '', '', sw_normal);
  132.     end
  133.     else
  134.     begin
  135.       Application.MessageBox('Es ist keine neue Programmversion vorhanden.', 'Information', MB_OK + MB_ICONASTERISK);
  136.     end;
  137.   end;
  138. end;
  139.  
  140. procedure TInfoForm.lblCloseClick(Sender: TObject);
  141. begin
  142.   close;
  143. end;
  144.  
  145. procedure TInfoForm.lblWeb1Click(Sender: TObject);
  146. begin
  147.   ShellExecute(Handle, 'open', 'https://www.daniel-marschall.de/', nil, nil, SW_SHOWNORMAL);
  148. end;
  149.  
  150. procedure TInfoForm.lblWeb2Click(Sender: TObject);
  151. begin
  152.   ShellExecute(Handle, 'open', 'https://www.viathinksoft.de/', nil, nil, SW_SHOWNORMAL);
  153. end;
  154.  
  155. end.
  156.