setsystem.pas

中控800型号考勤机的自动采集数据程序。能够手动采集

unit setsystem;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls,inifiles,Registry, ExtCtrls, Menus,
  cxLookAndFeelPainters, cxButtons;

type
  Tsystemset = class(TForm)
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    DateTimePicker1: TDateTimePicker;
    Button1: TButton;
    Button2: TButton;
    Image1: TImage;
    Image2: TImage;
    Label5: TLabel;
    Label7: TLabel;
    Label6: TLabel;
    Label8: TLabel;
    Bevel2: TBevel;
    Bevel1: TBevel;
    Label9: TLabel;
    Label10: TLabel;
    Bevel3: TBevel;
    GroupBox1: TGroupBox;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    ComboBox1: TComboBox;
    Edit1: TEdit;
    Edit2: TEdit;
    ComboBox3: TComboBox;
    TabSheet2: TTabSheet;
    Label15: TLabel;
    Edit3: TEdit;
    Button4: TButton;
    CheckBox3: TCheckBox;
    Button5: TcxButton;
    procedure Edit11KeyPress(Sender: TObject; var Key: Char);
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    aSQLServerList: TStrings;
    { Private declarations }
    function SaveToRun(execname: string;aRun: boolean):boolean;
    function WriterReg:boolean;
    procedure GetInfo;
    function ReadReg:boolean;
  public
    { Public declarations }
    function TestDabaseconn(aServer,aLogName,aLogPw,aDataBase: string;aTpye: integer):boolean;
  end;

var
  systemset: Tsystemset;

implementation
uses shareunit,CommonUnit, u_dm;
{$R *.dfm}
function Tsystemset.TestDabaseconn(aServer,aLogName,aLogPw,aDataBase: string;aTpye: integer):boolean;
begin
 result := false;
 if aTpye=1 then
 begin
 try
    Screen.Cursor:=crSQLWait;
    if dm.con1.Connected then dm.Con1.Close;
    //Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=TestDB;Data Source=IT014
    dm.Con1.ConnectionString:='Provider=SQLOLEDB.1;'
                              +'Persist Security Info=False;'
                              +'Initial Catalog='+trim(aDataBase)+';'
                              +'User ID='+trim(aLogName)+';'
                              +'Password='+trim(aLogPw)+';'
                              +'Data Source='+trim(aServer);
    dm.Con1.Open;
    result := true;
  except
    Screen.Cursor:=crDefault;
    exit;
  end;
 end
 else if aTpye=2 then
 begin
 try
    Screen.Cursor:=crSQLWait;
    if dm.Con1.Connected then dm.Con1.Close;
    dm.Con1.ConnectionString:='Provider=SQLOLEDB.1;'
                              +'Persist Security Info=False;'
                              +'Initial Catalog='+trim(aDataBase)+';'
                              +'User ID='+trim(aLogName)+';'
                              +'Password='+trim(aLogPw)+';'
                              +'Data Source='+trim(aServer);
    dm.Con1.Open;
    result := true;
  except
    Screen.Cursor:=crDefault;
    exit;
  end;
 end
 else
 begin
 try
    Screen.Cursor:=crSQLWait;
    if dm.Con1.Connected then dm.Con1.Close;
    dm.Con1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;'
                              +'Data Source='+trim(aDataBase)
                              +';Persist Security Info=False';
    dm.Con1.Open;
    result := true;
  except
    Screen.Cursor:=crDefault;
    exit;
  end;
 end;
 Screen.Cursor:=crDefault;
end;
function Tsystemset.ReadReg:boolean;
var
  Registry: TRegistry;
  i: integer;
begin
  Result := false;
  Registry := TRegistry.Create;
  try
    Registry.RootKey := HKEY_CURRENT_USER;
    if Registry.OpenKey('Software\PiaoxueskySoft\GetDevData', True)  then
    begin
    if Registry.ValueExists('SQLServer') then
      combobox1.Text := Decryption('piaoxuesky',Registry.ReadString('SQLServer'))
     else combobox1.Text := '';
    if Registry.ValueExists('LoginName') then
      Edit1.Text:=Decryption('piaoxuesky',Registry.ReadString('LoginName'))
    else
      Edit1.Text:='';
    if Registry.ValueExists('LoginPwd') then
      Edit2.Text:=Decryption('piaoxuesky',Registry.ReadString('LoginPwd'))
    else
      Edit2.Text:='';
    if Registry.ValueExists('DataBase') then
      combobox3.Text := Decryption('piaoxuesky',Registry.ReadString('DataBase'))
     else combobox3.Text := '';
    Result := true;
  end;
  finally
    Registry.CloseKey;
    Registry.Free;
  end;
end;
procedure Tsystemset.GetInfo;
var i: integer;
begin
 //try
 {DateTimePicker1.Date := StrToDatetime(ForMatDateTime('yyyy-mm-dd',now()));
 aSQLServerList := TStringList.Create;
 Combobox1.Items.Clear;
 Combobox1.Items.BeginUpdate;
 if GetNetWorkServer(aSQLServerList) then
  begin
   if aSQLServerList.Count<=0 then
    begin
     application.MessageBox('获取服务器列表失败！网络中不存在数据库服务器请检查网络！','提示',MB_OK);
     Combobox1.Items.EndUpdate;
    end;
   for i:=0 to aSQLServerList.Count-1 do
   begin
    if aSQLServerList.Strings[i]='.' then
    begin
    end
    else
    begin
    Combobox1.Items.Add(aSQLServerList.Strings[i]);
    end;
   end;
  end
 else
  begin
     application.MessageBox('获取服务器列表失败！网络中不存在数据库服务器请检查网络！','提示',MB_OK);
     Combobox1.Items.EndUpdate;
  end;
 Combobox1.Items.EndUpdate;
 except
  application.MessageBox('获取服务器列表失败！网络中不存在数据库服务器请检查网络！','提示',MB_OK);
  Combobox1.Items.EndUpdate;
 end;} 
 if not ReadReg then
 begin
  application.MessageBox('读取服务器信息失败！','提示',MB_OK);
  exit;
 end;
