📄 main.pas
字号:
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 + -