unit U_FileUp4; 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, strutils, cxLookAndFeels, cxLookAndFeelPainters, cxNavigator; type TfrmFileUp4 = 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; 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(FTFID: string); procedure ReadINIFile10(); { Private declarations } public CYID: string; { Public declarations } end; var frmFileUp4: TfrmFileUp4; implementation uses U_DataLink, U_Fun; {$R *.dfm} procedure TfrmFileUp4.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 TfrmFileUp4.FileUpClick(Sender: TObject); var i, j: Integer; PatFile: string; FTPPath, FConNo, MaxNo: string; AJpeg: TJPEGImage; myStream: TADOBlobStream; 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 IdFTP1.Host := PicSvr; //PicSvr; IdFTP1.Username := 'three'; IdFTP1.Password := '641010'; IdFTP1.Connect(); except IdFTP1.Quit; Application.MessageBox('无法连接到文件服务器,请检查!', '提示', MB_ICONWARNING); Exit; end; end; Panel16.Visible := True; Panel16.Refresh; try AJpeg := TJpegImage.Create(); ADOQueryCmd.Connection.BeginTrans; for i := 0 to lstPat.Count - 1 do begin with ADOQueryTemp do begin Close; sql.Clear; sql.Add('select isnull(max(abs(cast(right(left(FileName,charindex(''.'',FileName)-1),2) as int))),0)+1 as BH from XD_File'); sql.Add('where CYID=''' + trim(CYID) + ''' '); open; end; PatFile := trim(Code.Text) + '-' + inttostr(ADOQueryTemp.fieldbyname('BH').AsInteger) + '.' + Copy(ExtractFileName(lstPat[i]), (Pos('.', ExtractFileName(lstPat[i])) + 1), (Length(ExtractFileName(lstPat[i])) - Pos('.', ExtractFileName(lstPat[i])))); AJpeg.LoadFromFile(ExtractFileName(lstPat[i])); CreThumb(AJpeg, Image2, 6400, 4800); if IdFTP1.Connected then begin try IdFTP1.Put(lstPat[i], Trim(UserDataFlag + 'YP') + '\' + Trim(PatFile)); if GetLSNo(ADOQueryCmd, MaxNo, 'YP', '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<>1'); 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('FM'); Post; end; with ADOQueryCmd do begin close; sql.Clear; sql.Add(' select * from TP_File where TFID=''' + Trim(MaxNo) + ''''); open; end; with ADOQueryCmd do begin if ADOQueryCmd.IsEmpty 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(MaxNo); FieldByName('WBID').Value := Trim(CYID); FieldByName('TFType').Value := '样品'; myStream := TADOBlobStream.Create(TBlobField(ADOQueryCmd.FieldByName('FilesOther')), bmWrite); AJpeg.Assign(Image2.Picture.Graphic); AJpeg.SaveToStream(myStream); myStream.Free; Post; end; except end; end; end; // with ADOQueryCmd do // begin // Close; // sql.Clear; // sql.Add('Update CP_YDang Set TPFlag=1 where CYID=''' + Trim(CYID) + ''''); // ExecSQL; // end; ADOQueryCmd.Connection.CommitTrans; AJpeg.Free; except AJpeg.Free; 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 FileType =''FM'' and CYID=''' + Trim(CYID) + ''''); open; end; Panel16.Visible := False; if i > 0 then Application.MessageBox(PChar(inttostr(i) + '个文件上传成功!'), '提示', 0); ModalResult := 1; end; procedure TfrmFileUp4.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 TfrmFileUp4.SaveImageOther(FTFID: string); var AJpeg: TJPEGImage; myStream: TADOBlobStream; ImgMaxNo: string; i, j: Integer; PatFile: string; FConNo, MaxNo: string; begin if Image2.Picture = nil then Exit; AJpeg := TJpegImage.Create(); 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(FTFID); FieldByName('WBID').Value := Trim(CYID); FieldByName('TFType').Value := '样品'; AJpeg.Assign(Image2.Picture.Graphic); myStream := TADOBlobStream.Create(TBlobField(ADOQueryCmd.FieldByName('FilesOther')), bmWrite); AJpeg.Assign(Image2.Picture.Graphic); AJpeg.SaveToStream(myStream); myStream.Free; Post; end; end; procedure TfrmFileUp4.FormCreate(Sender: TObject); begin lstPat := TStringList.Create; end; procedure TfrmFileUp4.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 TFID=''' + Trim(ADOQueryFile.fieldbyname('XFID').AsString) + ''''); ExecSQL; end; with ADOQueryFile do begin Close; SQL.Clear; SQL.Add('select * from XD_File where CYID=''' + Trim(CYID) + ''''); SQL.Add(' and FileType=''FM'''); open; end; // if ADOQueryFile.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; end; procedure TfrmFileUp4.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=''FM'''); Open; end; end; end.