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, ShlObj, cxShellCommon, cxControls, cxContainer, cxShellTreeView, cxShellListView, ShellCtrls; 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; cxButton4: TcxButton; ShellListView1: TShellListView; ShellTreeView1: TShellTreeView; 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 cxButton4Click(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_RTFun; {$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 :='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:='D:\图片查看'; if not DirectoryExists(pchar(sFieldName)) then CreateDirectory(pchar(sFieldName),nil); fileName:=ListView1.Selected.Caption; sFieldName:=sFieldName+'\'+trim(fileName); try IdFTP1.Host :='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,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 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 := '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; procedure TfrmFjList.cxButton4Click(Sender: TObject); var fFilePath,FName:string; begin if Assigned(ShellListView1.Selected) then begin if ShellListView1.Selected.Selected then begin if ShellListView1.SelectedFolder.IsFolder then begin ShowMessage(ShellListView1.SelectedFolder.PathName); end else begin ShowMessage(ShellListView1.SelectedFolder.PathName); end; end; end; //if fFilePath <> '' then //fFilePath:=ShellListView1.SelectedFolder.PathName; // FName:=ShellListView1.SelectedFolder.DisplayName; begin try IdFTP1.Host :='127.0.0.1'; IdFTP1.Username := 'three'; IdFTP1.Password := '641010'; IdFTP1.Connect(); IdFTP1.Put(ShellListView1.SelectedFolder.PathName, 'FJ\' +ShellListView1.SelectedFolder.PathName); IdFTP1.Quit; except IdFTP1.Quit; Application.MessageBox('上传客户图样文件失败,请检查文件服务器!', '提示', MB_ICONWARNING); end; end; IdFTP1.Quit; end; end.