⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 uselectacc.pas

📁 天涯進銷存系統
💻 PAS
字号:
unit uSelectAcc;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, jpeg, ExtCtrls, LBCtrls, StdCtrls, LBDBScrollBar, Grids,
  LBDBGrid, DBXpress, DB, DBClient, SimpleDS, SqlExpr, Registry, FMTBcd,
  IdBaseComponent, IdComponent, IdIPWatch,IniFiles;

type
  TfrmSelectAcc = class(TForm)
    Panel1: TPanel;
    Shape1: TShape;
    Shape2: TShape;
    Shape4: TShape;
    Shape3: TShape;
    Shape5: TShape;
    Shape6: TShape;
    EnterButton: TLBButton;
    CancelButton: TLBButton;
    Image2: TImage;
    Panel2: TPanel;
    Label17: TLabel;
    Label21: TLabel;
    Shape7: TShape;
    DataDBGrid: TLBDBGrid;
    LBDBScrollBar1: TLBDBScrollBar;
    SQLConnection: TSQLConnection;
    AccCds: TSimpleDataSet;
    AccDs: TDataSource;
    SQLQuery: TSQLQuery;
    CreateAccButton: TLBButton;
    DeleteAccButton: TLBButton;
    Label1: TLabel;
    Label2: TLabel;
    IdIPWatch1: TIdIPWatch;
    adocx: TSimpleDataSet;
    Label3: TLabel;
    Label4: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure EnterButtonClick(Sender: TObject);
    procedure DataDBGridKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure CancelButtonClick(Sender: TObject);
    procedure CreateAccButtonClick(Sender: TObject);
    procedure DeleteAccButtonClick(Sender: TObject);
    procedure checkisok();
  private
    { Private declarations }
  public
    YesSet: Boolean;
    isUser: Boolean;
    isok:boolean;
  end;

var
  frmSelectAcc: TfrmSelectAcc;
  Reg :TRegistry;

implementation

uses uPublicvar, uConst, uCreateAccount, uDeleteAccount,connectsql;

{$R *.dfm}
procedure TfrmSelectAcc.checkisok();
begin
    if not isok then
       begin
          showmessage('服务器刚刚设置,请退出后重新登陆');
          close;
          exit;
       end;
end;
procedure TfrmSelectAcc.FormCreate(Sender: TObject);
var
  Newset: string;
  sqltext:tstrings;
  ok:boolean;
   F:TextFile;
   MyIniFile:TInifile;
   sFileName:string;
