Ich hab ne Update-Form die ich anzeigen will.
Wenn ich aber
Code: Alles auswählen
Form4.Show
Alle andere Formulare gehen aber.
Hier der Code:
Code: Alles auswählen
unit updater;
{$mode delphi}
{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
ComCtrls, Buttons, ExtCtrls, process, HTTPSend, blcksock, serial;
type
{ TForm4 }
TForm4 = class(TForm)
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
Combo1: TComboBox;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
GroupBox3: TGroupBox;
GroupBox4: TGroupBox;
Memo1: TMemo;
ProgressBar1: TProgressBar;
ProgressBar2: TProgressBar;
SaveDialog1: TSaveDialog;
SelectDirectoryDialog1: TSelectDirectoryDialog;
Timer1: TTimer;
StatusBar1:TStatusBar;
procedure BitBtn1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure SockCallBack(Sender: TObject; Reason: THookSocketReason;const Value: string) register;
procedure StatusBar1DblClick(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form4: TForm4;
x:THTTPSend;
Val:integer;
gesamt:integer;
BinOrt:string;
implementation
{ TForm4 }
procedure TForm4.FormShow(Sender: TObject);
begin
end;
procedure TForm4.SockCallBack(Sender: TObject; Reason: THookSocketReason;const Value: string);
var
V:double;
Val2:integer;
begin
Application.ProcessMessages;
Val2:=StrToIntDef(Value, -1);
Application.ProcessMessages;
If Reason = HR_Connect then begin StatusBar1.Panels[0].Text:='Verbinden...';end;
If Reason = HR_Error then StatusBar1.Panels[0].Text:='Unnbekannter Fehler';
If Reason = HR_Wait then StatusBar1.Panels[0].Text:='Bitte warten...';
Application.ProcessMessages;
Val:=x.Sock.RecvCounter;
end;
procedure TForm4.StatusBar1DblClick(Sender: TObject);
begin
end;
procedure TForm4.FormCreate(Sender: TObject);
var
i:integer;
t:TStringList;
begin
For i:=0 to 50 Do
begin
{$IFDEF UNIX}
// if FileExists('/dev/ttyUSB'+inttostr(i)+'') then Combo1.Items.Add('/dev/ttyUSB'+inttostr(i)+'');
{$ENDIF}
{$IFDEF WINDOWS}
// Combo1.Items.Add('COM'+inttostr(i)+'');
{$ENDIF}
end;
memo1.Clear;
with THTTPSend.Create do
begin
if HTTPMethod('GET','http://tiersendung.ti.funpic.de/tristan/territorium_desc.txt') then
try
t:= TStringList.Create;
t.LoadFromStream(Document);
i:=0;
Application.ProcessMessages;
For i:=0 to 50 do
Memo1.Lines.Add(t.Strings[i]);
except
MessageDlg('Fehler','Es konnte keine Verbindung zum Internet hergestellt werden.',mtError,[mbOk],'');
end;
BinOrt:=t.Strings[53];
try
Progressbar1.max:=strtoint(t.Strings[52]);
gesamt:=strtoint(t.Strings[52]);
except
MessageDlg('Fehler','Die Datei ist falsch aufgebaut.'+#13+'Das bedeutet,das die Fortschrittsanzeige nicht gehen wird.',mtError,[mbOk],'');
end;
t.Free;
Free;
end;
end;
procedure TForm4.BitBtn1Click(Sender: TObject);
var
UnZip: TProcess;
buf:String;
begin
SaveDialog1.Execute;
x:=THTTPSend.Create;
with x do
begin
if HTTPMethod('GET',BinOrt) then
try
Application.ProcessMessages;
MessageDlg('Information','Juhu!'+#13+'Das Update war erfolgreich.'+#13+'Bitte starten sie die Datei "TS-Territoriums-Strg_neu".',mtInformation,[mbOk],'');
StatusBar1.Panels[0].Text:='Speichern...';
Document.SaveToFile(SaveDialog1.FileName+'.gz');
//UnZip.Options:=[poWaitOnExit];
UnZip.CommandLine := 'gzip --decompress '+SaveDialog1.FileName+'.gz';
sleep(200);
UnZip.Execute;
StatusBar1.Panels[0].Text:='Entpacken...';
sleep(500);
UnZip.CommandLine:='chmod 666 '+SaveDialog1.FileName;
UnZip.Execute;
Free;
UnZip.Free;
except
MessageDlg('Fehler','Unnbekannter Fehler während dem Download.',mtError,[mbOk],'');
end;
end;
end;
initialization
{$I updater.lrs}
end.