📄 sys_enter_mrpaccount.pas

📁 一个MRPII系统源代码版本
💻 PAS
字号:
unit Sys_Enter_MrpAccount;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ToolWin, ComCtrls, ExtCtrls, ActnList, ImgList, Grids, DBGridEh, Db,
  Menus, ADODB, StdCtrls;

type
  TFrm_Sys_Enter_MrpAccount = class(TForm)
    Pnl_Title: TPanel;
    Pnl_body: TPanel;
    AdoQry_Head: TADOQuery;
    AdoQry_Headid: TWideStringField;
    AdoQry_Headname: TWideStringField;
    AdoQry_Headvalid: TWideStringField;
    AdoQry_HeadServerName: TWideStringField;
    AdoQry_HeadDataBaseName: TWideStringField;
    AdoQry_HeadDataBasePath: TWideStringField;
    AdoQry_HeadSystemName: TWideStringField;
    AdoQry_HeadSystemPassWord: TWideStringField;
    AdoQry_HeadCreateDate: TWideStringField;
    AdoQry_HeadModifyDate: TWideStringField;
    PopupMenu: TPopupMenu;
    HideColumn: TMenuItem;
    DataSource: TDataSource;
    AdoQry_Tmp: TADOQuery;
    DBGridEh: TDBGridEh;
    Pnl_Hint: TPanel;
    ImageList: TImageList;
    ActionList: TActionList;
    Act_Modify: TAction;
    Act_Open: TAction;
    Act_Copy: TAction;
    Act_InsertLine: TAction;
    Act_DeleteLine: TAction;
    Act_Delete: TAction;
    Act_CancelCheck: TAction;
    Act_Close: TAction;
    Act_Save: TAction;
    Act_Quit: TAction;
    Act_Hint: TAction;
    Act_Filter: TAction;
    Act_First: TAction;
    Act_Prior: TAction;
    Act_next: TAction;
    Act_last: TAction;
    Act_Property: TAction;
    Act_Locate: TAction;
    Act_Mange: TAction;
    Act_Order: TAction;
    Act_Sum: TAction;
    Act_Cancel: TAction;
    Act_Look: TAction;
    Act_Check: TAction;
    Act_error: TAction;
    Act_auto: TAction;
    Act_all: TAction;
    Act_CheckDebt: TAction;
    Act_Print: TAction;
    Act_Preview: TAction;
    Act_Expend: TAction;
    Act_Collapse: TAction;
    Action1: TAction;
    Action2: TAction;
    Act_SetCount: TAction;
    Act_ShowGrid: TAction;
    Act_Help: TAction;
    Action3: TAction;
    Act_Excel: TAction;
    Act_SetColumn: TAction;
    act_new: TAction;
    ControlBar: TControlBar;
    ToolBar: TToolBar;
    ToolButton1: TToolButton;
    TlBtn_New: TToolButton;
    TlBtn_Modify: TToolButton;
    TlBtn_Delete: TToolButton;
    TlBtn_Look: TToolButton;
    ToolButton5: TToolButton;
    TlBtn_Filter: TToolButton;
    TlBtn_Locate: TToolButton;
    ToolButton3: TToolButton;
    TlBtn_Order: TToolButton;
    ToolButton2: TToolButton;
    ToolButton9: TToolButton;
    ToolButton4: TToolButton;
    ToolButton6: TToolButton;
    MainMenu: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure act_newExecute(Sender: TObject);
    procedure Act_ModifyExecute(Sender: TObject);
    procedure Act_DeleteExecute(Sender: TObject);
    procedure Action1Execute(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Act_QuitExecute(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
  private
  procedure dbopen;
    { Private declarations }
  public
  function login:boolean;
  procedure checkdatabase(databasename,servername,systemname,systempassword:string);    { Public declarations }
  function  deletedatabase(databasename,databasepath,servername,systemname,systempassword:string):boolean;
  procedure deleteaccount(id:string);
  end;



var
  Frm_Sys_Enter_MrpAccount: TFrm_Sys_Enter_MrpAccount;
  id,accountname,servername,databasename,databasepath,systemname,systempassword:string;
  iscanuse:integer;

implementation

uses Sys_Enter_MrpAccount_D, Sys_Enter_MrpAccount_B,Sys_Enter_MrpLogin;

{$R *.DFM}

procedure TFrm_Sys_Enter_MrpAccount.FormCreate(Sender: TObject);
begin
tlbtn_look.Action:=action1;
dbopen;
end;

procedure TFrm_Sys_Enter_MrpAccount.act_newExecute(Sender: TObject);
   function GetLocalName : String;
     var cName:Pchar;
		Size:^DWord;
    begin
     GetMem(cName,255);
     new(size);
    try
     GetcomputerName(cName,size^);
     Result := StrPas(cName);
     finally
      Dispose(cName);
      dispose(size);
     end;
     end;
var bookmark:string;
begin
bookmark:=adoqry_head.Bookmark;
 try
 with  TFrm_Sys_Enter_MrpAccount_D.Create(self) do
     begin
       show;
       cmb_id.Text:='001';
       edt_servername.Text:=getlocalname;
       edt_databasename.Text:='act0001';
       edt_databasepath.Text:=databasepath;
       edt_systemname.Text:='sa';
       cmb_iscanuse.ItemIndex:=1;
       hide;
       showmodal;
      if  modalresult<>mrok then exit;
     end;
 finally
  Frm_Sys_Enter_MrpAccount_D.Free;
 end;
adoqry_head.Bookmark:=bookmark;
dbopen;
end;


procedure TFrm_Sys_Enter_MrpAccount.Act_ModifyExecute(Sender: TObject);
begin
  with adoqry_head do
   begin
      if recordcount=0 then
        begin
         showmessage('当前无帐套可修改！');
         exit;
        end;
      id:=fieldbyname('id').asstring;
      accountname:=fieldbyname('name').asstring;
      servername:=fieldbyname('servername').asstring;
      databasename:=fieldbyname('databasename').asstring;
      databasepath:=fieldbyname('databasepath').asstring;
      systemname:=fieldbyname('systemname').asstring;
      systempassword:=fieldbyname('systempassword').asstring;
      iscanuse:=strtoint(fieldbyname('valid').asstring);
   end;
   try
  with TFrm_Sys_Enter_MrpAccount_D.Create(self) do
     begin
      show;
      caption:='帐套修改';
      btn_ok.Caption:='确定(&O)';
      cmb_id.Text:=id;
      edt_accountname.Text:=accountname;
      edt_servername.Text:=servername;
      edt_servername.Enabled:=false;
      edt_databasename.Text:=databasename;
      edt_databasename.Enabled:=false;
      edt_databasepath.Text:=databasepath;
      edt_databasepath.Enabled:=false;
      selectdir.Enabled:=false;
      edt_systemname.Text:=systemname;
      edt_systempassword.Text:=systempassword;
      cmb_iscanuse.ItemIndex:=iscanuse;
      btn_ok.Enabled:=false;
      setallchange;
      hide;
      showmodal;
       if modalresult<>mrok then  exit;
    end;
    dbopen;
  finally
    Frm_Sys_Enter_MrpAccount_D.Free;
   end;
dbopen;
end;


procedure TFrm_Sys_Enter_MrpAccount.Act_DeleteExecute(Sender: TObject);
begin
  with adoqry_head do
   begin
      if recordcount=0 then
        begin
         showmessage('当前无帐套可删除！');
         exit;
        end;
      id:=fieldbyname('id').asstring;
      accountname:=fieldbyname('name').asstring;
      servername:=fieldbyname('servername').asstring;
      databasename:=fieldbyname('databasename').asstring;
      databasepath:=fieldbyname('databasepath').asstring;
      systemname:=fieldbyname('systemname').asstring;
      systempassword:=fieldbyname('systempassword').asstring;
      iscanuse:=strtoint(fieldbyname('valid').asstring);
  end;
  if messagedlg('删除帐套会使该帐套所有的数据都丢失，确定继续吗？',mtwarning,[mbyes,mbno],0)<>mryes then exit;
  try
  if not  deletedatabase(databasename,databasepath,servername,systemname,systempassword)then
      exit;
  deleteaccount(id);
  adoqry_head.Delete;
  adoqry_head.Requery;
  dbopen;
  except
  showmessage('删除帐套出错！');
  end;
dbopen;
end;

procedure TFrm_Sys_Enter_MrpAccount.Action1Execute(Sender: TObject);
begin
  inherited;
  if adoqry_head.RecordCount=0 then
    begin
      showmessage('当前无帐套！');
      exit;
    end;
  try
    with TFrm_Sys_Enter_MrpAccount_B.Create(self) do
       begin
         edt_account.Text:=adoqry_head.fieldbyname('id').asstring+' '+adoqry_head.fieldbyname('name').asstring;
         edt_account.Enabled:=false;
         edt_databasename.Text:=adoqry_head.fieldbyname('databasename').asstring;
         edt_databasename.Enabled:=false;
         edt_bakdatabasename.Text:='bk'+adoqry_head.fieldbyname('databasename').asstring;
         showmodal;
         if modalresult<>mrok then exit;
       end;
  finally
   Frm_Sys_Enter_MrpAccount_B.Free;
  end;

end;




procedure TFrm_Sys_Enter_MrpAccount.dbopen;
begin
 with adoqry_head do
   begin
    close;
    open;
   end;

end;

procedure TFrm_Sys_Enter_MrpAccount.FormDestroy(Sender: TObject);
begin
  Frm_Sys_Enter_MrpAccount:=nil;
end;

procedure TFrm_Sys_Enter_MrpAccount.Act_QuitExecute(Sender: TObject);
begin
close;
end;

function TFrm_Sys_Enter_MrpAccount.login: boolean;
begin
  try
  with TFrm_Sys_Enter_MrpLogin.Create(self) do
    begin
       begin
       showmodal;
        if modalresult<>mrok then
         begin result:=false;application.Terminate; end;
       end;
    end;
  finally
   Frm_Sys_Enter_MrpLogin.Free;
end;
end;


procedure TFrm_Sys_Enter_MrpAccount.N11Click(Sender: TObject);
begin
close;
end;


procedure TFrm_Sys_Enter_MrpAccount.checkdatabase(databasename,
  servername, systemname, systempassword: string);
var sqlstr:string;
    adoqry_tmp:Tadoquery;
begin
 sqlstr:='dbcc checkdb ('+quotedstr(databasename)+')';
 try
  adoqry_tmp:=Tadoquery.Create(self);
   with adoqry_tmp do
    begin
      close;
      connectionstring:='Provider=SQLOLEDB.1;Password='+systempassword+';Persist Security Info=True;User ID='+systemname+';Initial Catalog=master;Data Source='+servername+';Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096';
      sql.Clear;
      sql.Add(sqlstr);
      prepared;
      try
       screen.Cursor:=crsqlwait;
       execsql;
       showmessage('检查完毕！');
      except
       showmessage('检查帐套时出错！');
       exit;
      end;
    end;
 finally
  screen.Cursor:=crdefault;
  adoqry_tmp.Free;
 end;
end;



procedure TFrm_Sys_Enter_MrpAccount.N6Click(Sender: TObject);
begin
  with adoqry_head do
    begin
      if recordcount=0 then begin showmessage('当前无帐套！');exit;end;
      servername:=fieldbyname('servername').asstring;
      databasename:=fieldbyname('databasename').asstring;
      systemname:=fieldbyname('systemname').asstring;
      systempassword:=fieldbyname('systempassword').asstring;
    end;
    checkdatabase(databasename,servername, systemname, systempassword);
end;

function TFrm_Sys_Enter_MrpAccount.deletedatabase(databasename,
  databasepath, servername, systemname, systempassword: string):boolean;
var sqlstr:string;adoqry_tmp:Tadoquery;
begin
result:=true;
  sqlstr:='drop database '+databasename;
try
adoqry_tmp:=Tadoquery.Create(self);
with adoqry_tmp do
begin
  connectionstring:='Provider=SQLOLEDB.1;Password='+systempassword+';Persist Security Info=True;User ID='+systemname+';Initial Catalog=master;Data Source='+servername+';Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096';
  close;
  sql.Clear;
  sql.Add(sqlstr);
  prepared;
  try
  screen.Cursor:=crsqlwait;
  execsql;
  showmessage('删除帐套成功！');
  except
   result:=false;
  end;
end;
finally
 screen.Cursor:=crdefault;
 adoqry_tmp.Free;
end;

end;


procedure TFrm_Sys_Enter_MrpAccount.deleteaccount(id: string);
 var adoqry_tmp:Tadoquery;
    con:widestring;
begin
try
  adoqry_tmp:=Tadoquery.Create(self);
with adoqry_tmp do
  begin
con:='Provider=Microsoft.Jet.OLEDB.4.0;Password="";Data Source='+extractfilepath(application.exename)+'\MrpACT.mdb;Persist Security Info=True';
connectionstring:=con;
  close;
  sql.Clear;
  sql.Add('delete from account where id='+quotedstr(id));
  prepared;
  try
  execsql;
  dbopen;
  except
  showmessage('删除帐套信息出错！');
  exit;
  end;
  end;
finally
  adoqry_tmp.Free;
end;

end;


end.
⌨️ 快捷键说明

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