begin
    ChDir(ExtractFilePath(Application.ExeName));
    strpath := GetCurrentDir;
    if FileExists(strpath+'\server.ini') then
      begin
          sFileName:=strpath+'\server.ini';
          MyIniFile:=TIniFile.Create(sFileName);
          cServer:=MyIniFile.ReadString('server','substring','');
          cdbname:=MyIniFile.ReadString('dbname','substring','');
          cpassword:=MyIniFile.ReadString('password','substring','');
          cuser:=MyIniFile.ReadString('user','substring','');
      end else begin
      ConnectsqlForm:=tConnectsqlForm.create(self);
      ConnectsqlForm.ShowModal;
      CreateAccButton.Enabled:=false;
      DeleteAccButton.Enabled:=false;
      EnterButton.Enabled:=false;
      exit;
      end;
      isok:=true;
   computer:=IdIPWatch1.LocalIP;
{  //检测是否第一次使用
  Reg:=TRegistry.Create;
  try
    Reg.RootKey:=HKEY_CURRENT_USER;
    Reg.OpenKey('Software\LongbangSoft\JXC', True);
    Newset:=Reg.ReadString('New');
    Reg.CloseKey;
    Reg.Free;
  except
    Application.MessageBox('读写文件错误。','错误信息',$10);
    Reg.CloseKey;
    Reg.Free;
    Application.Terminate;
    Halt;
  end;
  //如果不存在帐套数据库
  if (not FileExists('Data')) or (NewSet<>'1') then
  begin
    CopyFile('NSData','Data', False);
    NewSet:='0';
  end;

  //连接帐套数据库
  AccDataName:='Data';
  }
  YesSet:=False;
  try
    SQLConnection.ConnectionName:='SQLServerConnection';
    SQLConnection.DriverName:='SQLServer';
    SQLConnection.Params.Clear;
    SQLConnection.Params.Values['Database']:=cdbname;
    SQLConnection.Params.Values['User_Name']:=cuser;
    SQLConnection.Params.Values['HostName']:=cserver;
    SQLConnection.Params.Values['Password']:=cpassword;
    SQLConnection.Connected:=True;
    //如果是第一次运行则创建帐套数据库
    opendata('select * from sysobjects where name='+''''+'sp_tianyacreatedb'+'''',adocx);
    if adocx.Eof and adocx.Bof  then
    begin
      try
        with SQLQuery do
        begin
          Close;
          SqlText:=TStringList.Create;
          SqlText.LoadFromFile('createdbbase.txt');
          sql.Text:=sqltext.Text;
          execsql;
          close;
          sql.Text:='select * from sysobjects where name='+''''+'ACCOUNTINFO'+'''';
          open;
          if adocx.Eof and adocx.Bof then
             ok:=true
             else
             ok:=false;
          close;
          if ok then
          begin
          Sql.Text:='CREATE TABLE ACCOUNTINFO ('+
                    'CODE	VARCHAR(10) NOT NULL,'+
                    'NAME	VARCHAR(100),'+
                    'computer	char(20),'+
                    'createdate	datetime,'+
                    'username	char(20),'+
                    'password	char(20),'+
                    'DATAPATH	VARCHAR(200),'+
                    'dbname	VARCHAR(30),'+
                    'MEMO	VARCHAR(100),'+
                    'PRIMARY KEY (CODE) )';
          ExecSql;
          end;
          Close;
          {
          Reg:=TRegistry.Create;
          try
            Reg.RootKey:=HKEY_CURRENT_USER;
            Reg.OpenKey('Software\LongbangSoft\JXC', True);
            Reg.WriteString('New', '1');
            Reg.CloseKey;
            Reg.Free;
          except
            Application.MessageBox('读写文件错误。','错误信息',$10);
            Reg.CloseKey;
            Reg.Free;
            Close;
            Sql.Text:='Drop Table ACCOUNTINFO;';
            ExecSql;
            Close;
            Sql.Text:='Drop Table USERINFO';
            ExecSql;
            SQLConnection.Connected:=False;
            Application.Terminate;
            Halt;
          end;
          }
        end;
      except
        SQLConnection.Connected:=False;
        Application.MessageBox('建新帐套数据错误不成功。','提示信息', $10);
        Application.Terminate;
        Halt;
      end;
    end;
    //打开帐套信息
    OpenData('select * From Accountinfo', AccCds);
  except
    Application.MessageBox('连接数据库错误。请确定服务器是否启动或是否安装了本系统。',Errorinfo,$10);
    AccCds.Close;
    SQLConnection.Connected :=False;
    AccCds.Destroy;
    SQLConnection.Destroy;
    Application.Terminate;
    Halt;
  end;
end;

procedure TfrmSelectAcc.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  AccCds.Close;
  SQLConnection.Connected :=False;
  AccCds.Destroy;
  SQLConnection.Destroy;
  if not YesSet then
  begin
    Application.Terminate;
    Halt;
  end;
end;

procedure TfrmSelectAcc.EnterButtonClick(Sender: TObject);
begin
  checkisok;
  if AccCds.IsEmpty then
  begin
    Application.MessageBox('没有可选择的账套。',Hintinfo,$30);
    Exit;
  end;
  DatabaseName:=trim(AccCds.Fieldbyname('dbname').asstring);
  computer:=trim(AccCds.Fieldbyname('computer').asstring);
  AccbookName:=trim(AccCds.Fieldbyname('Name').asstring);
  serveruser:= trim(AccCds.Fieldbyname('username').asstring);
  serverpassword:=trim(AccCds.Fieldbyname('password').asstring);
  YesSet:=True;
  Close;
end;

procedure TfrmSelectAcc.DataDBGridKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key=13 then EnterButtonClick(Sender);
end;

procedure TfrmSelectAcc.CancelButtonClick(Sender: TObject);
begin
  YesSet:=false;
  application.Terminate;

end;

procedure TfrmSelectAcc.CreateAccButtonClick(Sender: TObject);
begin
  checkisok;
  frmCreateAccount:=TfrmCreateAccount.Create(Application);
  frmCreateAccount.ShowModal;
  frmCreateAccount.Free;
end;

procedure TfrmSelectAcc.DeleteAccButtonClick(Sender: TObject);
begin
  checkisok;
  isUser:=False;
  if AccCds.IsEmpty then
  begin
    Application.MessageBox('没有可删除的帐套。','提示信息',$30);
    Exit;
  end;
  if Application.MessageBox('确实要删除当前的帐套吗?','提示信息', $24)=idYes then
  begin
    frmDeleteAccount:=TfrmDeleteAccount.Create(Application);
    frmDeleteAccount.ShowModal;
    frmDeleteAccount.Free;
    DatabaseName:=AccCds.Fieldbyname('DataPath').asstring;
    if not isUser then Exit;
    if not DeleteFile(DatabaseName) then
    begin
      if Application.MessageBox('删除帐套数据库不成功,请确定该数据库是否正被使用。是否从帐套信息中删除该帐套信息?','提示信息',$24)=idYes then
      begin
        AccCds.Delete;
        AccCds.ApplyUpdates(-1);
        Exit;
      end;
    end
    else
    begin
      AccCds.Delete;
      AccCds.ApplyUpdates(-1);
    end;
  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -