unit U_FileUp_PB; 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, DBClient; type TfrmFileUp_PB = 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; ToolButton1: TToolButton; SC_TP: TClientDataSet; procedure FileUpClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FileDelClick(Sender: TObject); procedure FormShow(Sender: TObject); procedure ToolButton1Click(Sender: TObject); private lstPat: TStringList; AJpeg: TJPEGImage; procedure CreThumb(AJPeg:TJPEGImage;Image1:TImage;Width, Height: Integer); procedure SaveImageOther(); procedure SaveImageOther1(); procedure ReadINIFile10(); { Private declarations } public CYID,FSKID:String; { Public declarations } end; var frmFileUp_PB: TfrmFileUp_PB; implementation uses U_DataLink,U_Fun; {$R *.dfm} procedure TfrmFileUp_PB.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 TfrmFileUp_PB.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(); with ADOQueryTemp do begin Close; SQL.Clear; SQL.Add('select Count(*) MM from XD_File_TP where CYNO='''+Trim(Code.Text)+''''); SQL.Add('and filetype=''YP'''); Open; j:=fieldbyname('MM').AsInteger; end; Image2.Picture.LoadFromFile(ODPat.FileName); AJpeg.Assign(Image2.Picture.Graphic); CreThumb(AJpeg,Image2,216, 187); try ADOQueryCmd.Connection.BeginTrans; for i := 0 to lstPat.Count - 1 do begin PatFile := ExtractFileName(lstPat[i]); PatFile:=Copy(PatFile,(Pos('.',PatFile)+1),(Length(PatFile)-Pos('.',PatFile))) ; FConNo:=Trim(Code.Text); while Pos('/',FConNo)>0 do begin Delete(FConNo,Pos('/',FConNo),1); end; PatFile:=Trim(FConNo)+'-'+Inttostr(j+i+1)+'.'+PatFile; if IdFTP1.Connected then begin IdFTP1.Put(lstPat[i], Trim(UserDataFlag+'YP')+'\'+Trim(PatFile)); if GetLSNo(ADOQueryCmd,MaxNo,'YP','XD_File_TP',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_TP where 1=2'); Open; end; with ADOQueryCmd do begin Append; FieldByName('XFID').Value:=Trim(MaxNo); FieldByName('CYID').Value:=Trim(MaxNo); FieldByName('CYNO').Value:=Trim(Code.Text); FieldByName('SKID').Value:=Trim(FSKID); FieldByName('filename').Value:=Trim(PatFile); FieldByName('FileDate').Value:=SGetServerDate(ADOQueryTemp); fieldbyname('FileType').value:=Trim('YP'); Post; end; end; end; CYID:=Trim(maxno); SaveImageOther(); ADOQueryCmd.Connection.CommitTrans; except; ADOQueryCmd.Connection.RollbackTrans; Application.MessageBox('图片上传失败!','提示',0); end; if IdFTP1.Connected then IdFTP1.Quit; Panel16.Visible:=False; if i>0 then Application.MessageBox(PChar(inttostr(i)+'个文件上传成功!'),'提示',0); ModalResult:=1; end; procedure TfrmFileUp_PB.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 TfrmFileUp_PB.SaveImageOther(); var AJpeg: TJPEGImage; myStream: TADOBlobStream; ImgMaxNo:String; i,j: Integer; PatFile: String; FTPPath,FConNo,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_TP where WBID='''+Trim(CYID)+''''); Open; end; FTFID:=Trim(ADOQueryTemp.fieldbyname('TFID').AsString); if Trim(FTFID)='' then begin if GetLSNo(ADOQueryCmd,ImgMaxNo,'TF','TP_File_TP',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_TP 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 TfrmFileUp_PB.SaveImageOther1(); var AJpeg: TJPEGImage; myStream: TADOBlobStream; ImgMaxNo:String; i,j: Integer; PatFile: String; FTPPath,FConNo,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_TP where WBID='''+Trim(SC_TP.fieldbyname('CYID').AsString)+''''); Open; end; FTFID:=Trim(ADOQueryTemp.fieldbyname('TFID').AsString); ImgMaxNo:=Trim(FTFID); with ADOQueryCmd do begin close; sql.Clear; sql.Add( ' select * from TP_File_TP where TFID='''+Trim(FTFID)+''''); open; end; with ADOQueryCmd do begin Edit; FieldByName('Editer').Value:=Trim(DName); FieldByName('EditTime').Value:=SGetServerDateTime(ADOQueryTemp); FieldByName('TFID').Value:=Trim(ImgMaxNo); //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 TfrmFileUp_PB.FormCreate(Sender: TObject); begin lstPat := TStringList.Create; end; procedure TfrmFileUp_PB.FileDelClick(Sender: TObject); begin with ADOQueryCmd do begin Close; sql.Clear; SQL.Add(' Delete XD_File_TP where XFID='''+Trim(SC_TP.fieldbyname('XFID').AsString)+''''); SQL.Add(' Delete TP_File_TP where WBID='''+Trim(CYID)+''' '); ExecSQL; end; SC_TP.Delete; Application.MessageBox('删除成功','提示'); end; procedure TfrmFileUp_PB.FormShow(Sender: TObject); begin with ADOQueryFile do begin Close; SQL.Clear; SQL.Add('select * from XD_File_TP where SKID='''+Trim(FSKID)+''''); SQL.Add(' and FileType=''YP'''); Open; end; SCreateCDS20(ADOQueryFile,SC_TP); SInitCDSData20(ADOQueryFile,SC_TP); end; procedure TfrmFileUp_PB.ToolButton1Click(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(); with ADOQueryTemp do begin Close; SQL.Clear; SQL.Add('select Count(*) MM from XD_File_TP where CYNo='''+Trim(Code.Text)+''''); SQL.Add('and filetype=''YP'''); Open; j:=fieldbyname('MM').AsInteger; end; Image2.Picture.LoadFromFile(ODPat.FileName); AJpeg.Assign(Image2.Picture.Graphic); CreThumb(AJpeg,Image2,216, 187); try ADOQueryCmd.Connection.BeginTrans; for i := 0 to lstPat.Count - 1 do begin PatFile := ExtractFileName(lstPat[i]); PatFile:=Copy(PatFile,(Pos('.',PatFile)+1),(Length(PatFile)-Pos('.',PatFile))) ; FConNo:=Trim(Code.Text); while Pos('/',FConNo)>0 do begin Delete(FConNo,Pos('/',FConNo),1); end; PatFile:=Trim(CYID)+'-'+Inttostr(j+i+1)+'.'+PatFile; if IdFTP1.Connected then begin IdFTP1.Put(lstPat[i], Trim(UserDataFlag+'YP')+'\'+Trim(PatFile)); with ADOQueryCmd do begin Close; SQL.Clear; SQL.Add('select * from XD_File_TP where XFID='''+trim(SC_TP.fieldbyname('XFID').AsString)+''''); Open; end; with ADOQueryCmd do begin edit; FieldByName('CYNO').Value:=Trim(Code.Text); FieldByName('filename').Value:=Trim(PatFile); FieldByName('FileDate').Value:=SGetServerDate(ADOQueryTemp); Post; end; end; end; SaveImageOther1(); 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_TP where CYID='''+Trim(CYID)+''''); open; end; Panel16.Visible:=False; if i>0 then Application.MessageBox(PChar(inttostr(i)+'个文件上传成功!'),'提示',0); ModalResult:=1; end; end.