unitcompany.pas

一个不错的系统

unit UnitCompany;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, ADODB, FileCtrl, OleServer,
  ADOX_TLB;

type
  TfrmCompany = class(TForm)
    Panel1: TPanel;
    bbtnNew: TBitBtn;
    bbtnImport: TBitBtn;
    bbtnClose: TBitBtn;
    bbtnDelete: TBitBtn;
    Panel2: TPanel;
    Label5: TLabel;
    Label6: TLabel;
    Panel3: TPanel;
    Panel4: TPanel;
    Label7: TLabel;
    Label8: TLabel;
    lsbCompany: TListBox;
    bbtnOK: TBitBtn;
    bbtnExport: TBitBtn;
    odImport: TOpenDialog;
    procedure bbtnCloseClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure bbtnOKClick(Sender: TObject);
    procedure bbtnNewClick(Sender: TObject);
    procedure bbtnImportClick(Sender: TObject);
    procedure bbtnDeleteClick(Sender: TObject);
    procedure bbtnExportClick(Sender: TObject);
  private
    { Private declarations }
    function GetPath:Integer;
  public
    { Public declarations }
  end;

var
  frmCompany: TfrmCompany;

implementation

uses UnitCommon, UnitPassword, UnitInitialization;

{$R *.dfm}

procedure TfrmCompany.bbtnCloseClick(Sender: TObject);
begin
  frmCompany.Close;
end;

procedure TfrmCompany.FormCreate(Sender: TObject);
var
  ADORSHFEIS:TADOQuery;
begin
  ADORSHFEIS:=TADOQuery.Create(Self);
  try
    with ADORSHFEIS do begin
      ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+ExtractFilePath(Application.ExeName)+'DAT\HFEIS.mdb;Persist Security Info=False;Jet OLEDB:Database Password=19761227';
      SQL.Text:='select MID,MTitle from Company order by MID';
      Open;
      while not EOF do begin
        lsbCompany.Items.Add('DB'+Copy(IntToStr(1000+FieldByName('MID').AsInteger),2,3)+'         | '+Trim(FieldByName('MTitle').AsString));
        Next;
      end;
      Close;
      Free;
      lsbCompany.ItemIndex:=0;
    end;
  except
    raise Exception.Create('目标数据库无法打开。');
  end;
end;

procedure TfrmCompany.bbtnOKClick(Sender: TObject);
begin
  if lsbCompany.Count>0 then begin
    Users.Path:=Copy(lsbCompany.Items.Strings[lsbCompany.ItemIndex],1,5);
    frmPassword:=TfrmPassword.Create(Application);
    try
      frmPassword.ShowModal;
      if Users.Rule='Fail' then begin
        Users.Rule:='';
        Close;
      end else
        if Users.Rule<>'' then Close;
    finally
      frmPassword.Free;
    end;
  end;
end;

procedure TfrmCompany.bbtnNewClick(Sender: TObject);
var
  FAccount,FPassword,FTitle,FPath,FAPath:String;
  ADOCA:TCatalog;
  ADORSHFEIS:TADOQuery;
