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