config.pas

类似liveupdate的网络自动升级的程序

unit config;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, CHButton, StdCtrls, ExtCtrls, Buttons,Registry;

type
  TConfigure = class(TForm)
    Selektion: TScrollBox;
    showUserAdd: TCHButton;
    configaddUse: TScrollBox;
    Exitconfig: TCHButton;
    showProgrammAdd: TCHButton;
    configProgrammAdd: TScrollBox;
    ProgsList: TListBox;
    savecfg: TCHButton;
    makecfg: TCHButton;
    loadcfg: TCHButton;
    closecfg: TCHButton;
    General: TLabel;
    ConfigFile: TLabel;
    Panel1: TPanel;
    Panel2: TPanel;
    Memo1: TMemo;
    Label1: TLabel;
    Serverpfad: TEdit;
    SpeedButton1: TSpeedButton;
    hideprogs: TCheckBox;
    hideError: TCheckBox;
    Anwenden: TCHButton;
    Verwerfen: TCHButton;
    startup: TCheckBox;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    procedure deleteUserClick(Sender: TObject);
    procedure EditUserClick(Sender: TObject);
    procedure ExitconfigClick(Sender: TObject);
    procedure makecfgClick(Sender: TObject);
    procedure showItemClick(Sender: TObject);
    procedure loadcfgClick(Sender: TObject);
    procedure closecfgClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure savecfgClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure ServerpfadChange(Sender: TObject);
    procedure configClick(Sender: TObject);
    procedure AnwendenClick(Sender: TObject);
    procedure VerwerfenClick(Sender: TObject);
  private
    { Private declarations }
  public
    ConfigPath, progpath : String;
    startup1, hideerror1, hideprogs1 : Boolean;
    { Public declarations }
  end;

var
  Configure: TConfigure;

implementation
 VAR  newfile : Boolean = false;

{$R *.dfm}


procedure TConfigure.deleteUserClick(Sender: TObject);
var i : integer;
begin
end;

procedure TConfigure.EditUserClick(Sender: TObject);
var i : integer;
begin
  {for i := Einstellungenbox.UsersList.Count-1 downto 0 do
    If Einstellungenbox.UsersList.Selected[i] then
      Begin
        AddUsers.Benutzer.Text := ListofUsernames.Names[i];
        AddUsers.selecteddir.Text := whatdir(AddUsers.Benutzer.Text);
        AddUsers.Caption := 'Bearbeiten';
        AddUsers.ShowModal;
      End;}
end;

procedure TConfigure.ExitconfigClick(Sender: TObject);
begin
  close;
end;

procedure TConfigure.makecfgClick(Sender: TObject);
var s : String;
begin
  newfile := true;
  makecfg.Visible := false;
  loadcfg.Visible := false;
  closecfg.Visible := true;
  closecfg.Top := closecfg.Top - 46;
  savecfg.Visible := true;
  savecfg.Top := savecfg.Top - 46;
  Memo1.Lines.Add('[LANUpdateLite]');
  Memo1.Lines.Add('');
  Memo1.Lines.Add('[Prog1]');
  Memo1.Lines.Add('Datei=');
  Memo1.Lines.Add('Name=');
  Memo1.Lines.Add('Version=');
  Memo1.Lines.Add('Datum=');
  Memo1.Lines.Add('');
  Memo1.Lines.Add('[Prog2]');
  Memo1.Lines.Add('Datei=');
  Memo1.Lines.Add('Name=');
  Memo1.Lines.Add('Version=');
  Memo1.Lines.Add('Datum=');
  Memo1.Text := Memo1.Lines.Text;
end;

procedure TConfigure.showItemClick(Sender: TObject);
begin
  If Sender = showUserAdd Then
    Begin
      configProgrammAdd.Visible := false;
      configaddUse.Visible := True;
      showUserAdd.Border.Color := clred;
      showUserAdd.Border.HighlightColor := clred;
      showUserAdd.Border.ShadowColor := clred;
      showProgrammAdd.Border.Color := clnavy;
      showProgrammAdd.Border.HighlightColor := clnavy;
      showProgrammAdd.Border.ShadowColor := clnavy;
    End;
  If Sender = showProgrammAdd Then
    Begin
      configProgrammAdd.Visible := true;
      showProgrammAdd.Border.Color := clred;
      showProgrammAdd.Border.HighlightColor := clred;
      showProgrammAdd.Border.ShadowColor := clred;
      showUserAdd.Border.Color := clnavy;
      showUserAdd.Border.HighlightColor := clnavy;
      showUserAdd.Border.ShadowColor := clnavy;
      configaddUse.Visible := False;
      {Vor黚ergehend ...}
      {General.Visible := False;
      showUserAdd.Visible := False;
      showProgrammAdd.Top := showUserAdd.Top;
      ConfigFile.Top := General.Top;
      makecfg.Visible := False;
      loadcfg.Top := makecfg.Top;  }
      {... Ende}
    End;
