Subversion Repositories musikbox

Rev

Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 daniel-mar 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.