📄 main.pas.~1~
字号:
// Delphi Code Arrange Expert - (Unregisted verion)
// Please contact with Wolfgang Chien <wolfgang@ms2.hinet.net>
// or http://www.chih.com/download/ca.html to get the license key.
// ---------------------------------------------------------------
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)
OeBtn1: TSpeedButton;
ImBtn: TSpeedButton;
Database1: TDatabase;
PopupMenu1: TPopupMenu;
Panel1: TPanel;
UpdateProgram1: TMenuItem;
NotUpdateProgram1: TMenuItem;
BtnAR: TSpeedButton;
LBLUpdate: TLabel;
SrBtn: TSpeedButton;
ssuserQuery: TQuery;
ttvermTable: TTable;
FaBtn: TSpeedButton;
Label1: TLabel;
BtnPo: TSpeedButton;
BtnQc: TSpeedButton;
btnqcqc: TSpeedButton;
btnsam: TSpeedButton;
Qry_check_sam: TQuery;
BtnPr: TSpeedButton;
Qry_pr: TQuery;
Btnkq: TSpeedButton;
BtnMrp: TSpeedButton;
ExitBtn: TSpeedButton;
pp4btn: TSpeedButton;
BtnPr2: TSpeedButton;
btndmp: TSpeedButton;
Qry_show_text: TQuery;
Qry_command: TQuery;
btn_msg: TBitBtn;
CheckBox_auto_show: TCheckBox;
Database2: TDatabase;
sql_query1: TQuery;
sql_query2: TQuery;
tientaisqltable: TTable;
procedure OeBtn1Click(Sender: TObject);
procedure Run_main(vExe_file: string);
procedure ImBtnClick(Sender: TObject);
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 LBLUpdateClick(Sender: TObject);
procedure refreshLblUpdate;
procedure BtnARClick(Sender: TObject);
procedure SrBtnClick(Sender: TObject);
procedure FaBtnClick(Sender: TObject);
procedure BtnPoClick(Sender: TObject);
procedure BtnQcClick(Sender: TObject);
procedure btnqcqcClick(Sender: TObject);
procedure btnsamClick(Sender: TObject);
procedure BtnPrClick(Sender: TObject);
procedure BtnkqClick(Sender: TObject);
procedure BtnMrpClick(Sender: TObject);
procedure pp4btnClick(Sender: TObject);
procedure BtnPr2Click(Sender: TObject);
procedure btndmpClick(Sender: TObject);
procedure btn_msgClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure CheckBox_auto_showClick(Sender: TObject);
procedure Database2Login(Database: TDatabase; LoginParams: TStrings);
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.OeBtn1Click(Sender: TObject);
begin
OeBtn1.ENABLED := False;
Run_main('oemainxb.exe');
OeBtn1.ENABLED := True;
end; {_ procedure TMainForm.OeBtn1Click(Sender: TObject); _}
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)));
if gUpdate then
begin
//if (not (FromDateTime = ToDateTime)) then
if (FromDateTime <> ToDateTime) then
begin
if MessageDlg('现在进行更新?', mtConfirmation,[mbYes, mbNo], 0) = mrYes then
begin
Panel1.CAPTION := '版本更新中,请稍候...';
Panel1.Refresh;
CopyFile(pchar(Fromfile),pchar(ToFile),false);
Source := FileOpen(ToFile, fmOpenReadWrite);
if Source < 0 then
ShowMessage('open tofile fail !');
FileSetDate(Source, FileAge(Fromfile));
FileClose(Source);
end; {_ if MessageDlg('版本更新. Exit now?', mtConfirmation,[mbYes, mbNo], 0) = mrYes then _}
end; {_ if (not (FromDateTime = ToDateTime)) then _}
end; {_ if gUpdate then _}
Panel1.CAPTION := '';
Panel1.Refresh;
{//marked by dong at 040322--使在delphi6+2000/XP环境下也能compile和运行,用下句代替.
ExecuteFile(vExe_file, gUser_id + ' ' + gPassword,
'c:\pidpr\ttmis\pub\proj\', SW_SHOWNORMAL);
}
ShellExecute(handle, 'open', pchar(vExe_file), pchar(gUser_id + ' ' + gPassword), 'c:\pidpr\ttmis\pub\proj\', SW_SHOWNORMAL);
end; {_ procedure TMainForm.Run_main(vExe_file: string); _}
procedure TMainForm.ImBtnClick(Sender: TObject);
begin
ImBtn.ENABLED := False;
Run_main('immainxb.exe');
ImBtn.ENABLED := True;
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='1' then
CheckBox_auto_show.Checked:=true
else
CheckBox_auto_show.Checked:=false;
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.FieldByName('ver').AsString := Label1.Caption;
ttvermTable.post;
end
else
begin
ttvermTable.append;
ttvermTable.FieldByName('main_id').AsString := 'main';
ttvermTable.FieldByName('user_id').AsString := gUser_id;
ttvermTable.FieldByName('ver').AsString := Label1.Caption;
ttvermTable.post;
end;
ttvermTable.close;
//add by dong at 020524
with Qry_check_sam do
begin
close;
parambyname('user_id').asstring:=guser_id;
open;
if recordcount=0 then
begin
btnsam.Enabled:=false;
close;
end;
end;
//end by dong at 020524
// FYGANG 2002-05-28
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 (copy(guser_id,1,3)<>'com')
and (copy(guser_id,1,3)<>'scb')
and (copy(guser_id,1,3)<>'pyk')
and (guser_id<>'ywb11')
and (guser_id<>'ttmis') then
begin
btnmrp.Enabled:=false;
end;
if CheckBox_auto_show.Checked then
get_show_text(false);
//get_show_text_new(gemp_no);
if (guser_id='scb24') or (guser_id='ttmis') or (guser_id='scb37')then
BtnPr2.Enabled:=true;
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.LBLUpdateClick(Sender: TObject);
begin
gUpdate := not gUpdate;
refreshLblUpdate;
end; {_ procedure TMainForm.LBLUpdateClick(Sender: TObject); _}
procedure TMainForm.BtnARClick(Sender: TObject);
begin
BtnAR.ENABLED := False;
Run_main('armainxb.exe');
BtnAR.ENABLED := True;
end; {_ procedure TMainForm.BtnARClick(Sender: TObject); _}
procedure TMainForm.SrBtnClick(Sender: TObject);
begin
SrBtn.ENABLED := False;
Run_main('srmainb.exe');
SrBtn.ENABLED := True;
end;
procedure TMainForm.FaBtnClick(Sender: TObject);
begin
FaBtn.ENABLED := False;
Run_main('famainx.exe');
FaBtn.ENABLED := True;
end;
procedure TMainForm.BtnPoClick(Sender: TObject);
begin
BtnPo.ENABLED := False;
Run_main('pomainx.exe');
BtnPo.ENABLED := True;
end;
procedure TMainForm.BtnQcClick(Sender: TObject);
begin
btnqc.ENABLED := False;
Run_main('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.btnsamClick(Sender: TObject);
begin
btnsam.ENABLED := False;
Run_main('sammainb.exe');
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -