Subversion Repositories musikbox

Rev

Blame | 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. // http://www.delphipraxis.net/post43515.html
  35. Function GetHTML(AUrl: string): string;
  36. var
  37.   databuffer : array[0..4095] of char;
  38.   ResStr : string;
  39.   hSession, hfile: hInternet;
  40.   dwindex,dwcodelen,dwread,dwNumber: cardinal;
  41.   dwcode : array[1..20] of char;
  42.   res    : pchar;
  43.   Str    : pchar;
  44. begin
  45.   ResStr:='';
  46.   if pos('http://',lowercase(AUrl))=0 then
  47.      AUrl:='http://'+AUrl;
  48.  
  49.   // Hinzugefügt
  50.   application.ProcessMessages;
  51.  
  52.   hSession:=InternetOpen('InetURL:/1.0',
  53.                          INTERNET_OPEN_TYPE_PRECONFIG,
  54.                          nil,
  55.                          nil,
  56.                          0);
  57.   if assigned(hsession) then
  58.   begin
  59.     // Hinzugefügt
  60.     application.ProcessMessages;
  61.  
  62.     hfile:=InternetOpenUrl(
  63.            hsession,
  64.            pchar(AUrl),
  65.            nil,
  66.            0,
  67.            INTERNET_FLAG_RELOAD,
  68.            0);
  69.     dwIndex  := 0;
  70.     dwCodeLen := 10;
  71.  
  72.     // Hinzugefügt
  73.     application.ProcessMessages;
  74.  
  75.     HttpQueryInfo(hfile,
  76.                   HTTP_QUERY_STATUS_CODE,
  77.                   @dwcode,
  78.                   dwcodeLen,
  79.                   dwIndex);
  80.     res := pchar(@dwcode);
  81.     dwNumber := sizeof(databuffer)-1;
  82.     if (res ='200') or (res ='302') then
  83.     begin
  84.       while (InternetReadfile(hfile,
  85.                               @databuffer,
  86.                               dwNumber,
  87.                               DwRead)) do
  88.       begin
  89.  
  90.         // Hinzugefügt
  91.         application.ProcessMessages;
  92.  
  93.         if dwRead =0 then
  94.           break;
  95.         databuffer[dwread]:=#0;
  96.         Str := pchar(@databuffer);
  97.         resStr := resStr + Str;
  98.       end;
  99.     end
  100.     else
  101.       ResStr := 'Status:'+res;
  102.     if assigned(hfile) then
  103.       InternetCloseHandle(hfile);
  104.   end;
  105.  
  106.   // Hinzugefügt
  107.   application.ProcessMessages;
  108.  
  109.   InternetCloseHandle(hsession);
  110.   Result := resStr;
  111. end;
  112.  
  113. procedure TInfoForm.Button1Click(Sender: TObject);
  114. var
  115.   temp: string;
  116. begin
  117.   temp := GetHTML('http://www.viathinksoft.de/update/?id=musikbox');
  118.   if copy(temp, 0, 7) = 'Status:' then
  119.   begin
  120.     Application.MessageBox('Ein Fehler ist aufgetreten. Wahrscheinlich ist keine Internetverbindung aufgebaut, oder der der ViaThinkSoft-Server temporär offline.', 'Fehler', MB_OK + MB_ICONERROR)
  121.   end
  122.   else
  123.   begin
  124.     if GetHTML('http://www.viathinksoft.de/update/?id=musikbox') <> '1.5' then
  125.     begin
  126.       if Application.MessageBox('Eine neue Programmversion ist vorhanden. Möchten Sie diese jetzt herunterladen?', 'Information', MB_YESNO + MB_ICONASTERISK) = ID_YES then
  127.         shellexecute(application.handle, 'open', pchar('http://www.viathinksoft.de/update/?id=@musikbox'), '', '', sw_normal);
  128.     end
  129.     else
  130.     begin
  131.       Application.MessageBox('Es ist keine neue Programmversion vorhanden.', 'Information', MB_OK + MB_ICONASTERISK);
  132.     end;
  133.   end;
  134. end;
  135.  
  136. procedure TInfoForm.lblCloseClick(Sender: TObject);
  137. begin
  138.   close;
  139. end;
  140.  
  141. procedure TInfoForm.lblWeb1Click(Sender: TObject);
  142. begin
  143.   ShellExecute(Handle, 'open', 'http://www.daniel-marschall.de/', nil, nil, SW_SHOWNORMAL);
  144. end;
  145.  
  146. procedure TInfoForm.lblWeb2Click(Sender: TObject);
  147. begin
  148.   ShellExecute(Handle, 'open', 'http://www.viathinksoft.de/', nil, nil, SW_SHOWNORMAL);
  149. end;
  150.  
  151. end.
  152.