You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

423 lines
12 KiB
Plaintext

11 months ago
unit u_info_criterion;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, dxExEdtr, DB, ADODB, bsSkinCtrls, ExtCtrls, dxDBTLCl, dxGrClms,
dxTL, dxDBCtrl, dxDBGrid, dxCntner, StdCtrls, ComCtrls, DBCtrls,shellapi,
Mask;
type
Tfrm_info_criterion = class(TForm)
bsSkinPanel1: TbsSkinPanel;
bsSkinPanel2: TbsSkinPanel;
Label1: TLabel;
DBEdit1: TDBEdit;
DBRichEdit1: TDBRichEdit;
dxDBGrid1: TdxDBGrid;
dxDBGrid1Column1: TdxDBGridMaskColumn;
dxDBGrid1Column2: TdxDBGridMaskColumn;
dxDBGrid1Column3: TdxDBGridDateColumn;
Panel1: TPanel;
bsSkinButton7: TbsSkinButton;
bsSkinButton6: TbsSkinButton;
bsSkinButton1: TbsSkinButton;
bsSkinButton4: TbsSkinButton;
bsSkinButton3: TbsSkinButton;
bsSkinButton5: TbsSkinButton;
bsSkinButton8: TbsSkinButton;
t_info_criterion: TADOQuery;
t_info_criterion1: TDataSource;
bsSkinPanel3: TbsSkinPanel;
bsSkinButton2: TbsSkinButton;
bsSkinButton9: TbsSkinButton;
bsSkinButton11: TbsSkinButton;
bsSkinButton10: TbsSkinButton;
Splitter1: TSplitter;
dxDBGrid2: TdxDBGrid;
dxDBGrid2fid: TdxDBGridMaskColumn;
dxDBGrid2rl_id: TdxDBGridMaskColumn;
dxDBGrid2Column3: TdxDBGridColumn;
dxDBGrid2Column4: TdxDBGridColumn;
dxDBGrid2Column5: TdxDBGridColumn;
dxDBGrid2Column6: TdxDBGridDateColumn;
dxDBGrid2Column7: TdxDBGridColumn;
dxDBGrid2Column8: TdxDBGridColumn;
ProgressBar1: TProgressBar;
t_info_file: TADOQuery;
dsrFuJian: TDataSource;
qrytmp: TADOQuery;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure bsSkinButton5Click(Sender: TObject);
procedure bsSkinButton6Click(Sender: TObject);
procedure bsSkinButton7Click(Sender: TObject);
procedure bsSkinButton8Click(Sender: TObject);
procedure bsSkinButton4Click(Sender: TObject);
procedure bsSkinButton3Click(Sender: TObject);
procedure bsSkinButton1Click(Sender: TObject);
procedure t_info_criterionAfterInsert(DataSet: TDataSet);
procedure t_info_criterionBeforePost(DataSet: TDataSet);
procedure t_info_criterionBeforeEdit(DataSet: TDataSet);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormResize(Sender: TObject);
procedure DBEdit1KeyPress(Sender: TObject; var Key: Char);
procedure dxDBGrid1ColumnSorting(Sender: TObject;
Column: TdxDBTreeListColumn; var Allow: Boolean);
procedure bsSkinButton11Click(Sender: TObject);
procedure bsSkinButton10Click(Sender: TObject);
procedure bsSkinButton9Click(Sender: TObject);
procedure bsSkinButton2Click(Sender: TObject);
procedure t_info_fileBeforeEdit(DataSet: TDataSet);
procedure dxDBGrid2Exit(Sender: TObject);
private
{ Private declarations }
procedure UpLoadPro(fname:string); //fname<6D><65><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>·<EFBFBD><C2B7><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD><C4BC><EFBFBD>
procedure DownLoadPro(fname:string); //<2F><><EFBFBD><EFBFBD><EFBFBD>ݿ<EFBFBD><DDBF>ı<EFBFBD><C4B1><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
public
{ Public declarations }
end;
var
frm_info_criterion: Tfrm_info_criterion;
implementation
uses u_main, my_sys_function;
{$R *.dfm}
procedure Tfrm_info_criterion.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
frm_info_criterion.Hide;
frm_info_criterion.ManualFloat(frm_info_criterion.BoundsRect );
frm_main.freeTabs('frm_info_criterion');
action:=cafree;
frm_info_criterion:=nil;
end;
procedure Tfrm_info_criterion.FormShow(Sender: TObject);
begin
with t_info_criterion,sql do
begin
close ;clear ;
add('select * from t_info_criterion ');
add('where ¼<><C2BC><EFBFBD><EFBFBD>='+''''+employee+''' or ') ;
add(open_data('9004','¼<><C2BC><EFBFBD><EFBFBD>','no','no','no','no')) ;
add(' order by <20><><EFBFBD><EFBFBD><EFBFBD>淶 ');
Open;
end ;
t_info_file.Open ;
ProgressBar1.SendToBack ;
ProgressBar1.Visible:=false ;
end;
procedure Tfrm_info_criterion.bsSkinButton5Click(Sender: TObject);
begin
close;
end;
procedure Tfrm_info_criterion.bsSkinButton6Click(Sender: TObject);
begin
table_next(t_info_criterion);
end;
procedure Tfrm_info_criterion.bsSkinButton7Click(Sender: TObject);
begin
table_Prior(t_info_criterion);
end;
procedure Tfrm_info_criterion.bsSkinButton8Click(Sender: TObject);
begin
table_post(t_info_criterion);
end;
procedure Tfrm_info_criterion.bsSkinButton4Click(Sender: TObject);
begin
if t_info_criterion.isempty then
exit;
if not if_open('244') then
begin
showmessage('<27>Բ<EFBFBD><D4B2><EFBFBD><EFBFBD><EFBFBD>û<EFBFBD>д<EFBFBD>ģ<EFBFBD><C4A3><EFBFBD>IJ<EFBFBD><C4B2><EFBFBD>Ȩ<EFBFBD>ޣ<EFBFBD>');
exit;
end;
if do_data('9004',t_info_criterion.fieldbyname('¼<><C2BC><EFBFBD><EFBFBD>').asstring,'','','','','')=false then
begin
showmessage('<27>Բ<EFBFBD><D4B2><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ȩɾ<C8A8><C9BE><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ݣ<EFBFBD><DDA3><EFBFBD>');
abort;
end;
if application.MessageBox('<27><>ȷ<EFBFBD><C8B7>Ҫɾ<D2AA><C9BE><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>?','<27><><EFBFBD><EFBFBD>:',MB_OKCANCEL)=IDOK then
begin
with qrytmp,sql do //ɾ<><C9BE><EFBFBD>ӱ<EFBFBD>
begin
close ; clear ;
add('delete from t_info_criterion_file where ct_id=:rlid');
parameters.ParamByName('rlid').Value:=t_info_criterion.fieldbyname('ct_id').value ;
execsql ;
end ;
t_info_criterion.delete;
end ;
end;
procedure Tfrm_info_criterion.bsSkinButton3Click(Sender: TObject);
begin
table_cancel(t_info_criterion);
end;
procedure Tfrm_info_criterion.bsSkinButton1Click(Sender: TObject);
begin
if not if_open('242') then
begin
showmessage('<27>Բ<EFBFBD><D4B2><EFBFBD><EFBFBD><EFBFBD>û<EFBFBD>д<EFBFBD>ģ<EFBFBD><C4A3><EFBFBD>IJ<EFBFBD><C4B2><EFBFBD>Ȩ<EFBFBD>ޣ<EFBFBD>');
exit;
end;
t_info_criterion.insert;
end;
procedure Tfrm_info_criterion.t_info_criterionAfterInsert(
DataSet: TDataSet);
begin
t_info_criterion['¼<><C2BC><EFBFBD><EFBFBD><EFBFBD><EFBFBD>']:=date;
t_info_criterion['¼<><C2BC><EFBFBD><EFBFBD>']:=employee;
DBEdit1.SetFocus;
end;
procedure Tfrm_info_criterion.t_info_criterionBeforePost(
DataSet: TDataSet);
begin
table_before_post(t_info_criterion,'<27><><EFBFBD><EFBFBD><EFBFBD>淶');
table_before_post(t_info_criterion,'<27><><EFBFBD><EFBFBD>');
end;
procedure Tfrm_info_criterion.t_info_criterionBeforeEdit(
DataSet: TDataSet);
begin
if do_data('9004',t_info_criterion.fieldbyname('¼<><C2BC><EFBFBD><EFBFBD>').asstring,'','','','','')=false then
begin
showmessage('<27>Բ<EFBFBD><D4B2><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ȩ<EFBFBD>޸ģ<DEB8><C4A3><EFBFBD>');
abort;
end;
end;
procedure Tfrm_info_criterion.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
CanClose:=close_query(t_info_criterion);
end;
procedure Tfrm_info_criterion.FormResize(Sender: TObject);
var
i:integer;
begin
i:=round(panel1.Width/7);
bsSkinButton7.Width:=i;
bsSkinButton8.Width:=i;
bsSkinButton6.Width:=i;
bsSkinButton1.Width:=i;
bsSkinButton4.Width:=i;
bsSkinButton3.Width:=i;
DBEdit1.Width:=bsSkinPanel2.Width-DBEdit1.Left-6;
end;
procedure Tfrm_info_criterion.DBEdit1KeyPress(Sender: TObject;
var Key: Char);
begin
if key=#13 then
begin
key:=#0;
DBRichEdit1.SetFocus;
end;
end;
procedure Tfrm_info_criterion.dxDBGrid1ColumnSorting(Sender: TObject;
Column: TdxDBTreeListColumn; var Allow: Boolean);
begin
Column_sort(Column,t_info_criterion,'<27><><EFBFBD><EFBFBD><EFBFBD>淶');
end;
procedure Tfrm_info_criterion.UpLoadPro(fname:string);
const
BufSize=$F000;
var
Counter, N: Integer;
Buffer: PAnsiChar;
FieldStrm: TStream;
ExeFileStream:TFileStream;
size_tmp: Double;
filename,fileExt:string ;
begin
ProgressBar1.BringToFront ;
ProgressBar1.Visible:=true ;
filename:=ExtractFileName(fname) ;
fileExt:=ExtractFileExt(filename) ;
with t_info_file do
begin
Open;
append;
try
ExeFileStream:=TFileStream.Create(fname,fmopenRead); //<2F><><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD>
FieldStrm := CreateBlobStream(FieldByName('<27><><EFBFBD><EFBFBD>'),bmWrite);
GetMem(Buffer,BufSize);
try
Counter := ExeFileStream.Size;
size_tmp :=ExeFileStream.Size;
ProgressBar1.Position := 0;
ProgressBar1.Max := Counter div BufSize; //ÿ<><C3BF><EFBFBD>ϴ<EFBFBD><CFB4>ļ<EFBFBD><C4BC><EFBFBD>Ϊ61440 byte=$F000
while Counter<>0 do
begin
if Counter>BufSize then N :=BufSize else N:=Counter;
ExeFileStream.ReadBuffer(Buffer^,N);
FieldStrm.WriteBuffer(Buffer^, N);
Dec(Counter, N);
ProgressBar1.Position :=ProgressBar1.Position+1;
// Application.ProcessMessages;
end;
finally
FreeMem(Buffer,BufSize);
FieldStrm.Free;
end;
FieldByName('<27><><EFBFBD><EFBFBD>').AsString:=filename;
FieldByName('<27><>С').AsFloat:=size_tmp;
FieldByName('<27>ϴ<EFBFBD><CFB4><EFBFBD><EFBFBD><EFBFBD>').AsDateTime:=now();
FieldByName('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>').Asstring:=employee;
FieldByName('<27><><EFBFBD><EFBFBD>').Asstring:=fileExt;
Post;
ProgressBar1.SendToBack ;
ProgressBar1.Visible:=false ;
Application.MessageBox('<27><><EFBFBD><EFBFBD><EFBFBD>ϴ<EFBFBD><CFB4><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ɹ<EFBFBD>!','<27><>ʾ',MB_OK+MB_IconInformation);
finally
ProgressBar1.Position:=ProgressBar1.Max;
ExeFileStream.Free;
end;
end;
end ;
procedure Tfrm_info_criterion.DownLoadPro(fname:string) ; //<2F><><EFBFBD><EFBFBD><EFBFBD>ݿ<EFBFBD><DDBF>ı<EFBFBD><C4B1><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
const
MaxBufSize=$F000;
var
myfilename:string;//<2F><><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD><C4BC><EFBFBD>·<EFBFBD><C2B7><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD><C4BC><EFBFBD>
myfileStream,exeBlobStream:TStream;
Count,BufSize,N: Integer;
Buffer:PChar;
begin
ProgressBar1.BringToFront ;
ProgressBar1.Visible:=true ;
myfilename:=FName ;
with t_info_file do
begin
myfilename:=myfilename ; //+fieldbyname('<27><><EFBFBD><EFBFBD>').asstring ;
myfileStream :=TFileStream.Create(myfilename,fmCreate);//<2F><><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD>
try //SaveToStream(Stream);
ExeBlobStream:=CreateBlobStream(FieldByName('<27><><EFBFBD><EFBFBD>'),bmRead); //<2F><><EFBFBD><EFBFBD><EFBFBD>ݿ<EFBFBD><DDBF><EFBFBD>ȡ<EFBFBD>ü<EFBFBD>¼
Count:=0;
try
if Count=0 then
begin
ExeBlobStream.Position:=0;
Count:=ExeBlobStream.Size;//showmessage(inttostr(count));
end;
if Count>MaxBufSize then BufSize:=MaxBufSize else BufSize:=Count;
GetMem(Buffer,BufSize);
ProgressBar1.Position:=0;
ProgressBar1.Max:=count div bufsize;//ÿ<><C3BF>д<EFBFBD><D0B4><EFBFBD>ļ<EFBFBD><C4BC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>СΪbufsize,<2C><><EFBFBD><EFBFBD>maxΪcount <20><><EFBFBD><EFBFBD> bufsize
try
while Count<>0 do
begin
if Count>BufSize then N:=BufSize else N:=Count;
ExeBlobStream.ReadBuffer(Buffer^,N);//<2F><><EFBFBD><EFBFBD><EFBFBD>ݿ<EFBFBD><DDBF><EFBFBD><EFBFBD><EFBFBD>ȡ<EFBFBD><C8A1><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
MyFileStream.WriteBuffer(Buffer^,N);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>д<EFBFBD><D0B4><EFBFBD>ļ<EFBFBD>
Dec(Count,N);
ProgressBar1.Position:=ProgressBar1.Position+1;
end;
finally
FreeMem(Buffer,BufSize);
end;
finally
ExeBlobStream.Free;
end;
finally
myfileStream.Free;
end;
end;
ProgressBar1.Visible:=false ;
ProgressBar1.SendToBack ;
// MessageBox(Handle,pchar('<27><><EFBFBD>سɹ<D8B3>'),'<27><>Ϣ',MB_ICONINFORMATION);
end;
procedure Tfrm_info_criterion.bsSkinButton11Click(Sender: TObject);
var
arr: array[0..MAX_PATH] of Char;
num: DWORD;
tmpfile:string ;
begin
try
GetTempPath(MAX_PATH, arr);
tmpfile:=arr+t_info_file.fieldbyname('<27><><EFBFBD><EFBFBD>').asstring ;
DownLoadPro(tmpfile) ;
ShellExecute(Handle, nil, pchar(tmpfile), nil, nil, SW_NORMAL);
if ProgressBar1.Visible then
begin
ProgressBar1.Visible:=false ;
ProgressBar1.SendToBack ;
end ;
except
showmessage('<27><><EFBFBD>ܴ<EFBFBD><DCB4><EFBFBD><EFBFBD>ļ<EFBFBD><C4BC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ӵȴ<D3B5><C8B4><EFBFBD><EFBFBD><EFBFBD>');
end ;
end;
procedure Tfrm_info_criterion.bsSkinButton10Click(Sender: TObject);
begin
if not if_open('244') then
begin
showmessage('<27>Բ<EFBFBD><D4B2><EFBFBD><EFBFBD><EFBFBD>û<EFBFBD>д<EFBFBD>ģ<EFBFBD><C4A3><EFBFBD>IJ<EFBFBD><C4B2><EFBFBD>Ȩ<EFBFBD>ޣ<EFBFBD>');
exit;
end;
if do_data('9004',t_info_file.fieldbyname('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>').asstring,'','','','','')=false then
begin
showmessage('<27>Բ<EFBFBD><D4B2><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ȩɾ<C8A8><C9BE><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ݣ<EFBFBD><DDA3><EFBFBD>');
abort;
end;
if application.MessageBox('<27><>ȷ<EFBFBD><C8B7>Ҫɾ<D2AA><C9BE><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>?','<27><><EFBFBD><EFBFBD>:',MB_OKCANCEL)=IDOK then
t_info_file.delete ;
end;
procedure Tfrm_info_criterion.bsSkinButton9Click(Sender: TObject);
begin
if SaveDialog1.Execute then
DownLoadPro(Savedialog1.FileName+t_info_file.fieldbyname('<27><><EFBFBD><EFBFBD>').asstring)
else exit ;
end;
procedure Tfrm_info_criterion.bsSkinButton2Click(Sender: TObject);
begin
if not if_open('242') then
begin
showmessage('<27>Բ<EFBFBD><D4B2><EFBFBD><EFBFBD><EFBFBD>û<EFBFBD>д<EFBFBD>ģ<EFBFBD><C4A3><EFBFBD>IJ<EFBFBD><C4B2><EFBFBD>Ȩ<EFBFBD>ޣ<EFBFBD>');
exit;
end;
if t_info_criterion.State in [dsedit,dsinsert] then t_info_criterion.post ;
if OpenDialog1.Execute then UpLoadPro(Opendialog1.FileName)
else exit ;
end;
procedure Tfrm_info_criterion.t_info_fileBeforeEdit(DataSet: TDataSet);
begin
if t_info_file.FieldByName('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>').asstring<>employee then
begin
showmessage('<27>Բ<EFBFBD><D4B2><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ߣ<EFBFBD><DFA3><EFBFBD>Ȩ<EFBFBD>޸ģ<DEB8>');
abort ;
end ;
end;
procedure Tfrm_info_criterion.dxDBGrid2Exit(Sender: TObject);
begin
if t_info_file.state in [dsedit,dsinsert] then t_info_file.post ;
end;
end.