unit U_FileUp_PZ; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit, DB, cxDBData, ComCtrls, ToolWin, ExtCtrls, cxGridLevel, cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxClasses, cxControls, cxGridCustomView, cxGrid, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP, StdCtrls, ADODB,jpeg, BtnEdit,IniFiles; type TfrmFileUpPZ = class(TForm) cxGrid7: TcxGrid; TV7: TcxGridDBTableView; FileName: TcxGridDBColumn; FileDate: TcxGridDBColumn; cxGridLevel6: TcxGridLevel; Panel16: TPanel; ToolBar6: TToolBar; FileUp: TToolButton; FileDel: TToolButton; Panel1: TPanel; Label1: TLabel; Code: TEdit; ODPat: TOpenDialog; IdFTP1: TIdFTP; SaveDialog1: TSaveDialog; ADOQueryFile: TADOQuery; DataSource1: TDataSource; ADOQueryCmd: TADOQuery; ADOQueryTemp: TADOQuery; Image2: TImage; Label2: TLabel; ADOQuery1: TADOQuery; procedure FileUpClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FileDelClick(Sender: TObject); procedure FormShow(Sender: TObject); private lstPat: TStringList; AJpeg: TJPEGImage; procedure CreThumb(AJPeg:TJPEGImage;Image1:TImage;Width, Height: Integer); procedure SaveImageOther(); procedure ReadINIFile10(); { Private declarations } public CYID:String; { Public declarations } end; var frmFileUpPZ: TfrmFileUpPZ; implementation uses U_DataLink,U_RTFun; {$R *.dfm} procedure TfrmFileUpPZ.ReadINIFile10(); var programIni:Tinifile; //配置文件名 FileName:string; begin FileName:=ExtractFilePath(Paramstr(0))+'SYSTEMSET.INI'; programIni:=Tinifile.create(FileName); server:=programIni.ReadString('SERVER','服务器地址','127.0.0.1'); programIni.Free; end; procedure TfrmFileUpPZ.FileUpClick(Sender: TObject); var i,j: Integer; PatFile: String; FTPPath,FConNo,MaxNo:string; AJpeg: TJPEGImage; begin if Trim(Code.Text)='' then begin Application.MessageBox('图片编号不能为空!','提示',0); Exit; end; lstPat.Clear; if ODPat.Execute then begin lstPat.AddStrings(ODPat.Files); end; if lstPat.Count > 0 then begin try ReadINIFile10(); server:=ReadINIFileStr('SYSTEMSET.INI','SERVER','服务器地址','127.0.0.1'); IdFTP1.Host :=server;//PicSvr; IdFTP1.Username := 'three'; IdFTP1.Password := '641010'; IdFTP1.Connect(); except IdFTP1.Quit; Application.MessageBox('无法连接到文件服务器,请检查!', '提示', MB_ICONWARNING); Exit; end; end; Panel16.Visible:=True; Panel16.Refresh; AJpeg:=TJpegImage.Create(); Image2.Picture.LoadFromFile(ODPat.FileName); AJpeg.Assign(Image2.Picture.Graphic); CreThumb(AJpeg,Image2,800,400); //216,187 try ADOQueryCmd.Connection.BeginTrans; for i := 0 to lstPat.Count - 1 do begin PatFile := ExtractFileName(lstPat[i]); with ADOQueryTemp do begin Close; SQL.Clear; SQL.Add('select Count(*) MM from XD_File where filename='''+Trim(PatFile)+''' '); SQL.Add('and filetype=''PZ'''); Open; j:=fieldbyname('MM').AsInteger; end; if j>1 then begin PatFile:=IntToStr(j)+PatFile; end; if IdFTP1.Connected then begin try IdFTP1.Put(lstPat[i], Trim('\PZ')+'\'+Trim(PatFile)); with ADOQueryTemp do begin Close; SQL.Clear; SQL.Add('select * from XD_File where CYID='''+Trim(CYID)+''''); SQL.Add(' and filename='''+Trim(PatFile)+''''); SQL.Add(' and filetype=''PZ'''); Open; if not IsEmpty then begin Panel16.Visible:=False; Application.MessageBox(PChar('文件<'+Trim(PatFile)+'>重复,'+inttostr(i)+'个文件上传成功!'),'提示',0); Exit; end; end; if GetLSNo(ADOQueryCmd,MaxNo,'PZ','XD_File',4,1)=False then begin ADOQueryCmd.Connection.RollbackTrans; Application.MessageBox('取图片最大号失败!','提示',0); Exit; end; with ADOQueryCmd do begin Close; SQL.Clear; SQL.Add('select * from XD_File where 1=2'); Open; end; with ADOQueryCmd do begin Append; FieldByName('XFID').Value:=Trim(MaxNo); FieldByName('CYID').Value:=Trim(CYID); FieldByName('CYNO').Value:=Trim(Code.Text); FieldByName('filename').Value:=Trim(PatFile); FieldByName('FileDate').Value:=SGetServerDate(ADOQueryTemp); fieldbyname('FileType').value:=Trim('PZ'); Post; end; except ADOQueryCmd.Connection.RollbackTrans; Application.MessageBox('图片不是JPG格式!','提示',0); end; end; end; with ADOQueryCmd do begin Close; sql.Clear; sql.Add('Update CP_YDang Set TPFlag=1 where CYID='''+Trim(CYID)+''''); ExecSQL; end; SaveImageOther(); ADOQueryCmd.Connection.CommitTrans; except ADOQueryCmd.Connection.RollbackTrans; Application.MessageBox('图片上传失败!','提示',0); end; if IdFTP1.Connected then IdFTP1.Quit; with ADOQueryFile do begin Close; SQL.Clear; SQL.Add('select * from XD_File where CYID='''+Trim(CYID)+''''); open; end; Panel16.Visible:=False; if i>0 then Application.MessageBox(PChar(inttostr(i)+'个文件上传成功!'),'提示',0); ModalResult:=1; end; procedure TfrmFileUpPZ.CreThumb(AJPeg:TJPEGImage;Image1:TImage;Width, Height: Integer); var Bitmap: TBitmap; Ratio: Double; ARect: TRect; AHeight, AHeightOffset: Integer; AWidth, AWidthOffset: Integer; begin Bitmap := TBitmap.Create; try Ratio := AJPeg.Width /AJPeg.Height; if Ratio > 1.333 then begin AHeight := Round(Width / Ratio); AHeightOffset := (Height - AHeight) div 2; AWidth := Width; AWidthOffset := 0; end else begin AWidth := Round(Height * Ratio); AWidthOffset := (Width - AWidth) div 2; AHeight := Height; AHeightOffset := 0; end; Bitmap.Width := Width; Bitmap.Height := Height; Bitmap.Canvas.Brush.Color := clBtnFace; Bitmap.Canvas.FillRect(Rect(0, 0, Width, Height)); ARect := Rect(AWidthOffset, AHeightOffset, AWidth + AWidthOffset, AHeight + AHeightOffset); Bitmap.Canvas.StretchDraw(ARect, AJPeg); Image1.Picture.Assign(BitMap); finally Bitmap.Free; end; end; procedure TfrmFileUpPZ.SaveImageOther(); var AJpeg: TJPEGImage; myStream: TADOBlobStream; ImgMaxNo:String; i,j: Integer; PatFile: String; FTPPath,FConNo,MaxNo,FTFID:string; begin if Image2.Picture=nil then Exit; AJpeg:=TJpegImage.Create(); with ADOQueryTemp do begin Close; sql.Clear; sql.Add('select * from TP_File where WBID='''+Trim(CYID)+''''); Open; end; FTFID:=Trim(ADOQueryTemp.fieldbyname('TFID').AsString); if Trim(FTFID)='' then begin if GetLSNo(ADOQueryCmd,ImgMaxNo,'TF','TP_File',3,1)=False then begin ADOQueryCmd.Connection.RollbackTrans; Application.MessageBox('取图片表最大号失败!','提示',0); Exit; end; end else begin ImgMaxNo:=Trim(FTFID); end; with ADOQueryCmd do begin close; sql.Clear; sql.Add( ' select * from TP_File where TFID='''+Trim(FTFID)+''''); open; end; with ADOQueryCmd do begin if Trim(FTFID)='' then begin Append; FieldByName('Filler').Value:=Trim(DName); end else begin Edit; FieldByName('Editer').Value:=Trim(DName); FieldByName('EditTime').Value:=SGetServerDateTime(ADOQueryTemp); end; FieldByName('TFID').Value:=Trim(ImgMaxNo); FieldByName('WBID').Value:=Trim(CYID); //FieldByName('TFIdx').Value:=cxTabControl2.TabIndex; FieldByName('TFType').Value:='凭证'; AJpeg.Assign(Image2.Picture.Graphic); //CreThumb(AJpeg,Image1,160, 120); myStream := TADOBlobStream.Create(TBlobField(ADOQueryCmd.FieldByName('FilesOther')), bmWrite); AJpeg.Assign(Image2.Picture.Graphic); AJpeg.SaveToStream(myStream); myStream.Free; Post; end; end; procedure TfrmFileUpPZ.FormCreate(Sender: TObject); begin lstPat := TStringList.Create; end; procedure TfrmFileUpPZ.FileDelClick(Sender: TObject); begin with ADOQueryCmd do begin Close; sql.Clear; SQL.Add(' Delete XD_File where XFID='''+Trim(ADOQueryFile.fieldbyname('XFID').AsString)+''''); SQL.Add(' Delete TP_File where WBID='''+Trim(CYID)+''' and TFType=''凭证'' '); ExecSQL; end; with ADOQuery1 do begin Close; SQL.Clear; SQL.Add('select * from XD_File where CYID='''+Trim(CYID)+''''); SQL.Add(' and FileType=''PZ'''); open; end; if ADOQuery1.IsEmpty then begin with ADOQueryCmd do begin Close; sql.Clear; sql.Add('Update CP_YDang Set TPFlag=0 where CYID='''+Trim(CYID)+''''); ExecSQL; end; end; application.MessageBox('删除成功','提示'); end; procedure TfrmFileUpPZ.FormShow(Sender: TObject); begin with ADOQueryFile do begin Close; SQL.Clear; SQL.Add('select * from XD_File where CYID='''+Trim(CYID)+''''); SQL.Add(' and FileType=''PZ'''); Open; end; end; end.