unit U_FjList10; 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, strutils; type TfrmFjList10 = class(TForm) ListView1: TListView; Panel1: TPanel; FileName: TcxButton; cxButton1: TcxButton; cxButton2: TcxButton; cxButton3: TcxButton; ADOQueryTmp: TADOQuery; ADOQueryCmd: TADOQuery; ImageList1: TImageList; Panel2: TPanel; IdFTP1: TIdFTP; ADOConnection1: TADOConnection; 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); private procedure InitData(); { Private declarations } public fkeyNO: string; fType: string; fId: integer; fstatus: integer; { Public declarations } end; var frmFjList10: TfrmFjList10; implementation uses U_DataLink, U_Fun10, U_CompressionFun; {$R *.dfm} procedure TfrmFjList10.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 TP_File '); sql.Add('where WBID=' + quotedstr(trim(fkeyNO))); sql.Add('and TFType=' + quotedstr(trim(fType))); open; if not IsEmpty then begin while not eof do begin with ListView1 do begin LargeImages := ImageList1; Icon := TIcon.Create; ListItem := Items.Add; ListItem.Caption := trim(fieldbyname('fileName').AsString); // Listitem.SubItems.Add(OpenDiaLog.FileName); Flag := (SHGFI_SMALLICON or SHGFI_ICON or SHGFI_USEFILEATTRIBUTES); SHGetFileInfo(Pchar(trim(fieldbyname('fileName').AsString)), 0, info, Sizeof(info), Flag); Icon.Handle := info.hIcon; ImageList1.AddIcon(Icon); ListItem.ImageIndex := ImageList1.Count - 1; end; next; end; end; end; except end; end; procedure TfrmFjList10.cxButton3Click(Sender: TObject); begin ADOQueryTmp.Close; ADOQuerycmd.Close; ListView1.Items.Free; ModalResult := -1; end; procedure TfrmFjList10.FormDestroy(Sender: TObject); begin frmFjList10 := nil; end; procedure TfrmFjList10.FileNameClick(Sender: TObject); var OpenDiaLog: TOpenDialog; fFileName: string; fFilePath: string; maxNo: string; // myStream: TADOBlobStream; // FJStream : TMemoryStream; FJStream: TMemoryStream; mfileSize: integer; mCreationTime: TdateTime; mWriteTime: TdateTime; begin try OpenDiaLog := TOpenDialog.Create(Self); if OpenDiaLog.Execute then begin fFilePath := OpenDiaLog.FileName; fFileName := ExtractFileName(OpenDiaLog.FileName); with adoqueryCmd do begin close; sql.Clear; sql.Add('select TFId from TP_File '); sql.Add('where WBID<>' + quotedstr(trim(fkeyNO))); sql.Add('and TFType=' + quotedstr(trim(fType))); sql.Add('and FileName=' + quotedstr(trim(fFileName))); open; if not adoqueryCmd.IsEmpty then begin application.MessageBox('此附件名称已存在,请修改文件名,继续上传!', '提示信息', MB_ICONERROR); exit; end; end; Panel2.Caption := '正在上传数据,请稍等...'; Panel2.Visible := true; application.ProcessMessages; if GetLSNo(ADOQueryCmd, maxNo, 'FJ', 'TP_File', 4, 1) = False then begin Application.MessageBox('取最大号失败!', '提示', 0); Exit; end; //获取文件信息 GetFileInfo(fFilePath, mfileSize, mCreationTime, mWriteTime); adoqueryCmd.Connection.BeginTrans; with adoqueryCmd do begin close; sql.Clear; sql.Add('delete from TP_File '); sql.Add('where WBID=' + quotedstr(trim(fkeyNO))); sql.Add('and TFType=' + quotedstr(trim(fType))); sql.Add('and FileName=' + quotedstr(trim(fFileName))); execsql; end; try FJStream := TMemoryStream.Create; with adoqueryCmd do begin close; sql.Clear; sql.Add('select * from TP_File '); sql.Add('where WBID=' + quotedstr(trim(fkeyNO))); sql.Add('and TFType=' + quotedstr(trim(fType))); sql.Add('and FileName=' + quotedstr(trim(fFileName))); open; append; fieldbyname('TFID').Value := trim(maxNo); fieldbyname('WBID').Value := trim(fkeyNO); fieldbyname('TFType').Value := trim(fType); fieldbyname('FileName').Value := trim(fFileName); FJStream.LoadFromFile(fFilePath); CompressionStream(FJStream); tblobfield(FieldByName('Filesother')).LoadFromStream(FJStream); // tblobfield(FieldByName('Filesother')).LoadFromFile(fFilePath); post; end; { if fFilePath <> '' then begin try IdFTP1.Host := PicSvr; IdFTP1.Username := 'three'; IdFTP1.Password := '641010'; IdFTP1.Connect(); IdFTP1.Put(fFilePath, 'FJ\' + Trim(fFileName)); IdFTP1.Quit; except IdFTP1.Quit; Application.MessageBox('上传客户图样文件失败,请检查文件服务器!', '提示', MB_ICONWARNING); end; end; IdFTP1.Quit; } Panel2.Visible := false; initdata(); finally // FJStream.Free; end; adoqueryCmd.Connection.CommitTrans; end; except adoqueryCmd.Connection.RollbackTrans; application.MessageBox('附件保存失败!', '提示信息', 0); end; end; procedure TfrmFjList10.FormCreate(Sender: TObject); begin with ADOConnection1 do begin Connected := false; ConnectionString := DConString; //ConnectionString:=''; Connected := true; end; ListView1.Align := alclient; fstatus := 0; end; procedure TfrmFjList10.FormShow(Sender: TObject); begin if fstatus = 0 then Panel1.Visible := true else Panel1.Visible := false; initdata(); end; procedure TfrmFjList10.ListView1DblClick(Sender: TObject); var sFieldName: string; fileName: string; ff: TADOBlobStream; FJStream: TMemoryStream; begin if ListView1.Items.Count < 1 then EXIT; if listView1.SelCount < 1 then exit; sFieldName := leftbstr(ExtractFilePath(Application.ExeName), 1) + ':\图片查看'; 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,true, false); 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); } try adoqueryTmp.Locate('FileName', fileName, []); 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; procedure TfrmFjList10.cxButton1Click(Sender: TObject); var fFileName: string; fFilePath: string; begin if listView1.SelCount < 1 then exit; try fFileName := ListView1.Selected.Caption; // ADOQueryTmp.Locate('fileName',fFileName,[]); with ADOQueryCmd do begin close; sql.Clear; sql.Add('delete from TP_File '); sql.Add('where WBID=' + quotedstr(trim(fkeyNO))); sql.Add('and TFType=' + quotedstr(trim(fType))); sql.Add('and FileName=' + quotedstr(trim(fFileName))); execsql; end; initData(); except end; end; procedure TfrmFjList10.cxButton2Click(Sender: TObject); var SaveDialog: TSaveDialog; fFileName: string; fFilePath: string; ff: TADOBlobStream; FJStream: TMemoryStream; begin if listView1.SelCount < 1 then exit; try fFileName := ListView1.Selected.Caption; adoqueryTmp.Locate('FileName', fFileName, []); 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; Panel2.Visible := false; end; end; { 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(fFileName), fFilePath,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; end; } except Panel2.Visible := false; end; end; procedure TfrmFjList10.FormClose(Sender: TObject; var Action: TCloseAction); begin if fId = 10 then Action := cafree else Action := cahide; end; procedure TfrmFjList10.Panel2DblClick(Sender: TObject); begin Panel2.Visible := false; end; end.