unit U_FileUp; 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 TfrmFileUp = 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(); procedure ReadINIFile10(); { Private declarations } public CYID:String; { Public declarations } end; var frmFileUp: TfrmFileUp; implementation uses U_DataLink,U_RTFun; {$R *.dfm} procedure TfrmFileUp.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.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 where CYID='''+Trim(CYID)+''''); 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 try {if not DirectoryExists('D:\ͼƬ\'+Trim(gDef1)) then ForceDirectories('D:\ͼƬ\'+Trim(gDef1)); } IdFTP1.Put(lstPat[i], Trim('\YP')+'\'+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=''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,'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('YP'); Post; end; except //ADOQueryCmd.Connection.RollbackTrans; //Application.MessageBox('ͼƬ�ϴ�ʧ�ܣ�','��ʾ',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 TfrmFileUp.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.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 TfrmFileUp.FormCreate(Sender: TObject); begin lstPat := TStringList.Create; end; procedure TfrmFileUp.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 ADOQueryFile do begin Close; SQL.Clear; SQL.Add('select * from XD_File where CYID='''+Trim(CYID)+''''); SQL.Add(' and FileType=''YP'''); 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 TfrmFileUp.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=''YP'''); Open; end; end; end.