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

📄 main.pas

📁 公司ERP系统
💻 PAS
📖 第 1 页 / 共 2 页
字号:

unit main;

interface

uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, DBTables, ExtCtrls, Menus, Db,shellapi,registry,variants,
  Grids, DBGrids;

type
  TMainForm = class(TForm)
    ImBtn: TSpeedButton;
    Database1: TDatabase;
    LBLUpdate: TLabel;
    SrBtn: TSpeedButton;
    ttvermTable: TTable;
    BtnQc: TSpeedButton;
    btnqcqc: TSpeedButton;
    BtnPr: TSpeedButton;
    Qry_pr: TQuery;
    Btnkq: TSpeedButton;
    Qry_show_text: TQuery;
    Database2: TDatabase;
    sql_query1: TQuery;
    tientaisqltable: TTable;
    ssuserQuery: TQuery;
    sql_query2: TQuery;

    procedure Run_main(vExe_file: string);
    procedure Database1Login(Database: TDatabase;
      LoginParams: TStrings);
    procedure FormShow(Sender: TObject);
    procedure IvBtnClick(Sender: TObject);
    procedure ExitBtnClick(Sender: TObject);
    procedure UpdateProgram1Click(Sender: TObject);
    procedure NotUpdateProgram1Click(Sender: TObject);
    procedure refreshLblUpdate;
    procedure SrBtnClick(Sender: TObject);
    procedure BtnQcClick(Sender: TObject);
    procedure btnqcqcClick(Sender: TObject);
    procedure BtnPrClick(Sender: TObject);
    procedure BtnkqClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Database2Login(Database: TDatabase; LoginParams: TStrings);
    procedure ImBtnClick(Sender: TObject);
  private
    { Private declarations }
    procedure connect_drive_x;
    procedure get_show_text(bol:boolean);
    Procedure Get_Show_Text_New(emp_no:string);
  public
    { Public declarations }
  end; {_ TMainForm = class(TForm) _}

var
  MainForm           : TMainForm;
  gUser_id, gPassword, gUser_name,gemp_no: string;
  gUpdate            : Boolean = True;
implementation

uses  pilib97{,pwdkey}, pipwd, mainprompt{, pread};