end;
function Tsystemset.WriterReg:boolean;
var
  Registry: TRegistry;
begin
  Result := false;
  Registry := TRegistry.Create;
  try
    Registry.RootKey := HKEY_CURRENT_USER;
    if Registry.OpenKey('Software\PiaoxueskySoft\GetDevData', True)  then
    begin
      Registry.WriteString('SQLServer',Encryption('piaoxuesky',Trim(Combobox1.Text)));
      Registry.WriteString('LoginName',Encryption('piaoxuesky',Trim(Edit1.Text)));
      Registry.WriteString('LoginPwd',Encryption('piaoxuesky',Trim(Edit2.Text)));
      Registry.WriteString('DataBase',Encryption('piaoxuesky',Trim(Combobox3.Text)));
      Result := true;
    end;
  finally
    Registry.CloseKey;
    Registry.Free;
  end;
end;
function Tsystemset.SaveToRun(execname: string;aRun: boolean):boolean;
var
  Registry: TRegistry;
begin
  Result := false;
  Registry := TRegistry.Create;
  try
    Registry.RootKey := HKEY_LOCAL_MACHINE;
    if Registry.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run', True)  then
    begin
      if aRun then
      Registry.WriteString('KQLoadData',execname)
      else
      begin
      if not Registry.DeleteValue('KQLoadData') then exit;
      end;
      Result := true;
    end;
  finally
    Registry.CloseKey;
    Registry.Free;
  end;
end;
procedure Tsystemset.Edit11KeyPress(Sender: TObject; var Key: Char);
begin
 if  not (key in ['1','2','3','0','4','5','6','7','8','9']) then
  key := #0;
end;

procedure Tsystemset.Button2Click(Sender: TObject);
begin
close;
end;

procedure Tsystemset.FormShow(Sender: TObject);
var aIniFile: TIniFile;
    ainiFileName: string;
    acheck1,acheck2: boolean;
    aTime: string;
    atemptime: TDateTime;
begin
 ainiFileName := ChangeFileExt(ExePath+ExeName+'.exe','.ini');
 aIniFile := TIniFile.Create(ainiFileName);
 if not FileExists(ainiFileName) then
 begin
  application.MessageBox('配置文件丢失！请于管理员联系～','提示',MB_OK);
  exit;
 end;
 with aIniFile do
 begin
  if ReadString('SystemConfig','Run','-1')='1' then
  checkbox1.Checked := true
  else
  checkbox1.Checked := false;
  if ReadString('SystemConfig','SeftGetData','-1')='1' then
  checkbox2.Checked := true
  else
  checkbox2.Checked := false;
  if ReadString('SystemConfig','ClearData','-1')='1' then
  checkbox3.Checked := true
  else
  checkbox3.Checked := false;
  aTime := ReadString('SystemConfig','Time','');
  if tryStrToDateTime(aTime,atemptime) then
  DateTimePicker1.Time := atemptime
  else
  DateTimePicker1.Time := StrToDateTime('00:00:00');
 end;
  if checkbox2.Checked then
  begin
   DateTimePicker1.Enabled := true;
  end
  else
  begin
   DateTimePicker1.Enabled := false;
  end;
 GetInfo;
end;
procedure Tsystemset.CheckBox2Click(Sender: TObject);
begin
  if checkbox2.Checked then
  begin
   DateTimePicker1.Enabled := true;
  end
  else
  begin
   DateTimePicker1.Enabled := false;
  end;
end;

procedure Tsystemset.Button5Click(Sender: TObject);
var aIniFile: TIniFile;
    ainiFileName: string;
    aDate,aType: integer;
    aTime: String;
begin
//================================================
if not TestDabaseconn(combobox1.Text,edit1.Text,edit2.Text,combobox3.Text,1) then
begin
  application.MessageBox('数据源服务器连接失败,保存失败！','提示',MB_OK);
  exit;
end;
  //application.MessageBox('连接成功！','提示',MB_OK);
if not WriterReg then
 begin
  application.MessageBox('写入注册文件失败！','提示',MB_OK);
  exit;
 end;
//================================================
 ainiFileName := ChangeFileExt(ExePath+ExeName+'.exe','.ini');
 aIniFile := TIniFile.Create(ainiFileName);
 if not FileExists(ainiFileName) then
 begin
  application.MessageBox('配置文件丢失！请于管理员联系～','提示',MB_OK);
 end;
 with aIniFile do
 begin
  if checkbox1.Checked then
  WriteString('SystemConfig','Run','1')
  else
  WriteString('SystemConfig','Run','0');
  if checkbox2.Checked then
  WriteString('SystemConfig','SeftGetData','1')
  else
  WriteString('SystemConfig','SeftGetData','0');
  if checkbox3.Checked then
  WriteString('SystemConfig','ClearData','1')
  else
  WriteString('SystemConfig','ClearData','0');
  aTime := ForMatDateTime('hh:mm',DateTimePicker1.Time);
  WriteString('SystemConfig','Time',aTime);
  ifSelfLoad := checkbox2.Checked;
  ClearUpData := checkbox3.Checked;
  aLoadTime := StrToTime(ForMatDateTime('hh:mm',DateTimePicker1.Time));
 end;
 if SaveToRun(ExePath+ExeName+'.exe',checkbox1.Checked) then
 application.MessageBox('保存成功！','提示',MB_OK)
 else
 application.MessageBox('保存失败！','提示',MB_OK)
end;

end.