begin
  frmInitialization:=TfrmInitialization.Create(Application);
  try
    frmInitialization.ShowModal;
    FAccount:=frmInitialization.edtAccount.Text;
    FPassword:=frmInitialization.edtPassword.Text;
    FTitle:=frmInitialization.edtCompany.Text;
    if FTitle<>'' then begin
      FAPath:=ExtractFilePath(Application.ExeName)+'DAT\';
      FPath:='DB'+Copy(IntToStr(1000+GetPath),2,3);
      if ForceDirectories(FAPath+FPath) then begin
        ADOCA:=TCatalog.Create(Self);
        try
          ADOCA.Create1('Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+FAPath+FPath+'\HFEIS.mdb;Locale Identifier=0x0804;Jet OLEDB:Database Password=19761227');
        finally
          ADOCA.Free;
        end;
        ADORSHFEIS:=TADOQuery.Create(Self);
        try
          with ADORSHFEIS do begin
            ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+FAPath+FPath+'\HFEIS.mdb;Persist Security Info=False;Jet OLEDB:Database Password=19761227';
            SQL.Text:='CREATE TABLE System (MTitle VARCHAR(30) WITH COMPRESSION NOT NULL PRIMARY KEY,MDate DATETIME NULL)';
            ExecSQL;
            Close;
            SQL.Text:='CREATE TABLE Users (MID IDENTITY(1,1) NOT NULL PRIMARY KEY,MAccount VARCHAR(20) WITH COMPRESSION NULL,MPassword VARCHAR(255) WITH COMPRESSION NULL,MRule VARCHAR(255) WITH COMPRESSION NULL,MName VARCHAR(40) WITH COMPRESSION NULL)';
            ExecSQL;
            Close;
            SQL.Clear;
            SQL.Add('CREATE TABLE Employee (MID IDENTITY(1,1) NOT NULL PRIMARY KEY,MTagNO VARCHAR(8) WITH COMPRESSION NOT NULL,MName VARCHAR(16) WITH COMPRESSION NULL,MGender VARCHAR(2) WITH COMPRESSION NULL,MBirthday DATETIME NULL,');
            SQL.Add('MMarrigae VARCHAR(4) WITH COMPRESSION NULL,MPolitics VARCHAR(8) WITH COMPRESSION NULL,MMember VARCHAR(16) WITH COMPRESSION NULL,MEducation VARCHAR(12) WITH COMPRESSION NULL,MTitle VARCHAR(16) WITH COMPRESSION NULL,');
            SQL.Add('MNative VARCHAR(20) WITH COMPRESSION NULL,MFolk VARCHAR(16) WITH COMPRESSION NULL,MProvince VARCHAR(16) WITH COMPRESSION NULL,MCity VARCHAR(16) WITH COMPRESSION NULL,MPolice VARCHAR(16) WITH COMPRESSION NULL,');
            SQL.Add('MIDCardNO VARCHAR(18) WITH COMPRESSION NULL,MTel VARCHAR(30) WITH COMPRESSION NULL,MRegAdd VARCHAR(50) WITH COMPRESSION NULL,MRegPostalcode VARCHAR(6) WITH COMPRESSION NULL,MRegArea VARCHAR(20) WITH COMPRESSION NULL,');
            SQL.Add('MCurAdd VARCHAR(50) WITH COMPRESSION NULL,MCurPostalcode VARCHAR(6) WITH COMPRESSION NULL,MCurArea VARCHAR(20) WITH COMPRESSION NULL,MInDate DATETIME NULL,MDuty VARCHAR(16) WITH COMPRESSION NULL,');
            SQL.Add('MJob VARCHAR(10) WITH COMPRESSION NULL,MStartWorkDate DATETIME NULL,MSalary MONEY NULL,MWork VARCHAR(4) WITH COMPRESSION NULL,MContract VARCHAR(2) WITH COMPRESSION NULL,MPWork VARCHAR(4) WITH COMPRESSION NULL,');
            SQL.Add('MIncome MONEY NULL,MMemo TEXT WITH COMPRESSION NULL,MFName1 VARCHAR(16) WITH COMPRESSION NULL,MFName2 VARCHAR(16) WITH COMPRESSION NULL,MFName3 VARCHAR(16) WITH COMPRESSION NULL,MFName4 VARCHAR(16) WITH COMPRESSION NULL,');
            SQL.Add('MFName5 VARCHAR(16) WITH COMPRESSION NULL,MFAppellation1 VARCHAR(10) WITH COMPRESSION NULL,MFAppellation2 VARCHAR(10) WITH COMPRESSION NULL,MFAppellation3 VARCHAR(10) WITH COMPRESSION NULL,MFAppellation4 VARCHAR(10) WITH COMPRESSION NULL,');
            SQL.Add('MFAppellation5 VARCHAR(10) WITH COMPRESSION NULL,MFFactory1 VARCHAR(50) WITH COMPRESSION NULL,MFFactory2 VARCHAR(50) WITH COMPRESSION NULL,MFFactory3 VARCHAR(50) WITH COMPRESSION NULL,MFFactory4 VARCHAR(50) WITH COMPRESSION NULL,');
            SQL.Add('MFFactory5 VARCHAR(50) WITH COMPRESSION NULL,MF1 VARCHAR(60) WITH COMPRESSION NULL,MF2 VARCHAR(10) WITH COMPRESSION NULL,MF3 VARCHAR(14) WITH COMPRESSION NULL,MF4 VARCHAR(18) WITH COMPRESSION NULL,MF5 VARCHAR(10) WITH COMPRESSION NULL,');
            SQL.Add('MFType VARCHAR(8) WITH COMPRESSION NULL,MF6 TINYINT NULL,MF7 TINYINT NULL,MF8 VARCHAR(2) WITH COMPRESSION NULL)');
            ExecSQL;
            Close;
            SQL.Text:='insert into Users (MAccount,MPassword,MRule,MName) values('''+FAccount+''','''+hf_encrypt(FPassword)+''',''001001'',''系统管理员'')';
            ExecSQL;
            Close;
            SQL.Text:='insert into System (MTitle) values('''+FTitle+''')';
            ExecSQL;
            Close;
            ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+FAPath+'HFEIS.mdb;Persist Security Info=False;Jet OLEDB:Database Password=19761227';
            SQL.Text:='insert into Company (MID,MTitle) values('+Copy(FPath,3,3)+','''+FTitle+''')';
            ExecSQL;
            Close;
            Free;
            lsbCompany.Items.Add(FPath+'         | '+FTitle);
            lsbCompany.ItemIndex:=lsbCompany.Count-1;
            MessageBox(Handle,'新建数据库已完成。      ','系统信息',0);
          end;
        except
          raise Exception.Create('目标数据库无法打开。');
        end;
      end else begin
        MessageBox(Handle,'初始化数据库失败，请与系统管理员联系。','系统警告',16);
      end;
    end;
  finally
    frmInitialization.Free;
  end;
end;

procedure TfrmCompany.bbtnImportClick(Sender: TObject);
var
  FSPath,FAPath,FPath,FTitle:String;
  FSS,FSD:TFileStream;
  ADORSHFEIS:TADOQuery;
begin
  if odImport.Execute then begin
    FSPath:=odImport.FileName;
    FAPath:=ExtractFilePath(Application.ExeName)+'DAT\';
    FPath:='DB'+Copy(IntToStr(1000+GetPath),2,3);
    if ForceDirectories(FAPath+FPath) then begin
      FSS:=TFileStream.Create(FSPath,fmOpenRead+fmShareDenyRead);
      FSD:=TFileStream.Create(FAPath+FPath+'\HFEIS.mdb',fmCreate);
      try
        FSD.CopyFrom(FSS,FSS.Size);
      finally
        FreeAndNil(FSS);
        FreeAndNil(FSD);
      end;
      ADORSHFEIS:=TADOQuery.Create(Self);
      try
        with ADORSHFEIS do begin
          ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+FAPath+FPath+'\HFEIS.mdb;Persist Security Info=False;Jet OLEDB:Database Password=19761227';
          SQL.Text:='select MTitle from System';
          Open;
          FTitle:=Trim(FieldByName('MTitle').AsString);
          Close;
          ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+FAPath+'HFEIS.mdb;Persist Security Info=False;Jet OLEDB:Database Password=19761227';
          SQL.Text:='insert into Company (MID,MTitle) values('+Copy(FPath,3,3)+','''+FTitle+''')';
          ExecSQL;
          Close;
          Free;
          lsbCompany.Items.Add(FPath+'         | '+FTitle);
          lsbCompany.ItemIndex:=lsbCompany.Count-1;
          MessageBox(Handle,'导入数据库已完成。      ','系统信息',0);
        end;
      except
        raise Exception.Create('目标数据库无法打开。');
      end;
    end else begin
      MessageBox(Handle,'初始化数据库失败，请与系统管理员联系。','系统警告',16);
    end;
  end;
end;

procedure TfrmCompany.bbtnDeleteClick(Sender: TObject);
var
  FAPath,FPath:String;
  ADORSHFEIS:TADOQuery;
  FSearch:TSearchRec;
begin
  if MessageBox(Handle,'系统将删除选定公司资料，该操作将无法恢复。'+#13+'您是否真的要删除？','系统信息',MB_YESNO+32)=IDYES then begin
    FAPath:=ExtractFilePath(Application.ExeName)+'DAT\';
    FPath:=Copy(lsbCompany.Items.Strings[lsbCompany.ItemIndex],1,5);
    if FindFirst(FAPath+FPath+'\*.*',faAnyFile,FSearch)=0 then
      repeat
        if (FSearch.Name[1]<>'.') then
          if ((FSearch.Attr and faDirectory)>0) then begin
            RmDir(FAPath+FPath+'\'+FSearch.Name);
          end else begin
            DeleteFile(FAPath+FPath+'\'+FSearch.Name);
            Application.ProcessMessages;
          end;
      until FindNext(FSearch)<>0;
    FindClose(FSearch);
    RemoveDir(FAPath+FPath);
    ADORSHFEIS:=TADOQuery.Create(Self);
    try
      with ADORSHFEIS do begin
        ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+FAPath+'HFEIS.mdb;Persist Security Info=False;Jet OLEDB:Database Password=19761227';
        SQL.Text:='delete from Company where MID='+Copy(FPath,3,3);
        ExecSQL;
        Close;
        Free;
        lsbCompany.Items.Delete(lsbCompany.ItemIndex);
        MessageBox(Handle,'数据库已删除。      ','系统信息',0);
        lsbCompany.ItemIndex:=0;
      end;
    except
      raise Exception.Create('目标数据库无法打开。');
    end;
  end;
end;

procedure TfrmCompany.bbtnExportClick(Sender: TObject);
var
  FDPath:String;
  FSS,FSD:TFileStream;
begin
  FDPath:=GetCurrentDir;
  if SelectDirectory(FDPath,[],1000) then begin
    FSS:=TFileStream.Create(ExtractFilePath(Application.ExeName)+'DAT\'+Copy(lsbCompany.Items.Strings[lsbCompany.ItemIndex],1,5)+'\HFEIS.mdb',fmOpenRead+fmShareDenyRead);
    FSD:=TFileStream.Create(FDPath+'\HFEIS.exp',fmCreate);
    try
      FSD.CopyFrom(FSS,FSS.Size);
    finally
      FreeAndNil(FSS);
      FreeAndNil(FSD);
    end;
    MessageBox(Handle,'导出数据库已完成。      ','系统信息',0);
  end;
end;

function TfrmCompany.GetPath: Integer;
var
  i:Integer;
  FPath:String;
begin
  i:=1;
  FPath:=ExtractFilePath(Application.ExeName)+'DAT\DB';
  while DirectoryExists(FPath+Copy(IntToStr(1000+i),2,3)) do
    Inc(i);
  Result:=i;
end;

end.