D10SZKaiXiYa/A09财务通用管理/U_FKandFPUpload.pas

408 lines
9.9 KiB
ObjectPascal
Raw Normal View History

2026-03-24 10:22:19 +08:00
unit U_FKandFPUpload;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, ComCtrls, Menus, cxLookAndFeelPainters, StdCtrls, cxButtons,
DB, ADODB, ImgList, shellapi, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdFTP, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData,
cxDataStorage, cxEdit, cxDBData, cxGridCustomTableView, cxGridTableView,
cxGridDBTableView, cxGridLevel, cxClasses, cxControls, cxGridCustomView,
cxGrid, cxLookAndFeels, cxNavigator, dxDateRanges,
IdExplicitTLSClientServerBase, System.ImageList, U_BaseHelp, Vcl.ToolWin,
dxScrollbarAnnotations, cxImageList, dxSkinsCore, dxSkinsDefaultPainters;
type
TfrmFKandFPUpload = class(TfrmBaseHelp)
ListView1: TListView;
ADOQueryTmp: TADOQuery;
ADOQueryCmd: TADOQuery;
Panel2: TPanel;
IdFTP1: TIdFTP;
ADOConnection1: TADOConnection;
Tv1: TcxGridDBTableView;
cxGrid1Level1: TcxGridLevel;
cxGrid1: TcxGrid;
v1Column1: TcxGridDBColumn;
v1Column2: TcxGridDBColumn;
v1Column3: TcxGridDBColumn;
DataSource1: TDataSource;
v1Column4: TcxGridDBColumn;
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBAdd: TToolButton;
TBClose: TToolButton;
TBDel: TToolButton;
btnDown: TToolButton;
ImageList1: TImageList;
cxImageList_bar: TcxImageList;
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ListView1DblClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Panel2DblClick(Sender: TObject);
procedure Tv1DblClick(Sender: TObject);
procedure TBAddClick(Sender: TObject);
procedure TBDelClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure btnDownClick(Sender: TObject);
private
procedure InitData();
{ Private declarations }
public
fkeyNO: string;
fType: string;
fkeyNO2: string;
fType2: string;
fId: integer;
FEditAuthority: Boolean;
{ Public declarations }
end;
var
frmFKandFPUpload: TfrmFKandFPUpload;
implementation
uses
U_DataLink, U_RTFun, U_CompressionFun;
{$R *.dfm}
procedure TfrmFKandFPUpload.InitData();
var
ListItem: TListItem;
Flag: Cardinal;
info: SHFILEINFOA;
Icon: TIcon;
begin
ListView1.Items.Clear;
try
with adoqueryTmp do
begin
close;
sql.Clear;
sql.Add('select * from FJ_File ');
sql.Add('where (WBID=' + quotedstr(trim(fkeyNO)));
sql.Add('and TFType=' + quotedstr(trim(fType)) + ')');
sql.Add('or (WBID=' + quotedstr(trim(fkeyNO2)));
sql.Add('and TFType=' + quotedstr(trim(fType2)) + ')');
// ShowMessage(SQL.Text);
open;
end;
except
end;
end;
procedure TfrmFKandFPUpload.FormDestroy(Sender: TObject);
begin
frmFKandFPUpload := nil;
end;
procedure TfrmFKandFPUpload.FormCreate(Sender: TObject);
begin
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD>', '<27><>ʾ<EFBFBD><CABE>Ϣ');
end;
end;
procedure TfrmFKandFPUpload.FormShow(Sender: TObject);
begin
// if FEditAuthority then
// begin
// btnDown.Visible := True;
// TBDel.Visible := True;
// TBAdd.Visible := True;
// end
// else
// begin
// btnDown.Visible := false;
// TBDel.Visible := false;
// TBAdd.Visible := false;
// end;
initdata();
end;
procedure TfrmFKandFPUpload.ListView1DblClick(Sender: TObject);
var
sFieldName: string;
fileName: string;
begin
if ListView1.Items.Count < 1 then
EXIT;
if listView1.SelCount < 1 then
exit;
sFieldName := 'D:\<5C><><EFBFBD><EFBFBD><EFBFBD>鿴';
if not DirectoryExists(pchar(sFieldName)) then
CreateDirectory(pchar(sFieldName), nil);
fileName := ListView1.Selected.Caption;
sFieldName := sFieldName + '\' + trim(fileName);
try
IdFTP1.Host := PicSvr;
IdFTP1.Username := 'three';
IdFTP1.Password := '641010';
IdFTP1.Connect();
except
;
end;
if IdFTP1.Connected then
begin
Panel2.Caption := '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ݣ<EFBFBD><DDA3><EFBFBD><EFBFBD>Ե<EFBFBD>...';
Panel2.Visible := true;
application.ProcessMessages;
try
IdFTP1.Get('FJ\' + Trim(fileName), sFieldName, false, true);
except
Panel2.Visible := false;
Application.MessageBox('<27><><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD><C4BC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>', '<27><>ʾ', MB_ICONWARNING);
IdFTP1.Quit;
Exit;
end;
end
else
begin
Panel2.Visible := false;
Application.MessageBox('<27>޷<EFBFBD><DEB7><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD><C4BC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>', '<27><>ʾ', MB_ICONWARNING);
IdFTP1.Quit;
Exit;
end;
Panel2.Visible := false;
if IdFTP1.Connected then
IdFTP1.Quit;
ShellExecute(Handle, 'open', PChar(sFieldName), '', '', SW_SHOWNORMAL);
end;
procedure TfrmFKandFPUpload.btnDownClick(Sender: TObject);
var
SaveDialog: TSaveDialog;
fFileName: string;
fFilePath: string;
ff: TADOBlobStream;
FJStream: TMemoryStream;
begin
if adoqueryTmp.IsEmpty then
exit;
try
fFileName := adoqueryTmp.fieldbyname('FileName').AsString;
SaveDialog := TSaveDialog.Create(Self);
SaveDialog.FileName := fFileName;
if SaveDialog.Execute then
begin
Panel2.Caption := '<27><><EFBFBD>ڱ<EFBFBD><DAB1><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ݣ<EFBFBD><DDA3><EFBFBD><EFBFBD>Ե<EFBFBD>...';
Panel2.Visible := true;
application.ProcessMessages;
fFilePath := SaveDialog.FileName;
try
ff := TADOBlobstream.Create(adoqueryTmp.fieldByName('FilesOther') as TblobField, bmRead);
FJStream := TMemoryStream.Create;
ff.SaveToStream(FJStream);
UnCompressionStream(FJStream);
FJStream.SaveToFile(fFilePath);
// ShellExecute(Handle, 'open',PChar(sFieldName),'', '', SW_SHOWNORMAL);
finally
FJStream.free;
ff.Free;
end;
Panel2.Visible := false;
// if IdFTP1.Connected then IdFTP1.Quit;
end;
except
Panel2.Visible := false;
end;
end;
procedure TfrmFKandFPUpload.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if fId = 10 then
Action := cafree
else
Action := cahide;
end;
procedure TfrmFKandFPUpload.Panel2DblClick(Sender: TObject);
begin
Panel2.Visible := false;
end;
procedure TfrmFKandFPUpload.TBAddClick(Sender: TObject);
var
OpenDiaLog: TOpenDialog;
fFileName: string;
fFilePath: string;
maxNo: string;
FJStream: TMemoryStream;
mfileSize: integer;
mCreationTime: TdateTime;
mWriteTime: TdateTime;
begin
try
adoqueryCmd.Connection.BeginTrans;
OpenDiaLog := TOpenDialog.Create(Self);
if OpenDiaLog.Execute then
begin
fFilePath := OpenDiaLog.FileName;
fFileName := ExtractFileName(OpenDiaLog.FileName);
Panel2.Caption := '<27><><EFBFBD><EFBFBD><EFBFBD>ϴ<EFBFBD><CFB4><EFBFBD><EFBFBD>ݣ<EFBFBD><DDA3><EFBFBD><EFBFBD>Ե<EFBFBD>...';
Panel2.Visible := true;
application.ProcessMessages;
if GetLSNo(ADOQueryCmd, maxNo, 'FJ', 'FJ_File', 4, 1) = False then
begin
adoqueryCmd.Connection.RollbackTrans;
Application.MessageBox(<><C8A1><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD>', '<27><>ʾ', 0);
Exit;
end;
//<2F><>ȡ<EFBFBD>ļ<EFBFBD><C4BC><EFBFBD>Ϣ
GetFileInfo(fFilePath, mfileSize, mCreationTime, mWriteTime);
with adoqueryCmd do
begin
close;
sql.Clear;
sql.Add('delete from FJ_File ');
sql.Add('where TFID=' + quotedstr(trim(maxNo)));
execsql;
end;
try
FJStream := TMemoryStream.Create;
with adoqueryCmd do
begin
close;
sql.Clear;
sql.Add('select * from FJ_File ');
sql.Add('where TFID=' + quotedstr(trim(maxNo)));
open;
append;
fieldbyname('TFID').Value := trim(maxNo);
fieldbyname('WBID').Value := trim(fkeyNO);
fieldbyname('TFType').Value := trim(fType);
fieldbyname('Filler').Value := trim(DName);
fieldbyname('FileName').Value := trim(fFileName);
fieldbyname('TFDate').Value := mWriteTime;
FJStream.LoadFromFile(fFilePath);
CompressionStream(FJStream);
tblobfield(FieldByName('Filesother')).LoadFromStream(FJStream);
post;
end;
Panel2.Visible := false;
initdata();
finally
FJStream.Free;
end;
end;
adoqueryCmd.Connection.CommitTrans;
except
adoqueryCmd.Connection.RollbackTrans;
application.MessageBox('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD>', '<27><>ʾ<EFBFBD><CABE>Ϣ', 0);
end;
end;
procedure TfrmFKandFPUpload.TBCloseClick(Sender: TObject);
begin
ADOQueryTmp.Close;
ADOQuerycmd.Close;
ListView1.Free;
ModalResult := 1;
end;
procedure TfrmFKandFPUpload.TBDelClick(Sender: TObject);
var
fFileName: string;
fFilePath: string;
begin
if ADOQueryTmp.IsEmpty then
exit;
if trim(ADOQueryTmp.fieldbyname('Filler').AsString) <> trim(DName) then
begin
Application.MessageBox(<>޲<EFBFBD><DEB2><EFBFBD>ϴ<EFBFBD><CFB4>˻<EFBFBD><CBBB><EFBFBD>ɾ<EFBFBD><C9BE>!', '<27><>ʾ', 0);
Exit;
end;
if Application.MessageBox(<><C8B7>Ҫɾ<D2AA><C9BE><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>', '<27><>ʾ', 32 + 4) <> IDYES then
Exit;
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('delete from FJ_File ');
sql.Add('where TFID=' + quotedstr(trim(ADOQueryTmp.fieldbyname('TFID').AsString)));
execsql;
end;
initData();
end;
procedure TfrmFKandFPUpload.TBRafreshClick(Sender: TObject);
begin
initData();
end;
procedure TfrmFKandFPUpload.Tv1DblClick(Sender: TObject);
var
sFieldName: string;
fileName: string;
ff: TADOBlobStream;
FJStream: TMemoryStream;
begin
if adoqueryTmp.IsEmpty then
exit;
sFieldName := 'D:\<5C><><EFBFBD><EFBFBD><EFBFBD>鿴';
if not DirectoryExists(pchar(sFieldName)) then
CreateDirectory(pchar(sFieldName), nil);
fileName := adoqueryTmp.fieldbyname('FileName').AsString;
sFieldName := sFieldName + '\' + trim(fileName);
try
ff := TADOBlobstream.Create(adoqueryTmp.fieldByName('FilesOther') as TblobField, bmRead);
FJStream := TMemoryStream.Create;
ff.SaveToStream(FJStream);
UnCompressionStream(FJStream);
FJStream.SaveToFile(sFieldName);
ShellExecute(Handle, 'open', PChar(sFieldName), '', '', SW_SHOWNORMAL);
finally
FJStream.free;
ff.Free;
end;
end;
end.