end;

procedure TConfigure.loadcfgClick(Sender: TObject);
begin
  IF FileExists (ConfigPath) then
  Begin
    memo1.Lines.LoadFromFile(ConfigPath);
    makecfg.Visible := false;
    loadcfg.Visible := false;
    closecfg.Visible := true;
    closecfg.Top := closecfg.Top - 46;
    savecfg.Visible := true;
    savecfg.Top := savecfg.Top - 46;
  End
  Else
    showmessage ('Can not load the configuration-file. LAN refused or the file do not exist.');
  {EditProg.Visible := true;
  EditProg.Top := EditProg.Top - 46;
  delProg.Visible := true;
  delProg.Top := delProg.Top - 46;}
end;

procedure TConfigure.closecfgClick(Sender: TObject);
begin
  makecfg.Visible := true;
  loadcfg.Visible := true;
  closecfg.Visible := false;
  closecfg.Top := closecfg.Top + 46;
  savecfg.Visible := false;
  savecfg.Top := savecfg.Top + 46;
  memo1.Text := '';
end;

procedure loadRegconfig;
Var regist : TRegistry;
Begin
  regist := TRegistry.Create;
  regist.RootKey:= HKEY_LOCAL_MACHINE;
  regist.OpenKey('Software\LES\LANUpdate Lite', true);
  configure.ConfigPath := regist.ReadString('configpath');
  configure.progPath := regist.ReadString('progpath');
  If regist.ReadString('hideprogs') = 'True'  Then configure.hideprogs1 := true
    else configure.hideprogs1 := false;
  If regist.ReadString('hideerror') = 'True'  Then configure.hideerror1 := true
    else configure.hideerror1 := false;
  If regist.ReadString('startup') = 'True'  Then configure.startup1 := true
    else configure.startup1 := false;
  Configure.hideprogs.Checked := Configure.hideprogs1;
  Configure.hideerror.Checked := Configure.hideerror1;
  Configure.startup.Checked := Configure.startup1;
  Configure.Serverpfad.Text := configure.configpath;
  Configure.Anwenden.Enabled := False;
  Configure.Verwerfen.Enabled := False;
  regist.Free;
End;

procedure TConfigure.FormCreate(Sender: TObject);
begin
  loadRegconfig;
end;

procedure TConfigure.savecfgClick(Sender: TObject);
begin
  if newfile then
    Begin
      If serverpfad.Text = '' then
        Begin
        if SaveDialog1.Execute then
          memo1.Lines.SaveToFile(savedialog1.FileName);
        End
      else
        Begin
        If MessageDlg('Do You want to overwrite the existing config-file?',mtConfirmation, [mbYes, mbNo],0) = mrYes then
           memo1.Lines.SaveToFile(configpath)
        else
          if SaveDialog1.Execute then
          memo1.Lines.SaveToFile(savedialog1.FileName);
        End;
    End
  else
    memo1.Lines.SaveToFile(configpath);

end;

procedure TConfigure.SpeedButton1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    Begin
      Serverpfad.Text := OpenDialog1.FileName;
      Verwerfen.Enabled := true;
      Anwenden.Enabled := True;
    End;
end;

procedure TConfigure.ServerpfadChange(Sender: TObject);
begin
  Verwerfen.Enabled := true;
  Anwenden.Enabled := True;
end;

procedure TConfigure.configClick(Sender: TObject);
begin
  Verwerfen.Enabled := true;
  Anwenden.Enabled := True;
end;

function makedir(s : string):string;
Begin
  while s[length(s)] <> '\' do
    s := copy (s, 0, length(s)-1);
  Result := s;
End;

procedure TConfigure.AnwendenClick(Sender: TObject);
var regist : TRegistry;
begin
  regist := TRegistry.Create;
  regist.RootKey:= HKEY_LOCAL_MACHINE;
  regist.OpenKey('Software\LES\LANUpdate Lite', true);
  configpath := Serverpfad.Text;
  progpath := makedir(configpath);
  regist.writeString('configpath',serverpfad.Text);
  regist.writeString('progpath',progpath);
  hideerror1 := hideError.Checked;
  If hideerror1 then regist.writeString('hideerror','True')
    else regist.writeString('hideerror','False');
  hideprogs1 := hideProgs.Checked;
  If hideprogs1 then regist.writeString('hideprogs','True')
    else regist.writeString('hideprogs','False');
  startup1 := startup.Checked;
  If startup1 then regist.writeString('startup','True')
    else regist.writeString('startup','False');
  Anwenden.Enabled := False;
  Verwerfen.Enabled := False;
  regist.Free;
end;

procedure TConfigure.VerwerfenClick(Sender: TObject);
begin
  loadRegconfig;
  Anwenden.Enabled := False;
  Verwerfen.Enabled := False;
end;

end.