unit U_AttachmentUpload; 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, dxSkinsCore, dxSkinsDefaultPainters, cxNavigator, dxDateRanges, IdExplicitTLSClientServerBase, System.ImageList, U_BaseHelp; type TfrmAttachmentUpload = class(TfrmBaseHelp) ListView1: TListView; Panel1: TPanel; FileName: TcxButton; cxButton1: TcxButton; cxButton2: TcxButton; cxButton3: TcxButton; ADOQueryTmp: TADOQuery; ADOQueryCmd: TADOQuery; ImageList1: TImageList; Panel2: TPanel; IdFTP1: TIdFTP; ADOConnection1: TADOConnection; Tv1: TcxGridDBTableView; cxGrid1Level1: TcxGridLevel; cxGrid1: TcxGrid; v1Column1: TcxGridDBColumn; v1Column2: TcxGridDBColumn; v1Column3: TcxGridDBColumn; DataSource1: TDataSource; v1Column4: TcxGridDBColumn; procedure cxButton3Click(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FileNameClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormShow(Sender: TObject); procedure ListView1DblClick(Sender: TObject); procedure cxButton1Click(Sender: TObject); procedure cxButton2Click(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure Panel2DblClick(Sender: TObject); procedure Tv1DblClick(Sender: TObject); private procedure InitData(); { Private declarations } public fkeyNO: string; fType: string; fId: integer; FEditAuthority: Boolean; { Public declarations } end; var frmAttachmentUpload: TfrmAttachmentUpload; implementation uses U_DataLink, U_RTFun, U_CompressionFun; {$R *.dfm} procedure TfrmAttachmentUpload.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))); open; end; except end; end; procedure TfrmAttachmentUpload.cxButton3Click(Sender: TObject); begin ADOQueryTmp.Close; ADOQuerycmd.Close; ListView1.Items.Free; ModalResult := -1; end; procedure TfrmAttachmentUpload.FormDestroy(Sender: TObject); begin frmAttachmentUpload := nil; end; procedure TfrmAttachmentUpload.FileNameClick(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 := '�����ϴ����ݣ����Ե�...'; Panel2.Visible := true; application.ProcessMessages; if GetLSNo(ADOQueryCmd, maxNo, 'FJ', 'FJ_File', 4, 1) = False then begin adoqueryCmd.Connection.RollbackTrans; Application.MessageBox('ȡ����ʧ�ܣ�', '��ʾ', 0); Exit; end; //��ȡ�ļ���Ϣ 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('��������ʧ�ܣ�', '��ʾ��Ϣ', 0); end; end; procedure TfrmAttachmentUpload.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('��������ʧ�ܣ�', '��ʾ��Ϣ'); end; end; procedure TfrmAttachmentUpload.FormShow(Sender: TObject); begin if FEditAuthority then Panel1.Visible := true else Panel1.Visible := false; initdata(); end; procedure TfrmAttachmentUpload.ListView1DblClick(Sender: TObject); var sFieldName: string; fileName: string; begin if ListView1.Items.Count < 1 then EXIT; if listView1.SelCount < 1 then exit; sFieldName := 'D:\�����鿴'; 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 := '�����������ݣ����Ե�...'; Panel2.Visible := true; application.ProcessMessages; try IdFTP1.Get('FJ\' + Trim(fileName), sFieldName, false, true); except Panel2.Visible := false; Application.MessageBox('�����ļ�������', '��ʾ', MB_ICONWARNING); IdFTP1.Quit; Exit; end; end else begin Panel2.Visible := false; Application.MessageBox('�������ļ�������', '��ʾ', MB_ICONWARNING); IdFTP1.Quit; Exit; end; Panel2.Visible := false; if IdFTP1.Connected then IdFTP1.Quit; ShellExecute(Handle, 'open', PChar(sFieldName), '', '', SW_SHOWNORMAL); end; procedure TfrmAttachmentUpload.cxButton1Click(Sender: TObject); var fFileName: string; fFilePath: string; begin if ADOQueryTmp.IsEmpty then exit; try 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(); except end; end; procedure TfrmAttachmentUpload.cxButton2Click(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 := '���ڱ������ݣ����Ե�...'; 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 TfrmAttachmentUpload.FormClose(Sender: TObject; var Action: TCloseAction); begin if fId = 10 then Action := cafree else Action := cahide; end; procedure TfrmAttachmentUpload.Panel2DblClick(Sender: TObject); begin Panel2.Visible := false; end; procedure TfrmAttachmentUpload.Tv1DblClick(Sender: TObject); var sFieldName: string; fileName: string; ff: TADOBlobStream; FJStream: TMemoryStream; begin if adoqueryTmp.IsEmpty then exit; sFieldName := 'D:\�����鿴'; 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.