unit U_FjList; 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 TfrmFjList = 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 frmFjList: TfrmFjList; implementation uses U_DataLink,U_Fun10; {$R *.dfm} procedure TfrmFjList.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 fileName 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 TfrmFjList.cxButton3Click(Sender: TObject); begin ADOQueryTmp.Close; ADOQuerycmd.Close; ListView1.Items.Free; ModalResult:=-1; end; procedure TfrmFjList.FormDestroy(Sender: TObject); begin frmFjList:=nil; end; procedure TfrmFjList.FileNameClick(Sender: TObject); var OpenDiaLog: TOpenDialog; fFileName:string; fFilePath:string; maxNo:string; // myStream: TADOBlobStream; // FJStream : TMemoryStream; 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; 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 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); // tblobfield(FieldByName('Filesother')).LoadFromFile(fFilePath); post; end; if fFilePath <> '' then begin try IdFTP1.Host := ReadINIFileStr('SYSTEMSET.INI','SERVER','FTP地址','127.0.0.1'); 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; end; adoqueryCmd.Connection.CommitTrans; except adoqueryCmd.Connection.RollbackTrans; application.MessageBox('附件保存失败!','提示信息',0); end; end; procedure TfrmFjList.FormCreate(Sender: TObject); begin with ADOConnection1 do begin Connected:=false; ConnectionString:=DConString; //ConnectionString:=''; Connected:=true; end; ListView1.Align:=alclient; fstatus:=0; end; procedure TfrmFjList.FormShow(Sender: TObject); begin IF fstatus=0 then Panel1.Visible:=true else Panel1.Visible:=false; initdata(); end; procedure TfrmFjList.ListView1DblClick(Sender: TObject); var sFieldName:string; fileName:string; 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 := ReadINIFileStr('SYSTEMSET.INI','SERVER','FTP地址','127.0.0.1'); 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); end; procedure TfrmFjList.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 TfrmFjList.cxButton2Click(Sender: TObject); var SaveDialog: TSaveDialog; fFileName:string; fFilePath:string; begin if listView1.SelCount<1 then exit; try fFileName:=ListView1.Selected.Caption; SaveDialog := TSaveDialog.Create(Self); SaveDialog.FileName:=fFileName; if SaveDialog.Execute then begin Panel2.Caption:='正在保存数据,请稍等...'; Panel2.Visible:=true; application.ProcessMessages; fFilePath:=SaveDialog.FileName; try IdFTP1.Host := ReadINIFileStr('SYSTEMSET.INI','SERVER','FTP地址','127.0.0.1');; 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 TfrmFjList.FormClose(Sender: TObject; var Action: TCloseAction); begin if fId=10 then Action:=cafree else Action:=cahide; end; procedure TfrmFjList.Panel2DblClick(Sender: TObject); begin Panel2.Visible:=false; end; end.