ufwq.~pas

在公司做的一个小的系统源代码

unit Ufwq;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, winsock, DB, ADODB, Mask, jpeg, IniFiles,
  ComCtrls;

type
  TFrmsjfwq = class(TForm)
    ADOQfwq: TADOQuery;
    ADOQuery1: TADOQuery;
    Panel1: TPanel;
    Label2: TLabel;
    Panel2: TPanel;
    Image2: TImage;
    Bbtnsave: TBitBtn;
    Bbtnclose: TBitBtn;
    Panel3: TPanel;
    Label1: TLabel;
    Bbtncon: TBitBtn;
    StatusBar1: TStatusBar;
    Edtsjserver: TEdit;
    procedure BbtncloseClick(Sender: TObject);
  //  function findcomputer(a:string):boolean;
    procedure BbtnconClick(Sender: TObject);
    procedure BbtnsaveClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure EdtsjserverKeyPress(Sender: TObject; var Key: Char);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure EdtsjserverChange(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    ubc,dizhibz: boolean; //ubz：连接成功标志。dizhibz:地址修改标志
  end;

var
  Frmsjfwq: TFrmsjfwq;

implementation

uses Udm, Ulgb;

{$R *.dfm}

procedure TFrmsjfwq.BbtncloseClick(Sender: TObject);
begin
  close;
end;

procedure TFrmsjfwq.BbtnconClick(Sender: TObject);
begin
  if edtsjserver.Text = '' then
  begin
    messagebox(getforegroundwindow, '请输入服务器的地址！', Gsysname, mb_ok + mb_iconinformation);
    edtsjserver.SetFocus;
    abort;
  end;
  screen.Cursor := crhourglass;
  statusbar1.SimpleText := '正在连接服务器，请稍候...';
  dm.ADOConnection1.Connected := false;
  dm.ADOConnection1.ConnectionString := 'Provider=SQLOLEDB.1;Password=' + gserverpwd + ';Persist Security Info=True;User ID=' + gserveruser + ';Initial Catalog=pricedata;Data Source=' + #39 + edtsjserver.text + #39;
  try
     begin
      dm.ADOConnection1.Connected := true;
      messagebox(getforegroundwindow, '服务器连接成功！', Gsysname, mb_ok + mb_iconinformation);
      statusbar1.SimpleText := '服务器连接成功！';
      ubc := false;
      screen.Cursor := crdefault;
      bbtnsave.Enabled := true;
      bbtnsave.SetFocus;
    end;
  except
    begin
      statusbar1.Panels.Clear;
      statusbar1.SimpleText := '服务器连接失败！';
      screen.Cursor := crdefault;
      application.MessageBox('服务器连接失败，请重设服务器地址或检查网络情况！！！', Gsysname, MB_OK + MB_ICONINFORMATION);
      bbtnsave.Enabled := false;
      ubc := true;
      end
  end;
end;


procedure TFrmsjfwq.BbtnsaveClick(Sender: TObject);
var
Config: TIniFile;
begin
  renamefile(Gsyspath+'\zbcg.sys',Gsyspath+'\zbcg.ini');
  config:=Tinifile.Create(Gsyspath+'\zbcg.ini');
  config.WriteString('database','serverid',edtsjserver.Text);
  config.Free;
  renamefile(Gsyspath+'\zbcg.ini',Gsyspath+'\zbcg.sys') ;
  Gserverid:=edtsjserver.Text;
  messagebox(getforegroundwindow, '服务器设置成功！', Gsysname, mb_ok + mb_iconinformation);
  statusbar1.SimpleText := '服务器设置成功！';
  ubc := true;
  gserverid := trim(edtsjserver.Text);
   bbtnsave.Enabled := false;
end;

procedure TFrmsjfwq.FormShow(Sender: TObject);
begin
  ubc := true; dizhibz:=true;
  if Gserverid = '' then
    edtsjserver.Text := '218.57.128.245'
  else
    edtsjserver.Text :=gserverid;
   bbtncon.SetFocus;
end;

procedure TFrmsjfwq.FormClose(Sender: TObject; var Action: TCloseAction);
var
Config: TIniFile;
begin
  if (ubc = false) and (dizhibz=false) then begin
    if application.messagebox('服务器地址已连接成功,是否保存?', Gsysname, mb_yesno + mb_iconquestion) = mryes then
    begin
      renamefile(Gsyspath+'\zbcg.sys',Gsyspath+'\zbcg.ini');
      config:=Tinifile.Create(Gsyspath+'\zbcg.ini');
      config.WriteString('database','serverid',edtsjserver.Text);
      config.Free;
      renamefile(Gsyspath+'\zbcg.ini',Gsyspath+'\zbcg.sys') ;
      Gserverid:=edtsjserver.Text;
      ubc := true;
      gserverid :=trim(edtsjserver.Text);
      bbtnsave.Enabled := false;
    end;
  end;
end;

procedure TFrmsjfwq.EdtsjserverKeyPress(Sender: TObject; var Key: Char);
begin
  bbtnsave.Enabled := false;
  if key = #13 then begin
    bbtncon.SetFocus;
    key := #0;
  end;
end;

procedure TFrmsjfwq.EdtsjserverChange(Sender: TObject);
begin
dizhibz:=true;
end;

end.