{$R *.DFM}
var reg:Tregistry;
procedure TMainForm.refreshLblUpdate;
begin
  if gUpdate then
       LBLUpdate.CAPTION := '自动更新版本'
  else  {_ NOT if gUpdate then LBLUpdate.CAPTION := '自动更新版本 _}
       LBLUpdate.CAPTION := '不更新版本';
end; {_ procedure TMainForm.refreshLblUpdate; _}


procedure TMainForm.Run_main(vExe_file: string);
var
  Fromfile, ToFile, ToFilePath: string;
  Source                      : Integer;
  FromDateTime, ToDateTime    : string;
begin
  Fromfile := 'X:\pidpr\ttmis\pub\proj\' + vExe_file;
  if not FileExists(Fromfile) then
  begin
    Fromfile := 'C:\pidpr\ttmis\pub\proj\' + vExe_file;
    if not FileExists(Fromfile) then
       gUpdate := False;
    //ShowMessage(Fromfile + '不存在 !');
    //Abort;
  end; {_ if not FileExists(Fromfile) then _}
  ToFile := 'C:\pidpr\ttmis\pub\proj\' + vExe_file;
  ToFilePath := 'C:\pidpr\ttmis\pub\proj';
  ToDateTime := ' ';
  if FileExists(Fromfile) then
     FromDateTime := DateTimeToStr(FileDateToDateTime(FileAge(Fromfile)));
  if FileExists(ToFile) then
    ToDateTime := DateTimeToStr(FileDateToDateTime(FileAge(ToFile)));



end; {_ procedure TMainForm.ImBtnClick(Sender: TObject); _}

procedure TMainForm.Database1Login(Database: TDatabase;
    LoginParams: TStrings);
begin
  LoginParams.Values['USER NAME'] := piPwdForm.UsernameEdit.Text;
  LoginParams.Values['PASSWORD']  := piPwdForm.PasswordEdit.Text;
  gUser_id  := piPwdForm.UsernameEdit.Text;
  gPassword := piPwdForm.PasswordEdit.Text;
end; {_ procedure TMainForm.Database1Login(Database: TDatabase; _}

procedure TMainForm.FormShow(Sender: TObject);
var temp_str:string;
begin
  reg:=Tregistry.Create;
  reg.rootkey:=HKEY_LOCAL_MACHINE;
  if reg.OpenKey('\software\tientai_ks',true) then//存在
  begin
    temp_str:=reg.ReadString('tientai_sys_auto');
        if (temp_str='') or (temp_str=null) then
      reg.WriteString('tientai_sys_auto','0');
  end;
  if fileexists('c:\pidpr\ttmis\pub\proj\envir_set.exe') then
  //Executefile('envir_set.exe','','c:\pidpr\ttmis\pub\proj',SW_SHOWNORMAL);
  //上句marked by dong at 040322,用下句代替,目的:使其在delphi6+win2000/xp下能compile.
    ShellExecute(handle, 'open', pchar('envir_set.exe'),nil,'c:\pidpr\ttmis\pub\proj\', SW_SHOWNORMAL);
  if piPwdForm.Execute(Database1) = mrCancel then
  begin
    CLOSE;
    exit;
    // must have, else do next Table1.open, make error
  end; {_ if piPwdForm.Execute(Database1) = mrCancel then _}
  gUser_id  := piPwdForm.UsernameEdit.Text;
  refreshLblUpdate;
  ssuserQuery.ParamByName('user_id').AsString := gUser_id;
  ssuserQuery.open;
  if ssuserQuery.IsEmpty then
  begin
    showmessage('使用者错误!');
    close;
  end;
  gUser_name := ssuserQuery.fieldbyname('user_name').AsString;
  gemp_no:=ssuserQuery.fieldbyname('emp_no').asstring;
  MainForm.Caption := MainForm.Caption + ' USER NAME : ' + gUser_name;
  MainForm.Refresh;
  ttvermTable.open;
  if ttvermTable.FindKey(['main', gUser_id]) then
  begin
    ttvermTable.edit;
       ttvermTable.post;
  end
  else
  begin
    ttvermTable.append;
    ttvermTable.FieldByName('main_id').AsString := 'main';
    ttvermTable.FieldByName('user_id').AsString := gUser_id;
        ttvermTable.post;
  end;
  ttvermTable.close;

  with Qry_pr do
  begin
    close;
    parambyname('user_id').asstring:=guser_id;
    open;
    if isempty then
    begin
      btnpr.Enabled:=false;
      close;
    end;
  end;
  {
  if  (copy(guser_id,1,3)<>'com')
  and (guser_id<>'ttmis')
  and (guser_id<>'scb01')
  and (guser_id<>'glb02')
  and (guser_id<>'glb09')
  and (guser_id<>'glb07') then
  begin
    btnpr.Enabled:=false;
  end;
  }
  if (guser_id='scb24') or (guser_id='ttmis') or (guser_id='scb37')then
    connect_drive_x;//映射网络驱动器
end; {_ procedure TMainForm.FormShow(Sender: TObject); _}

procedure TMainForm.IvBtnClick(Sender: TObject);
begin
  Run_main('ivmainxb.exe');
end; {_ procedure TMainForm.IvBtnClick(Sender: TObject); _}


procedure TMainForm.ExitBtnClick(Sender: TObject);
begin
  CLOSE;
end; {_ procedure TMainForm.ExitBtnClick(Sender: TObject); _}

procedure TMainForm.UpdateProgram1Click(Sender: TObject);
begin
  gUpdate := True;
  refreshLblUpdate;
end; {_ procedure TMainForm.UpdateProgram1Click(Sender: TObject); _}

procedure TMainForm.NotUpdateProgram1Click(Sender: TObject);
begin
  gUpdate := False;
  refreshLblUpdate;
end; {_ procedure TMainForm.NotUpdateProgram1Click(Sender: TObject); _}




procedure TMainForm.SrBtnClick(Sender: TObject);
begin
     SrBtn.ENABLED := False;
     Run_main('srmainb.exe');
     SrBtn.ENABLED := True;
end;


procedure TMainForm.BtnQcClick(Sender: TObject);
begin
  btnqc.ENABLED := False;
  Run_main('c:\pidir\ttmis\pub.qc.exe');
  btnqc.ENABLED := True;
end;

procedure TMainForm.btnqcqcClick(Sender: TObject);
begin
  Btnqcqc.ENABLED := False;
  Run_main('qcmainx.exe');
  Btnqcqc.ENABLED := True;
end;




procedure TMainForm.BtnPrClick(Sender: TObject);
begin
  btnPr.ENABLED := false;
  Run_main('prmain.exe');
  btnPr.ENABLED := True;
end;


procedure TMainForm.BtnkqClick(Sender: TObject);
begin
  Btnkq.ENABLED := False;
  Run_main('kqmainb.exe');
  Btnkq.ENABLED := True;
end;




Procedure TMainForm.Get_Show_Text_New(emp_no:string);
Var
MyArray1:Array[0..10] of integer;
MyArray2:Array[0..10] of string;
i:integer;
gemp:string;
Begin
  //code here
  gemp:=emp_no;
  With Sql_Query1 do
  Begin
    Close;
    Sql.Clear;
    Sql.Add('select sql_expression from sql_table ');
    Open;
    First;
    i:=0;
    While Not Eof Do
    Begin
      If i<=(Sql_Query1.RecordCount-1) Then
        MyArray2[i]:=Sql_Query1.Fieldbyname('Sql_Expression').asstring;
      Next;
      i:=i+1;
    End;

⌨️ 快捷键说明

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