unit U_FileUp_TPSH; 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_TPSH = 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; Label2: TLabel; Image2: TImage; ToolButton1: TToolButton; SC_TP: TClientDataSet; procedure FileUpClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FileDelClick(Sender: TObject); procedure CreThumb(AJPeg:TJPEGImage;Image1:TImage;Width, Height: Integer); procedure FormShow(Sender: TObject); procedure ToolButton1Click(Sender: TObject); private lstPat: TStringList; AJpeg: TJPEGImage; procedure ReadINIFile10(); { Private declarations } public CYID,FSKID:String; { Public declarations } end; var frmFileUp_TPSH: TfrmFileUp_TPSH; implementation uses U_DataLink,U_Fun; {$R *.dfm} procedure TfrmFileUp_TPSH.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_TPSH.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_TPSH.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 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; with ADOQueryTemp do begin Close; SQL.Clear; SQL.Add('select Count(*) MM from XD_File where CYNO='''+Trim(Code.Text)+''''); SQL.Add('and filetype=''YP'''); Open; j:=fieldbyname('MM').AsInteger; end; try AJpeg:=TJpegImage.Create(); 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)) ); if GetLSNo(ADOQueryCmd,FConNo,'S','XD_File',3,0)=False then begin ADOQueryCmd.Connection.RollbackTrans; Application.MessageBox('取图片最大号失败!','提示',0); Exit; end; PatFile:=Trim(Code.Text)+Trim(FConNo)+'.'+PatFile; AJpeg.LoadFromFile(ExtractFileName(lstPat[i])); CreThumb(AJpeg,Image2,160, 120); if IdFTP1.Connected then begin IdFTP1.Put(lstPat[i], 'YP'+'\'+Trim(PatFile)); if GetLSNo(ADOQueryCmd,CYID,'H','XD_File',4,1)=False then begin ADOQueryCmd.Connection.RollbackTrans; Application.MessageBox('取图片最大号失败!','提示',0); Exit; end; 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=''YP'''); Open; if not IsEmpty then begin Panel16.Visible:=False; Application.MessageBox(PChar('文件<'+Trim(PatFile)+'>重复,'+inttostr(i)+'个文件上传成功!'),'提示',0); Exit; end; end; if GetLSNo(ADOQueryCmd,MaxNo,'SS','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('SKID').Value:=Trim(FSKID); FieldByName('filename').Value:=Trim(PatFile); FieldByName('FileDate').Value:=SGetServerDate(ADOQueryTemp); fieldbyname('FileType').value:=Trim('YP'); Post; end; with ADOQueryCmd do begin close; sql.Clear; sql.Add(' select * from TP_File where TFID='''+Trim(MaxNo)+''''); //ShowMessage(sql.Text); 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; end; end; 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 CYNo='''+Trim(Code.Text)+''''); open; end; Panel16.Visible:=False; if i>0 then Application.MessageBox(PChar(inttostr(i)+'个文件上传成功!'),'提示',0); ModalResult:=1; end; procedure TfrmFileUp_TPSH.FormCreate(Sender: TObject); begin lstPat := TStringList.Create; end; procedure TfrmFileUp_TPSH.FileDelClick(Sender: TObject); begin if SC_TP.isempty then exit; with ADOQueryCmd do begin Close; sql.Clear; SQL.Add(' Delete XD_File where XFID='''+Trim(SC_TP.fieldbyname('XFID').AsString)+''''); ExecSQL; end; SC_TP.Delete; end; procedure TfrmFileUp_TPSH.FormShow(Sender: TObject); begin with ADOQueryFile do begin Close; SQL.Clear; SQL.Add('select * from XD_File where CYNo='''+Trim(Code.Text)+''''); SQL.Add(' and FileType=''YP'''); Open; end; SCreateCDS20(ADOQueryFile,SC_TP); SInitCDSData20(ADOQueryFile,SC_TP); end; procedure TfrmFileUp_TPSH.ToolButton1Click(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 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; try AJpeg:=TJpegImage.Create(); 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)) ); if GetLSNo(ADOQueryCmd,FConNo,'','XD_File',3,0)=False then begin ADOQueryCmd.Connection.RollbackTrans; Application.MessageBox('取图片最大号失败!','提示',0); Exit; end; PatFile:=Trim(Code.Text)+Trim(FConNo)+'.'+PatFile; AJpeg.LoadFromFile(ExtractFileName(lstPat[i])); CreThumb(AJpeg,Image2,160, 120); if IdFTP1.Connected then begin try IdFTP1.Put(lstPat[i], 'YP'+'\'+Trim(PatFile)); if GetLSNo(ADOQueryCmd,CYID,'CY','XD_File',4,1)=False then begin ADOQueryCmd.Connection.RollbackTrans; Application.MessageBox('取图片最大号失败!','提示',0); Exit; end; 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=''YP'''); Open; if not IsEmpty then begin Panel16.Visible:=False; Application.MessageBox(PChar('文件<'+Trim(PatFile)+'>重复,'+inttostr(i)+'个文件上传成功!'),'提示',0); Exit; end; end; with ADOQueryCmd do begin Close; SQL.Clear; SQL.Add('select * from XD_File 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); fieldbyname('FileType').value:=Trim('YP'); Post; end; with ADOQueryCmd do begin close; sql.Clear; sql.Add(' select * from TP_File where TFID='''+Trim(SC_TP.fieldbyname('XFID').AsString)+''''); //ShowMessage(sql.Text); open; end; with ADOQueryCmd do begin Edit; FieldByName('Editer').Value:=Trim(DName); FieldByName('EditTime').Value:=SGetServerDateTime(ADOQueryTemp); myStream := TADOBlobStream.Create(TBlobField(ADOQueryCmd.FieldByName('FilesOther')), bmWrite); AJpeg.Assign(Image2.Picture.Graphic); AJpeg.SaveToStream(myStream); myStream.Free; Post; end; except //ADOQueryCmd.Connection.RollbackTrans; //Application.MessageBox('图片上传失败!','提示',0); end; end; end; 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 CYNo='''+Trim(Code.Text)+''''); open; end; Panel16.Visible:=False; if i>0 then Application.MessageBox(PChar(inttostr(i)+'个文件上传成功!'),'提示',0); ModalResult:=1; end; end.